Just another update

Task/Combinations/00DESCRIPTION

@@ -1,4 +1,5 @@
 Given non-negative integers <tt>m</tt> and <tt>n</tt>, generate all size <tt>m</tt> [http://mathworld.wolfram.com/Combination.html combinations] of the integers from 0 to <tt>n-1</tt> in sorted order (each combination is sorted and the entire table is sorted).
+
 For example, <tt>3 comb 5</tt> is
  0 1 2
  0 1 3

Task/Combinations/AppleScript/combinations.applescript

@@ -0,0 +1,27 @@
+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)

Task/Combinations/CoffeeScript/combinations.coffee

@@ -0,0 +1,25 @@
+combinations = (n, p) ->
+  return [ [] ] if p == 0
+  i = 0
+  combos = []
+  combo = []
+  while combo.length < p
+    if i < n
+      combo.push i
+      i += 1
+    else
+      break if combo.length == 0
+      i = combo.pop() + 1
+
+    if combo.length == p
+      combos.push clone combo
+      i = combo.pop() + 1
+  combos
+
+clone = (arr) -> (n for n in arr)
+
+N = 5
+for i in [0..N]
+  console.log "------ #{N} #{i}"
+  for combo in combinations N, i
+    console.log combo

Task/Combinations/D/combinations-2.d

@@ -1,10 +1,9 @@
 import std.stdio, std.algorithm, std.range;
 
-T[][] comb(T)(in T[] s, in int m) /*pure*/ nothrow {
+immutable(int)[][] comb(immutable int[] s, in int m) pure nothrow @safe {
   if (!m) return [[]];
   if (s.empty) return [];
-  return s[1 .. $].comb(m - 1).map!(x => s[0] ~ x).array ~
-         s[1 .. $].comb(m);
+  return s[1 .. $].comb(m - 1).map!(x => s[0] ~ x).array ~ s[1 .. $].comb(m);
 }
 
 void main() {

Task/Combinations/D/combinations-3.d

@@ -1,126 +1,94 @@
 module combinations3;
 
-ulong binomial(long n, long k) pure nothrow
-in {
-    assert(n > 0, "binomial: n must be > 0.");
-} body {
-    if (k < 0 || k > n)
-        return 0;
-    if (k > (n / 2))
-        k = n - k;
-    ulong result = 1;
-    foreach (ulong d; 1 .. k + 1) {
-        result *= n;
-        n--;
-        result /= d;
-    }
-    return result;
-}
-
+import std.traits: Unqual;
 
 struct Combinations(T, bool copy=true) {
-    // Algorithm by Knuth, Pre-fascicle 3A, draft of
-    // section 7.2.1.3: "Generating all partitions".
-    T[] items;
-    int k;
-    size_t len = -1; // computed lazily
+    Unqual!T[] pool, front;
+    size_t r, n;
+    bool empty = false;
+    size_t[] indices;
+    size_t len;
+    bool lenComputed = false;
 
-    this(in T[] items, in int k)
-    in {
-        assert(items.length, "combinations: items can't be empty.");
-    } body {
-        this.items = items.dup;
-        this.k = k;
+    this(T[] pool_, in size_t r_) pure nothrow @safe {
+        this.pool = pool_.dup;
+        this.r = r_;
+        this.n = pool.length;
+        if (r > n)
+            empty = true;
+        indices.length = r;
+        foreach (immutable i, ref ini; indices)
+            ini = i;
+        front.length = r;
+        foreach (immutable i, immutable idx; indices)
+            front[i] = pool[idx];
     }
 
-    @property size_t length() /*logic_const*/ {
-        if (len == -1) // set cache
-            len = cast(size_t)binomial(items.length, k);
+    @property size_t length() /*logic_const*/ pure nothrow @nogc {
+        static size_t binomial(size_t n, size_t k) pure nothrow @safe @nogc
+        in {
+            assert(n > 0, "binomial: n must be > 0.");
+        } body {
+            if (k < 0 || k > n)
+                return 0;
+            if (k > (n / 2))
+                k = n - k;
+            size_t result = 1;
+            foreach (size_t d; 1 .. k + 1) {
+                result *= n;
+                n--;
+                result /= d;
+            }
+            return result;
+        }
+
+        if (!lenComputed) {
+            // Set cache.
+            len = binomial(n, r);
+            lenComputed = true;
+        }
         return len;
     }
 
-    int opApply(int delegate(ref T[]) dg) {
-        if (k == items.length)
-            return dg(items);         // yield items
-
-        auto outarr = new T[k];
-        if (k == 0)
-            return dg(outarr);        // yield []
-
-        if (k < 0 || k > items.length)
-            return 0;                 // yield nothing
-
-        int result, x;
-        immutable n = items.length;
-        auto c = new uint[k + 3]; // c[0] isn'k used
-
-        foreach (j; 1 .. k + 1)
-            c[j] = j - 1;
-        c[k + 1] = n;
-        c[k + 2] = 0;
-        int j = k;
-
-        while (true) {
-            // The following lines equal to:
-            //int pos;
-            //foreach (i; 1 .. k +1)
-            //    outarr[pos++] = items[c[i]];
-            auto outarr_ptr = outarr.ptr;
-            auto c_ptr = &(c[1]);
-            auto c_ptrkp1 = &(c[k + 1]);
-            while (c_ptr != c_ptrkp1)
-                *outarr_ptr++ = items[*c_ptr++];
-
-
-            static if (copy) {
-                auto outarr2 = outarr.dup;
-                result = dg(outarr2); // yield outarr2
-            } else {
-                result = dg(outarr); // yield outarr
-            }
-
-            if (j > 0) {
-                x = j;
-                c[j] = x;
-                j--;
-                continue;
-            }
-
-            if ((c[1] + 1) < c[2]) {
-                c[1]++;
-                continue;
-            } else
-                j = 2;
-
-            while (true) {
-                c[j - 1] = j - 2;
-                x = c[j] + 1;
-                if (x == c[j + 1])
-                    j++;
-                else
+    void popFront() pure nothrow @safe {
+        if (!empty) {
+            bool broken = false;
+            size_t pos = 0;
+            foreach_reverse (immutable i; 0 .. r) {
+                pos = i;
+                if (indices[i] != i + n - r) {
+                    broken = true;
                     break;
+                }
             }
-
-            if (j > k)
-                return result; // End
-
-            c[j] = x;
-            j--;
+            if (!broken) {
+                empty = true;
+                return;
+            }
+            indices[pos]++;
+            foreach (immutable j; pos + 1 .. r)
+                indices[j] = indices[j - 1] + 1;
+            static if (copy)
+                front = new Unqual!T[front.length];
+            foreach (immutable i, immutable idx; indices)
+                front[i] = pool[idx];
         }
     }
 }
 
-Combinations!(T,copy) combinations(bool copy=true, T)
-                                  (in T[] items, in int k)
+Combinations!(T, copy) combinations(bool copy=true, T)
+                                   (T[] items, in size_t k)
 in {
     assert(items.length, "combinations: items can't be empty.");
 } body {
-    return Combinations!(T, copy)(items, k);
+    return typeof(return)(items, k);
 }
 
-
-// compile with -version=combinations3_main to run main
-version(combinations3_main) void main() {
-    import std.stdio, std.array;
-    writeln(array(combinations([1, 2, 3, 4], 2)));
+// Compile with -version=combinations3_main to run main.
+version(combinations3_main)
+void main() {
+    import std.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;
 }

Task/Combinations/Eiffel/combinations-1.e

@@ -0,0 +1,96 @@
+class
+	COMBINATIONS
+create
+	make
+feature
+	make(n, k:INTEGER)
+		require
+			n_positive: n>0
+			k_positive: k>0
+			k_smaller_equal: k<=n
+		do
+			create set.make
+			set.extend ("")
+			create sol.make
+			sol:=solve(set,k,n-k)
+			sol:= conv_sol(n, sol)
+		ensure
+			correct_num_of_sol: num_of_comb(n,k)= sol.count
+		end
+	set: LINKED_LIST[STRING]
+	sol: LINKED_LIST[STRING]
+
+	conv_sol(n: INTEGER; solution: LINKED_LIST[STRING]):LINKED_LIST[STRING]
+	local
+		i,j: INTEGER
+		temp: STRING
+	do
+		create temp.make (n)
+		from
+			i:=1
+		until
+			i>solution.count
+		loop
+			from
+				j:= 1
+			until
+				j> n
+			loop
+				if solution[i].at (j)= '1' then
+					temp.append (j.out)
+				end
+				j:= j+1
+			end
+			solution[i].deep_copy( temp)
+			temp.wipe_out
+			i:= i+1
+		end
+		Result:= solution
+	end
+
+	solve(seta: LINKED_LIST[STRING];one,zero: INTEGER): LINKED_LIST[STRING]
+		local
+			new_P1,  new_P0: LINKED_LIST[STRING]
+		do
+			create new_P1.make
+			create new_P0.make
+			if  one > 0  then
+				new_P1.deep_copy(seta)
+				across new_P1 as P1  loop new_P1.item.append ("1")  end
+			     new_P1:=solve(new_P1, one-1, zero)
+		 	end
+			if zero > 0 then
+				new_P0.deep_copy(seta)
+				across new_P0 as P0  loop new_P0.item.append ("0")  end
+				new_P0:=solve(new_P0, one, zero-1)
+			end
+			if one=0 and zero= 0 then
+				Result:= seta
+			else
+				create Result.make
+				Result.fill (new_p0)
+				Result.fill (new_p1)
+			end
+		end
+
+	num_of_comb (n,k:INTEGER):INTEGER
+	--- used for contracts
+		local
+			upper, lower, m, l: INTEGER
+		do
+			upper:= 1
+			lower:= 1
+			m:= n
+			l:= k
+			from
+			until
+				m<n-k+1
+			loop
+				upper:= m*upper
+				lower:= l*lower
+				m:= m-1
+				l:= l-1
+			end
+			Result:= upper//lower
+		end
+end

Task/Combinations/Eiffel/combinations-2.e

@@ -0,0 +1,14 @@
+class
+	APPLICATION
+inherit
+	ARGUMENTS
+create
+    make
+feature
+	make
+	do
+	    create comb.make (5, 3)
+	    across comb.sol as ar loop io.put_string (ar.item.out+"%T")   end
+	end
+	comb: COMBINATIONS
+end

Task/Combinations/Elena/combinations.elena

@@ -3,14 +3,14 @@
 #define extensions.
 #define extensions'routines.
 
-#symbol M = 3.
-#symbol N = 5.
+#symbol(const)M = 3.
+#symbol(const)N = 5.
 
 // --- Numbers ---
 
 #symbol numbers = (:anN)
 [
-    arrayControl new &length:anN &each: anIndex [ Integer new:(anIndex + 1) ]
+    arrayControl new &length:(anN int) &each: anIndex [ Integer new:(anIndex + 1) ]
 ].
 
 // --- Program ---
@@ -18,7 +18,7 @@
 #symbol program =
 [
     #var aNumbers := numbers:N.
-    controlEx for:(Combinator new:(arrayControl new &length:M &each: i [ aNumbers ])) &do: aRow
+    control for:(Combinator new:(arrayControl new &length:M &each: i [ aNumbers ])) &do: aRow
     [
         consoleEx writeLine:aRow.
     ].

Task/Combinations/Erlang/combinations-2.erl

@@ -0,0 +1,13 @@
+-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(fun lists:append/2, Step, Next)
+      end, [[[]]] ++ lists:duplicate(K, []), List).

Task/Combinations/Lua/combinations.lua

@@ -1,4 +1,3 @@
--- Recursive version
 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)
@@ -11,35 +10,3 @@ function combs(m, n)
 end
 
 for k, v in ipairs(combs(3, 5)) do print(unpack(v)) end
-
--- Iterative version
-function icombs(a,b)
-    if a==0 then return end
-    local taken = {} local slots = {}
-    for i=1,a do slots[i]=0 end
-    for i=1,b do taken[i]=false end
-    local index = 1
-    while index > 0 do repeat
-        repeat slots[index] = slots[index] + 1
-        until slots[index] > b or not taken[slots[index]]
-        if slots[index] > b then
-            slots[index] = 0
-            index = index - 1
-            if index > 0 then
-                taken[slots[index]] = false
-            end
-            break
-        else
-            taken[slots[index]] = true
-        end
-        if index == a then
-            for i=1,a do io.write(slots[i]) io.write(" ") end
-            io.write("\n")
-            taken[slots[index]] = false
-            break
-        end
-        index = index + 1
-    until true end
-end
-
-icombs(3, 5)

Task/Combinations/Maple/combinations.maple

@@ -0,0 +1,4 @@
+> 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]]

Task/Combinations/Perl-6/combinations-2.pl6

@@ -1,10 +1,15 @@
 sub combinations(Int $n, Int $k) {
-    return [] if $k == 0;
-    return () if $k > $n;
-    gather {
-        take [0, (1..^$n)[@$_]] for combinations($n-1, $k-1);
-        take [(1..^$n)[@$_]]    for combinations($n-1, $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);
+.say for combinations(5,3);

Task/Combinations/Perl-6/combinations-3.pl6

@@ -0,0 +1,10 @@
+sub combinations(Int $n, Int $k) {
+    return [] if $k == 0;
+    return () if $k > $n;
+    gather {
+        take [0, (1..^$n)[@$_]] for combinations($n-1, $k-1);
+        take [(1..^$n)[@$_]]    for combinations($n-1, $k  );
+    }
+}
+
+.say for combinations(5, 3);

Task/Combinations/Perl/combinations-1.pl

@@ -0,0 +1,2 @@
+use ntheory qw/forcomb/;
+forcomb { print "@_\n" } 5,3

Task/Combinations/Perl/combinations-2.pl

@@ -0,0 +1,3 @@
+use Algorithm::Combinatorics qw/combinations/;
+my @c = combinations( [0..4], 3 );
+print "@$_\n" for @c;

Task/Combinations/Perl/combinations-3.pl

@@ -0,0 +1,5 @@
+use Algorithm::Combinatorics qw/combinations/;
+my $iter = combinations([0..4],3);
+while (my $c = $iter->next) {
+  print "@$c\n";
+}

Task/Combinations/Perl/combinations.pl

@@ -1,4 +0,0 @@
-use Math::Combinatorics;
-
-@n = (0 .. 4);
-print join("\n", map { join(" ", @{$_}) } combine(3, @n)), "\n";

Task/Combinations/Prolog/combinations-2.pro

@@ -1,12 +1,10 @@
- ?- 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.
+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).

Task/Combinations/Prolog/combinations-3.pro

@@ -1,10 +1,3 @@
-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).
+:- 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)}.

Task/Combinations/REXX/combinations.rexx

@@ -1,27 +1,28 @@
 /*REXX program shows combination sets for  X  things taken  Y  at a time*/
-@abc='abcdefghijklmnopqrstuvwxyz'; @abcU=@abc; upper @abcU; @digs=123456789
-parse arg x y symbols .;  if x=='' | x==',' then x=5
-                          if y=='' | y==',' then y=3
-if symbols=='' then symbols=@digs||@abc||@abcU    /*symbol table string.*/
-say "────────────" x 'things taken' y "at a time:"
-say "────────────" combN(x,y) 'combinations.'
+parse arg x y $ .                      /*get optional args from the C.L.*/
+if x=='' | x==','  then x=5            /*X  specified?  No, use default.*/
+if y=='' | y==','  then y=3            /*Y  specified?  No, use default.*/
+@abc='abcdefghijklmnopqrstuvwxyz';   @abcU=@abc;   upper @abcU
+if $=='' then $=123456789||@abc||@abcU /*chars for symbol table string. */
+say "────────────"        x      ' things taken '      y     " at a time:"
+say "────────────"  combN(x,y)   ' combinations.'
 exit                                   /*stick a fork in it, we're done.*/
 /*──────────────────────────────────COMBN subroutine────────────────────*/
-combN: procedure expose symbols;  parse arg x,y;   base=x+1;  bbase=base-y
-!.=0;           do i=1 for y;    !.i=i
+combN: procedure expose $;    parse arg x,y;     base=x+1;    bbase=base-y
+!.=0;           do i=1  for y;    !.i=i
                 end   /*i*/
 
-          do j=1;  L=;           do d=1 for y
-                                 L=L   word(substr(symbols,!.d,1)   !.d,1)
-                                 end   /*d*/
+          do j=1;   L=;           do d=1  for y
+                                  L=L  word(substr($,!.d,1)   !.d,1)
+                                  end   /*d*/
           say L
-          !.y=!.y+1;   if !.y==base   then   if .combUp(y-1)   then leave
+          !.y=!.y+1;    if !.y==base   then   if .combUp(y-1)   then leave
           end         /*j*/
 return j
 
 .combUp: procedure expose !. y bbase;  parse arg d;  if d==0 then return 1
-p=!.d;        do u=d to y;     !.u=p+1
-              if !.u==bbase+u then return .combUp(u-1)
+p=!.d;        do u=d  to y;         !.u=p+1
+              if !.u==bbase+u  then return .combUp(u-1)
               p=!.u
               end     /*u*/
 return 0

Task/Combinations/Scala/combinations-2.scala

@@ -1,2 +1,8 @@
-scala> (0 to 4 toList) combinations(3) toList
-res1: 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))
+  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 :: _)
+    })
+  }

Task/Combinations/Scala/combinations-3.scala

@@ -0,0 +1,16 @@
+  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 :: _))

Task/Combinations/Scala/combinations-4.scala

@@ -0,0 +1,2 @@
+scala> (0 to 4 toList) combinations(3) toList
+res1: 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))

Task/Combinations/Smalltalk/combinations.st

@@ -1,6 +1,4 @@
-(0 to: 4)
-    combinations: 3 atATimeDo: [ :x |
-        ':-)' logCr: x ].
+(0 to: 4) combinations: 3 atATimeDo: [ :x | Transcript cr; show: x printString].
 
 "output on Transcript:
 #(0 1 2)