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

June 2018 Update

Browse source
This commit is contained in:
Ingy döt Net 2018-06-22 20:57:24 +00:00
parent ba8067c3b7
commit 22f33d4004
5278 changed files with 84726 additions and 14379 deletions
Download patch file Download diff file Expand all files Collapse all files

46
Task/Catamorphism/REXX/catamorphism.rexx
View file

@ -1,36 +1,36 @@
/*REXX program demonstrates a method for catamorphism for some simple functions. */
@list= 1 2 3 4 5 6 7 8 9 10
say 'show:' fold(@list, "show")
say ' sum:' fold(@list, "+" )
say 'prod:' fold(@list, "*" )
say ' cat:' fold(@list, "||" )
say ' min:' fold(@list, "min" )
say ' max:' fold(@list, "max" )
say ' avg:' fold(@list, "avg" )
say ' GCD:' fold(@list, "GCD" )
say ' LCM:' fold(@list, "LCM" )
say 'list:' fold(@list, "list")
say ' sum:' fold(@list, "+" )
say 'prod:' fold(@list, "*" )
say ' cat:' fold(@list, "||" )
say ' min:' fold(@list, "min" )
say ' max:' fold(@list, "max" )
say ' avg:' fold(@list, "avg" )
say ' GCD:' fold(@list, "GCD" )
say ' LCM:' fold(@list, "LCM" )
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
fold: procedure; parse arg z; arg ,f; z=space(z); BIFs='MIN MAX LCM GCD'
za=translate(z, f, ' '); zf=f"("translate(z, ',' , " ")')'
if f=='+' | f=="*" then interpret "return" za
if f=='||' then return space(z, 0)
if f=='AVG' then interpret "return" fold(z, '+') "/" words(z)
if wordpos(f,BIFs)\==0 then interpret "return" zf
if f=='SHOW' then return z
return 'illegal function:' arg(2)
fold: procedure; parse arg z; arg ,f; z=space(z); BIFs='MIN MAX LCM GCD'
za=translate(z, f, ' '); zf=f"("translate(z, ',' , " ")')'
if f=='+' | f=="*" then interpret "return" za
if f=='||' then return space(z, 0)
if f=='AVG' then interpret "return" fold(z, '+') "/" words(z)
if wordpos(f, BIFs)\==0 then interpret "return" zf
if f=='LIST' | f=="SHOW" then return z
return 'illegal function:' arg(2)
/*──────────────────────────────────────────────────────────────────────────────────────*/
GCD: procedure; $=; do j=1 for arg(); $=$ arg(j); end /*j*/
parse var $ x z .; if x=0 then x=z /* [↑] build a list of arguments.*/
x=abs(x)
do k=2 to words($); y=abs(word($,k)); if y==0 then iterate
do until _==0; _=x//y; x=y; y=_; end /*until*/
do k=2 to words($); y=abs(word($, k)); if y=0 then iterate
do until _=0; _=x//y; x=y; y=_; end /*until*/
end /*k*/
return x
/*──────────────────────────────────────────────────────────────────────────────────────*/
LCM: procedure; $=; do j=1 for arg(); $=$ arg(j); end /*j*/
x=abs(word($,1)) /* [↑] build a list of arguments.*/
do k=2 to words($); !=abs(word($,k)); if !==0 then return 0
x=x*! / GCD(x,!) /*have GCD do the heavy lifting.*/
end /*k*/
x=abs(word($, 1)) /* [↑] build a list of arguments.*/
do k=2 to words($); !=abs(word($, k)); if !=0 then return 0
x=x*! / GCD(x, !) /*have GCD do the heavy lifting.*/
end /*k*/
return x