首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

各位大侠,怎么优化下面的VB代码

2012-01-28 
各位大侠,如何优化下面的VB代码?运算量太大,每次数据一多就当机PublicSubTR(ByRefRR()AsDouble,ByRefRRR()

各位大侠,如何优化下面的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

[解决办法]
传递闭包法不合适打数据量的聚类!

热点排行