各位大侠,如何优化下面的VB代码?
运算量太大,每次数据一多就当机
Public Sub TR(ByRef RR() As Double, ByRef RRR() As Double)
Dim N As Integer, l As Integer
Dim i As Integer, j As Integer, k As Integer
Dim i1 As Integer, j1 As Integer
Dim dMax As Double
N = UBound(RR, 1)
ReDim DMin(0 To N) As Double
l = 0
mulnum = 1
20:
ReDim RRR(r, r) As Double
ReDim DMin(0 To N) As Double
mulnum = mulnum * 2
l = l + 1
If l > 20 Then
MsgBox "已进行20次自乘,仍然没有获得传递性 ", vbCritical, "错误 "
Exit Sub
End If
For i = 0 To N
For j = 0 To N
For k = 0 To N
If RR(i, k) <= RR(k, j) Then
DMin(k) = RR(i, k)
Else
DMin(k) = RR(k, j)
End If
Next
dMax = DMin(0) '模糊矩阵的乘法,取小取大
For k = 1 To N
If DMin(k) > dMax Then dMax = DMin(k)
Next
RRR(i, j) = dMax
Next
Next
Erase DMin
For i = 0 To N
For j = 0 To N
'判断是否式模糊等价矩阵,若非则继续做
If RR(i, j) <> RRR(i, j) Then
For i1 = 0 To N
For j1 = 0 To N
RR(i1, j1) = RRR(i1, j1)
Next
Next
Erase RRR
GoTo 20
End If
Next
Next
End Sub
[解决办法]
传递闭包法不合适打数据量的聚类!