7,762
社区成员
发帖
与我相关
我的任务
分享求比较一致性算法
有两个数组，a（6），b（6），要比较这两个数组中的数是不是完相同，也许有的数字不在同一位置上，该怎么做啊，我写了一个小算法，不知道还能不能优化
dim num(6)
for i=0 to 5
for j=0 to 5
if a(i)=b(j) then
num(i)=num(i)+1
exit for
end if
next j
next i
通过num(i)的情况判断是否相等，诸位还有没有什么更好的办法，谢谢了
dim num(6)
for i=0 to 5
for j=0 to 5
if a(i)=b(j) then
num(i)=num(i)+1
exit for
end if
next j
next i
通过num(i)的情况判断是否相等，诸位还有没有什么更好的办法，谢谢了
...全文
请发表友善的回复…
发表回复
magicmaster 2004-07-12
- 打赏
- 举报
顶
javafaq2004 2004-07-12
- 打赏
- 举报
顶
apple_001 2004-07-10
- 打赏
- 举报
想不到几天没来到了这种程度，我这样的菜鸟都快看不懂了，学习一下，看看能不能解决我那个小儿科的问题
thirdapple 2004-07-09
- 打赏
- 举报
//如果知道数组的上限，可以借鉴桶排序的方法：
Dim Num(9999) As Boolean
Dim IsMatch As Boolean
For i=0 To 5
Num(a(i)) = True
Next i
IsMatch = True
For i=0 To 5
If Not Num(b(i)) Then
IsMatch = False
End If
Next i
If IsMatch Then msgbox "Match All"
//这样的算法只需要O(2n)时间复杂度，不过需要很大的内存空间
单就算法而言，用哈希表应该是时间复杂度最低的O(2n)。用集合的方法取决于集合的效率。
Dim Num(9999) As Boolean
Dim IsMatch As Boolean
For i=0 To 5
Num(a(i)) = True
Next i
IsMatch = True
For i=0 To 5
If Not Num(b(i)) Then
IsMatch = False
End If
Next i
If IsMatch Then msgbox "Match All"
//这样的算法只需要O(2n)时间复杂度，不过需要很大的内存空间
单就算法而言，用哈希表应该是时间复杂度最低的O(2n)。用集合的方法取决于集合的效率。
111222 2004-07-09
- 打赏
- 举报
帮顶!
KiteGirl 2004-07-09
- 打赏
- 举报
1、确定数组取值范围。
2、根据范围做出判断：
（1）范围超过一定程度（本程序依据并不科学），采用虚拟数组。
（2）范围在一定范围，采用真实的数组。
3、真实的数组以雕兄的哈希表法来求匹配。但雕兄的哈希表法得出的结果，12235和12345也是匹配的。虚拟数组也是一样。
4、虚拟数组复杂度是取值多样性的平方关系。在虚拟数组运算前，还可以用近似算法根据数组的和排除不匹配数组。
2、根据范围做出判断：
（1）范围超过一定程度（本程序依据并不科学），采用虚拟数组。
（2）范围在一定范围，采用真实的数组。
3、真实的数组以雕兄的哈希表法来求匹配。但雕兄的哈希表法得出的结果，12235和12345也是匹配的。虚拟数组也是一样。
4、虚拟数组复杂度是取值多样性的平方关系。在虚拟数组运算前，还可以用近似算法根据数组的和排除不匹配数组。
KiteGirl 2004-07-09
- 打赏
- 举报
测试代码：
Private Sub Command1_Click()
Dim tActiveTable As New clsActiveTable_Long
For tIndex = 10000 To 20000
tActiveTable.Index = tIndex
tActiveTable.Value = tIndex
DoEvents
Text1.Text = tActiveTable.Size
Next
End Sub
Private Sub Command2_Click()
Dim tA() As Long
Dim tB() As Long
ReDim tA(3)
ReDim tB(3)
tA(0) = 1: tA(1) = 2: tA(3) = 3: tA(3) = 4
tB(0) = 4: tB(1) = 2: tB(3) = 3: tB(3) = 2
Text1.Text = Longs_MatchCheck(tA(), tB())
End Sub
Private Sub Form_Load()
End Sub
modLongs_MatchCheck代码
'Static Table
'Dynamic Table
Enum Longs_MatchCheck_Mode
cmNoDetect = 0
cmDynamicTable = 1
cmStaticTable = 2
cmAutoDetect = 3
End Enum
Function Longs_MatchCheck(ByRef pLongsA() As Long, ByRef pLongsB() As Long, Optional ByVal pMode As Longs_MatchCheck_Mode = 3, Optional ByVal pValueMax As Long = 9999, Optional ByVal pValueMin As Long = 0)
Dim tOutBool As Boolean
Dim tLongs_Min As Long
Dim tLongs_Max As Long
Select Case pMode
Case 0, 1, 2
tLongs_Max = pValueMax
tLongs_Min = pValueMin
Case 3
tLongs_Min = Longs_FindMin(pLongsA()): tLongs_Min = Longs_FindMin(pLongsB(), tLongs_Min)
tLongs_Max = Longs_FindMax(pLongsA()): tLongs_Max = Longs_FindMax(pLongsB(), tLongs_Max)
End Select
Dim tMode As Boolean
Dim tValueLength As Long
Dim tLongsLength As Long
tValueLength = tLongs_Max - tLongs_Min
tLongsLength = UBound(pLongsA())
tMode = (tValueLength > tLongsLength) Or pMode = cmDynamicTable
If tMode Then
tOutBool = Longs_MatchCheck_DynamicTable(pLongsA(), pLongsB())
Else
tOutBool = Longs_MatchCheck_StaticTable(pLongsA(), pLongsB(), tLongs_Max, tLongs_Min)
End If
Longs_MatchCheck = tOutBool
End Function
Function Longs_MatchCheck_DynamicTable(ByRef pLongsA() As Long, ByRef pLongsB() As Long) As Boolean
Dim tOutBool As Boolean
Dim tIndex As Long
Dim tIndex_Start As Long
Dim tIndex_End As Long
tIndex_Start = LBound(pLongsA())
tIndex_End = UBound(pLongsA())
Dim tActiveTable As New clsActiveTable_Long
For tIndex = tIndex_Start To tIndex_End
tActiveTable.Index = pLongsA(tIndex)
tActiveTable.Value = -1
Next
tIndex_Start = LBound(pLongsB())
tIndex_End = UBound(pLongsB())
tOutBool = True
For tIndex = tIndex_Start To tIndex_End
tActiveTable.Index = pLongsB(tIndex)
tOutBool = tOutBool And CBool(tActiveTable.Value)
If Not tOutBool Then Exit For
Next
Longs_MatchCheck_DynamicTable = tOutBool
End Function
Function Longs_MatchCheck_StaticTable(ByRef pLongsA() As Long, ByRef pLongsB() As Long, Optional ByVal pValueMax As Long = 9999, Optional ByVal pValueMin As Long = 0) As Boolean
Dim tOutBool As Boolean
Dim tTable() As Boolean
ReDim tTable(pValueMin To pValueMax)
Dim tIndex As Long
Dim tIndex_Start As Long
Dim tIndex_End As Long
tIndex_Start = UBound(pLongsA())
tIndex_End = UBound(pLongsA())
For tIndex = tIndex_Start To tIndex_End
tTable(pLongsA(tIndex)) = True
Next
tIndex_Start = UBound(pLongsB())
tIndex_End = UBound(pLongsB())
tOutBool = True
For tIndex = tIndex_Start To tIndex_End
tOutBool = tOutBool And tTable(pLongsB(tIndex))
If Not tOutBool Then Exit For
Next
Longs_MatchCheck_StaticTable = tOutBool
End Function
Function Longs_FindMin(ByRef pLongs() As Long, Optional ByVal pStartValue As Long = &H7FFFFFFF) As Long
Dim tOutMin As Long
tOutMin = pStartValue
Dim tLongs_Length As Long
tLongs_Length = UBound(pLongs())
Dim tIndex As Long
Dim tFindMin As Boolean
For tIndex = 0 To tLongs_Length
tFindMin = tOutMin > pLongs(tIndex)
If tFindMin Then tOutMin = pLongs(tIndex)
Next
Longs_FindMin = tOutMin
End Function
Function Longs_FindMax(ByRef pLongs() As Long, Optional ByVal pStartValue As Long = 0) As Long
Dim tOutMax As Long
tOutMax = pStartValue
Dim tLongs_Length As Long
tLongs_Length = UBound(pLongs())
Dim tIndex As Long
Dim tFindMax As Boolean
For tIndex = 0 To tLongs_Length
tFindMax = tOutMax < pLongs(tIndex)
If tFindMax Then tOutMax = pLongs(tIndex)
Next
Longs_FindMax = tOutMax
End Function
modActiveTable_Long代码：虚拟数组模块
Type tpActiveTable_Cell
tcIndex As Long
tcValue As Long
End Type
Function ActiveTable_ValueGet(ByVal pIndex As Long, ByRef pTable() As tpActiveTable_Cell) As Long
Dim tOutValue As Long
Dim tTableID As Long
tTableID = ActiveTable_IDGet(pIndex, pTable())
tOutValue = pTable(tTableID).tcValue
ActiveTable_ValueGet = tOutValue
End Function
Sub ActiveTable_ValuePut(ByVal pIndex As Long, ByVal pValue As Long, ByRef pTable() As tpActiveTable_Cell)
Dim tTableID As Long
tTableID = ActiveTable_IDGet(pIndex, pTable())
pTable(tTableID).tcValue = pValue
End Sub
Function ActiveTable_IDGet(ByVal pIndex As Long, ByRef pTable() As tpActiveTable_Cell) As Long
Dim tOutID As Long
Dim tTable_Length As Long
Err.Clear
On Error Resume Next
tTable_Length = UBound(pTable())
If Not CBool(Err.Number) Then
Dim tIndex As Long
Dim tIDFind As Boolean
For tIndex = 0 To tTable_Length
tIDFind = tIDFind Or (pIndex = pTable(tIndex).tcIndex)
If tIDFind Then tOutID = tIndex: Exit For
Next
If Not tIDFind Then
Dim tTable_LengthNew As Long
tTable_LengthNew = tTable_Length + 1
ReDim Preserve pTable(tTable_LengthNew)
pTable(tTable_LengthNew).tcIndex = pIndex
tOutID = tTable_LengthNew
End If
Else
ReDim pTable(0)
pTable(0).tcIndex = pIndex
End If
ActiveTable_IDGet = tOutID
End Function
clsActiveTable_Long代码：虚拟数组类模块
Private priActiveTable() As tpActiveTable_Cell
Private priTableID As Long
Private priIndex As Long
Public Property Get Index() As Long
Index = priIndex
End Property
Public Property Let Index(ByVal pNewValue As Long)
priIndex = pNewValue
priTableID = ActiveTable_IDGet(priIndex, priActiveTable())
End Property
Public Property Get Value() As Long
Value = priActiveTable(priTableID).tcValue
End Property
Public Property Let Value(ByVal pNewValue As Long)
priActiveTable(priTableID).tcValue = pNewValue
End Property
Public Property Get Size() As Long
Size = UBound(priActiveTable())
End Property
Public Sub Clear()
ReDim priActiveTable(0)
End Sub
Private Sub Class_Initialize()
Me.Clear
End Sub
Private Sub Command1_Click()
Dim tActiveTable As New clsActiveTable_Long
For tIndex = 10000 To 20000
tActiveTable.Index = tIndex
tActiveTable.Value = tIndex
DoEvents
Text1.Text = tActiveTable.Size
Next
End Sub
Private Sub Command2_Click()
Dim tA() As Long
Dim tB() As Long
ReDim tA(3)
ReDim tB(3)
tA(0) = 1: tA(1) = 2: tA(3) = 3: tA(3) = 4
tB(0) = 4: tB(1) = 2: tB(3) = 3: tB(3) = 2
Text1.Text = Longs_MatchCheck(tA(), tB())
End Sub
Private Sub Form_Load()
End Sub
modLongs_MatchCheck代码
'Static Table
'Dynamic Table
Enum Longs_MatchCheck_Mode
cmNoDetect = 0
cmDynamicTable = 1
cmStaticTable = 2
cmAutoDetect = 3
End Enum
Function Longs_MatchCheck(ByRef pLongsA() As Long, ByRef pLongsB() As Long, Optional ByVal pMode As Longs_MatchCheck_Mode = 3, Optional ByVal pValueMax As Long = 9999, Optional ByVal pValueMin As Long = 0)
Dim tOutBool As Boolean
Dim tLongs_Min As Long
Dim tLongs_Max As Long
Select Case pMode
Case 0, 1, 2
tLongs_Max = pValueMax
tLongs_Min = pValueMin
Case 3
tLongs_Min = Longs_FindMin(pLongsA()): tLongs_Min = Longs_FindMin(pLongsB(), tLongs_Min)
tLongs_Max = Longs_FindMax(pLongsA()): tLongs_Max = Longs_FindMax(pLongsB(), tLongs_Max)
End Select
Dim tMode As Boolean
Dim tValueLength As Long
Dim tLongsLength As Long
tValueLength = tLongs_Max - tLongs_Min
tLongsLength = UBound(pLongsA())
tMode = (tValueLength > tLongsLength) Or pMode = cmDynamicTable
If tMode Then
tOutBool = Longs_MatchCheck_DynamicTable(pLongsA(), pLongsB())
Else
tOutBool = Longs_MatchCheck_StaticTable(pLongsA(), pLongsB(), tLongs_Max, tLongs_Min)
End If
Longs_MatchCheck = tOutBool
End Function
Function Longs_MatchCheck_DynamicTable(ByRef pLongsA() As Long, ByRef pLongsB() As Long) As Boolean
Dim tOutBool As Boolean
Dim tIndex As Long
Dim tIndex_Start As Long
Dim tIndex_End As Long
tIndex_Start = LBound(pLongsA())
tIndex_End = UBound(pLongsA())
Dim tActiveTable As New clsActiveTable_Long
For tIndex = tIndex_Start To tIndex_End
tActiveTable.Index = pLongsA(tIndex)
tActiveTable.Value = -1
Next
tIndex_Start = LBound(pLongsB())
tIndex_End = UBound(pLongsB())
tOutBool = True
For tIndex = tIndex_Start To tIndex_End
tActiveTable.Index = pLongsB(tIndex)
tOutBool = tOutBool And CBool(tActiveTable.Value)
If Not tOutBool Then Exit For
Next
Longs_MatchCheck_DynamicTable = tOutBool
End Function
Function Longs_MatchCheck_StaticTable(ByRef pLongsA() As Long, ByRef pLongsB() As Long, Optional ByVal pValueMax As Long = 9999, Optional ByVal pValueMin As Long = 0) As Boolean
Dim tOutBool As Boolean
Dim tTable() As Boolean
ReDim tTable(pValueMin To pValueMax)
Dim tIndex As Long
Dim tIndex_Start As Long
Dim tIndex_End As Long
tIndex_Start = UBound(pLongsA())
tIndex_End = UBound(pLongsA())
For tIndex = tIndex_Start To tIndex_End
tTable(pLongsA(tIndex)) = True
Next
tIndex_Start = UBound(pLongsB())
tIndex_End = UBound(pLongsB())
tOutBool = True
For tIndex = tIndex_Start To tIndex_End
tOutBool = tOutBool And tTable(pLongsB(tIndex))
If Not tOutBool Then Exit For
Next
Longs_MatchCheck_StaticTable = tOutBool
End Function
Function Longs_FindMin(ByRef pLongs() As Long, Optional ByVal pStartValue As Long = &H7FFFFFFF) As Long
Dim tOutMin As Long
tOutMin = pStartValue
Dim tLongs_Length As Long
tLongs_Length = UBound(pLongs())
Dim tIndex As Long
Dim tFindMin As Boolean
For tIndex = 0 To tLongs_Length
tFindMin = tOutMin > pLongs(tIndex)
If tFindMin Then tOutMin = pLongs(tIndex)
Next
Longs_FindMin = tOutMin
End Function
Function Longs_FindMax(ByRef pLongs() As Long, Optional ByVal pStartValue As Long = 0) As Long
Dim tOutMax As Long
tOutMax = pStartValue
Dim tLongs_Length As Long
tLongs_Length = UBound(pLongs())
Dim tIndex As Long
Dim tFindMax As Boolean
For tIndex = 0 To tLongs_Length
tFindMax = tOutMax < pLongs(tIndex)
If tFindMax Then tOutMax = pLongs(tIndex)
Next
Longs_FindMax = tOutMax
End Function
modActiveTable_Long代码：虚拟数组模块
Type tpActiveTable_Cell
tcIndex As Long
tcValue As Long
End Type
Function ActiveTable_ValueGet(ByVal pIndex As Long, ByRef pTable() As tpActiveTable_Cell) As Long
Dim tOutValue As Long
Dim tTableID As Long
tTableID = ActiveTable_IDGet(pIndex, pTable())
tOutValue = pTable(tTableID).tcValue
ActiveTable_ValueGet = tOutValue
End Function
Sub ActiveTable_ValuePut(ByVal pIndex As Long, ByVal pValue As Long, ByRef pTable() As tpActiveTable_Cell)
Dim tTableID As Long
tTableID = ActiveTable_IDGet(pIndex, pTable())
pTable(tTableID).tcValue = pValue
End Sub
Function ActiveTable_IDGet(ByVal pIndex As Long, ByRef pTable() As tpActiveTable_Cell) As Long
Dim tOutID As Long
Dim tTable_Length As Long
Err.Clear
On Error Resume Next
tTable_Length = UBound(pTable())
If Not CBool(Err.Number) Then
Dim tIndex As Long
Dim tIDFind As Boolean
For tIndex = 0 To tTable_Length
tIDFind = tIDFind Or (pIndex = pTable(tIndex).tcIndex)
If tIDFind Then tOutID = tIndex: Exit For
Next
If Not tIDFind Then
Dim tTable_LengthNew As Long
tTable_LengthNew = tTable_Length + 1
ReDim Preserve pTable(tTable_LengthNew)
pTable(tTable_LengthNew).tcIndex = pIndex
tOutID = tTable_LengthNew
End If
Else
ReDim pTable(0)
pTable(0).tcIndex = pIndex
End If
ActiveTable_IDGet = tOutID
End Function
clsActiveTable_Long代码：虚拟数组类模块
Private priActiveTable() As tpActiveTable_Cell
Private priTableID As Long
Private priIndex As Long
Public Property Get Index() As Long
Index = priIndex
End Property
Public Property Let Index(ByVal pNewValue As Long)
priIndex = pNewValue
priTableID = ActiveTable_IDGet(priIndex, priActiveTable())
End Property
Public Property Get Value() As Long
Value = priActiveTable(priTableID).tcValue
End Property
Public Property Let Value(ByVal pNewValue As Long)
priActiveTable(priTableID).tcValue = pNewValue
End Property
Public Property Get Size() As Long
Size = UBound(priActiveTable())
End Property
Public Sub Clear()
ReDim priActiveTable(0)
End Sub
Private Sub Class_Initialize()
Me.Clear
End Sub
KiteGirl 2004-07-09
- 打赏
- 举报
嘿嘿！雕兄稍等，我有一个折中的玩意正在编写……
thirdapple 2004-07-09
- 打赏
- 举报
但是这样又消耗时间在求范围上了……
最好一开始就能确定
最好一开始就能确定
KiteGirl 2004-07-09
- 打赏
- 举报
我想，最后还是写一个彻底一点的函数吧：
1、先计算元素取值范围。
2、决定算法：如果元素的相对取值范围（Abs(Max-Min)）不大于元素数量的平方，则使用常规的哈希表。如果大于元素数量的平方……嘿嘿！
代码稍后就来，对Long类型的。
1、先计算元素取值范围。
2、决定算法：如果元素的相对取值范围（Abs(Max-Min)）不大于元素数量的平方，则使用常规的哈希表。如果大于元素数量的平方……嘿嘿！
代码稍后就来，对Long类型的。
KiteGirl 2004-07-09
- 打赏
- 举报
不过相同点都是“摆地摊”，如果仅仅是判断匹配不匹配，你的办法最快。
另外：0 To 9999有点不安全，而我的0 To 32767又太夸张了。具体Num数组的上限和下限应该是通过A()和B()当中最小的值和最大的值求出来的，即使这样也比其他办法快。
不过，真遇到一个long类型的大数，咱俩的算法就哭都来不及了。
另外：0 To 9999有点不安全，而我的0 To 32767又太夸张了。具体Num数组的上限和下限应该是通过A()和B()当中最小的值和最大的值求出来的，即使这样也比其他办法快。
不过，真遇到一个long类型的大数，咱俩的算法就哭都来不及了。
thirdapple 2004-07-09
- 打赏
- 举报
是的，思想相同，实现和效果相似。
KiteGirl 2004-07-09
- 打赏
- 举报
有点相似，但其实有差别的。如果是对Inetger做我那种运算要：
Dim NumA(0 To 32767) As Long
Dim NumB(0 To 32767) As Long
Dim Sum As Long
Dim IsMatch As Long
For i=0 To 5
NumA(a(i)) = NumA(a(i)) + 1
NumB(a(i)) = NumB(a(i)) + 1
Next i
For i=0 To 32767
Sum = Sum + (NumA(i) - NumB(i))
Next i
最后得到是有多少元素不匹配，而不是匹配还是不匹配。
Dim NumA(0 To 32767) As Long
Dim NumB(0 To 32767) As Long
Dim Sum As Long
Dim IsMatch As Long
For i=0 To 5
NumA(a(i)) = NumA(a(i)) + 1
NumB(a(i)) = NumB(a(i)) + 1
Next i
For i=0 To 32767
Sum = Sum + (NumA(i) - NumB(i))
Next i
最后得到是有多少元素不匹配，而不是匹配还是不匹配。
thirdapple 2004-07-09
- 打赏
- 举报
Dim Num(9999) As Boolean
Dim IsMatch As Boolean
For i=0 To 5
Num(a(i)) = True
Next i
IsMatch = True
For i=0 To 5
If Not Num(b(i)) Then
IsMatch = False
End If
Next i
If IsMatch Then msgbox "Match All"
一样的啊，建立一个哈希表，然后……
Dim IsMatch As Boolean
For i=0 To 5
Num(a(i)) = True
Next i
IsMatch = True
For i=0 To 5
If Not Num(b(i)) Then
IsMatch = False
End If
Next i
If IsMatch Then msgbox "Match All"
一样的啊，建立一个哈希表，然后……
KiteGirl 2004-07-09
- 打赏
- 举报
thirdapple(.:RNPA:.陨落雕-鍾意吊帶MM)：好象和你的方法是两回事。你说的是哪个？再贴一下。
KiteGirl 2004-07-09
- 打赏
- 举报
两级检测法是这样的：
先用根据元素的和判断是否匹配，进行初级检测。如果元素的算术和不一样，根本就不匹配。如果一样的话，有很大概率是匹配的。只需要对数组历遍一次。
然后对初级检测后，对两个数组同步冒泡排序。因为只要两个数组匹配，那么冒泡排序时每个排序后的元素应该是一一对应的。如果有一个不同步，就说明两个数组至少有一个不匹配。
上面的办法只能判断两个数组是不是匹配，但不能得知究竟有多少匹配。接下来这个办法可以满足楼主关于匹配程度的需要。此法是借鉴于图象上的直方图。
什么是直方图呢：看下列这组数字
1235357567561667
如果统计每个数字出现的次数，则得到一个表：
1 2
2 1
3 2
4 0
5 4
6 4
7 3
这就是所谓“直方图”。匹配的数组，两者直方图是完全相同的。而部分匹配的数组，体现在直方图里，匹配部分也是重合的。以两者直方图做减法取绝对值，就得到不匹配元素的数量。（同时，利用直方图还有一定排序的能力）
再看下面这个组数，只有一个元素与上面的不同。直方图如下。
1235357567562667
1 1
2 2
3 2
4 0
5 4
6 4
7 3
两者直方图做减法取绝对值，就得到：
1
1
0
0
0
0
0
给所有直方图的元素相加得到2。
（有一个不匹配得到2，两个返回4、三个返回6。请注意：前提是两个数组长度一致。）
直方图的缺点是这样的：
1、对取值范围有限制。如果你是对Long数组做这种操作，那么有点不大现实了。
2、如果取值范围超过数组元素数量，那么这个方法有点得不偿失。
鉴于以上原因，此法对Integer和Byte类型是适用的。而复杂度与数组元素的实际取值范围有很大关系，通过检测数组元素实际范围可以尽量缩小直方图数组的长度，但这个做法却要多历遍一次数组。
不过，你还有一个选择：将Long这种类型的数组转换成Byte类型做直方图，效果是一样的（只是结果需要一些调整）。
先用根据元素的和判断是否匹配，进行初级检测。如果元素的算术和不一样，根本就不匹配。如果一样的话，有很大概率是匹配的。只需要对数组历遍一次。
然后对初级检测后，对两个数组同步冒泡排序。因为只要两个数组匹配，那么冒泡排序时每个排序后的元素应该是一一对应的。如果有一个不同步，就说明两个数组至少有一个不匹配。
上面的办法只能判断两个数组是不是匹配，但不能得知究竟有多少匹配。接下来这个办法可以满足楼主关于匹配程度的需要。此法是借鉴于图象上的直方图。
什么是直方图呢：看下列这组数字
1235357567561667
如果统计每个数字出现的次数，则得到一个表：
1 2
2 1
3 2
4 0
5 4
6 4
7 3
这就是所谓“直方图”。匹配的数组，两者直方图是完全相同的。而部分匹配的数组，体现在直方图里，匹配部分也是重合的。以两者直方图做减法取绝对值，就得到不匹配元素的数量。（同时，利用直方图还有一定排序的能力）
再看下面这个组数，只有一个元素与上面的不同。直方图如下。
1235357567562667
1 1
2 2
3 2
4 0
5 4
6 4
7 3
两者直方图做减法取绝对值，就得到：
1
1
0
0
0
0
0
给所有直方图的元素相加得到2。
（有一个不匹配得到2，两个返回4、三个返回6。请注意：前提是两个数组长度一致。）
直方图的缺点是这样的：
1、对取值范围有限制。如果你是对Long数组做这种操作，那么有点不大现实了。
2、如果取值范围超过数组元素数量，那么这个方法有点得不偿失。
鉴于以上原因，此法对Integer和Byte类型是适用的。而复杂度与数组元素的实际取值范围有很大关系，通过检测数组元素实际范围可以尽量缩小直方图数组的长度，但这个做法却要多历遍一次数组。
不过，你还有一个选择：将Long这种类型的数组转换成Byte类型做直方图，效果是一样的（只是结果需要一些调整）。
thirdapple 2004-07-09
- 打赏
- 举报
晕，就是我的方法……复杂度为n一次方……
KiteGirl 2004-07-09
- 打赏
- 举报
不成：如果是这样还是会出错误。不过，作为初步判断依据还是可以的。我再考虑一下别的。
1、3、4
1、2、5
1、3、4
1、2、5
KiteGirl 2004-07-09
- 打赏
- 举报
如果数组所有元素都减去最小那个呢？或者都减去N
3、4一律减去3得到 0、1
2、5一律减去2得到 0、3
我也不肯定这样是不是100%，但的确是近似算法比较快的。
3、4一律减去3得到 0、1
2、5一律减去2得到 0、3
我也不肯定这样是不是100%，但的确是近似算法比较快的。
KiteGirl 2004-07-09
- 打赏
- 举报
如果数组的值在Byte和Integer范围内（也就是说不大），而数组的元素特别多。同时你想知道有多少元素被匹配，有多少不被匹配。那么我的“直方图”法可以满足你。（另外还有一个两级检测法）
复杂度比较低。
Private Sub Command1_Click()
Dim tArrayA() As Byte
Dim tArrayB() As Byte
Dim tMapA() As Long
Dim tMapB() As Long
tArrayA() = Text1.Text
tArrayB() = Text2.Text
'Text3.Text = Bytes_MatchingCheck(tArrayA(), tArrayB())
Text3.Text = Bytes_MatchingCheck2(tArrayA(), tArrayB()) '两级测试法
Bytes_MatchingCheck3_MapGet tArrayA(), tArrayB(), tMapA(), tMapB() '直方图法
Text4.Text = MatchingNumberGetByMap(tMapA(), tMapB()) '直方图法得到的不匹配数量。
End Sub
Function MatchingNumberGetByMap(ByRef pMapA() As Long, ByRef pMapB() As Long) As Long
'通过直方图计算不匹配数量。
Dim tOutNumber As Long
Dim tIndex As Long
For tIndex = LBound(pMapA()) To UBound(pMapA())
tOutNumber = tOutNumber + Abs(pMapA(tIndex) - pMapB(tIndex))
Next
MatchingNumberGetByMap = tOutNumber
End Function
Sub Bytes_MatchingCheck3_MapGet(ByRef pArrayA() As Byte, ByRef pArrayB() As Byte, ByRef pOutMapA() As Long, ByRef pOutMapB() As Long)
'获得数组直方图。
'对于文本来说，本方法最为适用。
Dim tOutMapA() As Long
Dim tOutMapB() As Long
Dim tArrayA_Max As Byte
Dim tArrayB_Max As Byte
Dim tArrayA_Min As Byte
Dim tArrayB_Min As Byte
Bytes_ValueBoundGet pArrayA(), tArrayA_Max, tArrayA_Min '求数组A()元素值的上限和下限
Bytes_ValueBoundGet pArrayA(), tArrayB_Max, tArrayB_Min '求数组B()元素值的上限和下限
Bytes_SwapByMaxLeft tArrayA_Max, tArrayB_Max
Bytes_SwapByMaxLeft tArrayB_Min, tArrayA_Min
tArray_Max = tArrayA_Max
tArray_Min = tArrayA_Min
ReDim tOutMapA(tArray_Min To tArray_Max) '定义数组A直方图
ReDim tOutMapB(tArray_Min To tArray_Max) '定义数组B直方图
Dim tArrayLength As Long
tArrayLength = UBound(pArrayA())
For tIndex = 0 To tArrayLength '产生两数组直方图
tOutMapA(pArrayA(tIndex)) = tOutMapA(pArrayA(tIndex)) + 1
tOutMapB(pArrayB(tIndex)) = tOutMapB(pArrayB(tIndex)) + 1
Next
pOutMapA() = tOutMapA()
pOutMapB() = tOutMapB()
End Sub
Function Bytes_MatchingCheck2(ByRef pArrayA() As Byte, ByRef pArrayB() As Byte) As Boolean
Dim tOutBool As Boolean
Dim tArrayLength As Long
'初级测试
tOutBool = Bytes_MatchingCheck(pArrayA(), pArrayB())
tArrayLength = tOutBool And (UBound(pArrayA()) - 1)
Dim tIndexLevel1 As Long
Dim tIndexLevel2 As Long
'次级测试
For tIndexLevel1 = 0 To tArrayLength
For tIndexLevel2 = tIndexLevel1 To tArrayLength
'同步排序
Bytes_SwapByMaxLeft pArrayA(tIndexLevel1), pArrayA(tIndexLevel2)
Bytes_SwapByMaxLeft pArrayB(tIndexLevel1), pArrayB(tIndexLevel2)
Next
'同步性检测
tOutBool = tOutBool And (pArrayA(tIndexLevel1) = pArrayB(tIndexLevel1))
If Not tOutBool Then
'不同步立即退出
Exit For
End If
Next
Bytes_MatchingCheck2 = tOutBool
End Function
Function Bytes_MatchingCheck(ByRef pArrayA() As Byte, ByRef pArrayB() As Byte) As Boolean
Dim tOutBool As Boolean
Dim tArrayLength As Long
tArrayLength = UBound(pArrayA())
Dim tIndex As Long
Dim tSumValue As Long
For tIndex = 0 To tArrayLength
tSumValue = tSumValue + (CLng(pArrayA(tIndex)) - CLng(pArrayB(tIndex)))
Next
tOutBool = Not CBool(tSumValue)
Bytes_MatchingCheck = tOutBool
End Function
Sub Bytes_ValueBoundGet(ByRef pBytes() As Byte, ByRef pMax As Byte, ByRef pMin As Byte)
Dim tBytes_Length As Long
tBytes_Length = UBound(pBytes())
Dim tIndex As Long
pMax = pBytes(tIndex)
pMin = pBytes(tIndex)
For tIndex = 0 To tBytes_Length
If pMax < pBytes(tIndex) Then pMax = pBytes(tIndex)
If pMin > pBytes(tIndex) Then pMin = pBytes(tIndex)
Next
End Sub
Sub Bytes_SwapByMaxLeft(ByRef pA As Byte, ByRef pB As Byte)
If pA < pB Then
Bytes_Swap pA, pB
End If
End Sub
Sub Bytes_Swap(ByRef pA As Byte, ByRef pB As Byte)
Dim tT As Byte
tT = pA: pA = pB: pB = tT
End Sub
复杂度比较低。
Private Sub Command1_Click()
Dim tArrayA() As Byte
Dim tArrayB() As Byte
Dim tMapA() As Long
Dim tMapB() As Long
tArrayA() = Text1.Text
tArrayB() = Text2.Text
'Text3.Text = Bytes_MatchingCheck(tArrayA(), tArrayB())
Text3.Text = Bytes_MatchingCheck2(tArrayA(), tArrayB()) '两级测试法
Bytes_MatchingCheck3_MapGet tArrayA(), tArrayB(), tMapA(), tMapB() '直方图法
Text4.Text = MatchingNumberGetByMap(tMapA(), tMapB()) '直方图法得到的不匹配数量。
End Sub
Function MatchingNumberGetByMap(ByRef pMapA() As Long, ByRef pMapB() As Long) As Long
'通过直方图计算不匹配数量。
Dim tOutNumber As Long
Dim tIndex As Long
For tIndex = LBound(pMapA()) To UBound(pMapA())
tOutNumber = tOutNumber + Abs(pMapA(tIndex) - pMapB(tIndex))
Next
MatchingNumberGetByMap = tOutNumber
End Function
Sub Bytes_MatchingCheck3_MapGet(ByRef pArrayA() As Byte, ByRef pArrayB() As Byte, ByRef pOutMapA() As Long, ByRef pOutMapB() As Long)
'获得数组直方图。
'对于文本来说，本方法最为适用。
Dim tOutMapA() As Long
Dim tOutMapB() As Long
Dim tArrayA_Max As Byte
Dim tArrayB_Max As Byte
Dim tArrayA_Min As Byte
Dim tArrayB_Min As Byte
Bytes_ValueBoundGet pArrayA(), tArrayA_Max, tArrayA_Min '求数组A()元素值的上限和下限
Bytes_ValueBoundGet pArrayA(), tArrayB_Max, tArrayB_Min '求数组B()元素值的上限和下限
Bytes_SwapByMaxLeft tArrayA_Max, tArrayB_Max
Bytes_SwapByMaxLeft tArrayB_Min, tArrayA_Min
tArray_Max = tArrayA_Max
tArray_Min = tArrayA_Min
ReDim tOutMapA(tArray_Min To tArray_Max) '定义数组A直方图
ReDim tOutMapB(tArray_Min To tArray_Max) '定义数组B直方图
Dim tArrayLength As Long
tArrayLength = UBound(pArrayA())
For tIndex = 0 To tArrayLength '产生两数组直方图
tOutMapA(pArrayA(tIndex)) = tOutMapA(pArrayA(tIndex)) + 1
tOutMapB(pArrayB(tIndex)) = tOutMapB(pArrayB(tIndex)) + 1
Next
pOutMapA() = tOutMapA()
pOutMapB() = tOutMapB()
End Sub
Function Bytes_MatchingCheck2(ByRef pArrayA() As Byte, ByRef pArrayB() As Byte) As Boolean
Dim tOutBool As Boolean
Dim tArrayLength As Long
'初级测试
tOutBool = Bytes_MatchingCheck(pArrayA(), pArrayB())
tArrayLength = tOutBool And (UBound(pArrayA()) - 1)
Dim tIndexLevel1 As Long
Dim tIndexLevel2 As Long
'次级测试
For tIndexLevel1 = 0 To tArrayLength
For tIndexLevel2 = tIndexLevel1 To tArrayLength
'同步排序
Bytes_SwapByMaxLeft pArrayA(tIndexLevel1), pArrayA(tIndexLevel2)
Bytes_SwapByMaxLeft pArrayB(tIndexLevel1), pArrayB(tIndexLevel2)
Next
'同步性检测
tOutBool = tOutBool And (pArrayA(tIndexLevel1) = pArrayB(tIndexLevel1))
If Not tOutBool Then
'不同步立即退出
Exit For
End If
Next
Bytes_MatchingCheck2 = tOutBool
End Function
Function Bytes_MatchingCheck(ByRef pArrayA() As Byte, ByRef pArrayB() As Byte) As Boolean
Dim tOutBool As Boolean
Dim tArrayLength As Long
tArrayLength = UBound(pArrayA())
Dim tIndex As Long
Dim tSumValue As Long
For tIndex = 0 To tArrayLength
tSumValue = tSumValue + (CLng(pArrayA(tIndex)) - CLng(pArrayB(tIndex)))
Next
tOutBool = Not CBool(tSumValue)
Bytes_MatchingCheck = tOutBool
End Function
Sub Bytes_ValueBoundGet(ByRef pBytes() As Byte, ByRef pMax As Byte, ByRef pMin As Byte)
Dim tBytes_Length As Long
tBytes_Length = UBound(pBytes())
Dim tIndex As Long
pMax = pBytes(tIndex)
pMin = pBytes(tIndex)
For tIndex = 0 To tBytes_Length
If pMax < pBytes(tIndex) Then pMax = pBytes(tIndex)
If pMin > pBytes(tIndex) Then pMin = pBytes(tIndex)
Next
End Sub
Sub Bytes_SwapByMaxLeft(ByRef pA As Byte, ByRef pB As Byte)
If pA < pB Then
Bytes_Swap pA, pB
End If
End Sub
Sub Bytes_Swap(ByRef pA As Byte, ByRef pB As Byte)
Dim tT As Byte
tT = pA: pA = pB: pB = tT
End Sub
加载更多回复（20）
