2016 Update

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

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