What Discrete Optimization family is this? - language-agnostic

Question

I am given N lists of M items that will be physically realized (someone actually has to put items (names abbreviated here,) in physical bins.) Then the bins are emptied, if necessary, and re-used, working left-to-right. There is a real cost to putting a different item in a bin than what was in it before. I rearrange the lists to minimize changes, manually. Software can do it faster, and more reliably in an optimum way. The whole thing happens in Excel (then paper, then in a factory.) I wrote some VBA, a brute-force affair, that did really well with some examples. But not all. If I knew the family of optimization that this is, I could code it, even if I just pass something to a DLL. But multiple searches online have not succeeded. I tried several phrasings. It's not a traveling S.., knapsack, etc. It seems similar to the Sequence Alignment problem from Bioinformatics. Someone recognize it? Let's hear it, Operations Research people.

Answer 1

As it turns out, the naive solution just needed tweaking. Look at a cell. Try to find the same letter in the column to it's right. If you find one, swap it with whatever it to the right of that cell now. Work your way down. The ColumnsPer parameter accounts for the real-world use, where each column has an associated list of numbers and the grid columns alternate labels, numbers, labels, ...
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