Combinations: Difference between revisions
Line 1,029:
comb :: Int -> [a] -> [[a]]
comb 0 _ = [[]]
comb m l =
To generate combinations of integers between 0 and ''n-1'', use
|
Revision as of 22:57, 26 November 2011
![Task](http://static.miraheze.org/rosettacodewiki/thumb/b/ba/Rcode-button-task-crushed.png/64px-Rcode-button-task-crushed.png)
You are encouraged to solve this task according to the task description, using any language you may know.
Given non-negative integers m and n, generate all size m combinations of the integers from 0 to n-1 in sorted order (each combination is sorted and the entire table is sorted).
For example, 3 comb 5 is
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 it is more "natural" in your language to start counting from 1 instead of 0 the combinations can be of the integers from 1 to n.
Ada
<lang ada>with Ada.Text_IO; use Ada.Text_IO;
procedure Test_Combinations is
generic type Integers is range <>; package Combinations is type Combination is array (Positive range <>) of Integers; procedure First (X : in out Combination); procedure Next (X : in out Combination); procedure Put (X : Combination); end Combinations; package body Combinations is procedure First (X : in out Combination) is begin X (1) := Integers'First; for I in 2..X'Last loop X (I) := X (I - 1) + 1; end loop; end First; procedure Next (X : in out Combination) is begin for I in reverse X'Range loop if X (I) < Integers'Val (Integers'Pos (Integers'Last) - X'Last + I) then X (I) := X (I) + 1; for J in I + 1..X'Last loop X (J) := X (J - 1) + 1; end loop; return; end if; end loop; raise Constraint_Error; end Next; procedure Put (X : Combination) is begin for I in X'Range loop Put (Integers'Image (X (I))); end loop; end Put; end Combinations; type Five is range 0..4; package Fives is new Combinations (Five); use Fives;
X : Combination (1..3);
begin
First (X); loop Put (X); New_Line; Next (X); end loop;
exception
when Constraint_Error => null;
end Test_Combinations;</lang> The solution is generic the formal parameter is the integer type to make combinations of. The type range determines n. In the example it is <lang ada>type Five is range 0..4;</lang> The parameter m is the object's constraint. When n < 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. Sample output:
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
ALGOL 68
<lang algol68>MODE DATA = INT;
PRIO C = 7;
- Calculate the number of combinations anticipated #
OP C = (INT n, k)INT:
CASE k + 1 IN # case 0: # 1, # case 1: # n OUT (n - 1) C (k - 1) * n OVER k ESAC;
PROC combinations = (INT m, []DATA list)[,]DATA: (
CASE m IN # case 1: # ( # transpose list # [UPB list,1]DATA out; out[,1]:=list; out ) OUT [UPB list C m, m]DATA out; INT index out := 1; FOR i TO UPB list DO DATA x = list[i]; [,]DATA y = combinations(m - 1, list[i+1:]); FOR suffix TO UPB y DO out[index out,1 ] := x; out[index out,2:] := y[suffix,]; index out +:= 1 OD OD; out ESAC
);
PRIO COMB = 7; OP COMB = (INT n, k)[,]INT: (
[k]DATA list; # create a list to recombine # FOR i TO UPB list DO list[i]:=i OD; combinations(n,list)
);
INT m = 3;
- IF formatted transput possible THEN#
FORMAT data repr = $d$; FORMAT list repr = $"("n(m-1)(f(data repr)",")f(data repr)")"$; printf ((list repr, 3 COMB 5, $l$));
- ELSE#
[,]DATA result = 3 COMB 5; FOR row TO UPB result DO print ((result[row,], new line)) OD
- FI#</lang>
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) +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
AppleScript
<lang AppleScript>on comb(n, k) set c to {} repeat with i from 1 to k set end of c to i's contents end repeat set r to {c's contents} repeat while my next_comb(c, k, n) set end of r to c's contents end repeat return r end comb
on next_comb(c, k, n) set i to k set c's item i to (c's item i) + 1 repeat while (i > 1 and c's item i ≥ n - k + 1 + i) set i to i - 1 set c's item i to (c's item i) + 1 end repeat if (c's item 1 > n - k + 1) then return false repeat with i from i + 1 to k set c's item i to (c's item (i - 1)) + 1 end repeat return true end next_comb
return comb(5, 3)</lang>Output:<lang AppleScript>{{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}}</lang>
AutoHotkey
contributed by Laszlo on the ahk forum <lang AutoHotkey>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, lexicographically
IfLess n,%t%, Return Loop %t% c%A_Index% := A_Index i := t+1, c%i% := n+1
Loop { Loop %t% i := t+1-A_Index, c .= c%i% " " c .= "`n" ; combinations in new lines j := 1, i := 2 Loop If (c%j%+1 = c%i%) c%j% := j, ++j, ++i Else Break If (j > t) Return c c%j% += 1 }
}</lang>
AWK
<lang awk>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 = 3 if (length(n) == 0) n = 5
for (i=1; i <= r; i++) { ## First combination of items: A[i] = i if (i < r ) printf i OFS else print i}
## 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 = i break}} ## 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) printf A[i] OFS else print A[i]}} exit}</lang>
Usage:
awk -v r=3 -v n=5 -f combn.awk
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
Bracmat
The program first constructs a pattern with m
variables and an expression that evaluates m
variables into a combination.
Then the program constructs a list of the integers 0 ... 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.
<lang bracmat>(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);</lang> 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)
C
<lang C>#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 */
typedef unsigned long marker; marker one = 1;
void comb(int pool, int need, marker chosen, int at) { 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 */ }
int main() { comb(5, 3, 0, 0); return 0; }</lang>
Lexicographic ordered generation
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; otherwise find right most item that can be moved, move it one step and put all items already to its right next to it. <lang c>#include <stdio.h>
void comb(int m, int n, unsigned char *c) { int i; 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 */ if (c[i]++ < m) continue;
for (i = 0; c[i] >= m - i;) if (++i >= n) return; for (c[i]++; i; i--) c[i-1] = c[i] + 1; } }
int main() { unsigned char buf[100]; comb(5, 3, buf); return 0; }</lang>
C++
<lang cpp>#include <algorithm>
- include <iostream>
- include <string>
void comb(int N, int K) {
std::string bitmask(K, 1); // K leading 1's bitmask.resize(N, 0); // N-K trailing 0's
// print integers and permute bitmask do { for (int i = 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()));
}
int main() {
comb(5, 3);
}</lang> Output:
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
C#
<lang csharp>using System; using System.Collections.Generic;
public class Program {
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; } } } }
static void Main() { foreach (int[] c in Combinations(3, 5)) { for (int i = 0; i < c.Length; i++) { Console.Write(c[i] + " "); } Console.WriteLine(); } }
}</lang>
Here is another implementation that uses recursion, intead of an explicit stack:
<lang csharp>
// end exclusive IEnumerable<int[]> FindCombosRec(int[] buffer, int done, int begin, int end) { for (int i = begin; i < end; i++) { buffer[done] = i;
if (done == buffer.Length - 1) yield return buffer; else foreach (int[] child in FindCombosRec(buffer, done+1, i+1, end)) yield return child; } }
IEnumerable<int[]> FindCombinations(int m, int n) { return FindCombosRec(new int[m], 0, 0, n); }
</lang>
Clojure
<lang clojure>(defn combinations
"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" [m n] (letfn [(comb-aux
[m start] (if (= 1 m) (for [x (range start n)] (list x)) (for [x (range start n) xs (comb-aux (dec m) (inc x))] (cons x xs))))]
(comb-aux m 0)))
(defn print-combinations
[m n] (doseq [line (combinations m n)] (doseq [n line] (printf "%s " n)) (printf "%n")))</lang>
Common Lisp
<lang lisp>(defun map-combinations (m n fn)
"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-list m))) (labels ((up-from (low) (let ((start (1- low))) (lambda () (incf start)))) (mc (curr left needed comb-tail) (cond ((zerop needed) (funcall fn combination)) ((= left needed) (map-into comb-tail (up-from curr)) (funcall fn combination)) (t (setf (first comb-tail) curr) (mc (1+ curr) (1- left) (1- needed) (rest comb-tail)) (mc (1+ curr) (1- left) needed comb))))) (mc 0 n m combination))))</lang>
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)
Recursive method: <lang lisp>(defun comb (m list fn)
(labels ((comb1 (l c m)
(when (>= (length l) m) (if (zerop m) (return-from comb1 (funcall fn c))) (comb1 (cdr l) c m) (comb1 (cdr l) (cons (first l) c) (1- m)))))
(comb1 list nil m)))
(comb 3 '(0 1 2 3 4 5) #'print)</lang>
D
Includes an algorithm to find mth Lexicographical Element of a Combination. <lang d>module comblex ; import std.stdio, std.algorithm, std.conv ;
ulong choose(int n, int k) {
static ulong[][] cache ; assert(n >= 0 && k >= 0, "choose:no negative input") ; if(n < k) return 0 ; else if(n == k) return 1 ; while(n >= cache.length) cache ~= [1UL] ; // = choose(m, 0) ; auto kmax = min(k,n-k) ; while(kmax >= cache[n].length) { auto h = cache[n].length ; cache[n] ~= choose(n-1, h-1) + choose(n-1, h) ; } return cache[n][kmax] ;
}
int largestV(int p, int q, long r) {
assert(p > 0 && q >= 0 && r >= 0, "largestV:no negative input") ; auto v = p - 1 ; while(choose(v,q) > r) v-- ; return v ;
}
struct Comb {
immutable int n, m ; size_t length() @property { return to!size_t(choose(n,m)) ; } int[] opIndex(size_t idx) { if(m < 0 || n < 0) return [] ; if(idx >= length) throw new Exception("Out of bound") ; ulong x = choose(n,m) - 1 - idx ; int a = n, b = m ; auto res = new int[](m); foreach(i;0..m) { a = largestV(a,b,x) ; x = x - choose(a,b) ; b = b - 1 ; res[i] = n - 1 - a ; } return res ; } int opApply(int delegate(ref int[]) dg) { int[] yield ; foreach(i;0..length) { yield = this[i] ; if(dg(yield)) break ; } return 0 ; } static auto On(T)(T[] arr, int m) { auto comb = Comb(arr.length, m) ; return new class { size_t length() @property { return comb.length ; } int opApply(int delegate(ref T[]) dg) { auto yield = new T[](m) ; foreach(c;comb) { foreach(idx; 0..m) yield[idx] = arr[c[idx]] ; if(dg(yield)) break ; } return 0 ; } } ; }
}</lang> Slower recursive versions:
<lang d>import std.stdio: writeln;
T[][] comb(T)(T[] arr, int k) {
if (k == 0) return [[]]; T[][] result; foreach (i, x; arr) foreach (suffix; comb(arr[i+1 .. $], k-1)) result ~= x ~ suffix; return result;
}
void main() {
writeln(comb([0, 1, 2, 3, 4], 3));
}</lang>
<lang d>import std.stdio, std.algorithm, std.range;
T[][] comb(T)(int m, T[] s) {
if (!m) return [[]]; if (!s.length) return []; return array(map!((a){return s[0]~a;})(comb(m-1,s[1..$]))) ~ comb(m,s[1..$]);
}
void main() {
writeln(comb(3, array(iota(5))));
}</lang>
E
<lang e>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) } } } } }
}</lang>
? for x in combinations(3, 0..4) { println(x) }
Factor
<lang factor>USING: math.combinatorics prettyprint ;
5 iota 3 all-combinations .</lang>
{ { 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: <lang factor>{ "a" "b" "c" } 2 all-combinations .</lang>
{ { "a" "b" } { "a" "c" } { "b" "c" } }
Fortran
<lang fortran>program Combinations
use iso_fortran_env implicit none
type comb_result integer, dimension(:), allocatable :: combs end type comb_result
type(comb_result), dimension(:), pointer :: r integer :: i, j
call comb(5, 3, r) do i = 0, choose(5, 3) - 1 do j = 2, 0, -1 write(*, "(I4, ' ')", advance="no") r(i)%combs(j) end do deallocate(r(i)%combs) write(*,*) "" end do deallocate(r)
contains
function choose(n, k, err) integer :: choose integer, intent(in) :: n, k integer, optional, intent(out) :: err
integer :: imax, i, imin, ie
ie = 0 if ( (n < 0 ) .or. (k < 0 ) ) then write(ERROR_UNIT, *) "negative in choose" choose = 0 ie = 1 else if ( n < k ) then choose = 0 else if ( n == k ) then choose = 1 else imax = max(k, n-k) imin = min(k, n-k) choose = 1 do i = imax+1, n choose = choose * i end do do i = 2, imin choose = choose / i end do end if end if if ( present(err) ) err = ie end function choose
subroutine comb(n, k, co) integer, intent(in) :: n, k type(comb_result), dimension(:), pointer, intent(out) :: co
integer :: i, j, s, ix, kx, hm, t integer :: err hm = choose(n, k, err) if ( err /= 0 ) then nullify(co) return end if
allocate(co(0:hm-1)) do i = 0, hm-1 allocate(co(i)%combs(0:k-1)) end do do i = 0, hm-1 ix = i; kx = k do s = 0, n-1 if ( kx == 0 ) exit t = choose(n-(s+1), kx-1) if ( ix < t ) then co(i)%combs(kx-1) = s kx = kx - 1 else ix = ix - t end if end do end do
end subroutine comb
end program Combinations</lang> Alternatively: <lang fortran>program combinations
implicit none integer, parameter :: m_max = 3 integer, parameter :: n_max = 5 integer, dimension (m_max) :: comb character (*), parameter :: fmt = '(i0' // repeat (', 1x, i0', m_max - 1) // ')'
call gen (1)
contains
recursive subroutine gen (m)
implicit none integer, intent (in) :: m integer :: n
if (m > m_max) then write (*, fmt) comb else do n = 1, n_max if ((m == 1) .or. (n > comb (m - 1))) then comb (m) = n call gen (m + 1) end if end do end if
end subroutine gen
end program combinations</lang> Output: <lang>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</lang>
GAP
<lang gap># Built-in Combinations([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 ] ]</lang>
Go
<lang go>package main
import (
"fmt"
)
func main() {
comb(5, 3, func(c []int) { fmt.Println(c) })
}
func comb(n, m int, emit func([]int)) {
s := make([]int, m) last := m - 1 var rc func(int, int) rc = func(i, next int) { for j := next; j < n; j++ { s[i] = j if i == last { emit(s) } else { rc(i+1, j+1) } } return } rc(0, 0)
}</lang> Output:
[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]
Groovy
Following the spirit of the Haskell solution.
In General
A recursive closure must be pre-declared. <lang groovy>def comb comb = { m, list ->
def n = list.size() m == 0 ? [[]] : (0..(n-m)).inject([]) { newlist, k -> def sublist = (k+1 == n) ? [] : list[(k+1)..<n] newlist += comb(m-1, sublist).collect { [list[k]] + it } }
}</lang>
Test program: <lang groovy>def csny = [ "Crosby", "Stills", "Nash", "Young" ] println "Choose from ${csny}" (0..(csny.size())).each { i -> println "Choose ${i}:"; comb(i, csny).each { println it }; println() }</lang>
Output:
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]
Zero-based Integers
<lang groovy>def comb0 = { m, n -> comb(m, (0..<n)) }</lang>
Test program: <lang groovy>println "Choose out of 5 (zero-based):" (0..3).each { i -> println "Choose ${i}:"; comb0(i, 5).each { println it }; println() }</lang>
Output:
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]
One-based Integers
<lang groovy>def comb1 = { m, n -> comb(m, (1..n)) }</lang>
Test program: <lang groovy>println "Choose out of 5 (one-based):" (0..3).each { i -> println "Choose ${i}:"; comb1(i, 5).each { println it }; println() }</lang>
Output:
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]
Haskell
It's more natural to extend the task to all (ordered) sublists of size m of a list.
Straightforward, unoptimized implementation with divide-and-conquer: <lang haskell>comb :: Int -> [a] -> a comb 0 _ = [[]] comb _ [] = [] comb m (x:xs) = map (x:) (comb (m-1) xs) ++ comb m xs</lang>
In the induction step, either x is not in the result and the recursion proceeds with the rest of the list xs, or it is in the result and then we only need m-1 elements.
Shorter version of the above: <lang haskell>import Data.List (tails)
comb :: Int -> [a] -> a comb 0 _ = [[]] comb m l = [x:ys | x:xs <- tails l, ys <- comb (m-1) xs]</lang>
To generate combinations of integers between 0 and n-1, use
<lang haskell>comb0 m n = comb m [0..n-1]</lang>
Similar, for integers between 1 and n, use
<lang haskell>comb1 m n = comb m [1..n]</lang>
Another method is to use the built in Data.List.subsequences function, filter for subsequences of length m and then sort:
<lang haskell> import Data.List (sort, subsequences) comb m n = sort . filter ((==m) . length) $ subsequences [0..n-1] </lang>
And yet another way is to use the list monad to generate all possible subsets:
<lang haskell> comb m n = filter ((==m . length) $ filterM (const [True, False]) [0..n-1] </lang>
Icon and Unicon
<lang Icon>procedure main() return combinations(3,5,0) end
procedure combinations(m,n,z) # demonstrate combinations /z := 1
write(m," combinations of ",n," integers starting from ",z) every put(L := [], z to n - 1 + z by 1) # generate list of n items from z write("Intial list\n",list2string(L)) write("Combinations:") every write(list2string(lcomb(L,m))) end
procedure list2string(L) # helper function every (s := "[") ||:= " " || (!L|"]") return s end
link lists</lang>
The
provides the core procedure lcomb in lists written by Ralph E. Griswold and Richard L. Goerwitz.
<lang Icon>procedure lcomb(L,i) #: list combinations
local j
if i < 1 then fail suspend if i = 1 then [!L] else [L[j := 1 to *L - i + 1]] ||| lcomb(L[j + 1:0],i - 1)
end</lang>
Sample output:
3 combinations of 5 integers starting from 0 Intial 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 ]
J
Iteration
<lang j>comb1=: dyad define
c=. 1 {.~ - d=. 1+y-x z=. i.1 0 for_j. (d-1+y)+/&i.d do. z=. (c#j) ,. z{~;(-c){.&.><i.{.c=. +/\.c end.
)</lang>
Recursion
<lang j>comb=: dyad define M.
if. (x>:y)+.0=x do. i.(x<:y),x else. (0,.x comb&.<: y),1+x comb y-1 end.
)</lang>
The M.
uses memoization which greatly reduces the running time.
Java
<lang java5>import java.util.Collections; import java.util.LinkedList;
public class Comb{
public static void main(String[] args){ System.out.println(comb(3,5)); }
public static String bitprint(int u){ String s= ""; for(int n= 0;u > 0;++n, u>>= 1) if((u & 1) > 0) s+= n + " "; return s; }
public static int bitcount(int u){ int n; for(n= 0;u > 0;++n, u&= (u - 1));//Turn the last set bit to a 0 return n; }
public static LinkedList<String> comb(int c, int n){ LinkedList<String> s= new LinkedList<String>(); for(int u= 0;u < 1 << n;u++) if(bitcount(u) == c) s.push(bitprint(u)); Collections.sort(s); return s; }
}</lang>
JavaScript
<lang javascript>function bitprint(u) {
var s=""; for (var n=0; u; ++n, u>>=1) if (u&1) s+=n+" "; return s;
} function bitcount(u) {
for (var n=0; u; ++n, u=u&(u-1)); return n;
} function comb(c,n) {
var s=[]; for (var u=0; u<1<<n; u++) if (bitcount(u)==c) s.push(bitprint(u)) return s.sort();
} comb(3,5)</lang>
Logo
<lang logo>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 :list
end print comb 3 [0 1 2 3 4]</lang>
Lua
<lang lua>function map(f, a, ...) if a then return f(a), map(f, ...) end end function incr(k) return function(a) return k > a and a or a+1 end end function combs(m, n)
if m * n == 0 then return {{}} end local ret, old = {}, combs(m-1, n-1) for i = 1, n do for k, v in ipairs(old) do ret[#ret+1] = {i, map(incr(i), unpack(v))} end end return ret
end
for k, v in ipairs(combs(3, 5)) do print(unpack(v)) end</lang>
Mathematica
<lang Mathematica>combinations[n_Integer, m_Integer]/;m>= 0:=Union[Sort /@ Permutations[Range[0, n - 1], {m}]]</lang>
M4
<lang M4>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)')
divert
comb(3,5)</lang>
MATLAB
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: <lang MATLAB>>> 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</lang>
OCaml
Like the Haskell code:
<lang ocaml>let rec comb m lst =
match m, lst with 0, _ -> [[]] | _, [] -> [] | m, x :: xs -> List.map (fun y -> x :: y) (comb (pred m) xs) @ comb m xs
comb 3 [0;1;2;3;4];;</lang>
Octave
<lang octave>nchoosek([0:4], 3)</lang>
Oz
This can be implemented as a trivial application of finite set constraints: <lang oz>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} end
in
{Inspect {Comb 3 5}}</lang>
Perl
<lang perl>use Math::Combinatorics;
@n = (0 .. 4); print join("\n", map { join(" ", @{$_}) } combine(3, @n)), "\n";</lang>
Pascal
<lang pascal>Program Combinations;
const
m_max = 3; n_max = 5;
var
combination: array [1..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.</lang>
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
Perl 6
<lang perl6>proto combine (Int, @) {*}
multi combine (0, @) { [] } multi combine ($, []) { () } multi combine ($n, [$head, *@tail]) {
map( { [$head, @^others] }, combine($n-1, @tail) ), combine($n, @tail);
}
.say for combine(3, [^5]);</lang> Perl 6's gradual typing allows this routine to work generically on any kind of elements. It could be parametrically typed by wrapping it up in a role, but this is not required by the language. Perl 6's typing is "strongly gradual"...
PicoLisp
<lang PicoLisp>(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))</lang>
Pop11
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.
<lang pop11>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) ==></lang>
Prolog
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.
<lang prolog>:- use_module(library(clpfd)).
comb_clpfd(L, M, N) :-
length(L, M), L ins 1..N, chain(L, #<), label(L).</lang>
output :
<lang prolog> ?- 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.</lang>
Another solution :
<lang prolog>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).
</lang> with the same output.
List comprehension
Works with SWI-Prolog, library clpfd from Markus Triska, and list comprehension (see http://rosettacode.org/wiki/List_comprehensions ). <lang Prolog>:- 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)}. </lang>
Output :
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.
Pure
<lang pure>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;</lang>
PureBasic
<lang PureBasic>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)
EndProcedure
Debug Combinations(5, 3)</lang>
Python
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: <lang python>>>> 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)]</lang>
Earlier versions could use functions like the following:
<lang python>def comb(m, lst):
if m == 0: return [[]] else: return [[x] + suffix for i, x in enumerate(lst) for suffix in comb(m - 1, lst[i + 1:])]</lang>
Example: <lang python>>>> 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]]</lang>
<lang python>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))</lang>
R
<lang R>print(combn(0:4, 3))</lang> Combinations are organized per column, so to provide an output similar to the one in the task text, we need the following: <lang R>r <- combn(0:4, 3) for(i in 1:choose(5,3)) print(r[,i])</lang>
REXX
<lang rexx> /*REXX program shows combination sets for X things taken Y at a time*/
@abc='abcdefghijklmnopqrstuvwxyz' @abcu=@abc; upper @abcu @digs=1234567890
parse arg x y symbols . /*take X things Y at a time.*/ if x== then x=5 /*no X specified? Use 5 */ if y== then y=3 /*no Y specified? Use 3 */ if y== then y=3 symbols=symbols||@digs||@abc||@abcu /*symbol(s) table string. */
do j=1 for x; @.j=substr(symbols,j,1); end /*build symbol table.*/
z.= /*placeholders for numerics.*/ zs.= /*placeholders for "digits".*/
do k=1 for y; z.k=k; zs.k=@.k; end do j=1 if j\==1 then if $setadd(y) then iterate if z.1>x then leave do k=1 for y; _=z.k; zs.k=@._; end _=zs.1 /*use first "digit". */ do k=2 to y; _=_ zs.k; end say _ /*display a list. */ end
exit
$setadd: parse arg s; if s==0 then return 1; z.s=z.s+1; if z.1>x then return 0
if z.s>x then if $setadd(s-1) then return 1
else do m=s+1 to y mm1=m-1; z.m=z.mm1+1; if z.m>x then return 1 end
return 0 </lang> Output (using the defaults):
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
Output when the following was specified:
5 3 01234
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
Output when the following was specified:
5 3 abcde
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
Ruby
<lang ruby>def comb(m, n)
(0...n).to_a.combination(m).to_a
end
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]]</lang>
Scala
<lang scala>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) }
}</lang>
Usage:
scala> 3 comb 5 res170: 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))
Scheme
Like the Haskell code: <lang scheme>(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))</lang>
Seed7
<lang seed7>$ 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;</lang>
Output:
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
SETL
<lang SETL>print({0..4} npow 3);</lang>
Smalltalk
<lang smalltalk> (0 to: 4)
combinations: 3 atATimeDo: [ :x | ':-)' logCr: x ].
"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)"
</lang>
Standard ML
<lang sml>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]);</lang>
Tcl
ref[1] <lang tcl>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}</lang>
Ursala
Most of the work is done by the standard library function choices
, whose implementation is shown here for the sake of comparison with other solutions,
<lang Ursala>choices = ^(iota@r,~&l); leql@a^& ~&al?\&! ~&arh2fabt2RDfalrtPXPRT</lang>
where leql
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 but
not necessarily in sorted order, which can be done like this.
<lang Ursala>#import std
- import nat
combinations = @rlX choices^|(iota,~&); -< @p nleq+ ==-~rh</lang>
- The sort combinator (
-<
) takes a binary predicate to a function that sorts a list in order of that predicate. - The predicate in this case begins by zipping its two arguments together with
@p
. - The prefiltering operator
-~
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. - The
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. - The
nleq
function then tests whether the left side of this pair is less than or equal to the right. - The overall effect of using everything starting from the
@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: <lang Ursala>#cast %nLL
example = combinations(3,5)</lang> output:
< <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>>
V
like scheme (using variables) <lang v>[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].</lang>
Using destructuring view and stack not *pure at all <lang v>[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].</lang>
Pure concatenative version <lang v>[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].</lang>
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]]
- Programming Tasks
- Discrete math
- Ada
- ALGOL 68
- AppleScript
- AutoHotkey
- AWK
- Bracmat
- C
- C++
- C sharp
- Clojure
- Common Lisp
- D
- E
- Factor
- Fortran
- GAP
- Go
- Groovy
- Haskell
- Icon
- Unicon
- Icon Programming Library
- J
- Java
- JavaScript
- Logo
- Lua
- Mathematica
- M4
- MATLAB
- OCaml
- Octave
- Oz
- Perl
- Pascal
- Perl 6
- PicoLisp
- Pop11
- Prolog
- Pure
- PureBasic
- Python
- R
- REXX
- Ruby
- Scala
- Scheme
- Seed7
- SETL
- Smalltalk
- Standard ML
- Tcl
- Ursala
- V