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

82
Task/Set-consolidation/REXX/set-consolidation.rexx
View file

@ -1,52 +1,52 @@
/*REXX program demonstrates a method of consolidating some sample sets. */
/*REXX program demonstrates a method of consolidating some sample sets. */
@.=; @.1 = '{A,B} {C,D}'
@.2 = "{A,B} {B,D}"
@.3 = '{A,B} {C,D} {D,B}'
@.4 = '{H,I,K} {A,B} {C,D} {D,B} {F,G,H}'
@.5 = '{snow,ice,slush,frost,fog} {icebergs,icecubes} {rain,fog,sleet}'
do j=1 while @.j\=='' /*traipse through each of sample sets. */
call SETconsolidate @.j /*have the function do the heavy work. */
do j=1 while @.j\=='' /*traipse through each of sample sets. */
call SETconsolidate @.j /*have the function do the heavy work. */
end /*j*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────ISIN SUBRoutine───────────────────────────*/
isIn: return wordpos(arg(1), arg(2))\==0 /*is (word) arg1 in set arg2 ? */
/*──────────────────────────────────SETCONSOLIDATE subroutine─────────────────*/
SETconsolidate: procedure; parse arg old,new; #=words(old) /*nullify NEW.*/
say ' the old set=' space(old)
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
isIn: return wordpos(arg(1), arg(2))\==0 /*is (word) argument 1 in the set arg2?*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
SETconsolidate: procedure; parse arg old; #=words(old); new=
say ' the old set=' space(old)
do k=1 for # /* [↓] change all commas to a blank. */
!.k=translate(word(old,k), , '},{') /*create a list of words (aka, a set).*/
end /*k*/ /* [↑] ··· and also remove the braces.*/
do k=1 for # /* [↓] change all commas to a blank. */
!.k=translate(word(old,k), , '},{') /*create a list of words (aka, a set).*/
end /*k*/ /* [↑] ··· and also remove the braces.*/
do until \changed; changed=0 /*consolidate some sets (well, maybe).*/
do set=1 for #-1
do item=1 for words(!.set); x=word(!.set,item)
do other=set+1 to #
if isIn(x,!.other) then do; changed=1 /*has changed*/
!.set=!.set !.other; !.other=
iterate set
end
end /*other*/
end /*item */
end /*set */
end /*until*/
/* ╔╦══════════════════════════════════════════════════elide any duplicates.*/
do set=1 for #; $= /*nullify $ */
do items=1 for words(!.set); x=word(!.set, items)
if x==',' then iterate; if x=='' then leave
$=$ x /*build new. */
do until \isIn(x, !.set)
_=wordpos(x, !.set)
!.set=subword(!.set,1,_-1) ',' subword(!.set,_+1) /*purify set.*/
end /*until ¬isIn ··· */
end /*items*/
!.set=translate(strip($), ',', " ")
end /*set*/
do until \changed; changed=0 /*consolidate some sets (well, maybe).*/
do set=1 for #-1
do item=1 for words(!.set); x=word(!.set, item)
do other=set+1 to #
if isIn(x, !.other) then do; changed=1 /*it's changed*/
!.set=!.set !.other; !.other=
iterate set
end
end /*other*/
end /*item */
end /*set */
end /*until ¬changed*/
do i=1 for #; if !.i=='' then iterate
new=space(new '{'!.i"}")
end /*i*/
do set=1 for #; $= /*elide dups*/
do items=1 for words(!.set); x=word(!.set, items)
if x==',' then iterate; if x=='' then leave
$=$ x /*build new. */
do until \isIn(x, !.set)
_=wordpos(x, !.set)
!.set=subword(!.set, 1, _-1) ',' subword(!.set, _+1) /*purify set*/
end /*until ¬isIn ··· */
end /*items*/
!.set=translate(strip($), ',', " ")
end /*set*/
say ' the new set=' new; say
return
do i=1 for #; if !.i=='' then iterate /*ignore any set that is a null set. */
new=space(new '{'!.i"}") /*prepend and append a set identifier. */
end /*i*/
say ' the new set=' new; say
return