VB - 用於顯示多個結果的二進制搜索算法（二維數組）

Question

我正在用VB編寫一個程序，它將從文件中對聯繫人列表（二維數組）進行排序，然後使用Binary Search Algorithm找到名稱starting withuser input。然後我顯示找到的姓名，以及他們的聯繫信息。問題是Binary Search Algorithm只搜索了一個的名字。我需要找到全部的名稱start withuser input。

這是到目前爲止我的代碼：

Dim found As Boolean = False 
Dim search as String = txtInput.Text 

Do 
    middle = CInt((first + last)/2) 'calcuate the middle position of the scope 

    If contacts(middle, 1).ToLower.StartsWith(search) Then 'if the middle name starts with the search String 
     found = True 'name was found 
    ElseIf contacts(middle, 1).ToLower < search Then 'if the search name comes after the middle position's value 
     first = middle + 1 'move the first position to be 1 below the middle 
    ElseIf contacts(middle, 1).ToLower > search Then 'if the search name comes before the middle position's value 
     last = middle - 1 'move the last position to be 1 above the middle 
    End If 

Loop Until first > last Or found = True 'loop until the name is not found or the name is found 

If found = True Then 
    For x = 0 To 4 'display the whole list of data for that name 
     txtDisplay.Text += contacts(middle,x).padLeft(15) 
    Loop 
End If 

Answer 1

您將需要創建另一個數組來跟蹤找到的名稱。

想想這樣：你找到一個名字，你想找到另一個名字。那麼，名稱的其餘名稱有將位於名稱的上方和/或下方。 因此，使用while循環來檢查上面和下面的名稱是否與輸入匹配，如果是，請將它們添加到數組中。

首先，創建將決定召開所有名稱所需要的數組的大小的程序（需要設置大小，然後才能設置值）：

'make sure the array is passed as ByRef because it needs to be changed 
Private Sub determineSize(ByVal middle As Integer, ByVal search As String, ByRef foundNames() As Integer) 

    'middle1 and middle2 as the positions (above and below) of the middle position in the search scope 
    Dim middle1 As Integer = middle, middle2 As Integer = middle 
    Dim foundTrack As Integer = 0 'number of names found 

    Do While contacts(middle1, 1).ToLower.StartsWith(search) 
     foundTrack += 1 '1 more name has been found 

     If middle1 > 0 Then 'if there are any positions above the current one 
      middle1 -= 1 'move up 1 
     Else 
      Exit Do 
     End If 
    Loop 

    If middle < UBound(contacts, 1) Then 'if there are more names below the current one 
     middle2 += 1 'this will help to not have a duplicate name from the other list 

     Do While contacts(middle2, 1).ToLower.StartsWith(search) 

      foundTrack += 1 'Add 1 to the name found tracker. 

      If middle2 < UBound(contacts, 1) Then 'if there are any positions below the current one 
       middle2 += 1 'move the position down to check for another name on the list 
      Else 
       Exit Do 
      End If 
     Loop 
    End If 

    ReDim foundNames(foundTrack - 1) 'set the size to be 1 less than the names found 
End Sub 

然後創建一個過程，將找到所有的名字，並指定這些位置的foundNames陣列：

Private Sub FindNames(ByVal middle As Integer, ByVal search As String, ByVal foundNames(,) As String) 

    Dim foundTrack As Integer = 0 'number of names found 
    'middle1 and middle2 as the positions (above and below) of the middle position in the search scope 
    Dim middle1 As Integer = middle, middle2 As Integer = middle 

    Do While contacts(middle1, 1).ToLower.StartsWith(search) 
     foundTrack += 1 '1 more name has been found 
     foundNames(foundTrack - 1) = middle 'set the position in the array to be the position of the name found 

     If middle1 > 0 Then 'if there are any positions above the current one 
      middle1 -= 1 'move up 1 
     Else 
      Exit Do 
     End If 
    Loop 

    If middle < UBound(contacts, 1) Then 'if there are more names on the list below the current position 
     middle2 += 1 'this will help to not have a duplicate name from the other list 

     Do While contacts(middle2, 1).ToLower.StartsWith(search) 

      foundTrack += 1 'Add 1 to the name found tracker. 

      If middle2 < UBound(contacts, 1) Then 'if there are any positions below the current one 
       middle2 += 1 'move the position down to check for another name on the list 
      Else 
       Exit Do 
      End If 
     Loop 
    End If 
End Sub 

然後，只需編輯您以前Binary Search Algorithm將這些程序：

Dim found As Boolean = False 
Dim search as String = txtInput.Text 
Dim foundNames() As Integer 'array that holds the row position of each of the found names 

Do 
    middle = CInt((first + last)/2) 'calcuate the middle position of the scope 

    If contacts(middle, 1).ToLower.StartsWith(search) Then 'if middle name starts with search string 
     found = True 'keep track of the fact that the name was found. 
     Call determineSize(middle, search, foundNames) 
     Call findNames(middle, search, foundNames) 
    ElseIf contacts(middle, 1).ToLower < search Then 'if the search name comes after the middle position's value 
     first = middle + 1 'move the first position to be 1 below the middle 
    ElseIf contacts(middle, 1).ToLower > search Then 'if the search name comes before the middle position's value 
     last = middle - 1 'move the last position to be 1 above the middle 
    End If 

Loop Until first > last Or found = True 'loop until the name is not found or the name is found 

If found = True Then 
    For i = 0 To UBound(foundNames) 
     For j = 0 To 4 
      txtDisplay.Text += contacts(i,j).padLeft(15) 
     Loop 
    Loop 
End If 

現在，您已經擁有陣列中的位置，因此您可以根據需要對其進行分類。

Answer 2

二進制搜索將終止「某處匹配值列表」。如果你期望有多個可能匹配的值，那麼你需要從該點向後工作（朝向A），直到你沒有匹配，然後再向前（朝向Z）。這是你如何找到所有的部分匹配。如果你不關心它們的顯示順序，則可以將代碼的最後一部分改變（類似）：

編輯，包括一些邊界檢查：

If found = True Then 
    lb = 0 
    ub = UBound(contacts) 
    if middle > lb Then 
     ii = middle 
     While contacts(ii, 1).ToLower.StartsWith(search) 
     ii = ii - 1 
     if ii < lb Then Exit While 
     End While 
     firstContact = ii + 1 
    Else 
     firstContact = lb 
    End If 

    ii = middle + 1 
    If middle <= ub Then 
     ii = middle 
     While contacts(ii, 1).ToLower.StartsWith(search) 
     ii = ii + 1 
     if ii > ub Then Exit While 
     End While 
     lastContact = ii - 1 
    Else 
     lastContact = ub 
    End If 

    numMatching = lastContact - firstContact + 1 

    Dim matchingContacts(1,1) 
    ReDim matchingContacts(1 To numMatching, 0 To 4) 

    For ii = 1 To numMatching 
     For jj = 0 To 4 
     matchingContacts(ii, jj) = contacts(firstContact + ii - 1, jj).padLeft(15) 
     Next jj 
    Next ii 

End If 

這應該找到匹配聯繫人的範圍，並創建一個僅包含這些聯繫人的新數組。我沒有測試這個 - 所以請原諒錯別字（我不經常寫VB）。 我加了一些邊界檢查;不保證它現在是「完美」...