這是什么離散優化系列？

Question

我得到了 N 個 M 項目的列表，這些項目將在物理上實現（實際上必須有人將項目（這里縮寫的名稱）放入物理箱中。）然后，如果需要，這些箱被清空，並重新使用，從左到 -正確的。 將與之前放入的物品不同的物品放入垃圾箱中會產生實際成本。 我手動重新排列列表以最小化更改。 軟件可以以最佳方式更快、更可靠地做到這一點。 整個事情發生在 Excel 中（然后是紙，然后是在工廠。）我寫了一些 VBA，一個蠻力事件，在一些例子中做得很好。 但不是所有的。 如果我知道這是優化系列，我可以對其進行編碼，即使我只是將某些內容傳遞給 DLL。 但是網上多次搜索都沒有成功。 我嘗試了幾個措辭。 它不是旅行 S..、背包等。它似乎類似於 Bioinformatics 中的 Sequence Alignment 問題。 有人認得嗎？ 讓我們聽聽，運籌學的人。

Answer 1

事實證明，這個幼稚的解決方案只需要調整即可。 看一個細胞。 嘗試在右側的列中找到相同的字母。 如果你找到了，現在把它和那個單元格右邊的任何東西交換。 向下工作。 ColumnsPer 參數說明了實際使用情況，其中每列都有一個關聯的數字列表，網格列交替使用標簽、數字、標簽……

Option Explicit
Public Const Row1 As Long = 4
Public Const ColumnsPer As Long = 1  '2, when RM, % 
Public Const BinCount As Long = 6  
Public Const ColCount As Long = 6

Private Sub reorder_items_max_left_to_right_repeats(wksht As Worksheet, _
    col1 As Long, maxBins As Long, maxRecipes As Long, ByVal direction As Integer)

    Dim here As Range
    Set here = wksht.Cells(Row1, col1)
        here.Activate
        
    Dim cond
    For cond = 1 To maxRecipes - 1
        Do While WithinTheBox(here, col1, direction)
            If Not Adjacent(here, ColumnsPer).Value = here.Value Then
                   Dim there As Range
                   Set there = Matching_R_ange(here, direction)
                If Not there Is Nothing Then swapThem Adjacent(here, ColumnsPer), there
            End If
NextItemDown:
            Set here = here.Offset(direction, 0)
                here.Activate
                'Debug.Assert here.Address <> "$AZ$6"
          DoEvents
        Loop
NextCond:
        Select Case direction
            Case 1
                Set here = Cells(Row1, here.Column + ColumnsPer)
            Case -1
                Set here = Cells(Row1 + maxBins - 1, here.Column + ColumnsPer)
        End Select
        here.Activate
    Next cond
End Sub

Function Adjacent(fromHereOnLeft As Range, colsRight As Long) As Range
    Set Adjacent = fromHereOnLeft.Offset(0, colsRight)
End Function

Function Matching_R_ange(fromHereOnLeft As Range, _
                         ByVal direction As Integer) As Range
    
    Dim rowStart As Long
        rowStart = Row1
        
    Dim colLook As Long
        colLook = fromHereOnLeft.Offset(0, ColumnsPer).Column
        
    Dim c As Range
    Set c = Cells(rowStart, colLook)
    
    Dim col1 As Long
    col1 = c.Column
    
    Do While WithinTheBox(c, col1, direction)
        Debug.Print "C " & c.Address
    
        If c.Value = fromHereOnLeft.Value _
        And c.Row <> fromHereOnLeft.Row Then
            Set Matching_R_ange = c
            Exit Function
        Else
                Set c = c.Offset(1 * direction, 0)
        End If
      DoEvents
    Loop
    'returning NOTHING is expected, often
End Function

Function WithinTheBox(ByVal c As Range, ByVal col1 As Long, ByVal direction As Integer)
    Select Case direction
        Case 1
            WithinTheBox = c.Row <= Row1 + BinCount - 1 And c.Row >= Row1
        Case -1
            WithinTheBox = c.Row <= Row1 + BinCount - 1 And c.Row > Row1
    End Select
    WithinTheBox = WithinTheBox And _
               c.Column >= col1 And c.Column < col1 + ColCount - 1
End Function

Private Sub swapThem(range10 As Range, range20 As Range)
    'Unlike with SUB 'Matching_R_ange', we have to swap the %s as well as the items
    'So set temporary range vars to hold %s, to avoid confusion due to referencing items/r_anges
    If ColumnsPer = 2 Then
        Dim range11 As Range
        Set range11 = range10.Offset(0, 1)
        
        Dim range21 As Range
        Set range21 = range20.Offset(0, 1)
        'sit on them for now
    End If
    
    Dim Stak As Object
    Set Stak = CreateObject("System.Collections.Stack")
        Stak.push (range10.Value)           'A
        Stak.push (range20.Value)           'BA
                   range10.Value = Stak.pop 'A
                   range20.Value = Stak.pop '_  Stak is empty now, can re-use
                   
    If ColumnsPer = 2 Then
        Stak.push (range11.Value)
        Stak.push (range21.Value)
                   range11.Value = Stak.pop
                   range21.Value = Stak.pop
    End If
End Sub