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

Another update from ingydotnet^djgoku

Browse source
This commit is contained in:
Ingy döt Net 2015-11-18 06:14:39 +00:00
parent 91df62d461
commit 948b86eafa
7604 changed files with 108452 additions and 22726 deletions
Download patch file Download diff file Expand all files Collapse all files

51
Task/Power-set/REXX/power-set.rexx
View file

@ -1,29 +1,30 @@
/*REXX program to display a power set, items may be anything (no blanks)*/
parse arg S /*let user specify the set. */
if S='' then S='one two three four' /*None specified? Use default*/
N=words(S) /*number of items in the list.*/
ps='{}' /*start with a null power set.*/
do chunk=1 for N /*traipse through the items. */
ps=ps combN(N,chunk) /*N items, a CHUNK at a time. */
/*REXX pgm displays a power set, items may be anything (but can't have blanks)*/
parse arg S /*allow the user specify optional set. */
if S='' then S='one two three four' /*None specified? Then use the default*/
N=words(S) /*the number of items in the list (set)*/
@='{}' /*start process with a null power set. */
do chunk=1 for N /*traipse through the items in the set.*/
@=@ combN(N,chunk) /*take N items, a CHUNK at a time. */
end /*chunk*/
w=words(ps)
do k=1 for w /*show combinations, one/line.*/
say right(k,length(w)) word(ps,k)
w=length(2**N) /*the number of items in the power set.*/
do k=1 for words(@) /* [↓] show combinations, one per line*/
say right(k,w) word(@,k) /*display a single combination to term.*/
end /*k*/
exit /*stick a fork in it, we done.*/
/*─────────────────────────────────────$COMBN subroutine────────────────*/
combN: procedure expose $ S; parse arg x,y; $=
!.=0; base=x+1; bbase=base-y; ym=y-1; do p=1 for y; !.p=p; end
do j=1; L=
do d=1 for y; _=!.d; L=L','word(S,_); end
$=$ '{'strip(L,'L',",")'}'
!.y=!.y+1; if !.y==base then if .combU(ym) then leave
exit /*stick a fork in it, we're all done. */
/*────────────────────────────────────────────────────────────────────────────*/
combN: procedure expose S; parse arg x,y; base=x+1; bbase=base-y; !.=0
do p=1 for y; !.p=p; end /*p*/
$=
do j=1; L=
do d=1 for y; L=L','word(S,!.d)
end /*d*/
$=$ '{'strip(L,'L',",")'}'
!.y=!.y+1; if !.y==base then if .combU(y-1) then leave
end /*j*/
return strip($) /*return with partial powerset*/
.combU: 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 .combU(u-1)
p=!.u
end /*u*/
return strip($) /*return with a partial powerset chunk.*/
/*────────────────────────────────────────────────────────────────────────────*/
.combU: 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 .combU(u-1)
p=!.u
end /*u*/
return 0