aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

2016 Update

Browse source
This commit is contained in:
Tina Müller 2016-12-05 22:15:40 +01:00
parent 948b86eafa
commit dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
Download patch file Download diff file Expand all files Collapse all files

14
Task/Combinations/00DESCRIPTION
View file

@ -1,6 +1,9 @@
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).
;Task:
Given non-negative integers &nbsp; <big> '''m''' </big> &nbsp; and &nbsp; <big> '''n'''</big>, &nbsp; generate all size &nbsp; <big> '''m''' </big> &nbsp; [http://mathworld.wolfram.com/Combination.html combinations] &nbsp; of the integers from &nbsp; <big> '''0'''</big> &nbsp; (zero) &nbsp; to &nbsp; <big> '''n-1''' </big> &nbsp; in sorted order &nbsp; (each combination is sorted and the entire table is sorted).
For example, <tt>3 comb 5</tt> is
;Example:
<big>'''3'''</big> &nbsp; comb &nbsp; <big> '''5''' </big> &nbsp; &nbsp; is:
0 1 2
0 1 3
0 1 4
@ -12,7 +15,10 @@ For example, <tt>3 comb 5</tt> is
1 3 4
2 3 4
If it is more "natural" in your language to start counting from <tt>1</tt> instead of <tt>0</tt> the combinations can be of the integers from <tt>1</tt> to <tt>n</tt>.
If it is more "natural" in your language to start counting from &nbsp; <big> '''1'''</big> &nbsp; (unity) instead of &nbsp; <big> '''0'''</big> &nbsp; (zero),
<br>the combinations can be of the integers from &nbsp; <big> '''1'''</big> &nbsp; to &nbsp; <big> '''n'''. </big>
'''See Also:'''
;See also:
{{Template:Combinations and permutations}}
<br><br>

64
Task/Combinations/360-Assembly/combinations.360 Normal file
View file

@ -0,0 +1,64 @@
* Combinations 26/05/2016
COMBINE 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=n
LOOPI1 STC R8,0(R7) do i=1 to n; c(i)=n-i+1
LA R7,1(R7) @c(i)++
BCT R8,LOOPI1 next i
LOOPBIG LA R10,PG big loop {------------------
LH R1,N n
LA R7,C-1(R1) @c(i)
LH R6,N i=n
LOOPI2 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=1
LOOPI3 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 i
ELOOPI3 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 i
ELOOPI4 B LOOPBIG big loop }------------------
ELOOPBIG L R13,4(0,R13) epilog
LM R14,R12,12(R13) "
XR R15,R15 "
BR R14 exit
M DC H'5' <=input
N DC H'3' <=input
C DS 64X array of 8 bit integers
PG DC CL92' ' buffer
YREGS
END COMBINE

40
Task/Combinations/AppleScript/combinations-1.applescript
View file

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

104
Task/Combinations/AppleScript/combinations-3.applescript Normal file
View file

@ -0,0 +1,104 @@
-- comb :: Int -> [a] -> [[a]]
on comb(n, lst)
set h to head(lst)
script headPrepended
on lambda(t)
h & t
end lambda
end script
if n < 1 then
[[]]
else if length of lst = 0 then
[]
else
set xs to tail(lst)
map(headPrepended, ¬
comb(n - 1, xs)) & comb(n, xs)
end if
end comb
-- TEST
-- spaced :: [a] -> String
on spaced(lst)
intercalate(space, lst)
end spaced
on run
intercalate(linefeed, ¬
map(spaced, comb(3, range(0, 4))))
end run
-- GENERIC FUNCTIONS
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to lambda(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
if class of f is script then
f
else
script
property lambda : f
end script
end if
end mReturn
-- intercalate :: Text -> [Text] -> Text
on intercalate(strText, lstText)
set {dlm, my text item delimiters} to {my text item delimiters, strText}
set strJoined to lstText as text
set my text item delimiters to dlm
return strJoined
end intercalate
-- range :: Int -> Int -> [Int]
on range(m, n)
if n < m then
set d to -1
else
set d to 1
end if
set lst to {}
repeat with i from m to n by d
set end of lst to i
end repeat
return lst
end range
-- head :: [a] -> a
on head(xs)
if length of xs > 0 then
item 1 of xs
else
missing value
end if
end head
-- tail :: [a] -> [a]
on tail(xs)
if length of xs > 1 then
items 2 thru -1 of xs
else
{}
end if
end tail

27
Task/Combinations/AppleScript/combinations.applescript
View file

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

2
Task/Combinations/Elena/combinations.elena
View file

@ -17,7 +17,7 @@
#symbol program =
[
#var aNumbers := numbers:N.
#var aNumbers := numbers eval:N.
Combinator new:M &of:aNumbers run &each: aRow
[
console writeLine:aRow.

11
Task/Combinations/Emacs-Lisp/combinations.l Normal file
View file

@ -0,0 +1,11 @@
(defun comb-recurse (m n n-max)
(cond ((zerop m) '(()))
((= n-max n) '())
(t (append (mapcar #'(lambda (rest) (cons n rest))
(comb-recurse (1- m) (1+ n) n-max))
(comb-recurse m (1+ n) n-max)))))
(defun comb (m n)
(comb-recurse m 0 n))
(comb 3 5)

29
Task/Combinations/JavaScript/combinations-3.js Normal file
View file

@ -0,0 +1,29 @@
(function () {
function comb(n, lst) {
if (!n) return [[]];
if (!lst.length) return [];
var x = lst[0],
xs = lst.slice(1);
return comb(n - 1, xs).map(function (t) {
return [x].concat(t);
}).concat(comb(n, xs));
}
// [m..n]
function range(m, n) {
return Array.apply(null, Array(n - m + 1)).map(function (x, i) {
return m + i;
});
}
return comb(3, range(0, 4))
.map(function (x) {
return x.join(' ');
}).join('\n');
})();

46
Task/Combinations/JavaScript/combinations-4.js Normal file
View file

@ -0,0 +1,46 @@
(function (n) {
// n -> [a] -> [[a]]
function comb(n, lst) {
if (!n) return [[]];
if (!lst.length) return [];
var x = lst[0],
xs = lst.slice(1);
return comb(n - 1, xs).map(function (t) {
return [x].concat(t);
}).concat(comb(n, xs));
}
// f -> f
function memoized(fn) {
m = {};
return function (x) {
var args = [].slice.call(arguments),
strKey = args.join('-');
v = m[strKey];
if ('u' === (typeof v)[0])
m[strKey] = v = fn.apply(null, args);
return v;
}
}
// [m..n]
function range(m, n) {
return Array.apply(null, Array(n - m + 1)).map(function (x, i) {
return m + i;
});
}
var fnMemoized = memoized(comb),
lstRange = range(0, 4);
return fnMemoized(n, lstRange)
.map(function (x) {
return x.join(' ');
}).join('\n');
})(3);

10
Task/Combinations/JavaScript/combinations-5.js Normal file
View file

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

47
Task/Combinations/JavaScript/combinations-6.js Normal file
View file

@ -0,0 +1,47 @@
(function (n) {
'use strict';
// n -> [a] -> [[a]]
let comb = (n, xs) => {
if (n < 1) return [[]];
if (xs.length === 0) return [];
let h = xs[0],
tail = xs.slice(1);
return comb(n - 1, tail)
.map((t) => [h].concat(t))
.concat(comb(n, tail));
},
// Derive a memoized version of a function
// Function -> Function
memoized = (f) => {
let m = {};
return function (x) {
let args = [].slice.call(arguments),
strKey = args.join('-'),
v = m[strKey];
return (
(v === undefined) &&
(m[strKey] = v = f.apply(null, args)),
v
);
}
},
range = (m, n) =>
Array.from({
length: (n - m) + 1
}, (_, i) => m + i);
return memoized(comb)(n, range(0, 4))
})(3);

6
Task/Combinations/Julia/combinations.julia
View file

@ -1,3 +1,5 @@
for i in combinations(1:5,3)
print(i')
n = 4
m = 3
for i in combinations(0:n,m)
println(i')
end

4
Task/Combinations/K/combinations.k Normal file
View file

@ -0,0 +1,4 @@
comb:{[n;k]
f:{:[k=#x; :,x; :,/_f' x,'(1+*|x) _ !n]}
:,/f' !n
}

48
Task/Combinations/PHP/combinations.php Normal file
View file

@ -0,0 +1,48 @@
<?php
function 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";
}

2
Task/Combinations/Pascal/combinations.pascal
View file

@ -4,7 +4,7 @@ const
m_max = 3;
n_max = 5;
var
combination: array [1..m_max] of integer;
combination: array [0..m_max] of integer;
procedure generate(m: integer);
var

35
Task/Combinations/PowerShell/combinations.psh Normal file
View file

@ -0,0 +1,35 @@
$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 -Force

49
Task/Combinations/REXX/combinations.rexx
View file

@ -1,28 +1,21 @@
/*REXX program shows combination sets for X things taken Y at a time*/
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 $; 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($,!.d,1) !.d,1)
end /*d*/
say L
!.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=!.u
end /*u*/
return 0
/*REXX program displays combination sets for X things taken Y at a time. */
parse arg x y $ . /*get optional arguments from the C.L. */
if x=='' | x=="," then x=5 /*No X specified? Then use default.*/
if y=='' | y=="," then y=3 /* " Y " " " " */
if $=='' | $=="," then $= '123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ'
/* [↑] No $ specified? Use default.*/
say "────────────" x ' things taken ' y " at a time:"
say "────────────" combN(x,y) ' combinations.'
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
combN: procedure expose $; parse arg x,y; xp=x+1; xm=xp-y; !.=0
do i=1 for y; !.i=i; end /*i*/
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==xp then if .combN(y-1) then leave
end /*j*/
return j
.combN: procedure expose !. y xm; parse arg d; if d==0 then return 1; p=!.d
do u=d to y; !.u=p+1; if !.u==xm+u then return .combN(u-1); p=!.u
end /*u*/
return 0