Combinations

[BobDog]

As in Mathematics, choose n things from m things.
I use mode delphi to save typing in generic and specialize each time.
(I believe they are being made redundant anyway?)
If your original array is not unique, a unique version of it is used. (SET like)
Console application only.

Code: Pascal  [Select][+][-]

1.  
2. {$mode delphi}
3. {$rangeChecks on}
4. {$APPTYPE CONSOLE}
5. Function factorial(n:integer):qword;
6. begin
7.       If (n <= 1) Then  exit (1) Else exit(n * factorial(n - 1))
8. End;
9.  
10. type Arrays<T>=object
11. public
12. original:array of T;
13. arr:array of array of T;
14. ar:array of T;
15. end;
16.  
17. function clean<T>(arr:T):T;
18. var
19. count:int32=0;
20. i,j,n:int32;
21. temp:T;
22.  begin
23.  temp:=nil;
24.  n:=high(arr);
25.  setlength(temp,length(arr));
26.   for i :=0 to n do
27.    begin
28.     for j:=0 to count do if (arr[i]=temp[j]) then break;
29.   if (j=count) then
30.     begin
31.  temp[count]:=arr[i];
32.  count:=count+1;
33.     end;
34.   end;
35.  setlength(temp,count);
36.  exit(temp);
37. End;
38.  
39.  
40. procedure combinations<T>(arr:array of T;n,r,index:int32;_data: array of T;var _out: Arrays<T>;i:int32;var ct:int32);
41. var
42. j:int32;
43. begin
44.       If (index=r) Then
45.       begin
46.         ct:=ct+1;
47.         For j:=0 To r-1 do
48.         begin
49.         _out.arr[ct,j+1]:= _data[j];
50.         end;
51.         exit;
52.       end;
53.       If (i>=n)  Then exit;
54.       _data[index] := arr[i];
55.      combinations<T>(arr,n,r,index + 1,_data,_out,i+1,ct);
56.      combinations<T>(arr,n,r,index,_data,_out,i+1,ct);
57. End;
58.  
59. procedure getcombinations<T>(f:array of T;r:int32;var ret:Arrays<T>);
60. type aa=array of T;
61. var
62.      n,i,j,counter:integer;
63.      k:qword;
64.      ct:int32=0;
65.      _data:array of T=nil;
66.      _ret :Arrays<T>=(arr:nil);
67.      c:aa=nil;
68.      begin
69.      setlength(c,length(f));
70.      for i:=0 to high(f) do
71.       c[i]:=f[i];
72.      c:=clean<aa>(c);
73.      counter:=0;
74.      n:=length(c);
75.       setlength(_data,r);
76.       k:=factorial(n) div (factorial(r)*factorial(n-r));
77.       setlength(_ret.arr,k+1,r+1);
78.       combinations<T>(c,high(c)+1,r,0,_data,_ret,0,ct);
79.       ret:=_ret;
80.      for i:=1 to high(_ret.arr) do
81.      begin
82.      for j:=1 to high(_ret.arr[0]) do
83.      begin
84.      counter:=counter+1;
85.      setlength(ret.ar,counter);
86.      ret.ar[counter-1]:=_ret.arr[i,j];
87.      
88.      end;
89.    
90.      end;
91.      //optional for showing original array
92.      setlength(ret.original,length(f));
93.      for i:=0 to high(f) do
94.      ret.original[i]:=f[i];
95.    
96. End;
97.  
98. procedure show<T>(ret:Arrays<T>);
99. var i,j:integer;
100. var counter:integer=0;
101. begin
102. writeln('Original set:');
103. for i:=0 to high(ret.original) do write (ret.original[i],' ');
104. writeln;writeln;
105. for i:=1 to high(ret.arr) do
106.      begin
107.      for j:=1 to high(ret.arr[0]) do
108.      begin
109.      counter:=counter+1;
110.      write(ret.ar[counter-1],' ');
111.      end;
112.      writeln;
113.      end;
114.      writeln;
115.      writeln('number of combinations: ',counter div high(ret.arr[0]));
116.      End;
117. var
118.  
119. a:array of string=['apple','orange','pear','peach','cherry','lemon'];
120. ret:Arrays<string>=(ar:nil);
121. retb:Arrays<integer>=(ar:nil);
122.  
123. begin
124. getcombinations<string>(a,4,ret);
125. show<string>(ret);
126. getcombinations<integer>([7,2,9,0,1,7,7,2],3,retb);
127. writeln('------------------------- ');
128. show<integer>(retb);
129. writeln('Press enter to end . . .');
130. readln;
131. end.
132.  
133.