全组合需要12个小时才能算出45选6的全部组合。有没有办法改进一下运行时间呢。程序代码如下：注意是VFP的，我只会这个编程。
我用VFP设计了一个计算全组合的程序发给大家看看。帮忙改进一下。应为算了一下运行时间，全组合需要12个小时才能算出45选6的全部组合。有没有办法改进一下运行时间呢。程序代码如下：注意是VFP的，我只会这个编程。CREAT TABLE ddd(x1 n,X2 N,x3 n,x4 n,x5 n,x6 n)
use ddd
x=45
dimension abs1(x)
for aa=1 to x
abs1(aa)=aa
endfor
dimension abs2(6)
for a=1 to x
for b=1 to x
if abs1(a)=abs1(b)
loop
endif
for c=1 to x
if abs1(a)=abs1(c) or abs1(b)=abs1(c)
loop
endif
for d=1 to x
if abs1(a)=abs1(d) or abs1(b)=abs1(d) or abs1(c)=abs1(d)
loop
endif
for e=1 to x
if abs1(a)=abs1(e) or abs1(b)=abs1(e) or abs1(c)=abs1(e) or abs1(d)=abs1(e)
loop
endif
for f=1 to x
if abs1(a)=abs1(f) or abs1(b)=abs1(f) or abs1(c)=abs1(f) or abs1(d)=abs1(f) or abs1(e)=abs1(f)
loop
endif
append blank
replace x1 with caa(1), x2 with caa(2), x3 with caa(3),x4 with caa(4),x5 with caa(5),x6 with caa(6)
endfor
endfor
endfor
endfor
endfor
endfor --------------------编程问答-------------------- 如果是做彩票程序，建议别做，真没意思！！！ --------------------编程问答-------------------- 请高手指教，在线等待 --------------------编程问答-------------------- 跪求啊，小弟不才。想不出更好的改进方法了，运行一次就要12个小时，这不是要命了吗？跪求大虾解救。 --------------------编程问答-------------------- 大虾出手吧，俺等着你们的帮忙。 --------------------编程问答-------------------- 用过递归函数吧，也不知道你怎么算了 要12小时？ --------------------编程问答-------------------- 晕,不会VFP啊.楼主尽量多学门语言吧.现在只会VB6都不好混,更别说VFP了 --------------------编程问答-------------------- 此处是 VB --------------------编程问答-------------------- 算法 ：45！/(6!*39!)
本人做个试验45！在非常短的时间就能计算出来。不知道为什么楼主需要12小时。 --------------------编程问答-------------------- Private Sub Command1_Click()'45!
Dim zong As Double
zong = 1
For i = 1 To 45
zong = zong * i
Next
Text1.Text = zong
End Sub
结果: 1.1962222086548E+56 --------------------编程问答-------------------- 我计算出来的是每个组合，不是算算总有多少个组合。 --------------------编程问答-------------------- 组合这么大的数无论什么算法都是很费时的。
--------------------编程问答-------------------- 一个Button,一个TextBox
1000个中取50个要不了多久.
使用递归的(等有时间弄个C#的)
代码如下:
--------------------编程问答--------------------
Option Explicit
Dim m_ResultList() As Integer '结果集
Dim m_SourceList() As Integer '源
Dim m_Count As Integer '当前结果集个数
Dim m_SelectCount As Integer '取数个数
Dim m_MaxCount As Integer '最大数
'最大数,取数个数
Private Sub Combinations(ByVal MaxCount As Integer, ByVal SelectCount As Integer)
Dim r As Variant
Dim i As Integer
'初始化
ReDim m_SourceList(MaxCount - 1)
ReDim m_ResultList(SelectCount - 1)
m_MaxCount = MaxCount
m_SelectCount = SelectCount
For i = 0 To MaxCount - 1
m_SourceList(i) = i + 1
Next
m_Count = 0 '初始化
r = GetList(m_ResultList)
End Sub
'递归
Private Function GetList(ByRef r As Variant) As Variant
While m_Count < m_SelectCount
Dim i As Integer
Dim j As Integer
Randomize
r(m_Count) = CInt(m_MaxCount * Rnd() + 1) '随机取值,范围为1 ~ m_MaxCount
For i = 0 To UBound(r)
For j = 0 To UBound(m_SourceList)
If r(i) = m_SourceList(j) Then
m_SourceList(j) = -1 '赋值为-1,标记不再使用
m_Count = m_Count + 1 '当前结果集个数+1
r = GetList(r)
End If
Next
Next
Wend
'检查是否有重复数据所用代码
' Dim m As Integer
' Dim n As Integer
' Dim ReaptCount As Integer
'
' For m = 0 To UBound(r) - 1
' ReaptCount = 1
'
' For n = 0 To UBound(r) - 1
'
' If r(m) = r(n) Then
' If ReaptCount = 2 Then
' MsgBox ("Repeated!")
' GoTo EndLine
' End If
'
' ReaptCount = ReaptCount + 1
' End If
'
' Next
' Next
'
EndLine: GetList = r
End Function
Private Sub cmdCommand1_Click()
Dim i As Integer
Combinations 1000, 50 '1000个中取个
txtText1.Text = ""
For i = 0 To UBound(m_ResultList) - 1
txtText1.Text = m_ResultList(i) & " " & txtText1.Text
Next
End Sub
'获得组合总数
Private Function Total(ByVal M As Long, ByVal N As Long) As Double
Dim i As Long
Dim Result As Double
Result = 1
For i = N To 1 Step -1
Result = Result * M / i
M = M - 1
Next
Total = Result
End Function
Private Sub Command1_Click()
Debug.Print Total(45, 6)
End Sub
'8145060
上面这个计算出45选6的完全组合为8145060个，如果单单是组合不要求输出结果，全部用long类型，VB的算法（不用递归，递归效率或许更低）估计10秒内可以完成，问题是在于要考虑输出，这样时间会消耗的很厉害....一时想不出好办法... --------------------编程问答-------------------- 不知道楼主弄这个出来有什么意义呢？ 难道还准备一一列出来？？ --------------------编程问答-------------------- 1.最小是8145060次可以列举出所有组合,还要考虑到随机选取的重复次数
2.不单单是考虑输出,还要考虑判断,因为每次拿出来的组合就要去和已有的组合去对比是否存在,这个判断越到后面消耗越大.最少扫描 8145060 次的判断(存放数据库中).如果不判断,直接保存,就需要进行取重复的操作.
还有要考虑到内存溢出的问题.
在.NET中可以用List<T>不判断直接插入,但是Distinct以及输出时间... ....
--------------------编程问答-------------------- 代码明显有问题：
⒈ abs2(6) 定义了，但没有使用。
⒉ caa() 没有定义、没有赋值，但却用它来更新数据库的字段。
--------------------编程问答-------------------- 从“目前的”代码来看，你那些 if语句 似乎没有实际意义。
--------------------编程问答-------------------- 高手都在，班门弄斧提一下建议：先遍历所有组合存入数据库，以后每次使用时，随机生成序列号查询数据库。这样一劳永逸，每次操作数据库也快。我自己刚刚写了代码，照我的机器现在运行10分钟已经47万组了，800万组也就3个小时。(不过不清楚楼主的用途，平时随机几组不就行吗？)
Dim i1%, i2%, i3%, i4%, i5%, i6%--------------------编程问答-------------------- ...................路过. --------------------编程问答-------------------- 路过要指点一下啊，老师。(这么晚还没休息，注意身体) --------------------编程问答-------------------- 你這个是排列,总数是:5,864,443,200
For i1 = 1 To 45
For i2 = 1 To 45
Do While i2 = i1
i2 = i2 + 1
Loop
For i3 = 1 To 45
Do While i3 = i1 Or i3 = i2
i3 = i3 + 1
Loop
For i4 = 1 To 45
Do While i4 = i1 Or i4 = i2 Or i4 = i3
i4 = i4 + 1
Loop
For i5 = 1 To 45
Do While i5 = i1 Or i5 = i2 Or i5 = i3 Or i5 = i4
i5 = i5 + 1
Loop
For i6 = 1 To 45
Do While i6 = i1 Or i6 = i2 Or i6 = i3 Or i6 = i4 Or i6 = i5
i6 = i6 + 1
Loop
MsgBox i1 & "-" & i2 & "-" & i3 & "-" & i4 & "-" & i5 & "-" & i6 '组合
Next i6
Next i5
Next i4
Next i3
Next i2
Next i1
45选6是组合,总数是:8,145,060
--------------------编程问答-------------------- 下面的算法在我机器上3秒不到(无输出)...
Option Explicit
'获得组合总数
Private Function Total(ByVal m As Long, ByVal n As Long) As Long
Dim i As Long
Dim Result As Double
Result = 1
For i = n To 1 Step -1
Result = Result * m / i
m = m - 1
Next
Total = Result
End Function
Private Sub CarryComb(CombItem() As Long, pComp() As Long, n As Long)
Dim i As Long
i = n
While CombItem(i) = pComp(i)
i = i - 1
Wend
CombItem(i) = CombItem(i) + 1
While i < n
i = i + 1
CombItem(i) = CombItem(i - 1) + 1
Wend
End Sub
Private Sub CombResult(m As Long, n As Long, Optional Result As Variant)
Dim i As Long, j As Long
Dim Num As Long
If n > m Then Exit Sub
ReDim CombItem(1 To n) As Long
ReDim pComp(1 To n) As Long
Num = m - n
For i = 1 To n - 1
CombItem(i) = i
pComp(i) = Num + i
Next
CombItem(n) = n - 1
pComp(n) = m
Num = Total(m, n) ': Debug.Print Num
'ReDim Result(1 To Num)
For i = 1 To Num
CarryComb CombItem, pComp, n
'Result(i) = CombItem
'DoEvents
Next
Result = CombItem '最后一个组合结果
End Sub
'输出单个组合结果
Private Sub PrintComb(CombItem, n As Long)
Dim i As Long
For i = 1 To n
Debug.Print CombItem(i);
Next
Debug.Print
End Sub
Private Sub Command1_Click()
Dim m As Long, n As Long
Dim myResult
Dim t As Double
t = Timer
m = 45
n = 6
Call CombResult(m, n, myResult)
'Debug.Print Join(myResult, vbCrLf)
Debug.Print Timer - t
Call PrintComb(myResult, n) '验证最后一个组合
End Sub
理论上,在一定规则下,应该可以实现指定第x个组合,不用循环直接得到第x个组合的结果,也可以由一个组合结果得到是第几个组合...等没事时,有兴趣的话再研究下.... --------------------编程问答-------------------- 谢谢21楼老师提醒，确实存在漏洞，呵呵。我修改一下，没详测，请老师们空了指点。
Private Sub Command1_Click()--------------------编程问答-------------------- 哇，高手，学习了。先上班待会再来请教老师。 --------------------编程问答-------------------- 如果仅仅是输出所有组合(跟随机数没关的话),不需要那么多多余的代码
Dim i1%, i2%, i3%, i4%, i5%, i6%
For i1 = 1 To 45
For i2 = 1 To 45
Do While i2 = i1
i2 = i2 + 1: If i2 > 45 Then Exit For
Loop
For i3 = 1 To 45
Do While i3 = i1 Or i3 = i2
i3 = i3 + 1: If i3 > 45 Then Exit For
Loop
For i4 = 1 To 45
Do While i4 = i1 Or i4 = i2 Or i4 = i3
i4 = i4 + 1: If i4 > 45 Then Exit For
Loop
For i5 = 1 To 45
Do While i5 = i1 Or i5 = i2 Or i5 = i3 Or i5 = i4
i5 = i5 + 1: If i5 > 45 Then Exit For
Loop
For i6 = 1 To 45
Do While i6 = i1 Or i6 = i2 Or i6 = i3 Or i6 = i4 Or i6 = i5
i6 = i6 + 1: If i6 > 45 Then Exit For
Loop
MsgBox i1 & "-" & i2 & "-" & i3 & "-" & i4 & "-" & i5 & "-" & i6 '组合
Next i6
Next i5
Next i4
Next i3
Next i2
Next i1
End Sub
下面的代码,把所有的组合都输出
输出是调用API的,每次输出2000组结果到txt,如果不调用API代码更少,只是会慢些
(应该还有更快的方法输出,直接操作数组,不用string)
目前大概51分钟,txt档案 130Mb左右
--------------------编程问答-------------------- 输入多个txt文本中...1分钟多点.....
Const GENERIC_WRITE = &H40000000
Const GENERIC_READ = &H80000000
Const FILE_ATTRIBUTE_NORMAL = &H80
Const CREATE_ALWAYS = 2
Const OPEN_ALWAYS = 4
Const INVALID_HANDLE_VALUE = -1
Private Declare Function WriteFile _
Lib "kernel32" (ByVal hFile As Long, _
ByVal lpBuffer As String, _
ByVal nNumberOfBytesToWrite As Long, _
lpNumberOfBytesWritten As Long, _
ByVal lpOverlapped As Long) As Long
Private Declare Function CreateFile _
Lib "kernel32" _
Alias "CreateFileA" (ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
Private Sub cmdCommand3_Click()
Dim i1 As Integer, i2 As Integer, i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer
Dim lCount As Long
Dim strResult As String
Dim fHandle As Long
Dim fSuccess As Long
Dim lBytesWritten As Long
Dim BytesToWrite As Long
Dim BeginTime As Date
Dim EndTime As Date
Dim TotalCount As Double
BeginTime = Now
If Dir("d:\1.txt") <> "" Then Kill ("d:\1.txt")
fHandle = CreateFile("d:\1.txt", GENERIC_WRITE Or GENERIC_READ, 0, 0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
If fHandle = INVALID_HANDLE_VALUE Then
CloseHandle (fHandle)
Exit Sub
End If
For i1 = 1 To 45
For i2 = 1 To 45
If i2 = i1 Then Exit For
For i3 = 1 To 45
If i3 = i2 Or i3 = i1 Then Exit For
For i4 = 1 To 45
If i4 = i3 Or i4 = i2 Or i4 = i1 Then Exit For
For i5 = 1 To 45
If i5 = i4 Or i5 = i3 Or i5 = i2 Or i5 = i1 Then Exit For
For i6 = 1 To 45
If i6 = i5 Or i5 = i4 Or i5 = i3 Or i5 = i2 Or i5 = i1 Then Exit For
strResult = strResult & i1 & "-" & i2 & "-" & i3 & "-" & i4 & "-" & i5 & "-" & i6 & " "
lCount = lCount + 1
TotalCount = TotalCount + 1
'每个结果输出一次到文本
If lCount = 2000 Then
'取得字符串长度
BytesToWrite = Len(strResult)
fSuccess = WriteFile(fHandle, strResult, BytesToWrite, lBytesWritten, 0)
'是否写入成功
If fSuccess <> 0 Then
'强制输出缓存
fSuccess = FlushFileBuffers(fHandle)
End If
'清空结果
strResult = ""
lCount = 0
End If
Next
Next
Next
Next
Next
Next
CloseHandle (fHandle)
EndTime = Now
MsgBox ("Time: " & DateDiff("n", BeginTime, EndTime) & " Count:" & TotalCount)
End Sub
--------------------编程问答-------------------- 上的计算用了Variant,与long相比,速度慢了许多....没时间深究了,算是个思路吧....
Option Explicit
'获得组合总数
Private Function Total(ByVal m As Long, ByVal n As Long) As Long
Dim i As Long
Dim Result As Double
Result = 1
For i = n To 1 Step -1
Result = Result * m / i
m = m - 1
Next
Total = Result
End Function
Private Sub CarryComb(CombItem, pComp() As Long, n As Long)
Dim i As Long
i = n
While CombItem(i) = pComp(i)
i = i - 1
Wend
CombItem(i) = CombItem(i) + 1
While i < n
i = i + 1
CombItem(i) = CombItem(i - 1) + 1
Wend
End Sub
Private Sub CombResult(m As Long, n As Long, Optional Result As Variant)
Dim i As Long, j As Long
Dim Num As Long
Dim Idx As Long
Dim h As Long
Const Length = 100000 '每个文本的组合个数
If n > m Then Exit Sub
ReDim CombItem(1 To n)
ReDim pComp(1 To n) As Long
Num = m - n
For i = 1 To n - 1
CombItem(i) = i
pComp(i) = Num + i
Next
CombItem(n) = n - 1
pComp(n) = m
Num = Total(m, n) ': Debug.Print Num
ReDim Result(1 To Length)
For i = 1 To Num
CarryComb CombItem, pComp, n
Idx = Idx + 1
Result(Idx) = Join(CombItem)
If Idx = Length Then
Idx = 0
h = FreeFile
Open "D:\comb" & i & ".txt" For Binary As h
Put #h, , Join(Result, vbCrLf)
Close
ReDim Result(1 To Length)
End If
'DoEvents
Next
Open "D:\comb" & i & ".txt" For Binary As h
Put #h, , Join(Result, vbCrLf)
Close
End Sub
Private Sub Command1_Click()
Dim m As Long, n As Long
Dim t As Double
t = Timer
m = 45
n = 6
Call CombResult(m, n)
Debug.Print Timer - t
End Sub
补充：VB , 基础类
