求M个数中取N个数的VB算法 (N

[yeah_yz]

求M个数中取N个数的VB算法 (N<M)

[jhone99]

看不懂

[fvflove]

'这是VB老鸟给出的算法.可以用一下.(10选N的)
'可以在此基础上改成 M选N的.
Option Explicit
#Const OUTPUT_VALUES = True

#If OUTPUT_VALUES Then
    Private m_aValues(1023 - 1) As Variant '先在 OUTPUT_VALUES = False 下求得 1023
    Private m_lCount As Long
    
    Sub AddValue(ByVal v As Variant)
        m_aValues(m_lCount) = v
        m_lCount = m_lCount + 1
    End Sub
    
    Sub PrintValues()
        Dim i As Long
        Debug.Print "Values(" & m_lCount & ") = {"
        For i = 0 To m_lCount - 1
            If ((i Mod 10) = 0) And (i <> 0) Then Debug.Print
            Debug.Print Format$(m_aValues(i), "@@@@@@@@@@") & ", ";
        Next
        Debug.Print "}"
    End Sub
#End If

Sub Main()
    Dim l As Long, lSum As Long
    Dim i As Long
    
    For i = 1 To 10
        l = f(CDec(0), 9, i)
        lSum = lSum + l
        Debug.Print i, l
    Next
    Debug.Print , lSum
    
#If OUTPUT_VALUES Then
    PrintValues
#End If
End Sub

'求用数字 [0-MaxDigtis] 组成的 Count 位数,Prefix 为前面已组合的数
Function f(ByVal Prefix As Variant, ByVal MaxDigits As Long, ByVal Count As Long) As Long
    Dim MinDigits As Long
    Dim i As Long
    
    If (MaxDigits + 1) < Count Then Exit Function
    
    '0 不能作为最高位
    If (Prefix = 0) And (Count > 1) Then
        MinDigits = 1
    Else
        MinDigits = 0
    End If
    
    
    If Count = 1 Then
#If OUTPUT_VALUES Then
        For i = MinDigits To MaxDigits
            AddValue (Prefix * 10 + i)
        Next
#End If
        f = f + (MaxDigits - MinDigits + 1)
    Else
        For i = MinDigits To MaxDigits
            f = f + f(Prefix * 10 + i, i - 1, Count - 1)
        Next
    End If
End Function

[zzyong00]

你是问M个数中取N个数有多少种取法，还是要N个数的列表，列表是组合还是排列?

[yeah_yz]

组合

[yeah_yz]

如　1,2,3,4,5　　这5（M）个数　任取3（N）个的组合
有:
1,2,3
1,2,4
1,2,5
1,3,4
1,3,5
1,4,5
2,3,4
2,3,5
2,4,5
3,4,5
这些组合列表

当m 、n固定且n很小时　如 m=5 ,n=3 可以用下面的方法列示出来，
dim i as long,j as long,k as long
for i=1 to 5
for j=i+1 to 5
for k=j+1 to 5
debug.print i & "," & j & "," & k
next
next
next

当m,n很大时或m、n未知时　这个方法就不行了。
求一种M个数中取N个数的组合列表的VB算法 (N <M)

[SharingAndGet]

这个要用到递归嵌套才行呀

[vbman2003]

Private Sub Carry(arr() As Long, m As Long, n As Long)
    Dim idx As Long
    Dim V As Long
    idx = n
    V = m - n
    Do
        arr(idx) = arr(idx) + 1
        If arr(idx) > V + idx Then
            idx = idx - 1
        Else
            Exit Do
        End If
    Loop
    Do While idx < n
        idx = idx + 1
        arr(idx) = arr(idx - 1) + 1
    Loop
End Sub

Private Sub PrintArray(a, idx() As Long)
    Dim i As Long
    For i = 1 To UBound(idx)
        Debug.Print a(idx(i) - 1);
    Next
    Debug.Print
End Sub


Private Sub Command1_Click()
    Dim a()
    Dim m As Long, n As Long
    Dim i As Long, j As Long
    
    a = Array(1, 2, 3, 4, 5)
    m = UBound(a) + 1
    n = 3
    
    
    ReDim idx(n) As Long
    For j = 1 To n
        idx(j) = j
    Next
    idx(0) = -1
    
    Do
        PrintArray a, idx
        Carry idx, m, n
    Loop Until idx(0) = 0
   
End Sub

[vbman2003]

[Quote=引用 13 楼 SharingAndGet 的回复:]
这个要用到递归嵌套才行呀
[/Quote]

我的算法不是递归......

[northwolves]

供参考回溯实现数组元素的排列组合

Sub getall(ByVal m As Byte, ByVal n As Byte, Optional types As Byte = 0)'types=0为排列 types=1 为组合
Dim num As Long, i As Integer, k As Integer, a(), s() As String
ReDim a(1 To n)
k = 1
Do
a(k) = a(k) + 1
If a(k) > m Then
k = k - 1
Else
For i = 1 To k - 1
If a(k) = a(i) Then Exit For
Next
If i = k Then
If k = n Then
num = num + 1
ReDim Preserve s(1 To num)
s(num) = Join(a, ",")
End If
If k < n Then k = k + 1: a(k) = a(k - 1) * types

End If
End If
Loop Until k = 0
Debug.Print Join(s, vbTab) 
End Sub

Sub getit()
getall 8, 3, 1 '组合
Debug.Print
getall 8, 3 '排列
End Sub

[northwolves]

我的博客列了几种方法,供参考:
排列组合

[东方之珠]

数学里面的排列和组合,都是有公式可计算的.不知道你问的是排列还是组合。像电话号码是一种排列。

[yeah_yz]

再说一次，是组合，不是排列。 如1,2,3 与1,3,2　算是同一个。
将所有可能的组合列示出来

[东方之珠]

C(m,n)=M!/(N!*(M-N)!),这是组合公式

[Tiger_Zhao]

'求M个数中取N个数的组合
'2008年10月, Tiger_Zhao(http://hi.csdn.net/Tiger_Zhao)
Option Explicit

Private M               As Long
Private N               As Long
Private m_Count         As Long '结果个数
Private m_LoopStack()   As Long '不定长的循环数
Private m_StackIndex    As Long '当前循环层次

Sub Main()
    Combination 5, 3
End Sub

Sub Combination(ByVal lM As Long, ByVal lN As Long)
    M = lM
    N = lN
    m_Count = 0
    ReDim m_LoopStack(1 To N)
    m_StackIndex = N
    
    If NewLoop(1, 1) Then
        NewResult
        
        While m_StackIndex > 0
            If m_LoopStack(m_StackIndex) < M Then
                '循环数 +1
                m_LoopStack(m_StackIndex) = m_LoopStack(m_StackIndex) + 1
                If NewLoop(m_StackIndex + 1, m_LoopStack(m_StackIndex) + 1) Then
                    '可以产生新的组合
                    NewResult
                    m_StackIndex = N
                Else
                    '无法产生新的组合，返回上层循环
                    m_StackIndex = m_StackIndex - 1
                End If
            Else
                '循环结束，返回上层循环
                m_StackIndex = m_StackIndex - 1
            End If
        Wend
    End If
    Debug.Print "Combination(" & M & ", " & N & ") = " & m_Count
End Sub

'初始化循环
'第 Level 层循环数起始值为 Value，下面的循环数起始值逐层 +1
Private Function NewLoop(ByVal Level As Long, ByVal Value As Long) As Boolean
    Dim i As Long, j As Long
    
    If Level > N Then
        NewLoop = True
        Exit Function
    End If
    If (Value + (N - Level)) > M Then Exit Function
    
    j = Value
    For i = Level To N
        m_LoopStack(i) = j
        j = j + 1
    Next
    
    NewLoop = True
End Function

Private Sub NewResult()
    Dim i As Long
    For i = 1 To N
        If i > 1 Then Debug.Print ", ";
        Debug.Print CStr(m_LoopStack(i));
    Next
    Debug.Print
    
    m_Count = m_Count + 1
End Sub

[东方之珠]

Option Explicit
'求组合数: M中任取N个的组合数
Private Sub Command1_Click()
        On Error Resume Next
        Dim M As Long, N As Long, L1 As Long, L2 As Long
        Dim CMN As Long
        M = Val(InputBox("输入M："))
Chenjl: N = Val(InputBox("输入N："))
        If N <= M Then
           L1 = Factorial(M)
           L2 = Factorial(N)
           L2 = L2 * Factorial(M - N)
           CMN = L1 / L2
           Debug.Print "M中任取N个的组合数=" & CMN
        Else
           MsgBox ("请重新输入N！"): GoTo Chenjl
        End If       
End Sub

Private Function Factorial(N As Long) As Long
        If N = 1 Then
           Factorial = 1
        Else
           Factorial = N * Factorial(N - 1)
        End If
End Function

[东方之珠]

将上面Long型全部换成Double型,可以计算大整数!

[bony05]

[Quote=引用 5 楼 yeah_yz 的回复:]
如　1,2,3,4,5　　这5（M）个数　任取3（N）个的组合
有:
1,2,3
1,2,4
1,2,5
1,3,4
1,3,5
1,4,5
2,3,4
2,3,5
2,4,5
3,4,5
这些组合列表

当m 、n固定且n很小时　如 m=5 ,n=3 可以用下面的方法列示出来，
dim i as long,j as long,k as long
for i=1 to 5
for j=i+1 to 5
for k=j+1 to 5
debug.print i & "," & j & "," & k
next
next
next

当m,n很大时或m、n未知时　这…
[/Quote]



上面这段for循环放到VB里运行没有结果！！？？？