2017-04-12 107 views
5

我正在尝试为组平衡问题产生一个初始解决方案,但我似乎被卡在了一些听起来应该很简单的东西上。基本上我有一个权重(随机整数)的数组,例如,从最小到最大的元素索引

W() = [1, 4, 3, 2, 5, 3, 2, 1] 

并且我想要分别创建代替的最小到最大的数字与数字1到阵列的大小相同长度的另一阵列,例如

S() = [1, 7, 5, 3, 8, 6, 4, 2] 

对于重复,第一次出现被视为指数中较小的一个。

我最初使用了BubbleSort算法,但不幸的是,这不允许我以所需的格式输出结果。

据我所知,这是一个相当具体的问题,但任何帮助将不胜感激。

+1

这是否需要在内存中做了什么?如果没有,你几乎肯定会更好地将值放入电子表格并使用内置函数来完成此操作 – User632716

回答

0

非常感谢大家给予的帮助!

尽管花了整整一天的时间研究一些与我的整体项目无关的事情,但我采纳了您的建议并以某种方式设法形成了自己的解决方案。

这里是下面的代码我使用:

Sub InitialSol(S() As Integer, n As Integer, k As Integer, W() As Long) 
Dim i As Integer, c As Integer 
Dim min As Long, max As Long, temp As Long 

min = W(1) 
max = W(1) 
For i = 2 To n 
    If W(i) <= min Then 
     min = W(i) 
    End If 
    If W(i) >= max Then 
     max = W(i) 
    End If 
Next i 

c = 1 
Do While c <= n 
    temp = max 
    For i = 1 To n 
     If W(i) = min Then 
      S(i) = c 
      c = c + 1 
     End If 
    Next i 
    For i = 1 To n 
     If W(i) > min And W(i) <= temp Then 
      temp = W(i) 
     End If 
    Next i 
    min = temp 
Loop 

End Sub 
1

你必须找到一种方法来粘合值(内容)和索引。 正如您已经标记了excel-vba,我建议您将数据写入工作表,第一列为值,第二列为索引,并使用range.sort对其进行排序。之后,第二列保存您的订单

如果使用Excel不是一个选项,我可以考虑的最好的方法是创建一个Scripting.Dictionary(以索引作为关键字)并对其进行排序(在函数中没有构建函数进行排序,但Google上搜寻它,你可以找到一些例子。

或者你可以做一些丑陋如创建双打的从你的数据与小数部分列保持你的索引 [1.001, 4.002, 3.003, 2.004, 5.005, 3.006, 2.007, 1.008],排序这一点,得到了小数和繁殖他们回整数

2

试试看,并告诉我它是如何工作的:

Option Base 0 
Option Explicit 
Option Compare Text 

Sub tmpSO() 

Dim tmp As Double 
Dim strJoin As String 
Dim i As Long, j As Long 
Dim W As Variant, S() As Double, X() As Long 

'Load W 
W = Array(1, 4, 3, 2, 5, 3, 2, 1) 

'Set the dimensions for the other arrays 
ReDim S(LBound(W) To UBound(W)) 
ReDim X(LBound(W) To UBound(W)) 

'Copy W into S 
For i = LBound(W) To UBound(W) 
    S(i) = W(i) 
Next i 

'Sort S 
For i = LBound(S) To UBound(S) - 1 
    For j = i + 1 To UBound(S) 
     If S(i) > S(j) Then 
      tmp = S(j) 
      S(j) = S(i) 
      S(i) = tmp 
     End If 
    Next j 
Next i 

'Get the results into X 
For i = LBound(S) To UBound(S) 
    X(i) = WorksheetFunction.Match(W(i), S, 0) 
    S(WorksheetFunction.Match(W(i), S, 0) - 1) = vbEmpty 
Next i 

'Print out W (original array) 
Debug.Print Join(W, ",") 

'Print out x (result array) 
For i = LBound(X) To UBound(X) 
    strJoin = strJoin & "," & X(i) 
Next i 
Debug.Print mid(strJoin, 2) 

End Sub 
+0

好的回答@Ralph –