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

4
Task/Catamorphism/Elena/catamorphism.elena
View file

@ -3,9 +3,9 @@ import system'routines.
import extensions.
import extensions'text.
program =
public program =
[
var numbers := 1 repeat till:10 each(:n)( n ); summarize(ArrayList new).
var numbers := 1 to:10 repeat(:n)( n ); summarize(ArrayList new).
var summary := numbers accumulate(Variable new:0) with(:a:b)( a + b ).

1
Task/Catamorphism/Factor/catamorphism.factor Normal file
View file

@ -0,0 +1 @@
{ 1 2 4 6 10 } 0 [ + ] reduce .

9
Task/Catamorphism/Fortran/catamorphism-1.f Normal file
View file

@ -0,0 +1,9 @@
SUBROUTINE FOLD(t,F,i,ist,lst)
INTEGER t
BYNAME F
DO i = ist,lst
t = F
END DO
END SUBROUTINE FOLD !Result in temp.
temp = a(1); CALL FOLD(temp,temp*a(i),i,2,N)

53
Task/Catamorphism/Fortran/catamorphism-2.f Normal file
View file

@ -0,0 +1,53 @@
INTEGER FUNCTION IFOLD(F,A,N) !"Catamorphism"...
INTEGER F !We're working only with integers.
EXTERNAL F !This is a function, not an array.
INTEGER A(*) !An 1-D array, of unspecified size.
INTEGER N !The number of elements.
INTEGER I !A stepper.
IFOLD = 0 !A default value.
IF (N.LE.0) RETURN !Dodge silly invocations.
IFOLD = A(1) !The function is to have two arguments.
IF (N.EQ.1) RETURN !So, if there is only one element, silly.
DO I = 2,N !Otherwise, stutter along the array.
IFOLD = F(IFOLD,A(I)) !Applying the function.
END DO !On to the next element.
END FUNCTION IFOLD!Thus, F(A(1),A(2)), or F(F(A(1),A(2)),A(3)), or F(F(F(A(1),A(2)),A(3)),A(4)), etc.
INTEGER FUNCTION IADD(I,J)
INTEGER I,J
IADD = I + J
END FUNCTION IADD
INTEGER FUNCTION IMUL(I,J)
INTEGER I,J
IMUL = I*J
END FUNCTION IMUL
INTEGER FUNCTION IDIV(I,J)
INTEGER I,J
IDIV = I/J
END FUNCTION IDIV
INTEGER FUNCTION IVID(I,J)
INTEGER I,J
IVID = J/I
END FUNCTION IVID
PROGRAM POKE
INTEGER ENUFF
PARAMETER (ENUFF = 6)
INTEGER A(ENUFF)
PARAMETER (A = (/1,2,3,4,5,6/))
INTEGER MSG
EXTERNAL IADD,IMUL,IDIV,IVID !Warn that these are the names of functions.
MSG = 6 !Standard output.
WRITE (MSG,1) ENUFF,A
1 FORMAT ('To apply a function in the "catamorphic" style ',
1 "to the ",I0," values ",/,(20I3))
WRITE (MSG,*) "Iadd",IFOLD(IADD,A,ENUFF)
WRITE (MSG,*) "Imul",IFOLD(IMUL,A,ENUFF)
WRITE (MSG,*) "Idiv",IFOLD(IDIV,A,ENUFF)
WRITE (MSG,*) "Ivid",IFOLD(IVID,A,ENUFF)
END PROGRAM POKE

4
Task/Catamorphism/J/catamorphism-3.j Normal file
View file

@ -0,0 +1,4 @@
1 * 2 * 3 * 20
1 * 2 * 60
1 * 120
120

1
Task/Catamorphism/Perl-6/catamorphism-2.pl6
View file

@ -1,3 +1,4 @@
my @list = 1..10;
say reduce &infix:<+>, @list;
say reduce &infix:<*>, @list;
say reduce &infix:<~>, @list;

1
Task/Catamorphism/Python/catamorphism-1.py
View file

@ -1,3 +1,4 @@
>>> # Python 2.X
>>> from operator import add
>>> listoflists = [['the', 'cat'], ['sat', 'on'], ['the', 'mat']]
>>> help(reduce)

2
Task/Catamorphism/Python/catamorphism-2.py
View file

@ -1,3 +1,5 @@
# Python 3.X
from functools import reduce
from operator import add, mul

2
Task/Catamorphism/R/catamorphism-1.r Normal file
View file

@ -0,0 +1,2 @@
Reduce('+', c(2,30,400,5000))
5432

2
Task/Catamorphism/R/catamorphism-2.r Normal file
View file

@ -0,0 +1,2 @@
Reduce(function(a,b){c(a,0,b)}, c(2,3,4,5))
2 0 3 0 4 0 5

2
Task/Catamorphism/R/catamorphism-3.r Normal file
View file

@ -0,0 +1,2 @@
Reduce(paste0, unlist(strsplit("freedom", NULL)), accum=T)
"f" "fr" "fre" "free" "freed" "freedo" "freedom"

3
Task/Catamorphism/R/catamorphism-4.r Normal file
View file

@ -0,0 +1,3 @@
Reduce(function(x,acc){if (0==x%%3) c(x*x,acc) else acc}, 0:22,
init=c(), right=T)
0 9 36 81 144 225 324 441

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

9
Task/Catamorphism/Scala/catamorphism.scala Normal file
View file

@ -0,0 +1,9 @@
object Main extends App {
val a = Seq(1, 2, 3, 4, 5)
println(s"Array : ${a.mkString(", ")}")
println(s"Sum : ${a.sum}")
println(s"Difference : ${a.reduce { (x, y) => x - y }}")
println(s"Product : ${a.product}")
println(s"Minimum : ${a.min}")
println(s"Maximum : ${a.max}")
}

5
Task/Catamorphism/Swift/catamorphism.swift Normal file
View file

@ -0,0 +1,5 @@
let nums = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
print(nums.reduce(0, +))
print(nums.reduce(1, *))
print(nums.reduce("", { $0 + String($1) }))