Так что потребовалось немного больше времени, чем я ожидал, но вот оно! Если вы раньше не работали с Tries, я предлагаю reading the Wikipedia article. В принципе, каждый уровень в дереве представляет символ номера. Когда конец числа достигнут вниз через дерево, это лист, и именно здесь хранится значение (название компании). По общему признанию, я сделал пятнистую работу по комментированию кода, поэтому, если есть что-нибудь, в частности, вы хотели бы знать, комментировать, и я могу расширить его.
Во-первых, создать clsTrieNode класс следующим образом:
Option Explicit
Public parent As clsTrieNode
Public value As String
Public count As Long
Public digit As String
'Arrays are not allowed to be public members of classes, sadly
Private m_children(0 To 9) As clsTrieNode
Public Property Get children(i As Byte) As clsTrieNode
Set children = m_children(i)
End Property
Public Property Set children(i As Byte, node As clsTrieNode)
Set m_children(i) = node
End Property
Далее, создайте clsNumberTrie так:
Option Explicit
Private head As clsTrieNode
Private Sub Class_Initialize()
Set head = New clsTrieNode
End Sub
Public Sub Add(key As String, value As String)
Dim temp As clsTrieNode
Set temp = head
Dim i As Long
Dim key_digit As Byte
For i = 1 To Len(key)
key_digit = Val(Mid(key, i, 1))
If Not temp.children(key_digit) Is Nothing Then
Set temp = temp.children(key_digit)
Else
Set temp.children(key_digit) = New clsTrieNode
Set temp.children(key_digit).parent = temp
Set temp = temp.children(key_digit)
temp.digit = key_digit 'implicit string conversion
End If
Next
temp.value = value
mergeTrieUpwards temp.parent
End Sub
Private Sub mergeTrieUpwards(node As clsTrieNode)
If isMergeable(node) Then
node.value = node.children(0).value
Dim i As Byte
For i = 0 To 9
Set node.children(i) = Nothing
Next
mergeTrieUpwards node.parent
End If
End Sub
Private Function isMergeable(node As clsTrieNode) As Boolean
Dim i As Byte
'Firstly, node must be defined (e.g., not the parent of head)
If node Is Nothing Then
isMergeable = False
Exit Function
End If
For i = 0 To 9
'Secondly, all children must be defined
If node.children(i) Is Nothing Then
isMergeable = False
Exit Function
'Thirdly, all children must be leaves
ElseIf node.children(i).value = "" Then
isMergeable = False
Exit Function
End If
Next
isMergeable = True
End Function
Public Function toString() As String
Dim strKey As String
Dim strOutput As String
If Not head Is Nothing Then
strOutput = toStringRecurse("", head)
End If
toString = strOutput
End Function
Private Function toStringRecurse(prefix As String, node As clsTrieNode) As String
Dim strOutput As String
Dim i As Byte
If node.value <> "" Then
toStringRecurse = prefix & node.digit & " " & node.value & vbCrLf
Exit Function
Else
For i = 0 To 9
If Not node.children(i) Is Nothing Then
strOutput = strOutput & toStringRecurse(prefix & node.digit, node.children(i))
End If
Next
toStringRecurse = strOutput
End If
End Function
Наконец, чтобы запустить его против ваших ввода цифр, я следующее модуль под названием mdlMain. Я перевернул собственный Split, потому что встроенный сплит не поддерживает игнорирование последовательных разделителей, и ваш ввод имеет переменное количество пробелов.
Public Sub Main()
Dim input_data As String
input_data = "3734 CompanyA" & vbCrLf & _
"3735 CompanyA" & vbCrLf & _
"375 CompanyA" & vbCrLf & _
"3760 CompanyA" & vbCrLf & _
"3761 CompanyA" & vbCrLf & _
"3762 CompanyA" & vbCrLf & _
"3763 CompanyA" & vbCrLf & _
"3764 CompanyA" & vbCrLf & _
"3765 CompanyA" & vbCrLf & _
"3766 CompanyA" & vbCrLf & _
"3767 CompanyA" & vbCrLf & _
"3768 CompanyA" & vbCrLf & _
"3769 CompanyA" & vbCrLf & _
"3770 CompanyA" & vbCrLf & _
"3771 CompanyA" & vbCrLf & _
"3773 CompanyB" & vbCrLf & _
"3774 CompanyB" & vbCrLf & _
"3775 CompanyB" & vbCrLf & _
"3776 CompanyB" & vbCrLf & _
"3778 CompanyB" & vbCrLf & _
"33045 CompanyB" & vbCrLf & _
"361 CompanyB"
Dim companyTrie As clsNumberTrie
Set companyTrie = New clsNumberTrie
Dim rows As Variant
Dim row As Variant
rows = SplitStr(input_data, vbCrLf)
Dim i As Long
For i = 0 To UBound(rows)
row = SplitStr(CStr(rows(i)), " ", True)
companyTrie.Add CStr(row(0)), CStr(row(1))
Next
Debug.Print companyTrie.toString
End Sub
'This implementation of split has supports ignoring consecutive delimiters
Public Function SplitStr(str As String, delim As String, Optional treatSuccessiveDelimitersAsOne = False) As Variant
'This is not an optimal implementation:
'1. Resizing an array is expensive because it requires copying the whole thing.
'2. String concatenation has the same problem; new memory is allocated to hold the result, and then both strings are copied to this new location.
'Thankfully, with the small strings in this example, it doesn't matter too much.
Dim i As Long
Dim outArr() As String
ReDim outArr(0 To 0)
'Iterate through the string
For i = 1 To Len(str)
'If the current character is the start of the delimiter...
If Mid(str, i, 1) = Mid(delim, 1, 1) Then
'Check and see if the whole delimiter is there...
If isSubstringDelim(str, i, delim) Then
'If so, jump i past the delimiter and add a new slot to the split array
i = i + Len(delim)
ReDim Preserve outArr(0 To (UBound(outArr) + 1))
'Check to see if there are multiple delimiters in a row...
While isSubstringDelim(str, i, delim)
i = i + Len(delim)
'If treatSuccessiveDelimitersAsOne is False, we add a blank string to the split array each time we encounter a successive delimiter.
'If it's true, just consume the delimiters without creating a blank string
If Not treatSuccessiveDelimitersAsOne Then
ReDim Preserve outArr(0 To (UBound(outArr) + 1))
End If
Wend
End If
End If
'Add the current character to the current slot of the split array
outArr(UBound(outArr)) = outArr(UBound(outArr)) + Mid(str, i, 1)
Next
SplitStr = outArr
End Function
Private Function isSubstringDelim(str, index, delim) As Boolean
Dim min As Long
If (Len(str) - index) < Len(delim) Then
isSubstringDelim = False
Exit Function
End If
For i = 1 To Len(delim)
If Not (Mid(str, i + index - 1, 1) = Mid(delim, i, 1)) Then
isSubstringDelim = False
Exit Function
End If
Next
isSubstringDelim = True
End Function
Результат выводится в алфавитном порядке из-за способа посещения узлов.Обратите внимание, что он поддерживает рекурсивную группировку, так что если вы бы компанию за 3351 через 3358, но вы также 33591 через 33599 для компании, было бы скатать 3359 первым, затем Накопительный 335.
33045 361 CompanyB CompanyB
3735 3734 компания компания
375 376 компания
3770 компания 3771 3773 CompanyB
CompanyB
CompanyB 3775 3776 3778 CompanyB
CompanyB
То, что я сомневаюсь, что вы найдете то, что вы можете копировать и вставлять. Скорее всего, вам нужно будет создать решение самостоятельно. – Tomalak
Есть ли логика, как глубоко Группировки Что они должны или идти применять? Например, почему бы «3734 CompanyA» и «3735 CompanyA» не сгруппировались до «373 CompanyA». Кроме того, как вы знаете, сколько цифр число представляет? Всегда ли считаются видимыми номерами, заполненными длиной 9 справа, с помощью 0? – Blackhawk
@Blackhawk Номер может быть до 8 цифр, и третья цифра для 4 цифр, чтобы Охватить один он должен охватывать все перестановки, т.е. должно быть четко указано, что Владеет компании в 3730-3739 группироваться, чтобы добраться до 373 , если это имеет смысл? – User632716