Given non-negative integers m and n, generate all size m combinations of the integers from 0 (zero) to n-1 in sorted order (each combination is sorted and the entire table is sorted).
3 comb 5 is:
0 1 20 1 30 1 40 2 30 2 40 3 41 2 31 2 41 3 42 3 4
If it is more "natural" in your language to start counting from 1 (unity) instead of 0 (zero),
the combinations can be of the integers from 1 to n.
| Order Unimportant | Order Important | |
|---|---|---|
| Without replacement | ||
| Task:Combinations | Task:Permutations | |
| With replacement | ||
| Task:Combinations with repetitions | Task:Permutations with repetitions |
F comb(arr, k) I k == 0 R [[Int]()] [[Int]] result L(x) arr V i = L.index L(suffix) comb(arr[i+1..], k-1) result [+]= x [+] suffix R resultprint(comb([0, 1, 2, 3, 4], 3))
[[0, 1, 2], [0, 1, 3], [0, 1, 4], [0, 2, 3], [0, 2, 4], [0, 3, 4], [1, 2, 3], [1, 2, 4], [1, 3, 4], [2, 3, 4]]
Nice algorithm without recursion borrowed from C. Recursion is elegant but iteration is efficient.For maximum compatibility, this program uses only the basic instruction set (S/360) and two ASSIST macros (XDECO, XPRNT) to keep the code as short as possible.
* Combinations 26/05/2016COMBINE CSECT USING COMBINE,R13 base register B 72(R15) skip savearea DC 17F'0' savearea STM R14,R12,12(R13) prolog ST R13,4(R15) " ST R15,8(R13) " LR R13,R15 " SR R3,R3 clear LA R7,C @c(1) LH R8,N v=nLOOPI1 STC R8,0(R7) do i=1 to n; c(i)=n-i+1 LA R7,1(R7) @c(i)++ BCT R8,LOOPI1 next iLOOPBIG LA R10,PG big loop {------------------ LH R1,N n LA R7,C-1(R1) @c(i) LH R6,N i=nLOOPI2 IC R3,0(R7) do i=n to 1 by -1; r2=c(i) XDECO R3,PG+80 edit c(i) MVC 0(2,R10),PG+90 output c(i) LA R10,3(R10) @pgi=@pgi+3 BCTR R7,0 @c(i)-- BCT R6,LOOPI2 next i XPRNT PG,80 print buffer LA R7,C @c(1) LH R8,M v=m LA R6,1 i=1LOOPI3 LR R1,R6 do i=1 by 1; r1=i IC R3,0(R7) c(i) CR R3,R8 while c(i)>=m-i+1 BL ELOOPI3 leave i CH R6,N if i>=n BNL ELOOPBIG exit loop BCTR R8,0 v=v-1 LA R7,1(R7) @c(i)++ LA R6,1(R6) i=i+1 B LOOPI3 next iELOOPI3 LR R1,R6 i LA R4,C-1(R1) @c(i) IC R3,0(R4) c(i) LA R3,1(R3) c(i)+1 STC R3,0(R4) c(i)=c(i)+1 BCTR R7,0 @c(i)--LOOPI4 CH R6,=H'2' do i=i to 2 by -1 BL ELOOPI4 leave i IC R3,1(R7) c(i) LA R3,1(R3) c(i)+1 STC R3,0(R7) c(i-1)=c(i)+1 BCTR R7,0 @c(i)-- BCTR R6,0 i=i-1 B LOOPI4 next iELOOPI4 B LOOPBIG big loop }------------------ELOOPBIG L R13,4(0,R13) epilog LM R14,R12,12(R13) " XR R15,R15 " BR R14 exitM DC H'5' <=input N DC H'3' <=input C DS 64X array of 8 bit integersPG DC CL92' ' buffer YREGS END COMBINE1 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
(defuncomb(mn(i.0))(cond((zeropm)'(()))((eqin)'())(t(append(mapc'(lambda(rest)(consirest))(comb(sub1m)n(add1i)))(combmn(add1i))))))(defunappend(ab)(cond((nulla)b)(t(cons(cara)(append(cdra)b)))))(mapprint(comb35))
(0 1 2)(0 1 3)(0 1 4)(0 2 3)(0 2 4)(0 3 4)(1 2 3)(1 2 4)(1 3 4)(2 3 4)
PROC PrintComb(BYTE ARRAY c BYTE len) BYTE i Put('() FOR i=0 TO len-1 DO IF i>0 THEN Put(',) FI PrintB(c(i)) OD Put(')) PutE()RETURNBYTE FUNC Increasing(BYTE ARRAY c BYTE len) BYTE i IF len<2 THEN RETURN (1) FI FOR i=0 TO len-2 DO IF c(i)>=c(i+1) THEN RETURN (0) FI ODRETURN (1)BYTE FUNC NextComb(BYTE ARRAY c BYTE n,k) INT pos,i DO pos=k-1 DO c(pos)==+1 IF c(pos)<n THEN EXIT ELSE pos==-1 IF pos<0 THEN RETURN (0) FI FI FOR i=pos+1 TO k-1 DO c(i)=c(pos) OD OD UNTIL Increasing(c,k) ODRETURN (1)PROC Comb(BYTE n,k) BYTE ARRAY c(10) BYTE i IF k>n THEN Print("Error! k is greater than n.") Break() FI FOR i=0 TO k-1 DO c(i)=i OD DO PrintComb(c,k) UNTIL NextComb(c,n,k)=0 ODRETURNPROC Main() Comb(5,3)RETURNScreenshot from Atari 8-bit computer
(0,1,2)(0,1,3)(0,1,4)(0,2,3)(0,2,4)(0,3,4)(1,2,3)(1,2,4)(1,3,4)(2,3,4)
withAda.Text_IO;useAda.Text_IO;procedureTest_CombinationsisgenerictypeIntegersisrange<>;packageCombinationsistypeCombinationisarray(Positiverange<>)ofIntegers;procedureFirst(X:inoutCombination);procedureNext(X:inoutCombination);procedurePut(X:Combination);endCombinations;packagebodyCombinationsisprocedureFirst(X:inoutCombination)isbeginX(1):=Integers'First;forIin2..X'LastloopX(I):=X(I-1)+1;endloop;endFirst;procedureNext(X:inoutCombination)isbeginforIinreverseX'RangeloopifX(I)<Integers'Val(Integers'Pos(Integers'Last)-X'Last+I)thenX(I):=X(I)+1;forJinI+1..X'LastloopX(J):=X(J-1)+1;endloop;return;endif;endloop;raiseConstraint_Error;endNext;procedurePut(X:Combination)isbeginforIinX'RangeloopPut(Integers'Image(X(I)));endloop;endPut;endCombinations;typeFiveisrange0..4;packageFivesis newCombinations(Five);useFives;X:Combination(1..3);beginFirst(X);loopPut(X);New_Line;Next(X);endloop;exceptionwhenConstraint_Error=>null;endTest_Combinations;
The solution is generic the formal parameter is the integer type to make combinations of. The type range determinesn. In the example it is
typeFiveisrange0..4;
The parameterm is the object's constraint. Whenn <m the procedure First (selects the first combination) will propagate Constraint_Error. The procedure Next selects the next combination. Constraint_Error is propagated when it is the last one.
0 1 2 0 1 3 0 1 4 0 2 3 0 2 4 0 3 4 1 2 3 1 2 4 1 3 4 2 3 4
File: prelude_combinations.a68
# -*- coding: utf-8 -*- #COMMENT REQUIRED BY "prelude_combinations_generative.a68" MODE COMBDATA = ~;PROVIDES:# COMBDATA*=~* ## comb*=~ list* #END COMMENTMODE COMBDATALIST = REF[]COMBDATA;MODE COMBDATALISTYIELD = PROC(COMBDATALIST)VOID;PROC comb gen combinations = (INT m, COMBDATALIST list, COMBDATALISTYIELD yield)VOID:( CASE m IN # case 1: transpose list # FOR i TO UPB list DO yield(list[i]) OD OUT [m + LWB list - 1]COMBDATA out; INT index out := 1; FOR i TO UPB list DO COMBDATA first = list[i]; # FOR COMBDATALIST sub recombination IN # comb gen combinations(m - 1, list[i+1:] #) DO (#, ## (COMBDATALIST sub recombination)VOID:( out[LWB list ] := first; out[LWB list+1:] := sub recombination; yield(out) # OD #)) OD ESAC);SKIP
File: test_combinations.a68
#!/usr/bin/a68g --script ## -*- coding: utf-8 -*- #CO REQUIRED BY "prelude_combinations.a68" CO MODE COMBDATA = INT;#PROVIDES:## COMBDATA~=INT~ ## comb ~=int list ~#PR READ "prelude_combinations.a68" PR;FORMAT data fmt = $g(0)$;main:( INT m = 3; FORMAT list fmt = $"("n(m-1)(f(data fmt)",")f(data fmt)")"$; FLEX[0]COMBDATA test data list := (1,2,3,4,5);# FOR COMBDATALIST recombination data IN # comb gen combinations(m, test data list #) DO (#,## (COMBDATALIST recombination)VOID:( printf ((list fmt, recombination, $l$))# OD # )))(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)
From Roger Hui's paper "A History of APL in 50 Functions":
comb←{(⍺=0)∨⍺=⍵:⌷⍉⍪⍳⍺⋄(0,1+(⍺-1)∇⍵-1)⍪1+⍺∇⍵-1}4comb501230125014503452345
comb←{⍺{0=⍺:⊂⍬0=≢⍵:⍬((⊃⍵),¨(⍺-1)∇r),⍺∇r←1↓⍵}⍳⍵}
3 comb 5┌─────┬─────┬─────┬─────┬─────┬─────┬─────┬─────┬─────┬─────┐│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│└─────┴─────┴─────┴─────┴─────┴─────┴─────┴─────┴─────┴─────┘
oncomb(n,k)setcto{}repeatwithifrom1toksetendofctoi'scontentsendrepeatsetrto{c'scontents}repeatwhilemynext_comb(c,k,n)setendofrtoc'scontentsendrepeatreturnrendcombonnext_comb(c,k,n)setitoksetc'sitemito(c'sitemi)+1repeatwhile(i>1andc'sitemi≥n-k+1+i)setitoi-1setc'sitemito(c'sitemi)+1endrepeatif(c'sitem1>n-k+1)thenreturnfalserepeatwithifromi+1toksetc'sitemito(c'sitem(i-1))+1endrepeatreturntrueendnext_combreturncomb(5,3)
{{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}}
----------------------- COMBINATIONS ----------------------- comb :: Int -> [a] -> [[a]]oncomb(n,lst)if1>nthen{{}}elseifnotisNull(lst)thenset{h,xs}touncons(lst)map(cons(h),¬comb(n-1,xs))&comb(n,xs)else{}endifendifendcomb--------------------------- TEST -------------------------onrunintercalate(linefeed,¬map(unwords,comb(3,enumFromTo(0,4))))endrun-------------------- GENERIC FUNCTIONS --------------------- cons :: a -> [a] -> [a]oncons(x)scripton|λ|(xs){x}&xsend|λ|endscriptendcons-- enumFromTo :: Int -> Int -> [Int]onenumFromTo(m,n)ifm≤nthensetlstto{}repeatwithifrommtonsetendoflsttoiendrepeatlstelse{}endifendenumFromTo-- intercalate :: Text -> [Text] -> Textonintercalate(strText,lstText)set{dlm,mytext item delimiters}to{mytext item delimiters,strText}setstrJoinedtolstTextastextsetmytext item delimiterstodlmreturnstrJoinedendintercalate-- isNull :: [a] -> BoolonisNull(xs)ifclassofxsisstringthenxs=""elsexs={}endifendisNull-- map :: (a -> b) -> [a] -> [b]onmap(f,xs)tellmReturn(f)setlngtolengthofxssetlstto{}repeatwithifrom1tolngsetendoflstto|λ|(itemiofxs,i,xs)endrepeatreturnlstendtellendmap-- Lift 2nd class handler function into 1st class script wrapper-- mReturn :: Handler -> ScriptonmReturn(f)ifclassoffisscriptthenfelsescriptproperty|λ|:fendscriptendifendmReturn-- uncons :: [a] -> Maybe (a, [a])onuncons(xs)setlngtolengthofxsiflng>0thenifclassofxsisstringthensetcstotextitemsofxs{item1ofcs,restofcs}else{item1ofxs,restofxs}endifelsemissing valueendifenduncons-- unwords :: [String] -> Stringonunwords(xs)intercalate(space,xs)endunwords
0 1 20 1 30 1 40 2 30 2 40 3 41 2 31 2 41 3 42 3 4
print.linescombine.by:3@0..4
[0 1 2][0 1 3][0 1 4][0 2 3][0 2 4][0 3 4][1 2 3][1 2 4][1 3 4][2 3 4]
contributed by Laszlo on the ahkforum
MsgBox%Comb(1,1)MsgBox%Comb(3,3)MsgBox%Comb(3,2)MsgBox%Comb(2,3)MsgBox%Comb(5,3)Comb(n,t){ ; Generate all n choose t combinations of 1..n, lexicographicallyIfLessn,%t%,ReturnLoop%t%c%A_Index%:=A_Indexi:=t+1,c%i%:=n+1Loop{Loop%t%i:=t+1-A_Index,c.=c%i%" "c.="`n" ; combinations in new linesj:=1,i:=2LoopIf(c%j%+1=c%i%)c%j%:=j,++j,++iElseBreakIf(j>t)Returncc%j%+=1}}
BEGIN{## Default values for r and n (Choose 3 from pool of 5). Can## alternatively be set on the command line:-## awk -v r=<number of items being chosen> -v n=<how many to choose from> -f <scriptname>if(length(r)==0)r=3if(length(n)==0)n=5for(i=1;i<=r;i++){## First combination of items:A[i]=iif(i<r)printfiOFSelseprinti}## While 1st item is less than its maximum permitted value...while(A[1]<n-r+1){## loop backwards through all items in the previous## combination of items until an item is found that is## less than its maximum permitted value:for(i=r;i>=1;i--){## If the equivalently positioned item in the## previous combination of items is less than its## maximum permitted value...if(A[i]<n-r+i){## increment the current item by 1:A[i]++## Save the current position-index for use## outside this "for" loop:p=ibreak}}## Put consecutive numbers in the remainder of the array,## counting up from position-index p.for(i=p+1;i<=r;i++)A[i]=A[i-1]+1## Print the current combination of items:for(i=1;i<=r;i++){if(i<r)printfA[i]OFSelseprintA[i]}}exit}
Usage:
awk -v r=3 -v n=5 -f combn.awk
1 2 31 2 41 2 51 3 41 3 51 4 52 3 42 3 52 4 53 4 5
input"Enter n comb m. ",ninputmoutstr$=""calliterate(outstr$,0,m-1,n-1)endsubroutineiterate(curr$,start,stp,depth)fori=starttostpifdepth=0thenprintcurr$+" "+string(i)calliterate(curr$+" "+string(i),i+1,stp,depth-1)nextiendsubroutine
Enter n comb m. 35 0 1 2 0 1 3 0 1 4 0 2 3 0 2 4 0 3 4 1 2 3 1 2 4 1 3 4 2 3 4
100 PROGRAM "Combinat.bas"110 LET MMAX=3:LET NMAX=5120 NUMERIC COMB(0 TO MMAX)130 CALL GENERATE(1)140 DEF GENERATE(M)150 NUMERIC N,I160 IF M>MMAX THEN170 FOR I=1 TO MMAX180 PRINT COMB(I);190 NEXT200 PRINT220 ELSE230 FOR N=0 TO NMAX-1240 IF M=1 OR N>COMB(M-1) THEN250 LET COMB(M)=N260 CALL GENERATE(M+1)270 END IF280 NEXT290 END IF300 END DEF
SUBiterate(curr$,start,stp,depth)FORi=startTOstpIFdepth=0THENPRINTcurr$+" "+STR$(i)CALLiterate(curr$+" "+STR$(i),i+1,stp,depth-1)NEXTiENDSUBINPUT"Enter n comb m. ",n,moutstr$=""CALLiterate(outstr$,0,m-1,n-1)END
Same as FreeBASIC entry.
subiteratecurr$,start,stp,depthfori=starttostpifdepth=0thenprintcurr$+" "+str$(i)calliteratecurr$+" "+str$(i),i+1,stp,depth-1nextiendsubinput"Enter n comb m. ";n,moutstr$=""calliterateoutstr$,0,m-1,n-1end
PROGRAM"Combinations"VERSION"0.0000"DECLAREFUNCTIONEntry()DECLAREFUNCTIONiterate(curr$,start,stp,depth)FUNCTIONEntry()n=3m=5outstr$=""iterate(outstr$,0,m-1,n-1)ENDFUNCTIONFUNCTIONiterate(curr$,start,stp,depth)FORi=startTOstpIFdepth=0THENPRINTcurr$+" "+STR$(i)iterate(curr$+" "+STR$(i),i+1,stp,depth-1)NEXTiRETURNENDFUNCTIONENDPROGRAM
INSTALL@lib$+"SORTLIB"sort%=FN_sortinit(0,0)M%=3N%=5C%=FNfact(N%)/(FNfact(M%)*FNfact(N%-M%))DIMs$(C%)PROCcomb(M%,N%,s$())CALLsort%,s$(0)FORI%=0TOC%-1PRINTs$(I%)NEXTENDDEFPROCcomb(C%,N%,s$())LOCALI%,U%FORU%=0TO2^N%-1IFFNbits(U%)=C%THENs$(I%)=FNlist(U%)I%+=1ENDIFNEXTENDPROCDEFFNbits(U%)LOCALN%WHILEU%N%+=1U%=U%AND(U%-1)ENDWHILE=N%DEFFNlist(U%)LOCALN%,s$WHILEU%IFU%AND1s$+=STR$(N%)+" "N%+=1U%=U%>>1ENDWHILE=s$DEFFNfact(N%)IFN%<=1THEN=1ELSE=N%*FNfact(N%-1)
Cmat←{⊑𝕨∊0‿𝕩?≍↕𝕨;0⊸∾˘⊸∾´1+(𝕨-1‿0)𝕊¨𝕩-1}# RecursiveCmat1←{k←⌽↕d←𝕩¬𝕨⋄∾⌽{k∾˘¨∾˜`1+𝕩}⍟𝕨d↑↓1‿0⥊0}# Roger Hui
┌─ ╵ 0 1 2 0 1 3 0 1 4 0 2 3 0 2 4 0 3 4 1 2 3 1 2 4 1 3 4 2 3 4 ┘
The program first constructs a pattern withm variables and an expression that evaluatesm variables into a combination.Then the program constructs a list of the integers0 ... n-1.The real work is done in the expression!list:!pat. When a combination is found, it is added to the list of combinations. Then we force the program to backtrack and find the next combination by evaluating the always failing~.When all combinations are found, the pattern fails and we are in the rhs of the last| operator.
(comb= bvar combination combinations list m n pat pvar var. !arg:(?m.?n) & ( pat = ? & !combinations (.!combination):?combinations & ~ ) & :?list:?combination:?combinations & whl ' ( !m+-1:~<0:?m & chu$(utf$a+!m):?var & glf$('(%@?.$var)):(=?pvar) & '(? ()$pvar ()$pat):(=?pat) & glf$('(!.$var)):(=?bvar) & ( '$combination:(=) & '$bvar:(=?combination) | '($bvar ()$combination):(=?combination) ) ) & whl ' (!n+-1:~<0:?n&!n !list:?list) & !list:!pat | !combinations);comb$(3.5)
(.0 1 2)(.0 1 3)(.0 1 4)(.0 2 3)(.0 2 4)(.0 3 4)(.1 2 3)(.1 2 4)(.1 3 4)(.2 3 4)
#include<stdio.h>/* Type marker stick: using bits to indicate what's chosen. The stick can't * handle more than 32 items, but the idea is there; at worst, use array instead */typedefunsignedlongmarker;markerone=1;voidcomb(intpool,intneed,markerchosen,intat){if(pool<need+at)return;/* not enough bits left */if(!need){/* got all we needed; print the thing. if other actions are * desired, we could have passed in a callback function. */for(at=0;at<pool;at++)if(chosen&(one<<at))printf("%d ",at);printf("\n");return;}/* if we choose the current item, "or" (|) the bit to mark it so. */comb(pool,need-1,chosen|(one<<at),at+1);comb(pool,need,chosen,at+1);/* or don't choose it, go to next */}intmain(){comb(5,3,0,0);return0;}
Without recursions, generate all combinations in sequence. Basic logic: put n items in the first n of m slots; each step, if right most slot can be moved one slot further right, do so; otherwisefind right most item that can be moved, move it one step and put all items already to its right next to it.
#include<stdio.h>voidcomb(intm,intn,unsignedchar*c){inti;for(i=0;i<n;i++)c[i]=n-i;while(1){for(i=n;i--;)printf("%d%c",c[i],i?' ':'\n');/* this check is not strictly necessary, but if m is not close to n, it makes the whole thing quite a bit faster */i=0;if(c[i]++<m)continue;for(;c[i]>=m-i;)if(++i>=n)return;for(c[i]++;i;i--)c[i-1]=c[i]+1;}}intmain(){unsignedcharbuf[100];comb(5,3,buf);return0;}
usingSystem;usingSystem.Collections.Generic;publicclassProgram{publicstaticIEnumerable<int[]>Combinations(intm,intn){int[]result=newint[m];Stack<int>stack=newStack<int>();stack.Push(0);while(stack.Count>0){intindex=stack.Count-1;intvalue=stack.Pop();while(value<n){result[index++]=++value;stack.Push(value);if(index==m){yieldreturnresult;break;}}}}staticvoidMain(){foreach(int[]cinCombinations(3,5)){Console.WriteLine(string.Join(",",c));Console.WriteLine();}}}
Here is another implementation that uses recursion, intead of an explicit stack:
usingSystem;usingSystem.Collections.Generic;publicclassProgram{publicstaticIEnumerable<int[]>FindCombosRec(int[]buffer,intdone,intbegin,intend){for(inti=begin;i<end;i++){buffer[done]=i;if(done==buffer.Length-1)yieldreturnbuffer;elseforeach(int[]childinFindCombosRec(buffer,done+1,i+1,end))yieldreturnchild;}}publicstaticIEnumerable<int[]>FindCombinations(intm,intn){returnFindCombosRec(newint[m],0,0,n);}staticvoidMain(){foreach(int[]cinFindCombinations(3,5)){for(inti=0;i<c.Length;i++){Console.Write(c[i]+" ");}Console.WriteLine();}}}
Recursive version
usingSystem;classCombinations{staticintk=3,n=5;staticint[]buf=newint[k];staticvoidMain(){rec(0,0);}staticvoidrec(intind,intbegin){for(inti=begin;i<n;i++){buf[ind]=i;if(ind+1<k)rec(ind+1,buf[ind]+1);elseConsole.WriteLine(string.Join(",",buf));}}}
#include<algorithm>#include<iostream>#include<string>voidcomb(intN,intK){std::stringbitmask(K,1);// K leading 1'sbitmask.resize(N,0);// N-K trailing 0's// print integers and permute bitmaskdo{for(inti=0;i<N;++i)// [0..N-1] integers{if(bitmask[i])std::cout<<" "<<i;}std::cout<<std::endl;}while(std::prev_permutation(bitmask.begin(),bitmask.end()));}intmain(){comb(5,3);}
0 1 2 0 1 3 0 1 4 0 2 3 0 2 4 0 3 4 1 2 3 1 2 4 1 3 4 2 3 4
(defncombinations"If m=1, generate a nested list of numbers [0,n) If m>1, for each x in [0,n), and for each list in the recursion on [x+1,n), cons the two"[mn](letfn[(comb-aux[mstart](if(=1m)(for[x(rangestartn)](listx))(for[x(rangestartn)xs(comb-aux(decm)(incx))](consxxs))))](comb-auxm0)))(defnprint-combinations[mn](doseq[line(combinationsmn)](doseq[nline](printf"%s "n))(printf"%n")))
The below code do not comply to the task described above. However, the combinations of n elements taken from m elements might be more natural to be expressed as a set of unordered sets of elements in Clojure using its Set data structure.
(defncombinations"Generate the combinations of n elements from a list of [0..m)"[mn](let[xs(rangem)](loop[i(int0)res#{#{}}](if(==in)res(recur(+1i)(set(for[xxsrres:when(not-any?#{x}r)](conjrx))))))))
% generate the size-M combinations from 0 to n-1combinations = iter (m, n: int) yields (sequence[int]) if m<=n then state: array[int] := array[int]$predict(1, m) for i: int in int$from_to(0, m-1) do array[int]$addh(state, i) end i: int := m while i>0 do yield (sequence[int]$a2s(state)) i := m while i>0 do state[i] := state[i] + 1 for j: int in int$from_to(i,m-1) do state[j+1] := state[j] + 1 end if state[i] < n-(m-i) then break end i := i - 1 end end end end combinations% print a combinationprint_comb = proc (s: stream, comb: sequence[int]) for i: int in sequence[int]$elements(comb) do stream$puts(s, int$unparse(i) || " ") endend print_combstart_up = proc () po: stream := stream$primary_output() for comb: sequence[int] in combinations(3, 5) do print_comb(po, comb) stream$putl(po, "") endend start_up
0 1 20 1 30 1 40 2 30 2 40 3 41 2 31 2 41 3 42 3 4
Basic backtracking solution.
combinations=(n, p) ->return[[]]ifp==0i=0combos=[]combo=[]whilecombo.length<pifi<ncombo.pushii+=1elsebreakifcombo.length==0i=combo.pop()+1ifcombo.length==pcombos.pushclonecomboi=combo.pop()+1combosclone=(arr) ->(nforninarr)N=5foriin[0..N]console.log"------#{N}#{i}"forcomboincombinationsN,iconsole.logcombo
> coffee combo.coffee ------ 5 0[]------ 5 1[ 0 ][ 1 ][ 2 ][ 3 ][ 4 ]------ 5 2[ 0, 1 ][ 0, 2 ][ 0, 3 ][ 0, 4 ][ 1, 2 ][ 1, 3 ][ 1, 4 ][ 2, 3 ][ 2, 4 ][ 3, 4 ]------ 5 3[ 0, 1, 2 ][ 0, 1, 3 ][ 0, 1, 4 ][ 0, 2, 3 ][ 0, 2, 4 ][ 0, 3, 4 ][ 1, 2, 3 ][ 1, 2, 4 ][ 1, 3, 4 ][ 2, 3, 4 ]------ 5 4[ 0, 1, 2, 3 ][ 0, 1, 2, 4 ][ 0, 1, 3, 4 ][ 0, 2, 3, 4 ][ 1, 2, 3, 4 ]------ 5 5[ 0, 1, 2, 3, 4 ]
(defunmap-combinations(mnfn)"Call fn with each m combination of the integers from 0 to n-1 as a list. The list may be destroyed after fn returns."(let((combination(make-listm)))(labels((up-from(low)(let((start(1-low)))(lambda()(incfstart))))(mc(currleftneededcomb-tail)(cond((zeropneeded)(funcallfncombination))((=leftneeded)(map-intocomb-tail(up-fromcurr))(funcallfncombination))(t(setf(firstcomb-tail)curr)(mc(1+curr)(1-left)(1-needed)(restcomb-tail))(mc(1+curr)(1-left)neededcomb-tail)))))(mc0nmcombination))))
Example use
> (map-combinations 3 5 'print)(0 1 2) (0 1 3) (0 1 4) (0 2 3) (0 2 4) (0 3 4) (1 2 3) (1 2 4) (1 3 4) (2 3 4) (2 3 4)
(defuncomb(mlistfn)(labels((comb1(lcm)(when(>=(lengthl)m)(if(zeropm)(return-fromcomb1(funcallfnc)))(comb1(cdrl)cm)(comb1(cdrl)(cons(firstl)c)(1-m)))))(comb1listnilm)))(comb3'(012345)#'print)
(defunnext-combination(na)(let((k(lengtha))m)(loopforifrom1do(when(>ik)(returnnil))(when(<(arefa(-ki))(-ni))(setfm(arefa(-ki)))(loopforjfromidownto1do(incfm)(setf(arefa(-kj))m))(returnt)))))(defunall-combinations(nk)(if(or(<k0)(<nk))'()(let((a(make-arrayk)))(loopforibelowkdo(setf(arefai)i))(loopcollect(coercea'list)while(next-combinationna)))))(defunmap-combinations(nkfun)(if(and(>=k0)(>=nk))(let((a(make-arrayk)))(loopforibelowkdo(setf(arefai)i))(loopdo(funcallfun(coercea'list))while(next-combinationna))))); all-combinations returns a list of lists>(all-combinations43)((012)(013)(023)(123)); map-combinations applies a function to each combination>(map-combinations64#'print)(0123)(0124)(0125)(0134)(0135)(0145)(0234)(0235)(0245)(0345)(1234)(1235)(1245)(1345)(2345)
defcomb(m,n)(0...n).to_a.each_combination(m){|p|puts(p)}end
[0,1,2][0,1,3][0,1,4][0,2,3][0,2,4][0,3,4][1,2,3][1,2,4][1,3,4][2,3,4]
T[][]comb(T)(inT[]arr,inintk)purenothrow{if(k==0)return[[]];typeof(return)result;foreach(immutablei,immutablex;arr)foreach(suffix;arr[i+1..$].comb(k-1))result~=x~suffix;returnresult;}voidmain(){importstd.stdio;[0,1,2,3].comb(2).writeln;}
[[0, 1], [0, 2], [0, 3], [1, 2], [1, 3], [2, 3]]
Same output.
importstd.stdio,std.algorithm,std.range;immutable(int)[][]comb(immutableint[]s,inintm)purenothrow@safe{if(!m)return[[]];if(s.empty)return[];returns[1..$].comb(m-1).map!(x=>s[0]~x).array~s[1..$].comb(m);}voidmain(){4.iota.array.comb(2).writeln;}
modulecombinations3;importstd.traits:Unqual;structCombinations(T,boolcopy=true){Unqual!T[]pool,front;size_tr,n;boolempty=false;size_t[]indices;size_tlen;boollenComputed=false;this(T[]pool_,insize_tr_)purenothrow@safe{this.pool=pool_.dup;this.r=r_;this.n=pool.length;if(r>n)empty=true;indices.length=r;foreach(immutablei,refini;indices)ini=i;front.length=r;foreach(immutablei,immutableidx;indices)front[i]=pool[idx];}@propertysize_tlength()/*logic_const*/purenothrow@nogc{staticsize_tbinomial(size_tn,size_tk)purenothrow@safe@nogcin{assert(n>0,"binomial: n must be > 0.");}body{if(k<0||k>n)return0;if(k>(n/2))k=n-k;size_tresult=1;foreach(size_td;1..k+1){result*=n;n--;result/=d;}returnresult;}if(!lenComputed){// Set cache.len=binomial(n,r);lenComputed=true;}returnlen;}voidpopFront()purenothrow@safe{if(!empty){boolbroken=false;size_tpos=0;foreach_reverse(immutablei;0..r){pos=i;if(indices[i]!=i+n-r){broken=true;break;}}if(!broken){empty=true;return;}indices[pos]++;foreach(immutablej;pos+1..r)indices[j]=indices[j-1]+1;staticif(copy)front=newUnqual!T[front.length];foreach(immutablei,immutableidx;indices)front[i]=pool[idx];}}}Combinations!(T,copy)combinations(boolcopy=true,T)(T[]items,insize_tk)in{assert(items.length,"combinations: items can't be empty.");}body{returntypeof(return)(items,k);}// Compile with -version=combinations3_main to run main.version(combinations3_main)voidmain(){importstd.stdio,std.array,std.algorithm;[1,2,3,4].combinations!false(2).array.writeln;[1,2,3,4].combinations!true(2).array.writeln;[1,2,3,4].combinations(2).map!(x=>x).writeln;}
Includes an algorithm to findmth Lexicographical Element of a Combination.
modulecombinations4;importstd.stdio,std.algorithm,std.conv;ulongchoose(intn,intk)nothrowin{assert(n>=0&&k>=0,"choose: no negative input.");}body{staticulong[][]cache;if(n<k)return0;elseif(n==k)return1;while(n>=cache.length)cache~=[1UL];// = choose(m, 0);autokmax=min(k,n-k);while(kmax>=cache[n].length){immutableh=cache[n].length;cache[n]~=choose(n-1,h-1)+choose(n-1,h);}returncache[n][kmax];}intlargestV(inintp,inintq,inlongr)nothrowin{assert(p>0&&q>=0&&r>=0,"largestV: no negative input.");}body{autov=p-1;while(choose(v,q)>r)v--;returnv;}structComb{immutableintn,m;@propertysize_tlength()const/*nothrow*/{returnto!size_t(choose(n,m));}int[]opIndex(insize_tidx)const{if(m<0||n<0)return[];if(idx>=length)thrownewException("Out of bound");ulongx=choose(n,m)-1-idx;inta=n,b=m;autores=newint[m];foreach(i;0..m){a=largestV(a,b,x);x=x-choose(a,b);b=b-1;res[i]=n-1-a;}returnres;}intopApply(intdelegate(refint[])dg)const{int[]yield;foreach(i;0..length){yield=this[i];if(dg(yield))break;}return0;}staticautoOn(T)(inT[]arr,inintm){autocomb=Comb(arr.length,m);returnnewclass{@propertysize_tlength()const/*nothrow*/{returncomb.length;}intopApply(intdelegate(refT[])dg)const{autoyield=newT[m];foreach(c;comb){foreach(idx;0..m)yield[idx]=arr[c[idx]];if(dg(yield))break;}return0;}};}}version(combinations4_main)voidmain(){foreach(c;Comb.On([1,2,3],2))writeln(c);}
SeePascal.
combinations(n,k) as defined here is a table-valued functionfor generating the nCk distinct k-combinations of range(1, n+1)in no particular order. The sorting of the table is easilyaccomplished as shown in the example. The `ORDER BY combination`clause could evidently be moved into the function if desired.
CREATEORREPLACEFUNCTIONcombinations(n,k)astable(WITHRECURSIVEcte(current,remaining)AS(-- start with empty combination and the full listSELECT[],range(1,n+1)UNIONALL-- recursive case: add one item to the current combinationSELECTcurrent||remaining[j:j],remaining[j+1:]FROMcte,range(1,length(remaining)+1)_(j)WHERElength(current)<k)SELECTcurrentAScombinationFROMcteWHERElength(current)=k);##Example:FROMcombinations(5,3)ORDERBYcombination;
┌─────────────┐│ combination ││ int32[] │├─────────────┤│ [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] │├─────────────┤│ 10 rows │└─────────────┘
def combinations(m, range) { return if (m <=> 0) { [[]] } else { def combGenerator { to iterate(f) { for i in range { for suffix in combinations(m.previous(), range & (int > i)) { f(null, [i] + suffix) } } } } }}? for x in combinations(3, 0..4) { println(x) }n = 5m = 3len result[] m# proc combinations pos val . if pos > m print result[] return . for i = val to pos + n - m result[pos] = i combinations pos + 1 i + 1 ..combinations 1 1
[ 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 ]
;;;; using the native (combinations) function(lib'list)(combinations(iota5)3)→((012)(013)(014)(023)(024)(034)(123)(124)(134)(234));;;; using an iterator;;(lib'sequences)(take(combinator(iota5)3)#:all)→((012)(013)(014)(023)(024)(034)(123)(124)(134)(234));;;; defining a function;;(define(combinelstp)(cond[(null?lst)null][(<(lengthlst)p)null][(=(lengthlst)p)(listlst)][(=p1)(maplistlst)][else(append(mapcons(circular-list(firstlst))(combine(restlst)(1-p)))(combine(restlst)p))]))(combine(iota5)3)→((012)(013)(014)(023)(024)(034)(123)(124)(134)(234))
(define $comb (lambda [$n $xs] (match-all xs (list integer) [(loop $i [1 ,n] <join _ <cons $a_i ...>> _) a])))(test (comb 3 (between 0 4)))
{[|0 1 2|] [|0 1 3|] [|0 2 3|] [|1 2 3|] [|0 1 4|] [|0 2 4|] [|0 3 4|] [|1 2 4|] [|1 3 4|] [|2 3 4|]}The core of the program is the recursive feature solve, which returns all possible strings of length n with k "ones" and n-k "zeros". The strings are then evaluated, each resulting in k corresponding integers for the digits where ones are found.
classCOMBINATIONScreatemakefeaturemake(n,k:INTEGER)requiren_positive:n>0k_positive:k>0k_smaller_equal:k<=ndocreateset.makeset.extend("")createsol.makesol:=solve(set,k,n-k)sol:=convert_solution(n,sol)ensurecorrect_num_of_sol:num_of_comb(n,k)=sol.countendsol:LINKED_LIST[STRING]feature{None}set:LINKED_LIST[STRING]convert_solution(n:INTEGER;solution:LINKED_LIST[STRING]):LINKED_LIST[STRING]-- strings of 'k' digits between 1 and 'n'locali,j:INTEGERtemp:STRINGdocreatetemp.make(n)fromi:=1untili>solution.countloopfromj:=1untilj>nloopifsolution[i].at(j)='1'thentemp.append(j.out)endj:=j+1endsolution[i].deep_copy(temp)temp.wipe_outi:=i+1endResult:=solutionendsolve(seta:LINKED_LIST[STRING];one,zero:INTEGER):LINKED_LIST[STRING]-- list of strings with a number of 'one' 1s and 'zero' 0, standig for wether the corresponing digit is taken or not.localnew_P1,new_P0:LINKED_LIST[STRING]docreatenew_P1.makecreatenew_P0.makeifone>0thennew_P1.deep_copy(seta)acrossnew_P1asP1loopnew_P1.item.append("1")endnew_P1:=solve(new_P1,one-1,zero)endifzero>0thennew_P0.deep_copy(seta)acrossnew_P0asP0loopnew_P0.item.append("0")endnew_P0:=solve(new_P0,one,zero-1)endifone=0andzero=0thenResult:=setaelsecreateResult.makeResult.fill(new_p0)Result.fill(new_p1)endendnum_of_comb(n,k:INTEGER):INTEGER-- number of 'k' sized combinations out of 'n'.localupper,lower,m,l:INTEGERdoupper:=1lower:=1m:=nl:=kfromuntilm<n-k+1loopupper:=m*upperlower:=l*lowerm:=m-1l:=l-1endResult:=upper//lowerendend
Test:
classAPPLICATIONcreatemakefeaturemakedocreatecomb.make(5,3)acrosscomb.solasarloopio.put_string(ar.item.out+"%T")endendcomb:COMBINATIONSend
345 245 235 234 145 135 134 125 124 123
ELENA 6.x :
import system'routines;import extensions;import extensions'routines;const int M = 3;const int N = 5; Numbers(n){ ^ Array.allocate(n).populate::(int n => n)}public Program(){ var numbers := Numbers(N); Combinator.new(M, numbers).forEach::(row) { Console.printLine(row.toString()) }; Console.readChar()}0,1,20,1,30,1,40,2,30,2,40,3,41,2,31,2,41,3,42,3,4
defmoduleRCdodefcomb(0,_),do:[[]]defcomb(_,[]),do:[]defcomb(m,[h|t])do(forl<-comb(m-1,t),do:[h|l])++comb(m,t)endend{m,n}={3,5}list=fori<-1..n,do:iEnum.each(RC.comb(m,list),fnx->IO.inspectxend)
[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]
(defuncomb-recurse(mnn-max)(cond((zeropm)'(()))((=n-maxn)'())(t(append(mapcar#'(lambda(rest)(consnrest))(comb-recurse(1-m)(1+n)n-max))(comb-recursem(1+n)n-max)))))(defuncomb(mn)(comb-recursem0n))(comb35)
((0 1 2) (0 1 3) (0 1 4) (0 2 3) (0 2 4) (0 3 4) (1 2 3) (1 2 4) (1 3 4) (2 3 4))
-module(comb).-compile(export_all).comb(0,_)->[[]];comb(_,[])->[];comb(N,[H|T])->[[H|L]||L<-comb(N-1,T)]++comb(N,T).
Could be optimized with a customzipwith/3 function instead of usinglists:sublist/2.
-module(comb).-export([combinations/2]).combinations(K,List)->lists:last(all_combinations(K,List)).all_combinations(K,List)->lists:foldr(fun(X,Next)->Sub=lists:sublist(Next,length(Next)-1),Step=[[]]++[[[X|S]||S<-L]||L<-Sub],lists:zipwith(funlists:append/2,Step,Next)end,[[[]]]++lists:duplicate(K,[]),List).
PROGRAM COMBINATIONSCONST M_MAX=3,N_MAX=5DIM COMBINATION[M_MAX],STACK[100,1]PROCEDURE GENERATE(M) LOCAL I IF (M>M_MAX) THEN FOR I=1 TO M_MAX DO PRINT(COMBINATION[I];" ";) END FOR PRINT ELSE FOR N=1 TO N_MAX DO IF ((M=1) OR (N>COMBINATION[M-1])) THEN COMBINATION[M]=N ! --- PUSH STACK ----------- STACK[SP,0]=M STACK[SP,1]=N SP=SP+1 ! -------------------------- GENERATE(M+1) ! --- POP STACK ------------ SP=SP-1 M=STACK[SP,0] N=STACK[SP,1] ! -------------------------- END IF END FOR END IFEND PROCEDUREBEGIN GENERATE(1)END PROGRAM
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
letchoosemn=letrecfCprefixmfrom=seq{letrecloopForf=seq{matchfwith|[]->()|x::xs->yield(x,fC[](m-1)xs)yield!loopForxs}ifm=0thenyieldprefixelsefor(i,s)inloopForfromdoforxinsdoyieldprefix@[i]@x}fC[]m[0..(n-1)][<EntryPoint>]letmainargv=choose35|>Seq.iter(printfn"%A")0
[0; 1; 2][0; 1; 3][0; 1; 4][0; 2; 3][0; 2; 4][0; 3; 4][1; 2; 3][1; 2; 4][1; 3; 4][2; 3; 4]
USING:math.combinatoricsprettyprint;5iota3all-combinations.
{ { 0 1 2 } { 0 1 3 } { 0 1 4 } { 0 2 3 } { 0 2 4 } { 0 3 4 } { 1 2 3 } { 1 2 4 } { 1 3 4 } { 2 3 4 }}This works with any kind of sequence:
{"a""b""c"}2all-combinations.{ { "a" "b" } { "a" "c" } { "b" "c" } }01.10 S M=301.20 S N=501.30 D 201.40 Q02.10 F I=1,M;S C(I)=I-102.20 D 302.30 S I=M02.40 S C(I)=C(I)+102.50 I (C(I)-N+M-I)2.802.60 S I=I-102.70 I (-I)2.4;R02.80 F J=I+1,M;S C(J)=C(J-1)+102.90 G 2.203.10 F I=1,M;T %3,C(I)03.20 T !
= 0= 1= 2= 0= 1= 3= 0= 1= 4= 0= 2= 3= 0= 2= 4= 0= 3= 4= 1= 2= 3= 1= 2= 4= 1= 3= 4= 2= 3= 4
programCombinationsuseiso_fortran_envimplicit none typecomb_resultinteger,dimension(:),allocatable::combsend typecomb_resulttype(comb_result),dimension(:),pointer::rinteger::i,jcallcomb(5,3,r)doi=0,choose(5,3)-1doj=2,0,-1write(*,"(I4, ' ')",advance="no")r(i)%combs(j)end do deallocate(r(i)%combs)write(*,*)""end do deallocate(r)contains functionchoose(n,k,err)integer::chooseinteger,intent(in)::n,kinteger,optional,intent(out)::errinteger::imax,i,imin,ieie=0if((n<0).or.(k<0))then write(ERROR_UNIT,*)"negative in choose"choose=0ie=1else if(n<k)thenchoose=0else if(n==k)thenchoose=1elseimax=max(k,n-k)imin=min(k,n-k)choose=1doi=imax+1,nchoose=choose*iend do doi=2,iminchoose=choose/iend do end if end if if(present(err))err=ieend functionchoosesubroutinecomb(n,k,co)integer,intent(in)::n,ktype(comb_result),dimension(:),pointer,intent(out)::cointeger::i,j,s,ix,kx,hm,tinteger::errhm=choose(n,k,err)if(err/=0)then nullify(co)return end if allocate(co(0:hm-1))doi=0,hm-1allocate(co(i)%combs(0:k-1))end do doi=0,hm-1ix=i;kx=kdos=0,n-1if(kx==0)exitt=choose(n-(s+1),kx-1)if(ix<t)thenco(i)%combs(kx-1)=skx=kx-1elseix=ix-tend if end do end do end subroutinecombend programCombinations
Alternatively:
programcombinationsimplicit noneinteger,parameter::m_max=3integer,parameter::n_max=5integer,dimension(m_max)::combcharacter(*),parameter::fmt='(i0'//repeat(', 1x, i0',m_max-1)//')'callgen(1)contains recursive subroutinegen(m)implicit noneinteger,intent(in)::minteger::nif(m>m_max)then write(*,fmt)combelse don=1,n_maxif((m==1).or.(n>comb(m-1)))thencomb(m)=ncallgen(m+1)end if end do end if end subroutinegenend programcombinations
1 2 31 2 41 2 51 3 41 3 51 4 52 3 42 3 52 4 53 4 5
This is remarkably compact and elegant.
subiterate(byvalcurrasstring,byvalstartasuinteger,_byvalstpasuinteger,byvaldepthasuinteger)dimasuintegerifori=starttostpifdepth=0thenprintcurr+" "+str(i)endifiterate(curr+" "+str(i),i+1,stp,depth-1)nextireturnendsubdimasuintegerm,ninput"Enter n comb m. ",n,mdimasstringoutstr=""iterateoutstr,0,m-1,n-1
Enter n comb m. 3,5 0 1 2 0 1 3 0 1 4 0 2 3 0 2 4 0 3 4 1 2 3 1 2 4 1 3 4 2 3 4
combinations[m, n] :={ a = toArray[0 to n-1] return lexicalSort[a.combinations[m]]}println[formatTable[combinations[3,5]]]0 1 20 1 30 1 40 2 30 2 40 3 41 2 31 2 41 3 42 3 4
void local fn Combinations( currStr as CFStringRef, start as int, stp as int, depth as int ) int i for i = start to stp if depth = 0 then printf @"%@ %d", currStr, i fn Combinations( fn StringWithFormat( @"%@ %d", currStr, i ), i+1, stp, depth-1 ) nextend fnint n : n = 3int m : m = 5printf @" %d combinations of integers 0 through %d are:", n, m-1fn Combinations( @"", 0, m-1, n-1 )HandleEvents
3 combinations of integers 0 through 4 are: 0 1 2 0 1 3 0 1 4 0 2 3 0 2 4 0 3 4 1 2 3 1 2 4 1 3 4 2 3 4
# Built-inCombinations([1..n],m);Combinations([1..5],3);# [ [ 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 ] ]
5!3 >>> ,,\$$(5!3) give all combinations of 3 out of 5$$(>>>) sorted up,$$(,,\) printed with crlf delimiters.
Result:
Result:1 2 31 2 41 2 51 3 41 3 51 4 52 3 42 3 52 4 53 4 5
packagemainimport("fmt")funcmain(){comb(5,3,func(c[]int){fmt.Println(c)})}funccomb(n,mint,emitfunc([]int)){s:=make([]int,m)last:=m-1varrcfunc(int,int)rc=func(i,nextint){forj:=next;j<n;j++{s[i]=jifi==last{emit(s)}else{rc(i+1,j+1)}}return}rc(0,0)}
[0 1 2][0 1 3][0 1 4][0 2 3][0 2 4][0 3 4][1 2 3][1 2 4][1 3 4][2 3 4]
Following the spirit of theHaskell solution.
A recursive closure must bepre-declared.
defcombcomb={m,list->defn=list.size()m==0?[[]]:(0..(n-m)).inject([]){newlist,k->defsublist=(k+1==n)?[]:list[(k+1)..<n]newlist+=comb(m-1,sublist).collect{[list[k]]+it}}}
Test program:
defcsny=["Crosby","Stills","Nash","Young"]println"Choose from ${csny}"(0..(csny.size())).each{i->println"Choose ${i}:";comb(i,csny).each{printlnit};println()}
Choose from [Crosby, Stills, Nash, Young]Choose 0:[]Choose 1:[Crosby][Stills][Nash][Young]Choose 2:[Crosby, Stills][Crosby, Nash][Crosby, Young][Stills, Nash][Stills, Young][Nash, Young]Choose 3:[Crosby, Stills, Nash][Crosby, Stills, Young][Crosby, Nash, Young][Stills, Nash, Young]Choose 4:[Crosby, Stills, Nash, Young]
defcomb0={m,n->comb(m,(0..<n))}
Test program:
println"Choose out of 5 (zero-based):"(0..3).each{i->println"Choose ${i}:";comb0(i,5).each{printlnit};println()}
Choose out of 5 (zero-based):Choose 0:[]Choose 1:[0][1][2][3][4]Choose 2:[0, 1][0, 2][0, 3][0, 4][1, 2][1, 3][1, 4][2, 3][2, 4][3, 4]Choose 3:[0, 1, 2][0, 1, 3][0, 1, 4][0, 2, 3][0, 2, 4][0, 3, 4][1, 2, 3][1, 2, 4][1, 3, 4][2, 3, 4]
defcomb1={m,n->comb(m,(1..n))}
Test program:
println"Choose out of 5 (one-based):"(0..3).each{i->println"Choose ${i}:";comb1(i,5).each{printlnit};println()}
Choose out of 5 (one-based):Choose 0:[]Choose 1:[1][2][3][4][5]Choose 2:[1, 2][1, 3][1, 4][1, 5][2, 3][2, 4][2, 5][3, 4][3, 5][4, 5]Choose 3:[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]
It's more natural to extend the task to all (ordered) sublists of sizem of a list.
Straightforward, unoptimized implementation with divide-and-conquer:
comb::Int->[a]->[[a]]comb0_=[[]]comb_[]=[]combm(x:xs)=map(x:)(comb(m-1)xs)++combmxs
In the induction step, eitherx is not in the result and the recursion proceeds with the rest of the listxs, or it is in the result and then we only needm-1 elements.
Shorter version of the above:
importData.List(tails)comb::Int->[a]->[[a]]comb0_=[[]]combml=[x:ys|x:xs<-tailsl,ys<-comb(m-1)xs]
To generate combinations of integers between 0 andn-1, use
comb0mn=combm[0..n-1]
Similar, for integers between 1 andn, use
comb1mn=combm[1..n]
Another method is to use the built inData.List.subsequences function, filter for subsequences of lengthm and then sort:
importData.List(sort,subsequences)combmn=sort.filter((==m).length)$subsequences[0..n-1]
And yet another way is to use the list monad to generate all possible subsets:
combmn=filter((==m.length)$filterM(const[True,False])[0..n-1]
The first solution is inefficient because it repeatedly calculates the same subproblem in different branches of recursion. For example,comb m (x1:x2:xs) involves computingcomb (m-1) (x2:xs) andcomb m (x2:xs), both of which (separately) computecomb (m-1) xs. To avoid repeated computation, we can use dynamic programming:
comb::Int->[a]->[[a]]combmxs=combsBySizexs!!mwherecombsBySize=foldrf([[]]:repeat[])fxnext=zipWith(<>)(fmap(x:)<$>([]:next))nextmain::IO()main=print$comb3[0..4]
[[0,1,2],[0,1,3],[0,1,4],[0,2,3],[0,2,4],[0,3,4],[1,2,3],[1,2,4],[1,3,4],[2,3,4]]
// @test: combinations((3, [0,1,2,3,4]))tail xs = [xs[i] | i <- [1L..length(xs)-1]]prepend x = match x with | (elem, lists) -> [([elem] ++ r) | r <- lists]combinations :: (int * [int]) -> [[int]]combinations x = match x with | (0, _) -> [[]] | (k, xs) -> if (length(xs) == 0) then [] else prepend((xs[0], combinations((k-1, tail(xs))))) ++ combinations((k, tail(xs)))
[[0, 1, 2], [0, 1, 3], [0, 1, 4], [0, 2, 3], [0, 2, 4], [0, 3, 4], [1, 2, 3], [1, 2, 4], [1, 3, 4], [2, 3, 4]]
proceduremain()returncombinations(3,5,0)endprocedurecombinations(m,n,z)# demonstrate combinations/z:=1write(m," combinations of ",n," integers starting from ",z)everyput(L:=[],zton-1+zby1)# generate list of n items from zwrite("Intial list\n",list2string(L))write("Combinations:")everywrite(list2string(lcomb(L,m)))endprocedurelist2string(L)# helper functionevery(s:="[")||:=" "||(!L|"]")returnsendlinklists
The
provides the core procedurelcomb in lists written by Ralph E. Griswold and Richard L. Goerwitz.
procedurelcomb(L,i)#: list combinationslocaljifi<1thenfailsuspendifi=1then[!L]else[L[j:=1to*L-i+1]]|||lcomb(L[j+1:0],i-1)end
3 combinations of 5 integers starting from 0Intial list[ 0 1 2 3 4 ]Combinations:[ 0 1 2 ][ 0 1 3 ][ 0 1 4 ][ 0 2 3 ][ 0 2 4 ][ 0 3 4 ][ 1 2 3 ][ 1 2 4 ][ 1 3 4 ][ 2 3 4 ]
require'stats'
Example use:
3comb5012013014023024034123124134234
All implementations here give that same result if given the same arguments.
comb1=:dyaddefinec=.1{.~-d=.1+y-xz=.i.10for_j.(d-1+y)+/&i.ddo.z=.(c#j),.z{~;(-c){.&.><i.{.c=.+/\.cend.)
another iteration version
comb2=:dyaddefined=.1+y-xk=.>:|.i.dz=.<\.|.i.dfor.i.x-1do.z=.,each/\.k,.eachzk=.1+kend.;{.z)
combr=:((0,.$:&.<:),1+($:<:))`(<:i.@,[)@.(>:+.0=[)M.
or expressed explicitly:
combr=:dyaddefineM.if.(x>:y)+.0=xdo.i.(x<:y),xelse.(0,.xcombr&.<:y),1+xcombry-1end.)
TheM. uses memoization (caching) which greatly reduces the running time. As a result, this is probably the fastest of the implementations here.
A less efficient but easier to understand recursion (similar to Python and Haskell):
combr1=:(({.@],.<:@[$:}.@]),($:}.))`]@.((=#)+.1=[)
and its explicit equivalent:
combr1=:dyaddefineif.(x=#y)+.x=1do.yelse.(({.y),.(x-1)combr(}.y)),(xcombr}.y)end.)
You need to supply the "list" for examplei.5
3 combr1 i.50 1 20 1 30 1 40 2 30 2 40 3 41 2 31 2 41 3 42 3 4
A compact iterative version requiring exponential space & time in the size of the result
comb3=:((=+/"1)|.@:I.@#])#:@i.@(2&^)
We can also generate all permutations and exclude those which are not properly sorted combinations. This is inefficient, but efficiency is not always important.
combb=:(#~((-:/:~)>/:~-:\:~)"1)@(##:[:i.^~)
importjava.util.Collections;importjava.util.LinkedList;publicclassComb{publicstaticvoidmain(String[]args){System.out.println(comb(3,5));}publicstaticStringbitprint(intu){Strings="";for(intn=0;u>0;++n,u>>=1)if((u&1)>0)s+=n+" ";returns;}publicstaticintbitcount(intu){intn;for(n=0;u>0;++n,u&=(u-1));//Turn the last set bit to a 0returnn;}publicstaticLinkedList<String>comb(intc,intn){LinkedList<String>s=newLinkedList<String>();for(intu=0;u<1<<n;u++)if(bitcount(u)==c)s.push(bitprint(u));Collections.sort(s);returns;}}
importjava.util.ArrayList;importjava.util.List;publicfinalclassCombinations{publicstaticvoidmain(String[]args){System.out.println(createCombinations(List.of(0,1,2,3,4),3));System.out.println(createCombinations(List.of("Crosby","Nash","Stills","Young"),3));}privatestatic<T>List<List<T>>createCombinations(List<T>elements,intk){List<List<T>>combinations=newArrayList<List<T>>();createCombinations(elements,k,newArrayList<T>(),combinations,0);returncombinations;}privatestatic<T>voidcreateCombinations(List<T>elements,intk,List<T>accumulator,List<List<T>>combinations,intindex){if(accumulator.size()==k){combinations.addFirst(newArrayList<T>(accumulator));}elseif(k-accumulator.size()<=elements.size()-index){createCombinations(elements,k,accumulator,combinations,index+1);accumulator.add(elements.get(index));createCombinations(elements,k,accumulator,combinations,index+1);accumulator.removeLast();}}}
[[0, 1, 2], [0, 1, 3], [0, 1, 4], [0, 2, 3], [0, 2, 4], [0, 3, 4], [1, 2, 3], [1, 2, 4], [1, 3, 4], [2, 3, 4]][[Crosby, Nash, Stills], [Crosby, Nash, Young], [Crosby, Stills, Young], [Nash, Stills, Young]]
functionbitprint(u){vars="";for(varn=0;u;++n,u>>=1)if(u&1)s+=n+" ";returns;}functionbitcount(u){for(varn=0;u;++n,u=u&(u-1));returnn;}functioncomb(c,n){vars=[];for(varu=0;u<1<<n;u++)if(bitcount(u)==c)s.push(bitprint(u))returns.sort();}comb(3,5)
Alternative recursive version using and an array of values instead of length:
functioncombinations(arr,k){vari,subI,ret=[],sub,next;for(i=0;i<arr.length;i++){if(k===1){ret.push([arr[i]]);}else{sub=combinations(arr.slice(i+1,arr.length),k-1);for(subI=0;subI<sub.length;subI++){next=sub[subI];next.unshift(arr[i]);ret.push(next);}}}returnret;}combinations([0,1,2,3,4],3);// produces: [[0, 1, 2], [0, 1, 3], [0, 1, 4], [0, 2, 3], [0, 2, 4], [0, 3, 4], [1, 2, 3], [1, 2, 4], [1, 3, 4], [2, 3, 4]]combinations(["Crosby","Stills","Nash","Young"],3);// produces: [["Crosby", "Stills", "Nash"], ["Crosby", "Stills", "Young"], ["Crosby", "Nash", "Young"], ["Stills", "Nash", "Young"]]
Simple recursion:
(function(){functioncomb(n,lst){if(!n)return[[]];if(!lst.length)return[];varx=lst[0],xs=lst.slice(1);returncomb(n-1,xs).map(function(t){return[x].concat(t);}).concat(comb(n,xs));}// [m..n]functionrange(m,n){returnArray.apply(null,Array(n-m+1)).map(function(x,i){returnm+i;});}returncomb(3,range(0,4)).map(function(x){returnx.join(' ');}).join('\n');})();
We can significantly improve on the performance of the simple recursive function by deriving a memoized version of it, which stores intermediate results for repeated use.
(function(n){// n -> [a] -> [[a]]functioncomb(n,lst){if(!n)return[[]];if(!lst.length)return[];varx=lst[0],xs=lst.slice(1);returncomb(n-1,xs).map(function(t){return[x].concat(t);}).concat(comb(n,xs));}// f -> ffunctionmemoized(fn){m={};returnfunction(x){varargs=[].slice.call(arguments),strKey=args.join('-');v=m[strKey];if('u'===(typeofv)[0])m[strKey]=v=fn.apply(null,args);returnv;}}// [m..n]functionrange(m,n){returnArray.apply(null,Array(n-m+1)).map(function(x,i){returnm+i;});}varfnMemoized=memoized(comb),lstRange=range(0,4);returnfnMemoized(n,lstRange).map(function(x){returnx.join(' ');}).join('\n');})(3);
012013014023024034123124134234
Defined in terms of a recursive helper function:
(()=>{'use strict';// ------------------ COMBINATIONS -------------------// combinations :: Int -> [a] -> [[a]]constcombinations=n=>xs=>{constcomb=n=>xs=>{return1>n?[[]]:0===xs.length?([]):(()=>{consth=xs[0],tail=xs.slice(1);returncomb(n-1)(tail).map(cons(h)).concat(comb(n)(tail));})()};returncomb(n)(xs);};// ---------------------- TEST -----------------------constmain=()=>show(combinations(3)(enumFromTo(0)(4)));// ---------------- GENERIC FUNCTIONS ----------------// cons :: a -> [a] -> [a]constcons=x=>// A list constructed from the item x,// followed by the existing list xs.xs=>[x].concat(xs);// enumFromTo :: Int -> Int -> [Int]constenumFromTo=m=>n=>!isNaN(m)?(Array.from({length:1+n-m},(_,i)=>m+i)):enumFromTo_(m)(n);// show :: a -> Stringconstshow=(...x)=>JSON.stringify.apply(null,x.length>1?[x[0],null,x[1]]:x);// MAIN ---returnmain();})();
[[0, 1, 2], [0, 1, 3], [0, 1, 4], [0, 2, 3], [0, 2, 4], [0, 3, 4], [1, 2, 3], [1, 2, 4], [1, 3, 4], [2, 3, 4]]
Or, defining combinations in terms of a more general subsequences function:
(()=>{'use strict';// ------------------ COMBINATIONS -------------------// comb :: Int -> Int -> [[Int]]constcomb=m=>n=>combinations(m)(enumFromTo(0)(n-1));// combinations :: Int -> [a] -> [[a]]constcombinations=k=>xs=>sort(filter(xs=>k===xs.length)(subsequences(xs)));// --------------------- TEST ---------------------constmain=()=>show(comb(3)(5));// ---------------- GENERIC FUNCTIONS ----------------// cons :: a -> [a] -> [a]constcons=x=>// A list constructed from the item x,// followed by the existing list xs.xs=>[x].concat(xs);// enumFromTo :: Int -> Int -> [Int]constenumFromTo=m=>n=>!isNaN(m)?(Array.from({length:1+n-m},(_,i)=>m+i)):enumFromTo_(m)(n);// filter :: (a -> Bool) -> [a] -> [a]constfilter=p=>// The elements of xs which match// the predicate p.xs=>[...xs].filter(p);// list :: StringOrArrayLike b => b -> [a]constlist=xs=>// xs itself, if it is an Array,// or an Array derived from xs.Array.isArray(xs)?(xs):Array.from(xs||[]);// show :: a -> Stringconstshow=x=>// JSON stringification of a JS value.JSON.stringify(x)// sort :: Ord a => [a] -> [a]constsort=xs=>list(xs).slice().sort((a,b)=>a<b?-1:(a>b?1:0));// subsequences :: [a] -> [[a]]// subsequences :: String -> [String]constsubsequences=xs=>{const// nonEmptySubsequences :: [a] -> [[a]]nonEmptySubsequences=xxs=>{if(xxs.length<1)return[];const[x,xs]=[xxs[0],xxs.slice(1)];constf=(r,ys)=>cons(ys)(cons(cons(x)(ys))(r));returncons([x])(nonEmptySubsequences(xs).reduceRight(f,[]));};return('string'===typeofxs)?(cons('')(nonEmptySubsequences(xs.split('')).map(x=>''.concat.apply('',x)))):cons([])(nonEmptySubsequences(xs));};// MAIN ---returnmain();})();
[[0,1,2],[0,1,3],[0,1,4],[0,2,3],[0,2,4],[0,3,4],[1,2,3],[1,2,4],[1,3,4],[2,3,4]]
With recursions:
functioncombinations(k,arr,prefix=[]){if(prefix.length==0)arr=[...Array(arr).keys()];if(k==0)return[prefix];returnarr.flatMap((v,i)=>combinations(k-1,arr.slice(i+1),[...prefix,v]));}
combination(r) generates a stream of combinations of the input array.The stream can be captured in an array as shown in the second example.
def combination(r): if r > length or r < 0 then empty elif r == length then . else ( [.[0]] + (.[1:]|combination(r-1))), ( .[1:]|combination(r)) end;# select r integers from the set (0 .. n-1)def combinations(n;r): [range(0;n)] | combination(r);
Example 1
combinations(5;3)
[0,1,2][0,1,3][0,1,4][0,2,3][0,2,4][0,3,4][1,2,3][1,2,4][1,3,4][2,3,4]
Example 2
["a", "b", "c", "d", "e"] | combination(3) ] | length
10
Thecombinations function in theCombinatorics.jl package generates an iterable sequence of the combinations that you can loop over. (Note that the combinations are computed on the fly during the loop iteration, and are not pre-computed or stored since there many be a very large number of them.)
usingCombinatoricsn=4m=3foriincombinations(0:n,m)println(i')end
[0 1 2][0 1 3][0 1 4][0 2 3][0 2 4][0 3 4][1 2 3][1 2 4][1 3 4][2 3 4]
Recursive solution without the library
The previous solution is the best: it is most elegant, production stile solution.
If, on the other hand we wanted to show how it could be done in Julia, this recursive solution shows some potentials of Julia lang.
############################### COMBINATIONS OF 3 OUT OF 5 ################################ Set n and mm=5n=3# Prepare the boundary of the calculation. Only m - n numbers are changing in each position.max_n=m-n#Prepare an array for resultresult=zeros(Int64,n)functioncombinations(pos,val)# n, max_n and result are visible in the functionfori=val:max_n# from current value to the boundaryresult[pos]=pos+i# fill the position of resultifpos<n# if combination isn't complete,combinations(pos+1,i)# go to the next positionelseprintln(result)# combination is complete, print itendendendcombinations(1,0)end
[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]
Alternatively, Julia's Iterators can be used for a very nice solution for any collection.
usingBase.Iteratorsfunctionbitmask(u,max_size)res=BitArray(undef,max_size)res.chunks[1]=u%UInt64resendfunctioncombinations(input_collection::Vector{T},choice_size::Int)::Vector{Vector{T}}whereTnum_elements=length(input_collection)size_filter(x)=Iterators.filter(y->count_ones(y)==choice_size,x)bitmask_map(x)=Iterators.map(y->bitmask(y,num_elements),x)getindex_map(x)=Iterators.map(y->input_collection[y],x)UnitRange(0,(2^num_elements)-1)|>size_filter|>bitmask_map|>getindex_map|>collectend
julia> show(combinations([1,2,3,4,5], 3))[[1, 2, 3], [1, 2, 4], [1, 3, 4], [2, 3, 4], [1, 2, 5], [1, 3, 5], [2, 3, 5], [1, 4, 5], [2, 4, 5], [3, 4, 5]]
end
Recursive implementation:
comb:{[n;k]f:{:[k=#x;:,x;:,/_f'x,'(1+*|x)_!n]}:,/f'!n}
Translation from Emacs-lisp
{defcomb{defcomb.r{lambda{:m:n:N}{if{=:m0}then{A.new{A.new}}else{if{=:n:N}then{A.new}else{A.concat{A.map{{lambda{:n:rest}{A.addfirst!:n:rest}}:n}{comb.r{-:m1}{+:n1}:N}}{comb.r:m{+:n1}:N}}}}}}{lambda{:m:n}{comb.r:m0:n}}}->comb{comb35}->[[0,1,2],[0,1,3],[0,1,4],[0,2,3],[0,2,4],[0,3,4],[1,2,3],[1,2,4],[1,3,4],[2,3,4]]
classCombinations(valm:Int,valn:Int){privatevalcombination=IntArray(m)init{generate(0)}privatefungenerate(k:Int){if(k>=m){for(iin0untilm)print("${combination[i]} ")println()}else{for(jin0untiln)if(k==0||j>combination[k-1]){combination[k]=jgenerate(k+1)}}}}funmain(args:Array<String>){Combinations(3,5)}
0 1 20 1 30 1 40 2 30 2 40 3 41 2 31 2 41 3 42 3 4
importjava.util.LinkedListinlinefun<reifiedT>combinations(arr:Array<T>,m:Int)=sequence{valn=arr.sizevalresult=Array(m){arr[0]}valstack=LinkedList<Int>()stack.push(0)while(stack.isNotEmpty()){varresIndex=stack.size-1;vararrIndex=stack.pop()while(arrIndex<n){result[resIndex++]=arr[arrIndex++]stack.push(arrIndex)if(resIndex==m){yield(result.toList())break}}}}funmain(){valn=5valm=3combinations((1..n).toList().toTypedArray(),m).forEach{println(it.joinToString(separator=" "))}}
1 2 31 2 41 2 51 3 41 3 51 4 52 3 42 3 52 4 53 4 5
import std// combi is an itertor that solves the Combinations problem for iota arrays as stateddef combi(m, n, f): let c = map(n): _ while true: f(c) var i = n-1 c[i] = c[i] + 1 if c[i] > m - 1: while c[i] >= m - n + i: i -= 1 if i < 0: return c[i] = c[i] + 1 while i < n-1: c[i+1] = c[i] + 1 i += 1combi(5, 3): print(_)
[0, 1, 2][0, 1, 3][0, 1, 4][0, 2, 3][0, 2, 4][0, 3, 4][1, 2, 3][1, 2, 4][1, 3, 4][2, 3, 4]
import std// comba solves the general problem for any values in an input arraydef comba<T>(arr: [T], k) -> [[T]]: let ret = [] for(arr.length) i: if k == 1: ret.push([arr[i]]) else: let sub = comba(arr.slice(i+1, -1), k-1) for(sub) next: next.insert(0, arr[i]) ret.push(next) return retprint comba([0,1,2,3,4], 3)print comba(["Crosby", "Stills", "Nash", "Young"], 3)// Of course once could use combi to index the input array insteadvar s = ""combi(4, 3): s += (map(_) i: ["Crosby", "Stills", "Nash", "Young"][i]) + " "print s
[[0, 1, 2], [0, 1, 3], [0, 1, 4], [0, 2, 3], [0, 2, 4], [0, 3, 4], [1, 2, 3], [1, 2, 4], [1, 3, 4], [2, 3, 4]][["Crosby", "Stills", "Nash"], ["Crosby", "Stills", "Young"], ["Crosby", "Nash", "Young"], ["Stills", "Nash", "Young"]]["Crosby", "Stills", "Nash"] ["Crosby", "Stills", "Young"] ["Crosby", "Nash", "Young"] ["Stills", "Nash", "Young"]
to comb :n :list if :n = 0 [output [[]]] if empty? :list [output []] output sentence map [sentence first :list ?] comb :n-1 bf :list ~ comb :n bf :listendprint comb 3 [0 1 2 3 4]
functionmap(f,a,...)ifathenreturnf(a),map(f,...)endendfunctionincr(k)returnfunction(a)returnk>aandaora+1endendfunctioncombs(m,n)ifm*n==0thenreturn{{}}endlocalret,old={},combs(m-1,n-1)fori=1,ndofork,vinipairs(old)doret[#ret+1]={i,map(incr(i),unpack(v))}endendreturnretendfork,vinipairs(combs(3,5))doprint(unpack(v))end
Including a helper sub to export result to clipboard through a global variable (a temporary global variable)
ModuleCheckit{FunctionCombinations(maslong,naslong){Globala$Documenta$ModuleLevel(n,s,h){Ifn=1thenwhileLen(s)a$<=h#str$("-")+"-"+car(s)#str$()+{}s=cdr(s)EndWhileElseWhilelen(s)callLeveln-1,cdr(s),cons(h,car(s))s=cdr(s)EndWhileEndif}Ifm<1orn<1thenErrors=(,)fori=0ton-1Appends,(i,)nexts=s#sort()Head=(,)CallLevelm,s,Head=a$}ClipBoardCombinations(3,5)reportclipboard$}Checkit
0-1-20-1-30-1-40-2-30-2-40-3-41-2-31-2-41-3-42-3-4
ModuleStepByStep{FunctionCombinationsStep(a,nn){c1=lambda(&f,&a)->{=car(a):a=cdr(a):f=len(a)=0}m=len(a)c=c1n=m-nn+1p=2Whilem>nc1=lambdac2=c,n=p,z=(,)(&f,&m)->{iflen(z)=0thenz=cdr(m)=cons(car(m),c2(&f,&z))iffthenz=(,):m=cdr(m):f=len(m)+len(z)<n}c=c1p++m--EndWhile=lambdac,a(&f)->{=c(&f,&a)}}enumout{screen="",file="out.txt"}m=each(out)whilemopeneval(m)foroutputas#fk=falseStepA=CombinationsStep((1,2,3,4,5),3)WhilenotkPrint#f,StepA(&k)#str$()EndWhilePrint#fk=falseStepA=CombinationsStep((0,1,2,3,4),3)WhilenotkPrint#f,StepA(&k)#str$()EndWhilePrint#fk=falseStepA=CombinationsStep(("A","B","C","D","E"),3)WhilenotkPrint#f,StepA(&k)#str$("-")EndWhilePrint#fk=falseStepA=CombinationsStep(("CAT","DOG","BAT"),2)WhilenotkPrint#f,StepA(&k)#str$("-")EndWhileclose#fendwhilewin"notepad",dir$+file}StepByStep
1 2 31 2 41 2 51 3 41 3 51 4 52 3 42 3 52 4 53 4 50 1 20 1 30 1 40 2 30 2 40 3 41 2 31 2 41 3 42 3 4A-B-CA-B-DA-B-EA-C-DA-C-EA-D-EB-C-DB-C-EB-D-EC-D-ECAT-DOGCAT-BATDOG-BAT
divert(-1)define(`set',`define(`$1[$2]',`$3')')define(`get',`defn(`$1[$2]')')define(`setrange',`ifelse(`$3',`',$2,`define($1[$2],$3)`'setrange($1, incr($2),shift(shift(shift($@))))')')define(`for', `ifelse($#,0,``$0'', `ifelse(eval($2<=$3),1, `pushdef(`$1',$2)$4`'popdef(`$1')$0(`$1',incr($2),$3,`$4')')')')define(`show', `for(`k',0,decr($1),`get(a,k) ')')define(`chklim', `ifelse(get(`a',$3),eval($2-($1-$3)), `chklim($1,$2,decr($3))', `set(`a',$3,incr(get(`a',$3)))`'for(`k',incr($3),decr($2), `set(`a',k,incr(get(`a',decr(k))))')`'nextcomb($1,$2)')')define(`nextcomb', `show($1)ifelse(eval(get(`a',0)<$2-$1),1, `chklim($1,$2,decr($1))')')define(`comb', `for(`j',0,decr($1),`set(`a',j,j)')`'nextcomb($1,$2)')divertcomb(3,5)
This is built-in in Maple:
>combinat:-choose(5,3);[[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]]
combinations[n_Integer, m_Integer]/;m>= 0:=Union[Sort /@ Permutations[Range[0, n - 1], {m}]]built-in function example
Subsets[Range[5], {2}]This a built-in function in MATLAB called "nchoosek(n,k)". The argument "n" is a vector of values from which the combinations are made, and "k" is a scalar representing the amount of values to include in each combination.
Task Solution:
>> nchoosek((0:4),3)ans = 0 1 2 0 1 3 0 1 4 0 2 3 0 2 4 0 3 4 1 2 3 1 2 4 1 3 4 2 3 4
next_comb(n, p, a) := block( [a: copylist(a), i: p], if a[1] + p = n + 1 then return(und), while a[i] - i >= n - p do i: i - 1, a[i]: a[i] + 1, for j from i + 1 thru p do a[j]: a[j - 1] + 1, a)$combinations(n, p) := block( [a: makelist(i, i, 1, p), v: [ ]], while a # 'und do (v: endcons(a, v), a: next_comb(n, p, a)), v)$combinations(5, 3);/* [[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]] */
main :: [sys_message]main = [Stdout (lay (map show (comb 3 5)))]comb :: num->num->[[num]]comb m n = comb' m [0..n-1] where comb' 0 xs = [[]] comb' m [] = [] comb' m (x:xs) = map (x:) (comb' (m-1) xs) ++ comb' m xs
[0,1,2][0,1,3][0,1,4][0,2,3][0,2,4][0,3,4][1,2,3][1,2,4][1,3,4][2,3,4]
MODULE Combinations;FROM STextIO IMPORT WriteString, WriteLn;FROM SWholeIO IMPORT WriteInt;CONST MMax = 3; NMax = 5;VAR Combination: ARRAY [0 .. MMax] OF CARDINAL;PROCEDURE Generate(M: CARDINAL);VAR N, I: CARDINAL;BEGIN IF (M > MMax) THEN FOR I := 1 TO MMax DO WriteInt(Combination[I], 1); WriteString(' '); END; WriteLn; ELSE FOR N := 1 TO NMax DO IF (M = 1) OR (N > Combination[M - 1]) THEN Combination[M] := N; Generate(M + 1); END END ENDEND Generate;BEGIN Generate(1);END Combinations.1 2 31 2 41 2 51 3 41 3 51 4 52 3 42 3 52 4 53 4 5
iterator comb(m, n: int): seq[int] = var c = newSeq[int](n) for i in 0 ..< n: c[i] = i block outer: while true: yield c var i = n - 1 inc c[i] if c[i] <= m - 1: continue while c[i] >= m - n + i: dec i if i < 0: break outer inc c[i] while i < n-1: c[i+1] = c[i] + 1 inc ifor i in comb(5, 3): echo i
@[0, 1, 2]@[0, 1, 3]@[0, 1, 4]@[0, 2, 3]@[0, 2, 4]@[0, 3, 4]@[1, 2, 3]@[1, 2, 4]@[1, 3, 4]@[2, 3, 4]
Another way, using a stack. Adapted from C#:
iterator combinations(m: int, n: int): seq[int] = var result = newSeq[int](n) var stack = newSeq[int]() stack.add 0 while stack.len > 0: var index = stack.high var value = stack.pop() while value < m: result[index] = value inc value inc index stack.add value if index == n: yield result break for i in combinations(5, 3): echo i
let combinations m n = let rec c = function | (0,_) -> [[]] | (_,0) -> [] | (p,q) -> List.append (List.map (List.cons (n-q)) (c (p-1, q-1))) (c (p , q-1)) in c (m , n)let () = let rec print_list = function | [] -> print_newline () | hd :: tl -> print_int hd ; print_string " "; print_list tl in List.iter print_list (combinations 3 5)
nchoosek([0:4], 3)
define variable r as integer no-undo extent 3.define variable m as integer no-undo initial 5.define variable n as integer no-undo initial 3.define variable max_n as integer no-undo.max_n = m - n.function combinations returns logical (input pos as integer, input val as integer): define variable i as integer no-undo. do i = val to max_n: r[pos] = pos + i.if pos lt n thencombinations(pos + 1, i).else message r[1] - 1 r[2] - 1 r[3] - 1. end.end function.combinations(1, 0).
0 1 2
0 1 3
0 1 4
0 2 3
0 2 4
0 3 4
1 2 3
1 2 4
1 3 4
2 3 4
This can be implemented as a trivial application of finite set constraints:
declare fun {Comb M N} proc {CombScript Comb} %% Comb is a subset of [0..N-1] Comb = {FS.var.upperBound {List.number 0 N-1 1}} %% Comb has cardinality M {FS.card Comb M} %% enumerate all possibilities {FS.distribute naive [Comb]} end in %% Collect all solutions and convert to lists {Map {SearchAll CombScript} FS.reflect.upperBoundList} endin {Inspect {Comb 3 5}}Crv ( k, v, d ) = { if( d == k, print ( vecextract( v , "2..-2" ) ) , for( i = v[ d + 1 ] + 1, #v, v[ d + 2 ] = i; Crv( k, v, d + 1 ) ));} combRV( n, k ) = Crv ( k, vector( n, X, X-1), 0 );Cr ( c, z, b, n, k ) = { if( z < b, print1( c, " " ); if( n>0, Cr( c+1, z , b* k \n, n-1, k - 1 )) , if( n>0, Cr( c+1, z-b, b*(n-k)\n, n-1, k )) );}combR( n, k ) = { local( bnk = binomial( n, k ), b11 = bnk * k \ n ); \\binomial( n-1, k-1 ) for( z = 0, bnk - 1, Cr( 1, z, b11, n-1, k-1 ); print );}Ci( z, b, n, k ) = { local( c = 1 ); n--; k--; while( k >= 0 , if( z < b, print1(c, " "); c++; if( n > 0, b = b*k \ n); n--; k--; , c++; z -= b; b = b*(n-k)\n; n-- ) );print;}combI( n, k ) = { local( bnk = binomial( n, k ), b11 = bnk * k \ n ); \\ binomial( n-1, k-1 ) for( z = 0, bnk - 1, Ci(z, b11, n, k ) );}Program Combinations; const m_max = 3; n_max = 5;var combination: array [0..m_max] of integer; procedure generate(m: integer); var n, i: integer; begin if (m > m_max) then begin for i := 1 to m_max do write (combination[i], ' '); writeln; end else for n := 1 to n_max do if ((m = 1) or (n > combination[m-1])) then begin combination[m] := n; generate(m + 1); end; end; begin generate(1);end.
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
##(0..4).combinations(3).printlines;
[0,1,2][0,1,3][0,1,4][0,2,3][0,2,4][0,3,4][1,2,3][1,2,4][1,3,4][2,3,4]
Thentheory module has a combinations iterator that runs in lexicographic order.
use ntheory qw/forcomb/;forcomb { print "@_\n" } 5,30 1 20 1 30 1 40 2 30 2 40 3 41 2 31 2 41 3 42 3 4
Algorithm::Combinatorics also does lexicographic order and can return the whole array or an iterator:
use Algorithm::Combinatorics qw/combinations/;my @c = combinations( [0..4], 3 );print "@$_\n" for @c;
use Algorithm::Combinatorics qw/combinations/;my $iter = combinations([0..4],3);while (my $c = $iter->next) { print "@$c\n";}Math::Combinatorics is another option but results will not be in lexicographic order as specified by the task.
Use a recursive solution, derived from the Raku (Haskell) solution
The majorPerl5i -isms are the implicit "autoboxing" of the intermediate resulting array into an array object, with the use of unshift() as a method, and the "func" keyword and signature.Note that Perl can construct ranges of numbers or of letters, so it is natural to identify the characters as 'a' .. 'e'.
use perl5i::2;# ----------------------------------------# generate combinations of length $n consisting of characters# from the sorted set @set, using each character once in a# combination, with sorted strings in sorted order.## Returns a list of array references, each containing one combination.#func combine($n, @set) { return unless @set; return map { [ $_ ] } @set if $n == 1; my ($head) = shift @set; my @result = combine( $n-1, @set ); for my $subarray ( @result ) { $subarray->unshift( $head ); } return ( @result, combine( $n, @set ) );}say @$_ for combine( 3, ('a'..'e') );abcabdabeacdaceadebcdbcebdecde
It does not get much simpler or easier than this. SeeSudoku for a practical application of this algorithm
withjavascript_semanticsprocedurecomb(integerpool,needed,done=0,sequencechosen={})ifneeded=0then-- got a full set?chosen-- (or use a routine_id, result arg, or whatever)returnendififdone+needed>poolthenreturnendif-- cannot fulfil -- get all combinations with and without the next item:done+=1comb(pool,needed-1,done,append(deep_copy(chosen),done))comb(pool,needed,done,chosen)endprocedurecomb(5,3)
{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}As of 1.0.2 there is a builtin combinations() function. Using a string here for simplicity and neater output, but it works with any sequence:
?join(combinations("12345",3),',')
"123,124,125,134,135,145,234,235,245,345"
Full non-recursive algorithm generating all combinations without repetions. Taken from here:[1]
Much slower than normal algorithm.
<?php$a=array(1,2,3,4,5);$k=3;$n=5;$c=array_splice($a, $k);$b=array_splice($a, 0, $k);$j=$k-1;print_r($b); while (1) { $m=array_search($b[$j]+1,$c); if ($m!==false) { $c[$m]-=1; $b[$j]=$b[$j]+1; print_r($b); } if ($b[$k-1]==$n) { $i=$k-1; while ($i >= 0) { if ($i == 0 && $b[$i] == $n-$k+1) break 2; $m=array_search($b[$i]+1,$c); if ($m!==false) { $c[$m]=$c[$m]-1; $b[$i]=$b[$i]+1; $g=$i;while ($g != $k-1) {array_unshift ($c, $b[$g+1]);$b[$g+1]=$b[$g]+1;$g++;}$c=array_diff($c,$b);print_r($b); break; } $i--;}} }?>Output:
Array( [0] => 1 [1] => 2)Array( [0] => 1 [1] => 3)Array( [0] => 2 [1] => 3)
<?phpfunction combinations_set($set = [], $size = 0) { if ($size == 0) { return [[]]; } if ($set == []) { return []; } $prefix = [array_shift($set)]; $result = []; foreach (combinations_set($set, $size-1) as $suffix) { $result[] = array_merge($prefix, $suffix); } foreach (combinations_set($set, $size) as $next) { $result[] = $next; } return $result;}function combination_integer($n, $m) { return combinations_set(range(0, $n-1), $m);}assert(combination_integer(5, 3) == [ [0, 1, 2], [0, 1, 3], [0, 1, 4], [0, 2, 3], [0, 2, 4], [0, 3, 4], [1, 2, 3], [1, 2, 4], [1, 3, 4], [2, 3, 4]]);echo "3 comb 5:\n";foreach (combination_integer(5, 3) as $combination) { echo implode(", ", $combination), "\n";}Outputs:
3 comb 5:0, 1, 20, 1, 30, 1, 40, 2, 30, 2, 40, 3, 41, 2, 31, 2, 41, 3, 42, 3, 4
go => % Integers 1..K N = 3, K = 5, printf("comb1(3,5): %w\n", comb1(N,K)), nl.% Recursive (numbers)comb1(M,N) = comb1_(M, 1..N).comb1_(0, _X) = [[]].comb1_(_M, []) = [].comb1_(M, [X|Xs]) = [ [X] ++ Xs2 : Xs2 in comb1_(M-1, Xs) ] ++ comb1_(M, Xs).comb1(3,5): [[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]]
comb2(K, N) = sort([[J : J in I] : I in power_set(1..N), I.length == K]).
go3 => L = "abcde", printf("comb3(%d,%w): %w\n",3,L,comb3(3,L)).comb3(M, List) = [ [List[P[I]] : I in 1..P.length] : P in comb1(M,List.length)].comb3(3,abcde): [abc,abd,abe,acd,ace,ade,bcd,bce,bde,cde]
(de comb (M Lst) (cond ((=0 M) '(NIL)) ((not Lst)) (T (conc (mapcar '((Y) (cons (car Lst) Y)) (comb (dec M) (cdr Lst)) ) (comb M (cdr Lst)) ) ) ) )(comb 3 (1 2 3 4 5))
require "perm"local fmt = require "fmt"local a = range(0, 4)local co = coroutine.create(comb.generate)while true do local _, res = coroutine.resume(co, a, 3) if !res then break end fmt.lprint(res)end
{0, 1, 2}{0, 1, 3}{0, 1, 4}{0, 2, 3}{0, 2, 4}{0, 3, 4}{1, 2, 3}{1, 2, 4}{1, 3, 4}{2, 3, 4}Natural recursive solution: first we choose first number i and then we recursively generate all combinations of m - 1 numbers between i + 1 and n - 1. Main work is done in the internal 'do_combs' function, the outer 'comb' just sets up variable to accumulate results and reverses the final result.
The 'el_lst' parameter to 'do_combs' contains partial combination (list of numbers which were chosen in previous steps) in reverse order.
define comb(n, m); lvars ress = []; define do_combs(l, m, el_lst); lvars i; if m = 0 then cons(rev(el_lst), ress) -> ress; else for i from l to n - m do do_combs(i + 1, m - 1, cons(i, el_lst)); endfor; endif; enddefine; do_combs(0, m, []); rev(ress);enddefine;comb(5, 3) ==>
An example of how PowerShell itself can translate C# code:
$source = @' using System; using System.Collections.Generic; namespace Powershell { public class CSharp { public static IEnumerable<int[]> Combinations(int m, int n) { int[] result = new int[m]; Stack<int> stack = new Stack<int>(); stack.Push(0); while (stack.Count > 0) { int index = stack.Count - 1; int value = stack.Pop(); while (value < n) { result[index++] = value++; stack.Push(value); if (index == m) { yield return result; break; } } } } } }'@Add-Type -TypeDefinition $source -Language CSharp[Powershell.CSharp]::Combinations(3,5) | Format-Wide {$_} -Column 3 -Force0 1 2 0 1 3 0 1 4 0 2 3 0 2 4 0 3 4 1 2 3 1 2 4 1 3 4 2 3 4
The solutions work with SWI-Prolog
Solution with library clpfd : we first create a list of M elements, we say that the members of the list are numbers between 1 and N and there are in ascending order, finally we ask for a solution.
:- use_module(library(clpfd)).comb_clpfd(L, M, N) :- length(L, M), L ins 1..N, chain(L, #<), label(L).
?- comb_clpfd(L, 3, 5), writeln(L), fail.[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]false.
Another solution :
comb_Prolog(L, M, N) :- length(L, M), fill(L, 1, N).fill([], _, _).fill([H | T], Min, Max) :- between(Min, Max, H), H1 is H + 1, fill(T, H1, Max).
with the same output.
Works with SWI-Prolog, libraryclpfd fromMarkus Triska, and list comprehension (seeList comprehensions ).
:- use_module(library(clpfd)).comb_lstcomp(N, M, V) :-V <- {L& length(L, N), L ins 1..M & all_distinct(L), chain(L, #<), label(L)}.2?- comb_lstcomp(3, 5, V).V = [[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]] ;false.
comb m n = comb m (0..n-1) with comb 0 _ = [[]]; comb _ [] = []; comb m (x:xs) = [x:xs | xs = comb (m-1) xs] + comb m xs;end;comb 3 5;
Procedure.s Combinations(amount, choose) NewList comb.s() ; all possible combinations with {amount} Bits For a = 0 To 1 << amount count = 0 ; count set bits For x = 0 To amount If (1 << x)&a count + 1 EndIf Next ; if set bits are equal to combination length ; we generate a String representing our combination and add it to list If count = choose string$ = "" For x = 0 To amount If (a >> x)&1 ; replace x by x+1 to start counting with 1 String$ + Str(x) + " " EndIf Next AddElement(comb()) comb() = string$ EndIf Next ; now we sort our list and format it for output as string SortList(comb(), #PB_Sort_Ascending) ForEach comb() out$ + ", [ " + comb() + "]" Next ProcedureReturn Mid(out$, 3)EndProcedureDebug Combinations(5, 3)fun combos<a>(lst :: List<a>, size :: Number) -> List<List<a>>: # return all subsets of lst of a certain size, # maintaining the original ordering of the list # Let's handle a bunch of degenerate cases up front # to be defensive... if lst.length() < size: # return an empty list if size is too big [list:] else if lst.length() == size: # combos([list: 1,2,3,4]) == list[list: 1,2,3,4]] [list: lst] else if size == 1: # combos(list: 5, 9]) == list[[list: 5], [list: 9]] lst.map(lam(elem): [list: elem] end) else: # The main resursive step here is to consider # all the combinations of the list that have the # first element (aka head) and then those that don't # don't. cases(List) lst: | empty => [list:] | link(head, rest) => # All the subsets of our list either include the # first element of the list (aka head) or they don't. with-head-combos = combos(rest, size - 1).map( lam(combo): link(head, combo) end ) without-head-combos = combos(rest, size) with-head-combos._plus(without-head-combos) end endwhere: # define semantics for the degenerate cases, although # maybe we should just make some of these raise errors combos([list:], 0) is [list: [list:]] combos([list:], 1) is [list:] combos([list: "foo"], 1) is [list: [list: "foo"]] combos([list: "foo"], 2) is [list:] # test the normal stuff lst = [list: 1, 2, 3] combos(lst, 1) is [list: [list: 1], [list: 2], [list: 3] ] combos(lst, 2) is [list: [list: 1, 2], [list: 1, 3], [list: 2, 3] ] combos(lst, 3) is [list: [list: 1, 2, 3] ] # remember the 10th row of Pascal's Triangle? :) lst10 = [list: 1,2,3,4,5,6,7,8,9,10] combos(lst10, 3).length() is 120 combos(lst10, 4).length() is 210 combos(lst10, 5).length() is 252 combos(lst10, 6).length() is 210 combos(lst10, 7).length() is 120 # more sanity checks... for each(sublst from combos(lst10, 6)): sublst.length() is 6 end for each(sublst from combos(lst10, 9)): sublst.length() is 9 endendfun int-combos(n :: Number, m :: Number) -> List<List<Number>>: doc: "return all lists of size m containing distinct, ordered nonnegative ints < n" lst = range(0, n) combos(lst, m)where: int-combos(5, 5) is [list: [list: 0,1,2,3,4]] int-combos(3, 2) is [list: [list: 0, 1], [list: 0, 2], [list: 1, 2] ]endfun display-3-comb-5-for-rosetta-code(): # The very concrete nature of this function is driven # by the web page from Rosetta Code. We want to display # output similar to the top of this page: # # https://rosettacode.org/wiki/Combinations results = int-combos(5, 3) for each(lst from results): print(lst.join-str(" ")) endenddisplay-3-comb-5-for-rosetta-code()Starting from Python 2.6 and 3.0 you have a pre-defined function that returns an iterator. Here we turn the result into a list for easy printing:
>>> from itertools import combinations>>> list(combinations(range(5),3))[(0, 1, 2), (0, 1, 3), (0, 1, 4), (0, 2, 3), (0, 2, 4), (0, 3, 4), (1, 2, 3), (1, 2, 4), (1, 3, 4), (2, 3, 4)]
Earlier versions could use functions like the following:
def comb(m, lst): if m == 0: return [[]] return [[x] + suffix for i, x in enumerate(lst) for suffix in comb(m - 1, lst[i + 1:])]
Example:
>>> comb(3, range(5))[[0, 1, 2], [0, 1, 3], [0, 1, 4], [0, 2, 3], [0, 2, 4], [0, 3, 4], [1, 2, 3], [1, 2, 4], [1, 3, 4], [2, 3, 4]]
def comb(m, s): if m == 0: return [[]] if s == []: return [] return [s[:1] + a for a in comb(m-1, s[1:])] + comb(m, s[1:])print comb(3, range(5))
A slightly different recursion version
def comb(m, s): if m == 1: return [[x] for x in s] if m == len(s): return [s] return [s[:1] + a for a in comb(m-1, s[1:])] + comb(m, s[1:])
[ over 0 = iff [ 2drop ' [ [ ] ] ] done dup [] = iff nip done 1 split rot tuck 1 - over recurse dip [ rot [] ] witheach [ dip over join nested join ] nip unrot recurse join ] is comb ( n [ --> [ ) [ [] swap times [ i^ join ] comb witheach [ witheach [ echo sp ] cr ] ] is task ( n n --> ) 3 5 task
0 1 2 0 1 3 0 1 4 0 2 3 0 2 4 0 3 4 1 2 3 1 2 4 1 3 4 2 3 4
[ 0 swap [ dup 0 != while dup 1 & if [ dip 1+ ] 1 >> again ] drop ] is bits ( n --> n ) [ [] unrot bit times [ i bits over = if [ dip [ i join ] ] ] drop ] is combnums ( n n --> [ ) [ [] 0 rot [ dup 0 != while dup 1 & if [ dip [ dup dip join ] ] dip 1+ 1 >> again ] 2drop ] is makecomb ( n --> [ ) [ over 0 = iff [ 2drop [] ] done combnums [] swap witheach [ makecomb nested join ] ] is comb ( n n --> [ ) [ behead swap witheach max ] is largest ( [ --> n ) [ 0 rot witheach [ [ dip [ over * ] ] + ] nip ] is comborder ( [ n --> n ) [ dup [] != while sortwith [ 2dup join largest 1+ dup dip [ comborder swap ] comborder < ] ] is sortcombs ( [ --> [ ) 3 5 comb sortcombs witheach [ witheach [ echo sp ] cr ]
0 1 2 0 1 3 0 1 4 0 2 3 0 2 4 0 3 4 1 2 3 1 2 4 1 3 4 2 3 4
[ stack ] is comb.stack [ stack ] is comb.items [ stack ] is comb.required [ stack ] is comb.result [ 1 - comb.items put 1+ comb.required put 0 comb.stack put [] comb.result put [ comb.required share comb.stack size = if [ comb.result take comb.stack behead drop nested join comb.result put ] comb.stack take dup comb.items share = iff [ drop comb.stack size 1 > iff [ 1 comb.stack tally ] ] else [ dup comb.stack put 1+ comb.stack put ] comb.stack size 1 = until ] comb.items release comb.required release comb.result take ] is comb ( n n --> ) 3 5 comb witheach [ witheach [ echo sp ] cr ]
0 1 2 0 1 3 0 1 4 0 2 3 0 2 4 0 3 4 1 2 3 1 2 4 1 3 4 2 3 4
Can be used withcomb, (bit-bashing and iterative versions) and is general purpose.
[ dup size dip [ witheach [ over swap peek swap ] ] nip pack ] is arrange ( [ [ --> [ ) ' [ 10 20 30 40 50 ] 3 5 comb witheach [ dip dup arrange witheach [ echo sp ] cr ] drop cr $ "zero one two three four" nest$ ' [ 4 3 1 0 1 4 3 ] arrange witheach [ echo$ sp ]
10 20 30 10 20 40 10 20 50 10 30 40 10 30 50 10 40 50 20 30 40 20 30 50 20 40 50 30 40 50 four three one zero one four three
print(combn(0:4, 3))
Combinations are organized per column, so to provide an output similar to the one in the task text, we need the following:
r <- combn(0:4, 3)for(i in 1:choose(5,3)) print(r[,i])
(define sublists (match-lambda** [(0 _) '(())] [(_ '()) '()] [(m (cons x xs)) (append (map (curry cons x) (sublists (- m 1) xs)) (sublists m xs))]))(define (combinations n m) (sublists n (range m)))
> (combinations 3 5)'((0 1 2) (0 1 3) (0 1 4) (0 2 3) (0 2 4) (0 3 4) (1 2 3) (1 2 4) (1 3 4) (2 3 4))
(formerly Perl 6)
There actually is a builtin:
.say for combinations(5,3);
(0 1 2)(0 1 3)(0 1 4)(0 2 3)(0 2 4)(0 3 4)(1 2 3)(1 2 4)(1 3 4)(2 3 4)
Here is an iterative routine with the same output:
sub combinations(Int $n, Int $k) { return ([],) unless $k; return if $k > $n || $n <= 0; my @c = ^$k; gather loop { take [@c]; next if @c[$k-1]++ < $n-1; my $i = $k-2; $i-- while $i >= 0 && @c[$i] >= $n-($k-$i); last if $i < 0; @c[$i]++; while ++$i < $k { @c[$i] = @c[$i-1] + 1; } }}.say for combinations(5,3);$ENTRY Go { = <Prout <Comb 3 5>>;};Comb { s.M s.N = <Comb1 s.M <Iota 0 <- s.N 1>>>;};Comb1 { 0 e.X = (); s.M = ; s.M s.X e.X = <PfxEach s.X <Comb1 <- s.M 1> e.X>> <Comb1 s.M e.X>;};PfxEach { s.X = ; s.X (e.X) e.Y = (s.X e.X) <PfxEach s.X e.Y>;};Iota { s.E s.E = s.E; s.S s.E = s.S <Iota <+ 1 s.S> s.E>;};(0 1 2 )(0 1 3 )(0 1 4 )(0 2 3 )(0 2 4 )(0 3 4 )(1 2 3 )(1 2 4 )(1 3 4 )(2 3 4 )
This REXX program supports up to 100 symbols (one symbol for each "thing").
If things taken at a time is negative, the combinations aren't listed, only a count is shown.
The symbol list could be extended by added any unique viewable symbol (character).
/*REXX program displays combination sets for X things taken Y at a time. */Parse Arg things size chars . /* get optional arguments from the command line */If things='?' Then Do Say 'rexx combi things size characters' Say ' defaults: 5 3 123456789...' Say 'example rexx combi , , xyzuvw' Say 'size<0 shows only the number of possible combinations' Exit EndIf things==''|things=="," Then things=5 /* No things specified? Then use default*/If size=='' |size=="," Then size=3 /* No size specified? Then use default*/If chars==''|chars=="," Then /* No chars specified? Then Use default*/ chars='123456789abcdefghijklmnopqrstuvwxyz'||, 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'||, "~!@#chars%^&*()_+`{}|[]\:;<>?,./¦++++±==˜·" /*some extended chars */show_details=sign(size) /* -1: Don't show details */size=abs(size)If things<size Then Call exit 'Not enough things ('things') for size ('size').'Say '------------' things 'things taken' size 'times at a time:'Say '------------' combn(things,size) 'combinations.'Exit /* stick a fork in it, we're all *//*-------------------------------------------------------------------------------*/combn: Procedure Expose chars show_details Parse Arg things,size thingsp=things+1 thingsm=thingsp-size index.=0 If things=0|size=0 Then Return 'no' Do i=1 For size index.i=i End done=0 Do combi=1 By 1 Until done combination='' Do d=1 To size combination=combination substr(chars,index.d,1) End If show_details=1 Then Say combination index.size=index.size+1 If index.size==thingsp Then done=.combn(size-1) End Return combi/*---------------------------------------------------------------------------------*/.combn: Procedure Expose index. size thingsm Parse Arg d--Say '.combn' d thingsm show() If d==0 Then Return 1 p=index.d Do u=d To size index.u=p+1 If index.u==thingsm+u Then Return .combn(u-1) p=index.u End Return 0show: list='' Do k=1 To size list=list index.k End Return listexit: Say '*****error*****' arg(1) Exit 13------------ 5 things taken 3 at a time: 0 1 2 0 1 3 0 1 4 0 2 3 0 2 4 0 3 4 1 2 3 1 2 4 1 3 4 2 3 4------------ 10 combinations.
------------ 5 things taken 3 at a time: a b c a b d a b e a c d a c e a d e b c d b c e b d e c d e------------ 10 combinations.
------------ 44 things taken 0 at a time:------------ no combinations.
------------ 52 things taken 5 at a time:------------ 2598960 combinations.
*****error***** Not enough things (5) for size (8).
/*REXX program displays combination sets for X things taken Y at a time. */Parse Arg things size charactersIf things='?' Then Do Say 'rexx combi2 things size characters' Say ' defaults: 5 3 123456789...' Say 'example rexx combi2 , , xyzuvw' Say 'size<0 shows only the number of possible combinations' Exit EndIf things==''|things=="," Then things=5 /* No things specified? Then use default*/If size=='' |size=="," Then size=3 /* No size specified? Then use default*/Numeric Digits 20show=sign(size)size=abs(size)If things<size Then Call exit 'Not enough things ('things') for size ('size').' Say '----------' things 'things taken' size 'at a time:'n=2**things-1nc=0Do u=1 to n nc=nc+combinations(u) EndSay '------------' nc 'combinations.'Exitcombinations: Procedure Expose things size characters show Parse Arg u nc=0 bu=x2b(d2x(u)) bu1=space(translate(bu,' ',0),0) If length(bu1)=size Then Do ub=reverse(bu) res='' Do i=1 To things If characters<>'' then c=substr(characters,i,1) Else c=i If substr(ub,i,1)=1 Then res=res c End If show=1 then Say res Return 1 End Else Return 0exit: Say '*****error*****' arg(1) Exit 13# Project : Combinationsn = 5k = 3temp = []comb = []num = com(n, k)while true temp = [] for n = 1 to 3 tm = random(4) + 1 add(temp, tm) next bool1 = (temp[1] = temp[2]) and (temp[1] = temp[3]) and (temp[2] = temp[3]) bool2 = (temp[1] < temp[2]) and (temp[2] < temp[3]) if not bool1 and bool2 add(comb, temp) ok for p = 1 to len(comb) - 1 for q = p + 1 to len(comb) if (comb[p][1] = comb[q][1]) and (comb[p][2] = comb[q][2]) and (comb[p][3] = comb[q][3]) del(comb, p) ok next next if len(comb) = num exit okendcomb = sortfirst(comb, 1)see showarray(comb) + nlfunc com(n, k) res1 = 1 for n1 = n - k + 1 to n res1 = res1 * n1 next res2 = 1 for n2 = 1 to k res2 = res2 * n2 next res3 = res1/res2 return res3func showarray(vect) svect = "" for nrs = 1 to len(vect) svect = "[" + vect[nrs][1] + " " + vect[nrs][2] + " " + vect[nrs][3] + "]" + nl see svect nextFunc sortfirst(alist, ind) aList = sort(aList,ind) for n = 1 to len(alist)-1 for m= n + 1 to len(aList) if alist[n][1] = alist[m][1] and alist[m][2] < alist[n][2] temp = alist[n] alist[n] = alist[m] alist[m] = temp ok next next for n = 1 to len(alist)-1 for m= n + 1 to len(aList) if alist[n][1] = alist[m][1] and alist[n][2] = alist[m][2] and alist[m][3] < alist[n][3] temp = alist[n] alist[n] = alist[m] alist[m] = temp ok next next return aList
Output:
[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]
≪ → currcomb start stop depth ≪WHILE start stop ≤REPEAT currcomb start + 1 'start' STO+IF depthTHEN start stop depth 1 -GENCOMBENDEND≫ ≫ 'GENCOMB' STO≪ { } 0 4 ROLL 1 - 4 ROLL 1 -GENCOMB≫ 'COMBS' STO
5 3COMBS10: { 0 1 2 }9: { 0 1 3 }8: { 0 1 4 }7: { 0 2 3 }6: { 0 2 4 }5: { 0 3 4 }4: { 1 2 3 }3: { 1 2 4 }2: { 1 3 4 }1: { 2 3 4 }def comb(m, n) (0...n).to_a.combination(m).to_aendcomb(3, 5) # => [[0, 1, 2], [0, 1, 3], [0, 1, 4], [0, 2, 3], [0, 2, 4], [0, 3, 4], [1, 2, 3], [1, 2, 4], [1, 3, 4], [2, 3, 4]]
fn comb<T: std::fmt::Default>(arr: &[T], n: uint) { let mut incl_arr: ~[bool] = std::vec::from_elem(arr.len(), false); comb_intern(arr, n, incl_arr, 0);}fn comb_intern<T: std::fmt::Default>(arr: &[T], n: uint, incl_arr: &mut [bool], index: uint) { if (arr.len() < n + index) { return; } if (n == 0) { let mut it = arr.iter().zip(incl_arr.iter()).filter_map(|(val, incl)| if (*incl) { Some(val) } else { None } ); for val in it { print!("{} ", *val); } print("\n"); return; } incl_arr[index] = true; comb_intern(arr, n-1, incl_arr, index+1); incl_arr[index] = false; comb_intern(arr, n, incl_arr, index+1);}fn main() { let arr1 = ~[1, 2, 3, 4, 5]; comb(arr1, 3); let arr2 = ~["A", "B", "C", "D", "E"]; comb(arr2, 3);}struct Combo<T> { data_len: usize, chunk_len: usize, min: usize, mask: usize, data: Vec<T>,}impl<T: Clone> Combo<T> { fn new(chunk_len: i32, data: Vec<T>) -> Self { let d_len = data.len(); let min = 2usize.pow(chunk_len as u32) - 1; let max = 2usize.pow(d_len as u32) - 2usize.pow((d_len - chunk_len as usize) as u32); Combo { data_len: d_len, chunk_len: chunk_len as usize, min: min, mask: max, data: data, } } fn get_chunk(&self) -> Vec<T> { let b = format!("{:01$b}", self.mask, self.data_len); b .chars() .enumerate() .filter(|&(_, e)| e == '1') .map(|(i, _)| self.data[i].clone()) .collect() }}impl<T: Clone> Iterator for Combo<T> { type Item = Vec<T>; fn next(&mut self) -> Option<Self::Item> { while self.mask >= self.min { if self.mask.count_ones() == self.chunk_len as u32 { let res = self.get_chunk(); self.mask -= 1; return Some(res); } self.mask -= 1; } None }}fn main() { let v1 = vec![1, 2, 3, 4, 5]; let combo = Combo::new(3, v1); for c in combo.into_iter() { println!("{:?}", c); } let v2 = vec!("A", "B", "C", "D", "E"); let combo = Combo::new(3, v2); for c in combo.into_iter() { println!("{:?}", c); }}fn comb<T>(slice: &[T], k: usize) -> Vec<Vec<T>>where T: Copy,{ // If k == 1, return a vector containing a vector for each element of the slice. if k == 1 { return slice.iter().map(|x| vec![*x]).collect::<Vec<Vec<T>>>(); } // If k is exactly the slice length, return the slice inside a vector. if k == slice.len() { return vec![slice.to_vec()]; } // Make a vector from the first element + all combinations of k - 1 elements of the rest of the slice. let mut result = comb(&slice[1..], k - 1) .into_iter() .map(|x| [&slice[..1], x.as_slice()].concat()) .collect::<Vec<Vec<T>>>(); // Extend this last vector with the all the combinations of k elements after from index 1 onward. result.extend(comb(&slice[1..], k)); // Return final vector. return result;}implicit def toComb(m: Int) = new AnyRef { def comb(n: Int) = recurse(m, List.range(0, n)) private def recurse(m: Int, l: List[Int]): List[List[Int]] = (m, l) match { case (0, _) => List(Nil) case (_, Nil) => Nil case _ => (recurse(m - 1, l.tail) map (l.head :: _)) ::: recurse(m, l.tail) }}Usage:
scala> 3 comb 5res170: List[List[Int]] = List(List(0, 1, 2), List(0, 1, 3), List(0, 1, 4), List(0, 2, 3), List(0, 2, 4), List(0, 3, 4), List(1, 2, 3), List(1, 2, 4), List(1, 3, 4), List(2, 3, 4))
Lazy version using iterators:
def combs[A](n: Int, l: List[A]): Iterator[List[A]] = n match { case _ if n < 0 || l.lengthCompare(n) < 0 => Iterator.empty case 0 => Iterator(List.empty) case n => l.tails.flatMap({ case Nil => Nil case x :: xs => combs(n - 1, xs).map(x :: _) }) }Usage:
scala> combs(3, (0 to 4).toList).toListres0: List[List[Int]] = List(List(0, 1, 2), List(0, 1, 3), List(0, 1, 4), List(0, 2, 3), List(0, 2, 4), List(0, 3, 4), List(1, 2, 3), List(1, 2, 4), List(1, 3, 4), List(2, 3, 4))
Adapted from Haskell version:
def combs[A](n: Int, xs: List[A]): Stream[List[A]] = combsBySize(xs)(n) def combsBySize[A](xs: List[A]): Stream[Stream[List[A]]] = { val z: Stream[Stream[List[A]]] = Stream(Stream(List())) ++ Stream.continually(Stream.empty) xs.toStream.foldRight(z)((a, b) => zipWith[Stream[List[A]]](_ ++ _, f(a, b), b)) } def zipWith[A](f: (A, A) => A, as: Stream[A], bs: Stream[A]): Stream[A] = (as, bs) match { case (Stream.Empty, _) => Stream.Empty case (_, Stream.Empty) => Stream.Empty case (a #:: as, b #:: bs) => f(a, b) #:: zipWith(f, as, bs) } def f[A](x: A, xsss: Stream[Stream[List[A]]]): Stream[Stream[List[A]]] = Stream.empty #:: xsss.map(_.map(x :: _))Usage:
combs(3, (0 to 4).toList).toListres0: List[List[Int]] = List(List(0, 1, 2), List(0, 1, 3), List(0, 1, 4), List(0, 2, 3), List(0, 2, 4), List(0, 3, 4), List(1, 2, 3), List(1, 2, 4), List(1, 3, 4), List(2, 3, 4))
scala>(0 to 4).combinations(3).toListres0: List[scala.collection.immutable.IndexedSeq[Int]] = List(Vector(0, 1, 2), Vector(0, 1, 3), Vector(0, 1, 4), Vector(0, 2, 3), Vector(0, 2, 4), Vector(0, 3, 4), Vector(1, 2, 3), Vector(1, 2, 4), Vector(1, 3, 4), Vector(2, 3, 4))
See it running in your browser byScalaFiddle (JavaScript, non JVM) or byScastie (JVM).
Like the Haskell code:
(define (comb m lst) (cond ((= m 0) '(())) ((null? lst) '()) (else (append (map (lambda (y) (cons (car lst) y)) (comb (- m 1) (cdr lst))) (comb m (cdr lst))))))(comb 3 '(0 1 2 3 4))
$ include "seed7_05.s7i";const type: combinations is array array integer;const func combinations: comb (in array integer: arr, in integer: k) is func result var combinations: combResult is combinations.value; local var integer: x is 0; var integer: i is 0; var array integer: suffix is 0 times 0; begin if k = 0 then combResult := 1 times 0 times 0; else for x key i range arr do for suffix range comb(arr[succ(i) ..], pred(k)) do combResult &:= [] (x) & suffix; end for; end for; end if; end func;const proc: main is func local var array integer: aCombination is 0 times 0; var integer: element is 0; begin for aCombination range comb([] (0, 1, 2, 3, 4), 3) do for element range aCombination do write(element lpad 3); end for; writeln; end for; end func;
0 1 2 0 1 3 0 1 4 0 2 3 0 2 4 0 3 4 1 2 3 1 2 4 1 3 4 2 3 4
print({0..4} npow 3);combinations(5, 3, {|*c| say c })func combine(n, set) { set.len || return [] n == 1 && return set.map{[_]} var (head, result) head = set.shift result = combine(n-1, [set...]) for subarray in result { subarray.prepend(head) } result + combine(n, set)}combine(3, @^5).each {|c| say c }func forcomb(callback, n, k) { if (k == 0) { callback([]) return() } if (k<0 || k>n || n==0) { return() } var c = @^k loop { callback([c...]) c[k-1]++ < n-1 && next var i = k-2 while (i>=0 && c[i]>=(n-(k-i))) { --i } i < 0 && break c[i]++ while (++i < k) { c[i] = c[i-1]+1 } } return()}forcomb({|c| say c }, 5, 3)[0, 1, 2][0, 1, 3][0, 1, 4][0, 2, 3][0, 2, 4][0, 3, 4][1, 2, 3][1, 2, 4][1, 3, 4][2, 3, 4]
(0 to: 4) combinations: 3 atATimeDo: [ :x | Transcript cr; show: x printString]."output on Transcript:#(0 1 2)#(0 1 3)#(0 1 4)#(0 2 3)#(0 2 4)#(0 3 4)#(1 2 3)#(1 2 4)#(1 3 4)#(2 3 4)"
[reverse subSet(5,3,i)$SGCF for i in 0..binomial(5,3)-1] [[0,1,2], [0,1,3], [0,2,3], [1,2,3], [0,1,4], [0,2,4], [1,2,4], [0,3,4], [1,3,4], [2,3,4]] Type: List(List(Integer))
SGCF==> SymmetricGroupCombinatoricFunctions
As a structured script.
#!/usr/local/bin/sparpragma annotate( summary, "combinations" ) @( description, "Given non-negative integers m and n, generate all size m" ) @( description, "combinations of the integers from 0 to n-1 in sorted" ) @( description, "order (each combination is sorted and the entire table" ) @( description, "is sorted" ) @( see_also, "http://rosettacode.org/wiki/Combinations" ) @( author, "Ken O. Burtch" );pragma restriction( no_external_commands );procedure combinations is number_of_items : constant natural := 3; max_item_value : constant natural := 5; -- get_first_combination -- return the first combination (e.g. 0,1,2 for 3 items) function get_first_combination return string is c : string; begin for i in 1..number_of_items loop c := @ & strings.image( natural( i-1 ) ); end loop; return c; end get_first_combination; -- get_last_combination -- return the highest value (e.g. 4,4,4 for 3 items -- with a maximum value of 5). function get_last_combination return string is c : string; begin for i in 1..number_of_items loop c := @ & strings.image( max_item_value-1 ); end loop; return c; end get_last_combination; combination : string := get_first_combination; last_combination : constant string := get_last_combination; item : natural; -- a number from the combination bad : boolean; -- true if we know a value is too big s : string; -- a temp string for deleting leading spacebegin put_line( combination ); while combination /= last_combination loop -- the combination is 3 numbers with leading spaces -- so the field positions start at 2 (1 is a null string) for i in reverse 1..number_of_items loop item := numerics.value( strings.field( combination, i+1, ' ') ); if item < max_item_value-1 then item := @+1; s := strings.image( item ); s := strings.delete( s, 1, 1 ); strings.replace( combination, i+1, s, ' ' ); bad := false; for j in i+1..number_of_items loop item := numerics.value( strings.field( combination, j, ' ') ); if item < max_item_value-1 then item := @+1; s := strings.image( item ); s := strings.delete( s, 1, 1 ); strings.replace( combination, j+1, s, ' ' ); else bad; end if; end loop; exit; end if; end loop; if not bad then put_line( combination ); end if; end loop;end combinations;
fun comb (0, _ ) = [[]] | comb (_, [] ) = [] | comb (m, x::xs) = map (fn y => x :: y) (comb (m-1, xs)) @ comb (m, xs);comb (3, [0,1,2,3,4]);
program combintempfile cptempvar kgen `k'=1quietly save "`cp'"rename `1' `1'1forv i=2/`2' {joinby `k' using "`cp'"rename `1' `1'`i'quietly drop if `1'`i'<=`1'`=`i'-1'}sort `1'*endExample
. set obs 5. gen a=_n. combin a 3. list +--------------+ | a1 a2 a3 | |--------------| 1. | 1 2 3 | 2. | 1 2 4 | 3. | 1 2 5 | 4. | 1 3 4 | 5. | 1 3 5 | |--------------| 6. | 1 4 5 | 7. | 2 3 4 | 8. | 2 3 5 | 9. | 2 4 5 | 10. | 3 4 5 | +--------------+
function combinations(n,k) {a = J(comb(n,k),k,.)u = 1..kfor (i=1; 1; i++) {a[i,.] = ufor (j=k; j>0; j--) {if (u[j]-j<n-k) break}if (j<1) return(a)u[j..k] = u[j]+1..u[j]+1+k-j}}combinations(5,3)Output
1 2 3 +-------------+ 1 | 1 2 3 | 2 | 1 2 4 | 3 | 1 2 5 | 4 | 1 3 4 | 5 | 1 3 5 | 6 | 1 4 5 | 7 | 2 3 4 | 8 | 2 3 5 | 9 | 2 4 5 | 10 | 3 4 5 | +-------------+
func addCombo(prevCombo: [Int], var pivotList: [Int]) -> [([Int], [Int])] { return (0..<pivotList.count) .map { _ -> ([Int], [Int]) in (prevCombo + [pivotList.removeAtIndex(0)], pivotList) }}func combosOfLength(n: Int, m: Int) -> [[Int]] { return [Int](1...m) .reduce([([Int](), [Int](0..<n))]) { (accum, _) in accum.flatMap(addCombo) }.map { $0.0 }}println(combosOfLength(5, 3))[[0, 1, 2], [0, 1, 3], [0, 1, 4], [0, 2, 3], [0, 2, 4], [0, 3, 4], [1, 2, 3], [1, 2, 4], [1, 3, 4], [2, 3, 4]]
operator (m comb n) [by 0..~$n] -> # when <[](..~$m)> do [$..., by $(last)~..~$n] -> # otherwise $!end comb(3 comb 5) -> !OUT::write
[0, 1, 2][0, 1, 3][0, 1, 4][0, 2, 3][0, 2, 4][0, 3, 4][1, 2, 3][1, 2, 4][1, 3, 4][2, 3, 4]
ref[2]
proc comb {m n} { set set [list] for {set i 0} {$i < $n} {incr i} {lappend set $i} return [combinations $set $m]}proc combinations {list size} { if {$size == 0} { return [list [list]] } set retval {} for {set i 0} {($i + $size) <= [llength $list]} {incr i} { set firstElement [lindex $list $i] set remainingElements [lrange $list [expr {$i + 1}] end] foreach subset [combinations $remainingElements [expr {$size - 1}]] { lappend retval [linsert $subset 0 $firstElement] } } return $retval}comb 3 5 ;# ==> {0 1 2} {0 1 3} {0 1 4} {0 2 3} {0 2 4} {0 3 4} {1 2 3} {1 2 4} {1 3 4} {2 3 4}TXR has repeating and non-repeating permutation and combination functions that produce lazy lists. They are generic over lists, strings and vectors. In addition, the combinations function also works over hashes.
Combinations and permutations are produced in lexicographic order (except in the case of hashes).
(defun comb-n-m (n m) (comb (range* 0 n) m))(put-line `3 comb 5 = @(comb-n-m 5 3)`)
$ txr combinations.tl 3 comb 5 = ((0 1 2) (0 1 3) (0 1 4) (0 2 3) (0 2 4) (0 3 4) (1 2 4) (1 3 4) (2 3 4))
o = 1Proc _Comb(5, 3, 0, 0)End_Comb Param (4) If a@ < b@ + d@ Then Return If b@ = 0 Then For d@ = 0 To a@-1 If AND(c@, SHL(o, d@)) Then Print d@;" "; : Fi Next Print : Return EndIf Proc _Comb(a@, b@ - 1, OR(c@, SHL(o, d@)), d@ + 1) Proc _Comb(a@, b@, c@, d@ + 1)Return
0 1 2 0 1 3 0 1 4 0 2 3 0 2 4 0 3 4 1 2 3 1 2 4 1 3 4 2 3 4 0 OK, 0:33
This task is trivial with thetuples monadic modifier.
3 5 # 3 combo 5⊙⇡ # Create the array of numbers⧅< # Get the permutations
╭─ ╷ 0 1 2 0 1 3 0 1 4 0 2 3 0 2 4 0 3 4 1 2 3 1 2 4 1 3 4 2 3 4 ╯
Most of the work is done by the standard library functionchoices, whose implementation is shown here for the sake of comparison with other solutions,
choices = ^(iota@r,~&l); leql@a^& ~&al?\&! ~&arh2fabt2RDfalrtPXPRT
whereleql is the predicate that compares list lengths. The main body of the algorithm (~&arh2fabt2RDfalrtPXPRT) concatenates the results of two recursive calls, one of which finds all combinations of the required size from the tail of the list, and the other of which finds all combinations of one less size from the tail, and then inserts the head into each.choices generates combinations of an arbitrary set butnot necessarily in sorted order, which can be done like this.
#import std#import natcombinations = @rlX choices^|(iota,~&); -< @p nleq+ ==-~rh
-<) takes a binary predicate to a function that sorts a list in order of that predicate.@p.-~ scans a list from the beginning until it finds the first item to falsify a predicate (in this case equality,==) and returns a pair of lists with the scanned items satisfying the predicate on the left and the remaining items on the right.rh suffix on the-~ operator causes it to return only the head of the right list as its result, which in this case will be the first pair of unequal items in the list.nleq function then tests whether the left side of this pair is less than or equal to the right.@p as the predicate to a sort combinator is therefore to sort a list of lists of natural numbers according to the order of the numbers in the first position where they differ.test program:
#cast %nLLexample = combinations(3,5)
< <0,1,2>, <0,1,3>, <0,1,4>, <0,2,3>, <0,2,4>, <0,3,4>, <1,2,3>, <1,2,4>, <1,3,4>, <2,3,4>>
like scheme (using variables)
[comb [m lst] let [ [m zero?] [[[]]] [lst null?] [[]] [true] [m pred lst rest comb [lst first swap cons] map m lst rest comb concat] ] when].
Using destructuring view and stack not *pure at all
[comb [ [pop zero?] [pop pop [[]]] [null?] [pop pop []] [true] [ [m lst : [m pred lst rest comb [lst first swap cons] map m lst rest comb concat]] view i ] ] when].
Pure concatenative version
[comb [2dup [a b : a b a b] view]. [2pop pop pop]. [ [pop zero?] [2pop [[]]] [null?] [2pop []] [true] [2dup [pred] dip uncons swapd comb [cons] map popd rollup rest comb concat] ] when].
Using it
|3 [0 1 2 3 4] comb=[[0 1 2] [0 1 3] [0 1 4] [0 2 3] [0 2 4] [0 3 4] [1 2 3] [1 2 4] [1 3 4] [2 3 4]]
Option ExplicitOption Base 0'Option Base 1Private ArrResult Sub test() 'compute Main_Combine 5, 3 'return Dim j As Long, i As Long, temp As String For i = LBound(ArrResult, 1) To UBound(ArrResult, 1) temp = vbNullString For j = LBound(ArrResult, 2) To UBound(ArrResult, 2) temp = temp & " " & ArrResult(i, j) Next Debug.Print temp Next Erase ArrResultEnd Sub Private Sub Main_Combine(M As Long, N As Long)Dim MyArr, i As Long ReDim MyArr(M - 1) If LBound(MyArr) > 0 Then ReDim MyArr(M) 'Case Option Base 1 For i = LBound(MyArr) To UBound(MyArr) MyArr(i) = i Next i i = IIf(LBound(MyArr) > 0, N, N - 1) ReDim ArrResult(i, LBound(MyArr)) Combine MyArr, N, LBound(MyArr), LBound(MyArr) ReDim Preserve ArrResult(UBound(ArrResult, 1), UBound(ArrResult, 2) - 1) 'In VBA Excel we can use Application.Transpose instead of personal Function Transposition ArrResult = Transposition(ArrResult)End SubPrivate Sub Combine(MyArr As Variant, Nb As Long, Deb As Long, Ind As Long)Dim i As Long, j As Long, N As Long For i = Deb To UBound(MyArr, 1) ArrResult(Ind, UBound(ArrResult, 2)) = MyArr(i) N = IIf(LBound(ArrResult, 1) = 0, Nb - 1, Nb) If Ind = N Then ReDim Preserve ArrResult(UBound(ArrResult, 1), UBound(ArrResult, 2) + 1) For j = LBound(ArrResult, 1) To UBound(ArrResult, 1) ArrResult(j, UBound(ArrResult, 2)) = ArrResult(j, UBound(ArrResult, 2) - 1) Next j Else Call Combine(MyArr, Nb, i + 1, Ind + 1) End If Next iEnd SubPrivate Function Transposition(ByRef MyArr As Variant) As VariantDim T, i As Long, j As Long ReDim T(LBound(MyArr, 2) To UBound(MyArr, 2), LBound(MyArr, 1) To UBound(MyArr, 1)) For i = LBound(MyArr, 1) To UBound(MyArr, 1) For j = LBound(MyArr, 2) To UBound(MyArr, 2) T(j, i) = MyArr(i, j) Next j Next i Transposition = T Erase TEnd Function
If Option Base 0 :
0 1 2 0 1 3 0 1 4 0 2 3 0 2 4 0 3 4 1 2 3 1 2 4 1 3 4 2 3 4
If Option Base 1 :
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
Private Sub comb(ByVal pool As Integer, ByVal needed As Integer, Optional ByVal done As Integer = 0, Optional ByVal chosen As Variant) If needed = 0 Then '-- got a full set For Each x In chosen: Debug.Print x;: Next x Debug.Print Exit Sub End If If done + needed > pool Then Exit Sub '-- cannot fulfil '-- get all combinations with and without the next item: done = done + 1 Dim tmp As Variant tmp = chosen If IsMissing(chosen) Then ReDim tmp(1) Else ReDim Preserve tmp(UBound(chosen) + 1) End If tmp(UBound(tmp)) = done comb pool, needed - 1, done, tmp comb pool, needed, done, chosenEnd SubPublic Sub main() comb 5, 3End Sub
Function Dec2Bin(n)q = nDec2Bin = ""Do Until q = 0Dec2Bin = CStr(q Mod 2) & Dec2Binq = Int(q / 2)LoopDec2Bin = Right("00000" & Dec2Bin,6)End FunctionSub Combination(n,k)Dim arr()ReDim arr(n-1)For h = 0 To n-1arr(h) = h + 1NextSet list = CreateObject("System.Collections.Arraylist")For i = 1 To 2^nbin = Dec2Bin(i)c = 0tmp_combo = ""If Len(Replace(bin,"0","")) = k ThenFor j = Len(bin) To 1 Step -1If CInt(Mid(bin,j,1)) = 1 Thentmp_combo = tmp_combo & arr(c) & ","End Ifc = c + 1Nextlist.Add Mid(tmp_combo,1,(k*2)-1)End IfNextlist.SortFor l = 0 To list.Count-1WScript.StdOut.Write list(l)WScript.StdOut.WriteLineNextEnd Sub'Testing with n = 5 / k = 3Call Combination(5,3)1,2,31,2,41,2,51,3,41,3,51,4,52,3,42,3,52,4,53,4,5
import "./perm" for Combvar fib = Fiber.new { Comb.generate((0..4).toList, 3) }while (true) { var c = fib.call() if (!c) return System.print(c)}[0, 1, 2][0, 1, 3][0, 1, 4][0, 2, 3][0, 2, 4][0, 3, 4][1, 2, 3][1, 2, 4][1, 3, 4][2, 3, 4]
code ChOut=8, CrLf=9, IntOut=11;def M=3, N=5;int A(N-1);proc Combos(D, S); \Display all size M combinations of N in sorted orderint D, S; \depth of recursion, starting value of Nint I;[if D<M then \depth < size for I:= S to N-1 do [A(D):= I; Combos(D+1, I+1); ]else [for I:= 0 to M-1 do [IntOut(0, A(I)); ChOut(0, ^ )]; CrLf(0); ];];Combos(0, 0)
0 1 2 0 1 3 0 1 4 0 2 3 0 2 4 0 3 4 1 2 3 1 2 4 1 3 4 2 3 4
fcn comb(k,seq){// no repeats, seq is finite seq=seq.makeReadOnly();// because I append to parts of seq fcn(k,seq){ if(k<=0) return(T(T)); if(not seq) return(T); self.fcn(k-1,seq[1,*]).pump(List,seq[0,1].extend) .extend(self.fcn(k,seq[1,*])); }(k,seq);}comb(3,"abcde".split("")).apply("concat")L("abc","abd","abe","acd","ace","ade","bcd","bce","bde","cde")