For the impatient, like me, here is a very clean implementation of the Hungarian alogorim in C # here , and there was a quick test setup to solve the problem. Problem with OP:
Module Module1 Sub Main() test1() End Sub Sub test1() Dim menus() As String = {"File", "Fiddle", "Forest", "Fangle", "Edit", "Entity", "Entropy", "Eviction", "View", "Vixen", "Visible", "Window", "Wait", "What", "Tools", "Time", "Total", "Tea"} Dim items As Integer = menus.GetUpperBound(0) Dim alphabet As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" Dim letters As Integer = alphabet.Length - 1 Dim costs(items, letters) As Integer Dim cost As Integer Dim ch As String Dim o As Integer Dim longest As Integer = 0 For i = 0 To items cost = 1 If menus(i).Length > longest Then longest = menus(i).Length End If For j = 0 To menus(i).Length - 1 ch = menus(i).Substring(j, 1) o = alphabet.IndexOf(ch, StringComparison.InvariantCultureIgnoreCase) If costs(i, o) = 0 Then ' Don't overwrite when same letter more than once in word costs(i, o) = cost cost += 2 End If Next For j = 0 To letters If costs(i, j) = 0 Then costs(i, j) = 99 End If Next Next longest += 1 For r = 1 To 2 Console.Write("".PadRight(longest)) For i = 0 To letters Console.Write(alphabet.Substring(i, 1).PadLeft(3)) Next Console.WriteLine("") For i = 0 To items Console.Write(menus(i).PadRight(longest)) For j = 0 To letters Console.Write(costs(i, j).ToString.PadLeft(3)) Next Console.WriteLine("") Next If r = 1 Then Dim h As New HungarianAlgorithm Dim result() As Integer result = h.FindAssignments(costs) Console.WriteLine("Answer:") For i = 0 To items Console.WriteLine(menus(i).PadRight(longest) & alphabet.Substring(result(i), 1)) Next End If Next r End Sub
End module
source share