1、第一个关于组合的问题：这个我知道算法，可是我怎么样都写不出来：
比如： a b c d e 四个字母取三个可组合成：abc abc abd abe acd ace ade bcd dce cde 分析上面可以看到 ：首先固定第一（如a），其后是在另４数中再"组合"２个。这就将"５个中３的组合"推到了"４个中２个的组合"上去了。第一位数可以是n取r(如５取3)，n个数中r个组合递推到n-1个中r-1个有组合，这是一个递归的算法。 请给出一个完整可行的VB源程序！
2、第二个关于集合的问题：应该很简单
请给出一个可以通用的函数或者说过程，可以进行pascal 程序中的集合交、并、补的运算！要求是各元素都放数组。
请给出一个完整可行的VB源程序！
比如： a b c d e 四个字母取三个可组合成：abc abc abd abe acd ace ade bcd dce cde 分析上面可以看到 ：首先固定第一（如a），其后是在另４数中再"组合"２个。这就将"５个中３的组合"推到了"４个中２个的组合"上去了。第一位数可以是n取r(如５取3)，n个数中r个组合递推到n-1个中r-1个有组合，这是一个递归的算法。 请给出一个完整可行的VB源程序！
2、第二个关于集合的问题：应该很简单
请给出一个可以通用的函数或者说过程，可以进行pascal 程序中的集合交、并、补的运算！要求是各元素都放数组。
请给出一个完整可行的VB源程序！
你能教我怎么样做吗？
pascal有专门的函数，可以VB中没有的。
我是想把那些所有的组合都打印出来。
比如： 现共有a b c d e 五个字母取三个组合有：
abc abc abd abe acd ace ade bcd dce cde
就是想把这些可能存在的组合都打印出来。
最好是构造出一个函数或过程出来，这样的通用性会常些。
我编了一个结果可不行。
Dim cm As Long
Const aa = 5
Const bb = 3
Const kk = 5Sub rand() ‘产生随机数
Dim count As Integer
Dim intNum As Integer
Dim num As Integer
num = 33
For k = 1 To kk
count = count + 1
Randomize
intNum = Int((num * Rnd) + 1)
If count <> 1 Then
For i = 1 To count - 1
Do Until arrnum(i) <> intNum
If arrnum(i) = intNum Then
intNum = Int((num * Rnd) + 1)
i = 1
End If
Loop
Next i
End If
arrnum(k) = intNum
If count = kk Then
count = 0
Exit Sub
End If
Next k
End Sub Sub comb(n As Integer, r As Integer)’请帮忙改写这部分，N个数中取R的组合。
Dim k, i, temp As Integer
For i = n To r Step -1
If r > 1 Then Call comb(i - 1, r - 1)
If r <= 1 Then Print arrnum(Abs(n - i + 1));
Next i
Print
End SubPrivate Sub Command1_Click()’产生随机数并排序并且计算出可能的组合有多少种！
Cls
Call rand
Call BubbleSortNumbers(arrnum())
For i = 1 To kk
Print arrnum(i);
Next i
Call cmn(aa, bb)
Print: Print
Print aa; "取"; bb; "的值是:"; cm
End SubPrivate Sub Command2_Click() ‘这个是我要的关键，想把所有组合排列出来。
Dim i As Integer
Call comb(aa, bb)
Next i
End Sub
Sub cmn(mm As Long, nn As Long) ’用于计算组合的数量
k = mm
j = 1
For i = 1 To nn - 1
k = k * (mm - i)
j = j * (i + 1)
Next i
cm = k / j
End SubSub BubbleSortNumbers(iArray As Variant)‘冒泡排序
Dim lLoop1 As Long
Dim lLoop2 As Long
Dim lTemp As Long
For lLoop1 = UBound(iArray) To LBound(iArray) Step -1
For lLoop2 = LBound(iArray) + 1 To lLoop1
If iArray(lLoop2 - 1) > iArray(lLoop2) Then
lTemp = iArray(lLoop2 - 1)
iArray(lLoop2 - 1) = iArray(lLoop2)
iArray(lLoop2) = lTemp
End If
Next lLoop2
Next lLoop1
End Sub运行结果：
1 12 13 14 23
5取3的值是：10
1 12 13
1 12
1 1 12
1
1而我想的结果不是这样的，而是
1 12 13
1 12 14
1 12 23
1 13 14
1 13 23
1 14 2312 13 14
12 13 23
12 14 2313 14 23
两个for循环解决
用for怎么样解决呢？
请具体些好吗？
穷举搜索法是穷举所有可能情形，并从中找出符合要求的解。
穷举所有可能情形，最直观的是联系循环的算法。
[例]找出n个自然数(1,2,3,…,n)中r个数的组合。例如，当n=５,r=3时，所有组合为：
５ ４ ３
５ ４ ２
５ ４ １
５ ３ ２
５ ３ １
５ ２ １
４ ３ ２
４ ３ １
４ ２ １
３ ２ １
total=10 {组合的总数}
[解]n个数中r的组合，其中每r 个数中，数不能相同。另外，任何两组组合的数，所包含的数也不应相同。例如，５、４、３与３、４、５。为此，约定前一个数应大于后一个数。
将上述两条不允许为条件，当r=3时，可用三重循环进行搜索。
［程序］
Program zuhe11;
const n=5;
var i,j,k,t:integer;
begin t:=0;
for i:=n downto 1 do
for j:=n downto 1 do
for k:=n downto 1 do
if (i<>j)and(i<>k)and(i>j)and(j>k) then
begin t:=t+1;writeln(i:3,j:3,k:3);end;
writeln('total=',t);
end.
或者
Program zuhe12;
const n=5;r=3;
var i,j,k,t:integer;
begin t:=0;
for i:=n downto r do
for j:=i-1 downto r-1 do
for k:=j-1 downto 1 do
begin t:=t+1;writeln(i:3,j:3,k:3);end;
writeln('total=',t);
end.
这两个程序，前者穷举了所有可能情形，从中选出符合条件的解，而后者比较简洁。但是这两个程序都有一个问题，当r变化时，循环重数改变，这就影响了这一问题的解，即没有一般性。
但是，很多情况下穷举搜索法还是常用的。
二、递归法
递归法也是常用的方法。
［例］仍以前节例题为例，找n个数的r个数的组合。要求：
输入：n,r=5 3
输出：５ ４ ３
５ ４ ２
５ ４ １
５ ３ ２
５ ３ １
５ ２ １
４ ３ ２
４ ３ １
４ ２ １
３ ２ １
total=10 {组合的总数}
［解］分析所提示的10组数。首先固定第一位数（如５），其后是在另４个数中再“组合”２个数。这就将“５个数中３个数的组合”推到了“４个数中２个数的组合”上去了。第一位数可以是n r(如５ 3)，n个数中r个数组合递推到n-1个数中r-1个数有组合，这是一个递归的算法。即：
Procedure comb(n,r:integer);
var i:integer;
begin
for i:=n downto r do
begin {固定i的输出位置}
comb(i-1,r-1); {原过程递推到i-1个数的r-1个数组合}
end;
end;
再考虑打印输出格式。
［程序］
Program zuhe2;
var k,n,r:integer;
Produrce comb(n,r:integer);
var i,temp:integer;
begin for i:=n downto r do
if (i<>n)and(k<>r) then {k为过程外定义的}
begin for temp:=1 to (k-r)*3 do write(' '); {确定i的输出位置}
end;
write(i:3);
if i>1 then comb(i-1,r-1); {递推到下一情形}
else writeln;
end;
Begin {main}
write('n,r=');readln(n,r);
if r>n then
begin writeln('Input n,r error!');halt; end;
comb(n,r); {调用递归过程}
End;
三、回溯法
回溯法是一种选优搜索法，按选优条件向前搜索，以达到目标。但当探索到某一步时，发现原先选择并不优或达不到目标，就退回一步重新选择，这种走不通就退回再走的技术为回溯法，而满足回溯条件的某个状态的点称为“回溯点”。
［例］再以前例说明，找n个数中r个数的组合。
［解］将自然数排列在数组A中：
A[1] A[2] A[3]
5 4 3
5 4 2
…
3 2 １
排数时从A[1] A[2] A[3]，后一个至少比前一个数小１，并且应满足ri+A[ri]>r。若ri+A[ri]≤r就要回溯，该关系就是回溯条件。为直观起见，当输出一组组合数后，若最后一位为１，也应作一次回溯（若不回，便由上述回溯条件处理）。
［程序］
program zuhe3;
type tp=array[1..100] of integer;
var n,r:integer;
procedure comb2(n,r:integer;a:tp);
var i,ri:integer;
begin ri:=1;a[1]:=n;
repeat
if ri<>r then {没有搜索到底}
if ri+a[ri]>r then ｛是否回溯｝
begin a[ri+1]:=a[ri]-1;
ri:=ri+1;
end
else
begin ri:=ri-1; a[ri]:=a[ri]-1;end; {回溯}
else
begin for j:=1 to r do write(a[j]:3);writeln; {输出组合数}
if a[r]=1 then {是否回溯}
begin ri:=ri-1; a[ri]:=a[ri]-1;end; {回溯}
else a[ri]:=a[ri]-1; {递推到下一个数｝
end;
until a[1]<>r-1;
end;
begin {MAIN}
write('n,r=');readln(n,r);
if r>n then
begin writeln('Input n,r error!');halt; end
comb2(n,r);
end.
这几个程序，我也看到过，但是它们通用性不强，而且那个递归的方法运行结果是错的，我用pascal运行过，它只能输出第一行，不能出第二行。
还是请哪位高手为我弄个标准的VB程序，或者是帮我在原来的程序上改改，分一定送上，不甚感激！
比如： a b c d e 四个字母取三个可组合成：abc abc abd abe acd ace ade bcd dce cde 分析上面可以看到 ：首先固定第一（如a），其后是在另４数中再"组合"２个。这就将"５个中３的组合"推到了"４个中２个的组合"上去了。第一位数可以是n取r(如５取3)，n个数中r个组合递推到n-1个中r-1个有组合，这是一个递归的算法。 请给出一个完整可行的VB源程序！ Sub a(ByRef theArray() As String, ByVal num As Long)
Dim pos() As Long
Dim i As Long
Dim tmp As String
If num = 0 Then Exit Sub
If num > UBound(theArray) Then num = UBound(theArray)
ReDim pos(num - 1)
For i = 0 To num - 1
pos(i) = i
Next i
Do
tmp = ""
For i = 0 To num - 1
tmp = tmp & theArray(pos(i))
Next i
Debug.Print tmp
Loop While Not (b(pos(), num - 1, UBound(theArray)) < 0)
End SubFunction b(ByRef thePosArray() As Long, ByVal currentPos As Long, ByVal max As Long) As Long
Dim i As Long
b = currentPos
If currentPos < 0 Then Exit Function
thePosArray(currentPos) = thePosArray(currentPos) + 1
For i = currentPos + 1 To UBound(thePosArray)
thePosArray(i) = thePosArray(i - 1) + 1
Next i
If thePosArray(UBound(thePosArray)) > max Then
b = b(thePosArray, currentPos - 1, max)
End If
End FunctionPrivate Sub Form_Load()
Dim x(4) As String
Dim xx
x(0) = "a"
x(1) = "b"
x(2) = "c"
x(3) = "d"
x(4) = "e"
Call a(x(), 3)
End Sub
'交集
Dim ArrayN() As Variant
Dim i As Long, j As Long
Dim count As Long
ReDim ArrayN(IIf(UBound(Array1) > UBound(Array2), UBound(Array1), UBound(Array2)))
For i = 0 To UBound(Array1)
For j = 0 To UBound(Array2)
If Array1(i) = Array2(j) Then
ArrayN(count) = Array1(i)
count = count + 1
Exit For
End If
Next j
Next i
If count > 0 Then
ReDim Preserve ArrayN(count - 1)
n = ArrayN
End If
End FunctionFunction u(Array1 As Variant, Array2 As Variant) As Variant()
'并集
Dim ArrayU() As Variant
Dim i As Long, j As Long
Dim count As Long
Dim flag As Boolean
ReDim Preserve ArrayU(UBound(Array1) + UBound(Array2) + 1)
For i = 0 To UBound(Array1)
ArrayU(i) = Array1(i)
Next i
count = UBound(Array1) + 1
For i = 0 To UBound(Array2)
flag = False
For j = 0 To UBound(Array1)
If Array2(i) = Array1(j) Then
flag = True
Exit For
End If
Next j
If Not flag Then
ArrayU(count) = Array2(i)
count = count + 1
End If
Next i
ReDim Preserve ArrayU(count - 1)
u = ArrayU
End FunctionFunction s(ArrayAll As Variant, ArraySub As Variant) As Variant()
'补集
Dim ArrayS() As Variant
Dim i As Long, j As Long
Dim count As Long
Dim flag As Boolean
If UBound(ArrayAll) - UBound(ArraySub) = 0 Then Exit Function
ReDim ArrayS(UBound(ArrayAll) - UBound(ArraySub) - 1)
For i = 0 To UBound(ArrayAll)
flag = False
For j = 0 To UBound(ArraySub)
If ArrayAll(i) = ArraySub(j) Then
flag = True
Exit For
End If
Next j
If Not flag Then
ArrayS(count) = ArrayAll(i)
count = count + 1
End If
Next i
s = ArrayS
End Function
我的留言您收到了吗？
我现在履行自己的诺言，请问怎么样把给送给您！
我真想和您交朋友，可以吗？
QQ：17630795
Email：[email protected]