7,763
社区成员
发帖
与我相关
我的任务
分享求一段完整的高效排列算法
A组：A1 A2 A3 A4 A5 A6 A7 A8 A9 A10 A11 A12
B组：B1 B2 B3 B4 B5 B6 B7 B8 B9 B10 B11 B12
C组：C1 C2 C3 C4 C5 C6 C7 C8 C9 C10 C11 C12
以上3组共36个数字全部由数字1至X中取值(35<X<40)；且互不相等
这三组数一定有N种排列的，VB中解决？有没有什么代码？
B组：B1 B2 B3 B4 B5 B6 B7 B8 B9 B10 B11 B12
C组：C1 C2 C3 C4 C5 C6 C7 C8 C9 C10 C11 C12
以上3组共36个数字全部由数字1至X中取值(35<X<40)；且互不相等
这三组数一定有N种排列的，VB中解决？有没有什么代码？
...全文
请发表友善的回复…
发表回复
jmslyz 2004-08-26
- 打赏
- 举报
up
jmslyz 2004-08-24
- 打赏
- 举报
好厉害，分别都用了多长时间啊？我们认识认识怎么样，太佩服了
northwolves 2004-08-24
- 打赏
- 举报
大家进来帮忙吗？真的没人能解决吗？
-----------------------------
没有给你解决吗？
-----------------------------
没有给你解决吗？
thirdapple 2004-08-24
- 打赏
- 举报
得到总数可以用排列组合算法，
jmslyz 2004-08-24
- 打赏
- 举报
大家进来帮忙吗？真的没人能解决吗？
northwolves 2004-08-24
- 打赏
- 举报
打开进程太多，重运行：
P(100000000,36)=999993700019099462889901926036938623246248083821852086887335098879658196254148212439642112581058534267823724891946173000409942028847772998454523183338992366391903282030547625265479803293232625111663749174046436512480646753560009542159099170554901700693994796197233746247680000000000000000
用时 0.00015625 秒, 结果 288 位
P(100000000,36)=999993700019099462889901926036938623246248083821852086887335098879658196254148212439642112581058534267823724891946173000409942028847772998454523183338992366391903282030547625265479803293232625111663749174046436512480646753560009542159099170554901700693994796197233746247680000000000000000
用时 0.00015625 秒, 结果 288 位
abc666 2004-08-24
- 打赏
- 举报
你不会是在做彩票软件吧，也用不着这样啊
northwolves 2004-08-24
- 打赏
- 举报
列出所有结果对于现阶段的计算机完全没必要，也几乎不可能。
而求出排列总数则比较简单，你甚至可以求出当X=100000000时，应该得到的排列总数：
Sub getP(ByVal m As Long, ByVal n As Long, Optional ByRef P As String)
Dim mlen As Long, last As Variant, i As Long, j As Long, temp As Variant
Dim result() As Currency, s() As String, stime As Double
If m < n Then MsgBox "条件错误！": Exit Sub
mlen = 1
stime = Timer
ReDim result(1 To mlen)
result(1) = 1
i = m - n
Do While i < m
i = i + 1
last = 0
For j = 1 To mlen
temp = result(j) * i + last
If temp < 100000 Then
result(j) = temp
last = 0
Else
result(j) = Val(Right(temp, 5))
last = Val(Left(temp, Len(temp) - 5))
End If
Next
Do While Not last = 0
mlen = mlen + 1
ReDim Preserve result(1 To mlen)
If last < 100000 Then
result(mlen) = last
last = 0
Else
result(mlen) = Val(Right(last, 5))
last = Val(Left(last, Len(last) - 5))
End If
Loop
Loop
ReDim s(1 To mlen)
For i = 2 To mlen
s(i) = Format(result(mlen + 1 - i), "00000")
Next
s(1) = result(mlen)
P = Join(s, "")
Debug.Print "P(" & m & "," & n & ")=" & P
Debug.Print "用时 "; FormatNumber(Timer - stime, 8, vbTrue) & " 秒, 结果 " & Len(P) & " 位"
Erase s
Erase result
End Sub
Private Sub Command1_Click()
getP 100000000, 36
End Sub
返回：
P(100000000,36)=999993700019099462889901926036938623246248083821852086887335098879658196254148212439642112581058534267823724891946173000409942028847772998454523183338992366391903282030547625265479803293232625111663749174046436512480646753560009542159099170554901700693994796197233746247680000000000000000
用时 0.05937500 秒, 结果 288 位
而求出排列总数则比较简单，你甚至可以求出当X=100000000时，应该得到的排列总数：
Sub getP(ByVal m As Long, ByVal n As Long, Optional ByRef P As String)
Dim mlen As Long, last As Variant, i As Long, j As Long, temp As Variant
Dim result() As Currency, s() As String, stime As Double
If m < n Then MsgBox "条件错误！": Exit Sub
mlen = 1
stime = Timer
ReDim result(1 To mlen)
result(1) = 1
i = m - n
Do While i < m
i = i + 1
last = 0
For j = 1 To mlen
temp = result(j) * i + last
If temp < 100000 Then
result(j) = temp
last = 0
Else
result(j) = Val(Right(temp, 5))
last = Val(Left(temp, Len(temp) - 5))
End If
Next
Do While Not last = 0
mlen = mlen + 1
ReDim Preserve result(1 To mlen)
If last < 100000 Then
result(mlen) = last
last = 0
Else
result(mlen) = Val(Right(last, 5))
last = Val(Left(last, Len(last) - 5))
End If
Loop
Loop
ReDim s(1 To mlen)
For i = 2 To mlen
s(i) = Format(result(mlen + 1 - i), "00000")
Next
s(1) = result(mlen)
P = Join(s, "")
Debug.Print "P(" & m & "," & n & ")=" & P
Debug.Print "用时 "; FormatNumber(Timer - stime, 8, vbTrue) & " 秒, 结果 " & Len(P) & " 位"
Erase s
Erase result
End Sub
Private Sub Command1_Click()
getP 100000000, 36
End Sub
返回：
P(100000000,36)=999993700019099462889901926036938623246248083821852086887335098879658196254148212439642112581058534267823724891946173000409942028847772998454523183338992366391903282030547625265479803293232625111663749174046436512480646753560009542159099170554901700693994796197233746247680000000000000000
用时 0.05937500 秒, 结果 288 位
jmslyz 2004-08-24
- 打赏
- 举报
thirdapple(.:RNPA:.陨落雕-最近很有审美疲劳) ：
要一个运行时间最短的，最多不得超过8分钟，如果行，你试试，谢谢！
要一个运行时间最短的，最多不得超过8分钟，如果行，你试试，谢谢！
thirdapple 2004-08-24
- 打赏
- 举报
排列组合问题，回溯递归都可以
northwolves 2004-08-23
- 打赏
- 举报
天文数字，做什么用？（对于A组：A1 A2 A3 A4 A5 A6 A7 A8 A9 A10 A11 A12感觉你需要的应该是组合）
northwolves 2004-08-23
- 打赏
- 举报
看看你得算到何时？
x=36 时，有 371993326789901217467999448150835200000000 种排列方法
x=37 时，有 13763753091226345046315979581580902400000000 种排列方法
x=38 时，有 261511308733300555880003612050037145600000000 种排列方法
x=39 时，有 3399647013532907226440046956650482892800000000 种排列方法
x=36 时，有 371993326789901217467999448150835200000000 种排列方法
x=37 时，有 13763753091226345046315979581580902400000000 种排列方法
x=38 时，有 261511308733300555880003612050037145600000000 种排列方法
x=39 时，有 3399647013532907226440046956650482892800000000 种排列方法
jmslyz 2004-08-23
- 打赏
- 举报
请大家帮帮忙，怎么样能快速得到结果呢？
jmslyz 2004-08-23
- 打赏
- 举报
要求列出所有结果
northwolves 2004-08-23
- 打赏
- 举报
x=36 时，有371993326789901217467999448150835200000000种排列方法
视图-->立即窗口查看：
Sub pailie(ByVal n As Integer)
Dim x() As String
Dim i As Integer, j As Integer, Num As Variant
Dim a() As Integer '记载数组下标
Dim b() As Integer '记载使用标识
ReDim x(1 To n)
For i = 1 To n
x(i) = Right("00" & i, 2)
Next
ReDim a(1 To n)
ReDim b(1 To n)
i = 1
a(1) = 0
Num = 1
Do While i <= n
a(i) = a(i) + 1
If a(i) <= n Then
If b(a(i)) = 0 Then
If i = n Then '达到数组末，则输出组合情况
Debug.Print Num & ":"
For j = 0 To 35
Debug.Print Chr(j \ 12 + 65) & j Mod 12 + 1 & "=" & x(a(j + 1)) & " "; '输出
If j Mod 12 = 11 Then Debug.Print
Next
Debug.Print
Num = Num + 1
i = i - 1
b(a(i)) = 0 '清空使用标识
Else
b(a(i)) = 1 '标记已使用
i = i + 1
a(i) = 0 '重查
End If
End If
Else
i = i - 1
If i = 0 Then Exit Do
b(a(i)) = 0
End If
DoEvents
Loop
End Sub
Private Sub Command1_Click()
pailie 37 'x=37时
End Sub
jmslyz 2004-08-23
- 打赏
- 举报
northwolves(狼行天下)：
你写的是把结果写到哪里了？如果NUM 改成DOUBLE 型，执行结果的速度是多长时间？
你写的是把结果写到哪里了？如果NUM 改成DOUBLE 型，执行结果的速度是多长时间？
northwolves 2004-08-23
- 打赏
- 举报
存成文件，你的硬盘即使1000G 估计也放不下，NUM 肯定要溢出，改成DOUBLE 型
northwolves 2004-08-23
- 打赏
- 举报
估计算到明天也算不完
Sub pailie(ByVal n As Integer)
Dim x() As String
Dim i As Integer, j As Integer, Num As Long
Dim a() As Integer '记载数组下标
Dim b() As Integer '记载使用标识
ReDim x(1 To n)
For i = 1 To n
x(i) = Right("00" & i, 2)
Next
ReDim a(1 To n)
ReDim b(1 To n)
i = 1
a(1) = 0
Num = 1
Do While i <= n
a(i) = a(i) + 1
If a(i) <= n Then
If b(a(i)) = 0 Then
If i = n Then '达到数组末，则输出组合情况
Debug.Print Num & ":"
For j = 0 To 35
Debug.Print Chr(j \ 12 + 65) & j Mod 12 + 1 & "=" & x(a(j + 1)) & " "; '输出
If j Mod 12 = 11 Then Debug.Print
Next
Debug.Print
Num = Num + 1
i = i - 1
b(a(i)) = 0 '清空使用标识
Else
b(a(i)) = 1 '标记已使用
i = i + 1
a(i) = 0 '重查
End If
End If
Else
i = i - 1
If i = 0 Then Exit Do
b(a(i)) = 0
End If
DoEvents
Loop
End Sub
Private Sub Command1_Click()
pailie 37 'x=37时
End Sub
Sub pailie(ByVal n As Integer)
Dim x() As String
Dim i As Integer, j As Integer, Num As Long
Dim a() As Integer '记载数组下标
Dim b() As Integer '记载使用标识
ReDim x(1 To n)
For i = 1 To n
x(i) = Right("00" & i, 2)
Next
ReDim a(1 To n)
ReDim b(1 To n)
i = 1
a(1) = 0
Num = 1
Do While i <= n
a(i) = a(i) + 1
If a(i) <= n Then
If b(a(i)) = 0 Then
If i = n Then '达到数组末，则输出组合情况
Debug.Print Num & ":"
For j = 0 To 35
Debug.Print Chr(j \ 12 + 65) & j Mod 12 + 1 & "=" & x(a(j + 1)) & " "; '输出
If j Mod 12 = 11 Then Debug.Print
Next
Debug.Print
Num = Num + 1
i = i - 1
b(a(i)) = 0 '清空使用标识
Else
b(a(i)) = 1 '标记已使用
i = i + 1
a(i) = 0 '重查
End If
End If
Else
i = i - 1
If i = 0 Then Exit Do
b(a(i)) = 0
End If
DoEvents
Loop
End Sub
Private Sub Command1_Click()
pailie 37 'x=37时
End Sub
jmslyz 2004-08-23
- 打赏
- 举报
要求求出三组数的所有情况，比如 X=35 其中一种情况：A1=1 A2=2 A3=3 A4=4 A5=5 A6=6 A7=7 A8=8 A9=9 A10=10 A11=11 A12=12 B1=13 B2=14 B3=15 B4=16 B5=17 B6=18 B7=19 B8=20 B9=21 B10=22 B11=23 B12=24 C1=25 C2=26 C3=27 C4=28 C5=29 C6=30 C7=31 C8=32 C9=33 C10=34 C11=35 C12=36
northwolves 2004-08-20
- 打赏
- 举报
n=x!\(x-36)!
加载更多回复（1）
