【问题标题】:Indices of elements in order from smallest to largest元素索引从小到大
【发布时间】:2017-09-08 04:27:14
【问题描述】:

我正在尝试为组平衡问题生成一个初始解决方案,但我似乎被困在听起来应该很简单的事情上。

基本上我有一个权重数组(随机整数),例如

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

我想创建另一个长度相同的数组,其中数字 1 到数组的大小分别代替最小到最大的数字,例如

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

对于重复项,第一次出现被视为较小的索引。

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

我知道这是一个非常具体的问题,但我们将不胜感激。

【问题讨论】:

  • 这需要在内存中完成吗?如果不是,您几乎肯定会更好地将值放入电子表格并使用内置函数来执行此操作

标签: arrays vba excel max min


【解决方案1】:

您必须找到一种方法将值(内容)和索引粘合在一起。 正如您使用excel-vba 标记的那样,我建议您将数据写入工作表,第一列是值,第二列是索引,然后使用range.sort 对它们进行排序。之后,第二列保存您的订单

如果不能使用 Excel,我能想到的最好办法是创建一个 Scripting.Dictionary(以索引为键)并对其进行排序(没有内置函数对其进行排序,但谷歌搜索你可以找到一些例子。

或者你可以做一些丑陋的事情,比如用你的数据创建一个双精度数组,小数部分保存你的索引 [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
    

    【讨论】:

    • 不错的答案@Ralph
    【解决方案3】:

    非常感谢所有提供帮助的人!

    尽管我花了一整天的时间在一些与我的整个项目无关的事情上,但我还是采纳了你的建议并设法打造了我自己的解决方案。

    这是我使用的以下代码:

    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
    

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2018-10-17
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多