大数据量循环判断,常规方法速度太慢,敬请高手"提速"(附常规方法程序源码)

Question

要干掉的问题是这个样子的... 有一个数组:03 08 13 19 26 28
要求出所有的与之有4个相同的组合数组有5265组(取数范围在1-33之间,直接说就是双色球的33个号码 ^-^):
如
03 08 13 19 27 29
03 08 13 19 28 29
03 08 13 19 29 30
...我编写了以下的程序:
sub fourjz()Dim i As Integer, j As Integer, k As Integer, n As Integer, p As Integer, q As Integer, 1 As Integer,m as integerdim strtb() as stringdim kjh(1) as stringdim arr(1 to 6) as integerarr(1,1)=03
arr(1,2)=08
arr(1,3)=13
arr(1,4)=19
arr(1,5)=26
arr(1,6)=28kjh(1)="03 08 13 19 26 28"
redim strb(1 to 5265)dt = 0For i = 1 To arr(1, 3)For j = 2 To arr(1, 4)For k = arr(1, 1) To arr(1, 5)For n = arr(1, 2) To arr(1, 6)For p = arr(1, 3) To 32For q = arr(1, 4) To 33
If i < j And j < k And k < n And n < p And p < q Then
If InStr(kjh(1), Format(i, "00")) > 0 Then dt = dt + 1
If InStr(kjh(1), Format(j, "00")) > 0 Then dt = dt + 1
If InStr(kjh(1), Format(k, "00")) > 0 Then dt = dt + 1
If InStr(kjh(1), Format(n, "00")) > 0 Then dt = dt + 1
If InStr(kjh(1), Format(p, "00")) > 0 Then dt = dt + 1
If InStr(kjh(1), Format(q, "00")) > 0 Then dt = dt + 1End IfIf dt = 4 Then r1 = r1 + 1 strtb(r1) = Format(i, "00") + " " + Format(j, "00") + " " + Format(k, "00") + " " + Format(n, "00") + " " + Format(p, "00") + " " + Format(q, "00")
 
End If
 
 dt = 0Next qNext pNext nNext kNext jNext i
end sub以上是1期的循环判断,在我的电脑上大概要10秒,现在数据有705期,全部计算所需时间为:10*705=7050秒,近2个小时,太慢了,敬请各位高手指点一下,谢谢~

Answer 1

先谢谢jennyvenus的回复．．．但问题依然．．．

Answer 2

我用vb写过一个 大乐透过滤软件 35选5 ，全组很快，大概3秒之内，过滤稍慢，大概在30秒之内。我觉得我已经把vb的速度挖掘到80%以上了，但是这仍然是个问题，跟某些语言相比这只能算拖拉机的速度。
（因为我那是共享软件，所以，具体的代码就不便透露了）
给个建议：用c或vc做个计算的dll，或许会提速不少。

Answer 3

给个思路，尽量用1维数组，用for循环，不要用str或者cint等转来转去的，vb会自动把数值型的string转为long进行计算，尽量用long ，而不用integer，long 更快

Answer 4

如果不用字串...
If InStr(kjh(1), Format(i, "00")) > 0 Then dt = dt + 1 这句要用两个for i=1 to 6 这样的循环,速度也不会快的你是高手,能否写一个简单的示例,如你也玩双色的话,我们可以交流一下,我还有点心得,呵呵~

Answer 5

我重新定义类型为long型的试试,但只更改数据类型,估计速度也不会有明显的提高...

Answer 6

提示你一下
  先用数组把所有 05 10 15 20 22 32类似这样的都割断成单独的一项
然后
   for     step6

Answer 7

dim arr(1 to 6) as integer arr(1,1)=03 你这里能编译通过嘛?明显定义的一维数组，却用二维的方式赋值？

Answer 8

原来是二维的数组redim arr(1 to 开奖期数,1 to 6)为了说明方便,定义成这样了,理解为第一期开奖号码的第1至第6位谢谢你的参与...

Answer 9

我把所有的变量声明为long,
将所有的开奖号码设定为一个长的一维数组,进行了测试,速度没有提高原来是二维的数组 redim arr(1 to 开奖期数,1 to 6) 现在定义为redim arr(1 to 开奖期数*6)循环部分变为:do until 3+r4=开奖期数*6For i = 1 To arrt(3 + r4)For j = 2 To arrt(4 + r4)For k = arrt(1 + r4) To arrt(5 + r4)For n = arrt(2 + r4) To arrt(6 + r4)For p = arrt(3 + r4) To 32For q = arrt(4 + r4) To 33
If i < j And j < k And k < n And n < p And p < q Then
If InStr(kjh(mp), Format(i, "00")) > 0 Then dt = dt + 1
If InStr(kjh(mp), Format(j, "00")) > 0 Then dt = dt + 1
If InStr(kjh(mp), Format(k, "00")) > 0 Then dt = dt + 1
If InStr(kjh(mp), Format(n, "00")) > 0 Then dt = dt + 1
If InStr(kjh(mp), Format(p, "00")) > 0 Then dt = dt + 1
If InStr(kjh(mp), Format(q, "00")) > 0 Then dt = dt + 1End IfIf dt = 4 Then r1 = r1 + 1 strtb(r1) = Format(i, "00") + " " + Format(j, "00") + " " + Format(k, "00") + " " + Format(n, "00") + " " + Format(p, "00") + " " + Format(q, "00")
 
End If
 
 dt = 0Next qNext pNext nNext kNext jNext ir4 = r4 + 6loop请您烦心看一下,是否我改动的方法不对?

Answer 10

吐血，，，6层嵌套，还instr比较
 for i=1 to  最后期数 step6  ’总号码的一维数组
   n=0
   for j=1 to 6 ’每一组号码
     for k=1 to 6 '样本号码
       '比较
       if 相同 then
         n=n+1
       end if
     next
   next
   if n>=4 then '4个以上号码相同
    保存
   end if
 next

Answer 11

修改一下
   for j=1 to 6 --->for j=i to i+5

Answer 12

吐血，，，6层嵌套，还instr比较 
 for i=1 to  最后期数 step6  ’总号码的一维数组 
   n=0 
   for j=1 to 6 ’每一组号码 
     for k=1 to 6 '样本号码 
       '比较 
       if 相同 then 
         n=n+1 
       end if 
     next 
   next 
   if n>=4 then '4个以上号码相同 
    保存 
   end if 
 next我晕...for k=1 to 6 '样本号码 
       '比较 
       if 相同 then 
         n=n+1 
       end if 
     next 这里的for k=1 to 6 '样本号码 我费了这么大的劲就是为了求出这个"样本号码"呀, 你的程序里没见到怎么求出与"样本号码"...
没有"样本号码"怎么与奖号比较???

Answer 13

如果你这个问题只是针对这种情况的话，这些组合数量都是确定的，所以：
1.从6个数取4个有15种 (A1)
2.剩下的27个里取两个有351种组合 (A2)
3.A1,A2的笛卡尔积 15*351应该是不到1秒钟了
example:    Dim num1(6) As Integer  '6个
    Dim num2(27) As Integer '余下27个（33-6）
    Dim list1(15) As String '6选4 共15种组合
    Dim list2(351) As String '27选2 共351种组合
    Dim listall(5265) As String '总共5265种
    Dim index As Integer    Sub Init() '初始化数组 num1, num2
Dim i As Integer
        num1(1) = 3
        num1(2) = 8
        num1(3) = 13
        num1(4) = 19
        num1(5) = 26
        num1(6) = 28
        index = 1
        For i = 1 To 33
            If i <> num1(1) And i <> num1(2) And i <> num1(3) And i <> num1(4) And i <> num1(5) And i <> num1(6) Then
                num2(index) = i
                index = index + 1
            End If
        Next
    End Sub    Sub EnumNum1() '6选4所有组合
        Dim i, j, k, l As Integer
        index = 1
        For i = 4 To 6
            For j = 1 To i - 1
                For k = 1 To j - 1
                    For l = 1 To k - 1
                        list1(index) = list1(index) + Format(num1(i), "00")
                        list1(index) = list1(index) + "," + Format(num1(j), "00")
                        list1(index) = list1(index) + "," + Format(num1(k), "00")
                        list1(index) = list1(index) + "," + Format(num1(l), "00") + ","
                        index = index + 1
                    Next
                Next
            Next
        Next
    End Sub    Sub EnumNum2() '27选2所有组合
        Dim i, j As Integer
        index = 1
        For i = 2 To 27
            For j = 1 To i - 1
                list2(index) = Format(num2(i), "00") + "," + Format(num2(j), "00")
                index = index + 1
            Next
        Next
    End Sub    Sub EnumAll() '列举总共5265组
Init()
EnumNum1()
EnumNum2()
        index = 1
        Dim i, j As Integer
        For i = 1 To 15
            For j = 1 To 351
                listall(index) = list1(i) + list2(j)
                index = index + 1
            Next
        Next
    End Sub

Answer 14

从原来的代码看，稍微做一些调整，速度就可以增加，例如：调用了过多不必要的Format()'可以定一个数组，开始的时候一次算好
Dim StrOfNum(33) as String
For i = 0 to 33
    StrOfNum(i)=Format(i,'00')
Next以后需要用到字符串的地方直接用StrOfNum(x) 代替Format(x,"00")就可以了

Answer 15

本来不抱什么希望了,早晨到单位打开电脑随便看一眼,不想却遇blue-rat高人,幸甚,幸甚!
这种算法是从理论这个"根"上解决问题,非常理想,在下获益非浅...非常感谢!!!