update algorithm to deal with the ultra large dataset

Author: xieguigang

Data_science/Mathematica/SignalProcessing/SignalProcessing/KalmanFilter/HungarianAlgorithm.vb

@@ -61,6 +61,7 @@
 #End Region
 
 Imports System.Runtime.CompilerServices
+Imports Microsoft.VisualBasic.ComponentModel.Collection
 Imports Microsoft.VisualBasic.Math.LinearAlgebra.Matrix
 Imports std = System.Math
 
@@ -97,19 +98,19 @@ Namespace HungarianAlgorithm
         ''' is the column of the task assigned to agent <em>i</em>.</returns>
         ''' <exception cref="ArgumentNullException"><paramref name="costs"/> is null.</exception>
         <Extension()>
-        Public Function FindAssignments(costs As Double(,)) As Integer()
-            Dim h = costs.GetLength(0)
-            Dim w = costs.GetLength(1)
+        Public Function FindAssignments(costs As Double()()) As Integer()
+            Dim h = costs.Length
+            Dim w = costs(0).Length
             Dim rowsGreaterThanCols = h > w
 
             If rowsGreaterThanCols Then
                 ' make sure cost matrix has number of rows greater than columns
                 Dim row = w
                 Dim col = h
-                Dim transposeCosts = New Double(row - 1, col - 1) {}
+                Dim transposeCosts As Double()() = RectangularArray.Matrix(Of Double)(row, col)
                 For i As Integer = 0 To row - 1
                     For j As Integer = 0 To col - 1
-                        transposeCosts(i, j) = costs(j, i)
+                        transposeCosts(i)(j) = costs(j)(i)
                     Next
                 Next
                 costs = transposeCosts
@@ -121,22 +122,22 @@ Namespace HungarianAlgorithm
                 Dim min As Double = Double.MaxValue
 
                 For j As Integer = 0 To w - 1
-                    min = std.Min(min, costs(i, j))
+                    min = std.Min(min, costs(i)(j))
                 Next
 
                 For j As Integer = 0 To w - 1
-                    costs(i, j) -= min
+                    costs(i)(j) -= min
                 Next
             Next
 
-            Dim masks = New Byte(h - 1, w - 1) {}
+            Dim masks As Byte()() = RectangularArray.Matrix(Of Byte)(h, w)
             Dim rowsCovered = New Boolean(h - 1) {}
             Dim colsCovered = New Boolean(w - 1) {}
 
             For i As Integer = 0 To h - 1
                 For j As Integer = 0 To w - 1
-                    If costs(i, j) = 0.0 AndAlso Not rowsCovered(i) AndAlso Not colsCovered(j) Then
-                        masks(i, j) = 1
+                    If costs(i)(j) = 0.0 AndAlso Not rowsCovered(i) AndAlso Not colsCovered(j) Then
+                        masks(i)(j) = 1
                         rowsCovered(i) = True
                         colsCovered(j) = True
                     End If
@@ -145,8 +146,8 @@ Namespace HungarianAlgorithm
 
             Call ClearCovers(rowsCovered, colsCovered, w, h)
 
-            Dim path = New Location(w * h - 1) {}
-            Dim pathStart As Location = Nothing
+            Dim path = New(row As Integer, column As Integer)(w * h - 1) {}
+            Dim pathStart As (row As Integer, column As Integer) = Nothing
             Dim [step] = 1
 
             While [step] <> -1
@@ -167,7 +168,7 @@ Namespace HungarianAlgorithm
 
             For i As Integer = 0 To h - 1
                 For j As Integer = 0 To w - 1
-                    If masks(i, j) = 1 Then
+                    If masks(i)(j) = 1 Then
                         agentsTasks(i) = j
                         Exit For
                     Else
@@ -191,10 +192,10 @@ Namespace HungarianAlgorithm
             Return agentsTasks
         End Function
 
-        Private Function RunStep1(masks As Byte(,), colsCovered As Boolean(), w As Integer, h As Integer) As Integer
+        Private Function RunStep1(ByRef masks As Byte()(), ByRef colsCovered As Boolean(), w As Integer, h As Integer) As Integer
             For i As Integer = 0 To h - 1
                 For j As Integer = 0 To w - 1
-                    If masks(i, j) = 1 Then colsCovered(j) = True
+                    If masks(i)(j) = 1 Then colsCovered(j) = True
                 Next
             Next
 
@@ -209,14 +210,19 @@ Namespace HungarianAlgorithm
             Return 2
         End Function
 
-        Private Function RunStep2(costs As Double(,), masks As Byte(,), rowsCovered As Boolean(), colsCovered As Boolean(), w As Integer, h As Integer, ByRef pathStart As Location) As Integer
+        Private Function RunStep2(ByRef costs As Double()(),
+                                  ByRef masks As Byte()(),
+                                  ByRef rowsCovered As Boolean(),
+                                  ByRef colsCovered As Boolean(),
+                                  w As Integer, h As Integer,
+                                  ByRef pathStart As (row As Integer, column As Integer)) As Integer
             While True
                 Dim loc = FindZero(costs, rowsCovered, colsCovered, w, h)
 
                 If loc.row = -1 Then
                     Return 4
                 Else
-                    masks(loc.row, loc.column) = 2
+                    masks(loc.row)(loc.column) = 2
                 End If
 
                 Dim starCol = FindStarInRow(masks, w, loc.row)
@@ -233,7 +239,13 @@ Namespace HungarianAlgorithm
             Throw New Exception("never!")
         End Function
 
-        Private Function RunStep3(masks As Byte(,), rowsCovered As Boolean(), colsCovered As Boolean(), w As Integer, h As Integer, path As Location(), pathStart As Location) As Integer
+        Private Function RunStep3(ByRef masks As Byte()(),
+                                  ByRef rowsCovered As Boolean(),
+                                  ByRef colsCovered As Boolean(),
+                                  w As Integer, h As Integer,
+                                  path As (row As Integer, column As Integer)(),
+                                  pathStart As (row As Integer, column As Integer)) As Integer
+
             Dim pathIndex As Integer = 0
             path(0) = pathStart
 
@@ -242,12 +254,12 @@ Namespace HungarianAlgorithm
                 If row = -1 Then Exit While
 
                 pathIndex += 1
-                path(pathIndex) = New Location(row, path(pathIndex - 1).column)
+                path(pathIndex) = (row, path(pathIndex - 1).column)
 
                 Dim col = FindPrimeInRow(masks, w, path(pathIndex).row)
 
                 pathIndex += 1
-                path(pathIndex) = New Location(path(pathIndex - 1).row, col)
+                path(pathIndex) = (path(pathIndex - 1).row, col)
             End While
 
             ConvertPath(masks, path, pathIndex + 1)
@@ -257,93 +269,121 @@ Namespace HungarianAlgorithm
             Return 1
         End Function
 
-        Private Function RunStep4(costs As Double(,), rowsCovered As Boolean(), colsCovered As Boolean(), w As Integer, h As Integer) As Integer
-            Dim minValue = FindMinimum(costs, rowsCovered, colsCovered, w, h)
+        Private Function RunStep4(ByRef costs As Double()(),
+                                  ByRef rowsCovered As Boolean(),
+                                  ByRef colsCovered As Boolean(),
+                                  w As Integer, h As Integer) As Integer
+
+            Dim minValue As Double = FindMinimum(costs, rowsCovered, colsCovered, w, h)
 
             For i As Integer = 0 To h - 1
                 For j As Integer = 0 To w - 1
-                    If rowsCovered(i) Then costs(i, j) += minValue
-                    If Not colsCovered(j) Then costs(i, j) -= minValue
+                    If rowsCovered(i) Then
+                        costs(i)(j) += minValue
+                    End If
+                    If Not colsCovered(j) Then
+                        costs(i)(j) -= minValue
+                    End If
                 Next
             Next
 
             Return 2
         End Function
 
-        Private Function FindMinimum(costs As Double(,), rowsCovered As Boolean(), colsCovered As Boolean(), w As Integer, h As Integer) As Double
+        Private Function FindMinimum(ByRef costs As Double()(),
+                                     ByRef rowsCovered As Boolean(),
+                                     ByRef colsCovered As Boolean(),
+                                     w As Integer, h As Integer) As Double
+
             Dim minValue = Double.MaxValue
 
             For i As Integer = 0 To h - 1
                 For j As Integer = 0 To w - 1
                     If Not rowsCovered(i) AndAlso Not colsCovered(j) Then
-                        minValue = std.Min(minValue, costs(i, j))
+                        minValue = std.Min(minValue, costs(i)(j))
                     End If
                 Next
             Next
 
             Return minValue
         End Function
 
-        Private Function FindStarInRow(masks As Byte(,), w As Integer, row As Integer) As Integer
+        Private Function FindStarInRow(ByRef masks As Byte()(), w As Integer, row As Integer) As Integer
             For j As Integer = 0 To w - 1
-                If masks(row, j) = 1 Then Return j
+                If masks(row)(j) = 1 Then
+                    Return j
+                End If
             Next
 
             Return -1
         End Function
 
-        Private Function FindStarInColumn(masks As Byte(,), h As Integer, col As Integer) As Integer
+        Private Function FindStarInColumn(ByRef masks As Byte()(), h As Integer, col As Integer) As Integer
             For i As Integer = 0 To h - 1
-                If masks(i, col) = 1 Then Return i
+                If masks(i)(col) = 1 Then
+                    Return i
+                End If
             Next
 
             Return -1
         End Function
 
-        Private Function FindPrimeInRow(masks As Byte(,), w As Integer, row As Integer) As Integer
+        Private Function FindPrimeInRow(ByRef masks As Byte()(), w As Integer, row As Integer) As Integer
             For j As Integer = 0 To w - 1
-                If masks(row, j) = 2 Then Return j
+                If masks(row)(j) = 2 Then
+                    Return j
+                End If
             Next
 
             Return -1
         End Function
 
-        Private Function FindZero(costs As Double(,), rowsCovered As Boolean(), colsCovered As Boolean(), w As Integer, h As Integer) As Location
+        Private Function FindZero(ByRef costs As Double()(),
+                                  ByRef rowsCovered As Boolean(),
+                                  ByRef colsCovered As Boolean(), w As Integer, h As Integer) As (row As Integer, column As Integer)
+
             For i As Integer = 0 To h - 1
                 For j As Integer = 0 To w - 1
-                    If costs(i, j) = 0.0 AndAlso Not rowsCovered(i) AndAlso Not colsCovered(j) Then
-                        Return New Location(i, j)
+                    If costs(i)(j) = 0.0 AndAlso Not rowsCovered(i) AndAlso Not colsCovered(j) Then
+                        Return (i, j)
                     End If
                 Next
             Next
 
-            Return New Location(-1, -1)
+            Return (-1, -1)
         End Function
 
-        Private Sub ConvertPath(masks As Byte(,), path As Location(), pathLength As Integer)
+        Private Sub ConvertPath(ByRef masks As Byte()(),
+                                ByRef path As (row As Integer, column As Integer)(),
+                                pathLength As Integer)
+
             For i As Integer = 0 To pathLength - 1
-                Dim x = masks(path(i).row, path(i).column)
+                Dim x = masks(path(i).row)(path(i).column)
 
                 Select Case x
                     Case 1
                         x = 0
                     Case 2
                         x = 1
                     Case Else
-                        x = masks(path(i).row, path(i).column)
+                        x = masks(path(i).row)(path(i).column)
                 End Select
 
-                masks(path(i).row, path(i).column) = x
+                masks(path(i).row)(path(i).column) = x
             Next
         End Sub
-        Private Sub ClearPrimes(masks As Byte(,), w As Integer, h As Integer)
+
+        Private Sub ClearPrimes(ByRef masks As Byte()(), w As Integer, h As Integer)
             For i As Integer = 0 To h - 1
                 For j As Integer = 0 To w - 1
-                    If masks(i, j) = 2 Then masks(i, j) = 0
+                    If masks(i)(j) = 2 Then
+                        masks(i)(j) = 0
+                    End If
                 Next
             Next
         End Sub
-        Private Sub ClearCovers(rowsCovered As Boolean(), colsCovered As Boolean(), w As Integer, h As Integer)
+
+        Private Sub ClearCovers(ByRef rowsCovered As Boolean(), ByRef colsCovered As Boolean(), w As Integer, h As Integer)
             For i As Integer = 0 To h - 1
                 rowsCovered(i) = False
             Next
@@ -352,16 +392,5 @@ Namespace HungarianAlgorithm
                 colsCovered(j) = False
             Next
         End Sub
-
-        Private Structure Location
-
-            Friend ReadOnly row As Integer
-            Friend ReadOnly column As Integer
-
-            Friend Sub New(row As Integer, col As Integer)
-                Me.row = row
-                Me.column = col
-            End Sub
-        End Structure
     End Module
 End Namespace