Data commit

Task/Catamorphism/00-META.yaml

@@ -0,0 +1,2 @@
+---
+from: http://rosettacode.org/wiki/Catamorphism

Task/Catamorphism/00-TASK.txt

@@ -0,0 +1,11 @@
+''Reduce'' is a function or method that is used to take the values in an array or a list and apply a function to successive members of the list to produce (or reduce them to), a single value. 
+
+
+;Task:
+Show how ''reduce'' (or ''foldl'' or ''foldr'' etc), work (or would be implemented) in your language.
+
+
+;See also:
+* Wikipedia article:   [[wp:Fold (higher-order function)|Fold]]
+* Wikipedia article:   [[wp:Catamorphism|Catamorphism]]
+<br><br>

Task/Catamorphism/11l/catamorphism.11l

@@ -0,0 +1,4 @@
+print((1..3).reduce((x, y) -> x + y))
+print((1..3).reduce(3, (x, y) -> x + y))
+print([1, 1, 3].reduce((x, y) -> x + y))
+print([1, 1, 3].reduce(2, (x, y) -> x + y))

Task/Catamorphism/6502-Assembly/catamorphism.6502

@@ -0,0 +1,45 @@
+define catbuf $10
+define catbuf_temp $12
+
+ldx #0
+ramloop:
+txa
+sta $00,x
+inx
+cpx #$10
+bne ramloop	
+;load zero page addresses $00-$0f with values equal
+;to that address
+
+
+ldx #0		;zero X
+loop_cata:
+lda $00,x	;load the zeroth element
+clc
+adc $01,x	;add the first to it.
+inx		
+inx		;inx twice. Otherwise the same element
+		;would get added twice
+sta catbuf_temp ;store in temp ram
+lda catbuf	
+clc
+adc catbuf_temp ;add to previously stored value
+sta catbuf	;store in result
+cpx #$10	;is the range over?
+bne loop_cata	;if not, loop again
+
+ldx #$00
+lda catbuf
+sta $00,x	
+;store the sum in the zeroth entry of the range
+
+inx
+lda #$00
+
+;now clear the rest of zeropage, leaving only the sum
+
+clear_ram:
+sta $00,x
+inx
+cpx #$ff
+bne clear_ram

Task/Catamorphism/ABAP/catamorphism.abap

@@ -0,0 +1,44 @@
+report z_catamorphism.
+
+data(numbers) = value int4_table( ( 1 ) ( 2 ) ( 3 ) ( 4 ) ( 5 ) ).
+
+write: |numbers = { reduce string(
+  init output = `[`
+       index = 1
+  for number in numbers
+  next output = cond string(
+         when index eq lines( numbers )
+         then |{ output }, { number } ]|
+         when index > 1
+         then |{ output }, { number }|
+         else |{ output } { number }| )
+       index = index + 1 ) }|, /.
+
+write: |sum(numbers) = { reduce int4(
+  init result = 0
+  for number in numbers
+  next result = result + number ) }|, /.
+
+write: |product(numbers) = { reduce int4(
+  init result = 1
+  for number in numbers
+  next result = result * number ) }|, /.
+
+data(strings) = value stringtab( ( `reduce` ) ( `in` ) ( `ABAP` ) ).
+
+write: |strings = { reduce string(
+  init output = `[`
+       index = 1
+  for string in strings
+  next output = cond string(
+         when index eq lines( strings )
+         then |{ output }, { string } ]|
+         when index > 1
+         then |{ output }, { string }|
+         else |{ output } { string }| )
+       index = index + 1 ) }|, /.
+
+write: |concatenation(strings) = { reduce string(
+  init text = ``
+  for string in strings
+  next text = |{ text } { string }| ) }|, /.

Task/Catamorphism/ALGOL-68/catamorphism.alg

@@ -0,0 +1,20 @@
+# applies fn to successive elements of the array of values #
+# the result is 0 if there are no values                   #
+PROC reduce = ( []INT values, PROC( INT, INT )INT fn )INT:
+     IF UPB values < LWB values
+     THEN # no elements #
+          0
+     ELSE # there are some elements #
+          INT result := values[ LWB values ];
+          FOR pos FROM LWB values + 1 TO UPB values
+          DO
+              result := fn( result, values[ pos ] )
+          OD;
+          result
+     FI; # reduce #
+
+# test the reduce procedure #
+BEGIN print( ( reduce( ( 1, 2, 3, 4, 5 ), ( INT a, b )INT: a + b ), newline ) ) # sum #
+    ; print( ( reduce( ( 1, 2, 3, 4, 5 ), ( INT a, b )INT: a * b ), newline ) ) # product #
+    ; print( ( reduce( ( 1, 2, 3, 4, 5 ), ( INT a, b )INT: a - b ), newline ) ) # difference #
+END

Task/Catamorphism/APL/catamorphism-1.apl

@@ -0,0 +1,4 @@
+      +/ 1 2 3 4 5 6 7
+28
+      ×/ 1 2 3 4 5 6 7
+5040

Task/Catamorphism/APL/catamorphism-2.apl

@@ -0,0 +1,6 @@
+      +/⍬
+0
+      ×/⍬
+1
+      ⌈/⍬ ⍝ this gives the minimum supported value
+¯1.797693135E308

Task/Catamorphism/APL/catamorphism-3.apl

@@ -0,0 +1,10 @@
+      {⎕←'Input:',⍺,⍵ ⋄ ⍺+⍵}/ 1 2 3 4 5
+Input: 4 5
+Input: 3 9
+Input: 2 12
+Input: 1 14
+15
+      {⎕←'Input:',⍺,⍵ ⋄ ⍺+⍵}/ 1
+1
+      {⎕←'Input:',⍺,⍵ ⋄ ⍺+⍵}/ ⍬
+DOMAIN ERROR

Task/Catamorphism/Ada/catamorphism.ada

@@ -0,0 +1,29 @@
+with Ada.Text_IO;
+
+procedure Catamorphism is
+
+   type Fun is access function (Left, Right: Natural) return Natural;
+   type Arr is array(Natural range <>) of Natural;
+
+   function Fold_Left (F: Fun; A: Arr) return Natural is
+      Result: Natural := A(A'First);
+   begin
+      for I in A'First+1 .. A'Last loop
+	 Result := F(Result, A(I));
+      end loop;
+      return Result;
+   end Fold_Left;
+
+   function Max (L, R: Natural) return Natural is (if L > R then L else R);
+   function Min (L, R: Natural) return Natural is (if L < R then L else R);
+   function Add (Left, Right: Natural) return Natural is (Left + Right);
+   function Mul (Left, Right: Natural) return Natural is (Left * Right);
+
+   package NIO is new Ada.Text_IO.Integer_IO(Natural);
+
+begin
+   NIO.Put(Fold_Left(Min'Access, (1,2,3,4)), Width => 3);
+   NIO.Put(Fold_Left(Max'Access, (1,2,3,4)), Width => 3);
+   NIO.Put(Fold_Left(Add'Access, (1,2,3,4)), Width => 3);
+   NIO.Put(Fold_Left(Mul'Access, (1,2,3,4)), Width => 3);
+end Catamorphism;

Task/Catamorphism/Aime/catamorphism.aime

@@ -0,0 +1,5 @@
+integer s;
+
+s = 0;
+list(1, 2, 3, 4, 5, 6, 7, 8, 9).ucall(add_i, 1, s);
+o_(s, "\n");

Task/Catamorphism/AppleScript/catamorphism.applescript

@@ -0,0 +1,121 @@
+---------------------- CATAMORPHISMS ---------------------
+
+-- the arguments available to the called function f(a, x, i, l) are
+-- a: current accumulator value
+-- x: current item in list
+-- i: [ 1-based index in list ] optional
+-- l: [ a reference to the list itself ] optional
+
+-- foldl :: (a -> b -> a) -> a -> [b] -> a
+on foldl(f, startValue, xs)
+    tell mReturn(f)
+        set v to startValue
+        set lng to length of xs
+        repeat with i from 1 to lng
+            set v to |λ|(v, item i of xs, i, xs)
+        end repeat
+        return v
+    end tell
+end foldl
+
+-- the arguments available to the called function f(a, x, i, l) are
+-- a: current accumulator value
+-- x: current item in list
+-- i: [ 1-based index in list ] optional
+-- l: [ a reference to the list itself ] optional
+
+-- foldr :: (a -> b -> a) -> a -> [b] -> a
+on foldr(f, startValue, xs)
+    tell mReturn(f)
+        set v to startValue
+        set lng to length of xs
+        repeat with i from lng to 1 by -1
+            set v to |λ|(v, item i of xs, i, xs)
+        end repeat
+        return v
+    end tell
+end foldr
+
+
+--- OTHER FUNCTIONS DEFINED IN TERMS OF FOLDL AND FOLDR --
+
+-- concat :: [String] -> string
+on concat(xs)
+    foldl(my append, "", xs)
+end concat
+
+
+-- product :: Num a => [a] -> a
+on product(xs)
+    script
+        on |λ|(a, b)
+            a * b
+        end |λ|
+    end script
+
+    foldr(result, 1, xs)
+end product
+
+
+-- str :: a -> String
+on str(x)
+    x as string
+end str
+
+
+-- sum :: Num a => [a] -> a
+on sum(xs)
+    script
+        on |λ|(a, b)
+            a + b
+        end |λ|
+    end script
+
+    foldl(result, 0, xs)
+end sum
+
+
+--------------------------- TEST -------------------------
+on run
+    set xs to {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}
+
+    {sum(xs), product(xs), concat(map(str, xs))}
+
+    --> {55, 3628800, "10987654321"}
+end run
+
+
+-------------------- GENERIC FUNCTIONS -------------------
+
+-- append :: String -> String -> String
+on append(a, b)
+    a & b
+end append
+
+
+-- map :: (a -> b) -> [a] -> [b]
+on map(f, xs)
+    -- The list obtained by applying f
+    -- to each element of xs.
+    tell mReturn(f)
+        set lng to length of xs
+        set lst to {}
+        repeat with i from 1 to lng
+            set end of lst to |λ|(item i of xs, i, xs)
+        end repeat
+        return lst
+    end tell
+end map
+
+
+-- Lift 2nd class handler function into 1st class script wrapper
+-- mReturn :: Handler -> Script
+on mReturn(f)
+    if class of f is script then
+        f
+    else
+        script
+            property |λ| : f
+        end script
+    end if
+end mReturn

Task/Catamorphism/Arturo/catamorphism.arturo

@@ -0,0 +1,5 @@
+; find the sum, with seed:0 (default)
+print fold [1 2 3 4] => add
+
+; find the product, with seed:1
+print fold [1 2 3 4] .seed:1 => mul

Task/Catamorphism/BASIC256/catamorphism.basic

@@ -0,0 +1,40 @@
+arraybase 1
+global n
+dim n = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}
+
+print "  +: "; " "; cat(10, "+")
+print "  -: "; " "; cat(10, "-")
+print "  *: "; " "; cat(10, "*")
+print "  /: "; " "; cat(10, "/")
+print "  ^: "; " "; cat(10, "^")
+print "max: "; " "; cat(10, "max")
+print "min: "; " "; cat(10, "min")
+print "avg: "; " "; cat(10, "avg")
+print "cat: "; " "; cat(10, "cat")
+end
+
+function min(a, b)
+    if a < b then return a else return b
+end function
+function max(a, b)
+    if a > b then return a else return b
+end function
+
+function cat(cont, op$)
+    temp = n[1]
+    temp$ = ""
+    for i = 2 to cont
+        if op$ = "+" then temp += n[i]
+        if op$ = "-" then temp -= n[i]
+        if op$ = "*" then temp *= n[i]
+        if op$ = "/" then temp /= n[i]
+        if op$ = "^" then temp = temp ^ n[i]
+        if op$ = "max" then temp = max(temp, n[i])
+        if op$ = "min" then temp = min(temp, n[i])
+        if op$ = "avg" then temp += n[i]
+        if op$ = "cat" then temp$ += string(n[i])
+    next i
+    if op$ = "avg" then temp /= cont
+    if op$ = "cat" then temp = int(string(n[1]) + temp$)
+    return temp
+end function

Task/Catamorphism/BBC-BASIC/catamorphism.basic

@@ -0,0 +1,15 @@
+      DIM a(4)
+      a() = 1, 2, 3, 4, 5
+      PRINT FNreduce(a(), "+")
+      PRINT FNreduce(a(), "-")
+      PRINT FNreduce(a(), "*")
+      END
+
+      DEF FNreduce(arr(), op$)
+      REM!Keep tmp, arr()
+      LOCAL I%, tmp
+      tmp = arr(0)
+      FOR I% = 1 TO DIM(arr(), 1)
+        tmp = EVAL("tmp " + op$ + " arr(I%)")
+      NEXT
+      = tmp

Task/Catamorphism/BCPL/catamorphism.bcpl

@@ -0,0 +1,15 @@
+get "libhdr"
+
+let reduce(f, v, len, seed) =
+    len = 0 -> seed,
+    reduce(f, v+1, len-1, f(!v, seed))
+
+let start() be
+$(  let add(x, y) = x+y
+    let mul(x, y) = x*y
+
+    let nums = table 1,2,3,4,5,6,7
+
+    writef("%N*N", reduce(add, nums, 7, 0))
+    writef("%N*N", reduce(mul, nums, 7, 1))
+$)

Task/Catamorphism/Bracmat/catamorphism.bracmat

@@ -0,0 +1,18 @@
+( ( fold
+  =   f xs init first rest
+    .   !arg:(?f.?xs.?init)
+      & ( !xs:&!init
+        |   !xs:%?first ?rest
+          & !f$(!first.fold$(!f.!rest.!init))
+        )
+  )
+&   out
+  $ ( fold
+    $ ( (=a b.!arg:(?a.?b)&!a+!b)
+      . 1 2 3 4 5
+      . 0
+      )
+    )
+& (product=a b.!arg:(?a.?b)&!a*!b)
+& out$(fold$(product.1 2 3 4 5.1))
+);

Task/Catamorphism/C++/catamorphism.cpp

@@ -0,0 +1,14 @@
+#include <iostream>
+#include <numeric>
+#include <functional>
+#include <vector>
+
+int main() {
+	std::vector<int> nums = { 1, 2, 3, 4, 5 };
+	auto nums_added = std::accumulate(std::begin(nums), std::end(nums), 0, std::plus<int>());
+	auto nums_other = std::accumulate(std::begin(nums), std::end(nums), 0, [](const int& a, const int& b) {
+		return a + 2 * b;
+	});
+	std::cout << "nums_added: " << nums_added << std::endl;
+	std::cout << "nums_other: " << nums_other << std::endl;
+}

Task/Catamorphism/C-sharp/catamorphism.cs

@@ -0,0 +1,9 @@
+var nums = Enumerable.Range(1, 10);
+
+int summation = nums.Aggregate((a, b) => a + b);
+
+int product = nums.Aggregate((a, b) => a * b);
+
+string concatenation = nums.Aggregate(String.Empty, (a, b) => a.ToString() + b.ToString());
+
+Console.WriteLine("{0} {1} {2}", summation, product, concatenation);

Task/Catamorphism/C/catamorphism.c

@@ -0,0 +1,24 @@
+#include <stdio.h>
+
+typedef int (*intFn)(int, int);
+
+int reduce(intFn fn, int size, int *elms)
+{
+    int i, val = *elms;
+    for (i = 1; i < size; ++i)
+        val = fn(val, elms[i]);
+    return val;
+}
+
+int add(int a, int b) { return a + b; }
+int sub(int a, int b) { return a - b; }
+int mul(int a, int b) { return a * b; }
+
+int main(void)
+{
+    int nums[] = {1, 2, 3, 4, 5};
+    printf("%d\n", reduce(add, 5, nums));
+    printf("%d\n", reduce(sub, 5, nums));
+    printf("%d\n", reduce(mul, 5, nums));
+    return 0;
+}

Task/Catamorphism/CLU/catamorphism.clu

@@ -0,0 +1,35 @@
+% Reduction.
+% First type = sequence type (must support S$elements and yield R)
+% Second type = right (input) datatype
+% Third type = left (output) datatype
+reduce = proc [S,R,L: type] (f: proctype (L,R) returns (L),
+                             id: L,
+                             seq: S)
+         returns (L)
+         where S has elements: itertype (S) yields (R)
+
+    for elem: R in S$elements(seq) do
+        id := f(id, elem)
+    end
+    return(id)
+end reduce
+
+% This is necessary to get rid of the exceptions
+add = proc (a,b: int) returns (int) return (a+b) end add
+mul = proc (a,b: int) returns (int) return (a*b) end mul
+
+% Usage
+start_up = proc ()
+    % abbreviation - reducing int->int->int function over an array[int]
+    int_reduce = reduce[array[int], int, int]
+
+    po: stream := stream$primary_output()
+    nums: array[int] := array[int]$[1,2,3,4,5,6,7,8,9,10]
+
+    % find the sum and the product using reduce
+    sum: int := int_reduce(add, 0, nums)
+    product: int := int_reduce(mul, 1, nums)
+
+    stream$putl(po, "The sum of [1..10] is: " || int$unparse(sum))
+    stream$putl(po, "The product of [1..10] is: " || int$unparse(product))
+end start_up

Task/Catamorphism/Clojure/catamorphism.clj

@@ -0,0 +1,6 @@
+; Basic usage
+> (reduce * '(1 2 3 4 5))
+120
+; Using an initial value
+> (reduce + 100 '(1 2 3 4 5))
+115

Task/Catamorphism/Common-Lisp/catamorphism.lisp

@@ -0,0 +1,18 @@
+; Basic usage
+> (reduce #'* '(1 2 3 4 5))
+120
+; Using an initial value
+> (reduce #'+ '(1 2 3 4 5) :initial-value 100)
+115
+; Using only a subsequence
+> (reduce #'+ '(1 2 3 4 5) :start 1 :end 4)
+9
+; Apply a function to each element first
+> (reduce #'+ '((a 1) (b 2) (c 3)) :key #'cadr)
+6
+; Right-associative reduction
+> (reduce #'expt '(2 3 4) :from-end T)
+2417851639229258349412352
+; Compare with
+> (reduce #'expt '(2 3 4))
+4096

Task/Catamorphism/D/catamorphism.d

@@ -0,0 +1,13 @@
+void main() {
+    import std.stdio, std.algorithm, std.range, std.meta, std.numeric,
+           std.conv, std.typecons;
+
+    auto list = iota(1, 11);
+    alias ops = AliasSeq!(q{a + b}, q{a * b}, min, max, gcd);
+
+    foreach (op; ops)
+        writeln(op.stringof, ": ", list.reduce!op);
+
+    // std.algorithm.reduce supports multiple functions in parallel:
+    reduce!(ops[0], ops[3], text)(tuple(0, 0.0, ""), list).writeln;
+}

Task/Catamorphism/DCL/catamorphism.dcl

@@ -0,0 +1,26 @@
+$ list = "1,2,3,4,5"
+$ call reduce list "+"
+$ show symbol result
+$
+$ numbers = "5,4,3,2,1"
+$ call reduce numbers "-"
+$ show symbol result
+$
+$ call reduce list "*"
+$ show symbol result
+$ exit
+$
+$ reduce: subroutine
+$ local_list = 'p1
+$ value = f$integer( f$element( 0, ",", local_list ))
+$ i = 1
+$ loop:
+$  element = f$element( i, ",", local_list )
+$  if element .eqs. "," then $ goto done
+$  value = value 'p2 f$integer( element )
+$  i = i + 1
+$  goto loop
+$ done:
+$ result == value
+$ exit
+$ endsubroutine

Task/Catamorphism/EchoLisp/catamorphism.l

@@ -0,0 +1,19 @@
+;; rem : the foldX family always need an initial value
+;; fold left a list
+(foldl + 0 (iota 10)) ;; 0 + 1 + .. + 9
+  → 45
+
+;; fold left a sequence
+(lib 'sequences)
+(foldl * 1 [ 1 .. 10])
+    → 362880 ;; 10!
+
+;; folding left and right
+(foldl / 1 ' ( 1 2 3 4))
+    → 8/3
+(foldr / 1 '(1 2 3 4))
+    → 3/8
+
+;;scanl gives the list (or sequence) of intermediate values :
+(scanl * 1 '( 1 2 3 4 5))
+   → (1 1 2 6 24 120)

Task/Catamorphism/Elena/catamorphism.elena

@@ -0,0 +1,17 @@
+import system'collections;
+import system'routines;
+import extensions;
+import extensions'text;
+
+public program()
+{
+    var numbers := new Range(1,10).summarize(new ArrayList());
+
+    var summary := numbers.accumulate(new Variable(0), (a,b => a + b));
+
+    var product := numbers.accumulate(new Variable(1), (a,b => a * b));
+
+    var concatenation := numbers.accumulate(new StringWriter(), (a,b => a.toPrintable() + b.toPrintable()));
+
+    console.printLine(summary," ",product," ",concatenation)
+}

Task/Catamorphism/Elixir/catamorphism.elixir

@@ -0,0 +1,6 @@
+iex(1)> Enum.reduce(1..10, fn i,acc -> i+acc end)
+55
+iex(2)> Enum.reduce(1..10, fn i,acc -> i*acc end)
+3628800
+iex(3)> Enum.reduce(10..-10, "", fn i,acc -> acc <> to_string(i) end)
+"109876543210-1-2-3-4-5-6-7-8-9-10"

Task/Catamorphism/Erlang/catamorphism.erl

@@ -0,0 +1,16 @@
+-module(catamorphism).
+
+-export([test/0]).
+
+test() ->
+	Nums = lists:seq(1,10),
+	Summation =
+		lists:foldl(fun(X, Acc) -> X + Acc end, 0, Nums),
+	Product =
+		lists:foldl(fun(X, Acc) -> X * Acc end, 1, Nums),
+	Concatenation =
+		lists:foldr(
+			fun(X, Acc) -> integer_to_list(X) ++ Acc end,
+			"",
+			Nums),
+	{Summation, Product, Concatenation}.

Task/Catamorphism/Excel/catamorphism.excel

@@ -0,0 +1,84 @@
+FOLDROW
+=LAMBDA(op,
+    LAMBDA(a,
+        LAMBDA(xs,
+            LET(
+                b, op(a)(HEADROW(xs)),
+
+                IF(1 < COLUMNS(xs),
+                    FOLDROW(op)(b)(
+                        TAILROW(xs)
+                    ),
+                    b
+                )
+            )
+        )
+    )
+)
+
+
+updatedBracketDepth
+=LAMBDA(depth,
+    LAMBDA(c,
+        IF(0 <= depth,
+            IF("[" = c,
+                1 + depth,
+                IF("]" = c,
+                    depth - 1,
+                    depth
+                )
+            ),
+            depth
+        )
+    )
+)
+
+
+bracketCount
+=LAMBDA(a,
+    LAMBDA(c,
+        IF(ISNUMBER(FIND(c, "[]", 1)),
+            1 + a,
+            a
+        )
+    )
+)
+
+
+HEADROW
+=LAMBDA(xs,
+    LET(REM, "The first item of each row in xs",
+
+        INDEX(
+            xs,
+            SEQUENCE(ROWS(xs)),
+            SEQUENCE(1, 1)
+        )
+    )
+)
+
+
+TAILROW
+=LAMBDA(xs,
+    LET(REM,"The tail of each row in the grid",
+        n, COLUMNS(xs) - 1,
+
+        IF(0 < n,
+            INDEX(
+                xs,
+                SEQUENCE(ROWS(xs), 1, 1, 1),
+                SEQUENCE(1, n, 2, 1)
+            ),
+            NA()
+        )
+    )
+)
+
+
+CHARSROW
+=LAMBDA(s,
+    MID(s,
+        SEQUENCE(1, LEN(s), 1, 1),
+        1
+    )
+)

Task/Catamorphism/Factor/catamorphism.factor

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

Task/Catamorphism/Forth/catamorphism-1.fth

@@ -0,0 +1,5 @@
+: lowercase? ( c -- f )
+  [char] a [ char z 1+ ] literal within ;
+
+: char-upcase ( c -- C )
+  dup lowercase? if bl xor then ;

Task/Catamorphism/Forth/catamorphism-2.fth

@@ -0,0 +1,19 @@
+: string-at ( c-addr u +n -- c )
+  nip + c@ ;
+: string-at! ( c-addr u +n c -- )
+  rot drop  -rot  + c! ;
+
+: type-lowercase ( c-addr u -- )
+  dup 0 ?do
+    2dup i string-at  dup lowercase?  if emit else drop then
+  loop  2drop ;
+
+: upcase ( 'string' -- 'STRING' )
+  dup 0 ?do
+    2dup 2dup  i string-at  char-upcase  i swap string-at!
+  loop ;
+
+: count-lowercase ( c-addr u -- n )
+  0 -rot dup 0 ?do
+    2dup i string-at  lowercase? if rot 1+ -rot then
+  loop  2drop ;

Task/Catamorphism/Forth/catamorphism-3.fth

@@ -0,0 +1,8 @@
+: next-char ( a +n -- a' n' c -1 )  ( a 0 -- 0 )
+  dup if 2dup  1 /string  2swap drop c@ true
+  else 2drop 0 then ;
+
+: type-lowercase ( c-addr u -- )
+  begin next-char while
+    dup lowercase? if emit else drop then
+  repeat ;

Task/Catamorphism/Forth/catamorphism-4.fth

@@ -0,0 +1,17 @@
+: each-char[ ( c-addr u -- )
+  postpone BOUNDS postpone ?DO
+  postpone I postpone C@ ;  immediate
+
+  \ interim code: ( c -- )
+
+: ]each-char ( -- )
+  postpone LOOP ;  immediate
+
+: type-lowercase ( c-addr u -- )
+  each-char[ dup lowercase? if emit else drop then ]each-char ;
+
+: upcase ( 'string' -- 'STRING' )
+  2dup each-char[ char-upcase i c! ]each-char ;
+
+: count-lowercase ( c-addr u -- n )
+  0 -rot each-char[ lowercase? if 1+ then ]each-char ;

Task/Catamorphism/Forth/catamorphism-5.fth

@@ -0,0 +1,17 @@
+: each-char ( c-addr u xt -- )
+  {: xt :}  bounds ?do
+    i c@ xt execute
+  loop ;
+
+: type-lowercase ( c-addr u -- )
+  [: dup lowercase? if emit else drop then ;]
+  each-char ;
+
+\ producing a new string
+: upcase ( 'string' -- 'STRING' )
+  dup cell+ allocate throw -rot
+  [: ( new-string-addr c -- new-string-addr )
+    upcase over c+! ;] each-char  $@ ;
+
+: count-lowercase ( c-addr u -- n )
+  0 -rot [: lowercase? if 1+ then ;] each-char ;

Task/Catamorphism/Fortran/catamorphism-1.f

@@ -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)

Task/Catamorphism/Fortran/catamorphism-2.f

@@ -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

Task/Catamorphism/FreeBASIC/catamorphism.basic

@@ -0,0 +1,44 @@
+' FB 1.05.0 Win64
+
+Type IntFunc As Function(As Integer, As Integer) As Integer
+
+Function reduce(a() As Integer, f As IntFunc) As Integer
+   '' if array is empty or function pointer is null, return 0 say
+   If UBound(a) = -1 OrElse f = 0 Then Return 0
+   Dim result As Integer = a(LBound(a))
+   For i As Integer = LBound(a) + 1 To UBound(a)
+     result = f(result, a(i))
+   Next
+   Return result
+End Function
+
+Function add(x As Integer, y As Integer) As Integer
+  Return x + y
+End Function
+
+Function subtract(x As Integer, y As Integer) As Integer
+  Return x - y
+End Function
+
+Function multiply(x As Integer, y As Integer) As Integer
+  Return x * y
+End Function
+
+Function max(x As Integer, y As Integer) As Integer
+  Return IIf(x > y, x, y)
+End Function
+
+Function min(x As Integer, y As Integer) As Integer
+  Return IIf(x < y, x, y)
+End Function
+
+Dim a(4) As Integer = {1, 2, 3, 4, 5}
+Print "Sum is        :"; reduce(a(), @add)
+Print "Difference is :"; reduce(a(), @subtract)
+Print "Product is    :"; reduce(a(), @multiply)
+Print "Maximum is    :"; reduce(a(), @max)
+Print "Minimum is    :"; reduce(a(), @min)
+Print "No op is      :"; reduce(a(), 0)
+Print
+Print "Press any key to quit"
+Sleep

Task/Catamorphism/Go/catamorphism.go

@@ -0,0 +1,25 @@
+package main
+
+import (
+	"fmt"
+)
+
+func main() {
+	n := []int{1, 2, 3, 4, 5}
+
+	fmt.Println(reduce(add, n))
+	fmt.Println(reduce(sub, n))
+	fmt.Println(reduce(mul, n))
+}
+
+func add(a int, b int) int { return a + b }
+func sub(a int, b int) int { return a - b }
+func mul(a int, b int) int { return a * b }
+
+func reduce(rf func(int, int) int, m []int) int {
+	r := m[0]
+	for _, v := range m[1:] {
+		r = rf(r, v)
+	}
+	return r
+}

Task/Catamorphism/Groovy/catamorphism.groovy

@@ -0,0 +1,13 @@
+def vector1 = [1,2,3,4,5,6,7]
+def vector2 = [7,6,5,4,3,2,1]
+def map1 = [a:1, b:2, c:3, d:4]
+
+println vector1.inject { acc, val -> acc + val }       // sum
+println vector1.inject { acc, val -> acc + val*val }   // sum of squares
+println vector1.inject { acc, val -> acc * val }       // product
+println vector1.inject { acc, val -> acc<val?val:acc } // max
+println ([vector1,vector2].transpose().inject(0) { acc, val -> acc + val[0]*val[1] }) //dot product (with seed 0)
+
+println (map1.inject { Map.Entry accEntry, Map.Entry entry ->     // some sort of weird map-based reduction
+    [(accEntry.key + entry.key):accEntry.value + entry.value ].entrySet().toList().pop()
+})

Task/Catamorphism/Haskell/catamorphism-1.hs

@@ -0,0 +1,8 @@
+main :: IO ()
+main =
+  putStrLn . unlines $
+  [ show . foldr (+)    0  -- sum
+  , show . foldr (*)    1  -- product
+  , foldr ((++) . show) "" -- concatenation
+  ] <*>
+  [[1 .. 10]]

Task/Catamorphism/Haskell/catamorphism-2.hs

@@ -0,0 +1,12 @@
+import Data.Monoid
+
+main :: IO ()
+main =
+  let xs = [1 .. 10]
+  in (putStrLn . unlines)
+       [ (show . getSum     . foldr (<>) mempty) (Sum     <$> xs)
+       , (show . getProduct . foldr (<>) mempty) (Product <$> xs)
+       , (show .              foldr (<>) mempty) (show    <$> xs)
+       , (show .              foldr (<>) mempty) (words
+                     "Love is one damned thing after each other")
+       ]

Task/Catamorphism/Icon/catamorphism.icon

@@ -0,0 +1,9 @@
+procedure main(A)
+    write(A[1],": ",curry(A[1],A[2:0]))
+end
+
+procedure curry(f,A)
+    r := A[1]
+    every r := f(r, !A[2:0])
+    return r
+end

Task/Catamorphism/J/catamorphism-1.j

@@ -0,0 +1 @@
+    /

Task/Catamorphism/J/catamorphism-2.j

@@ -0,0 +1,6 @@
+   +/ 1 2 3 4 5
+15
+   */ 1 2 3 4 5
+120
+   !/ 1 2 3 4 5  NB.  "n ! k" is "n choose k"
+45

Task/Catamorphism/J/catamorphism-3.j

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

Task/Catamorphism/Java/catamorphism.java

@@ -0,0 +1,9 @@
+import java.util.stream.Stream;
+
+public class ReduceTask {
+
+    public static void main(String[] args) {
+        System.out.println(Stream.of(1, 2, 3, 4, 5).mapToInt(i -> i).sum());
+        System.out.println(Stream.of(1, 2, 3, 4, 5).reduce(1, (a, b) -> a * b));
+    }
+}

Task/Catamorphism/JavaScript/catamorphism-1.js

@@ -0,0 +1,17 @@
+var nums = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10];
+
+function add(a, b) {
+    return a + b;
+}
+
+var summation = nums.reduce(add);
+
+function mul(a, b) {
+    return a * b;
+}
+
+var product = nums.reduce(mul, 1);
+
+var concatenation = nums.reduce(add, "");
+
+console.log(summation, product, concatenation);

Task/Catamorphism/JavaScript/catamorphism-2.js

@@ -0,0 +1,21 @@
+(function (xs) {
+    'use strict';
+
+    // foldl :: (b -> a -> b) -> b -> [a] -> b
+    function foldl(f, acc, xs) {
+        return xs.reduce(f, acc);
+    }
+
+    // foldr :: (b -> a -> b) -> b -> [a] -> b
+    function foldr(f, acc, xs) {
+        return xs.reduceRight(f, acc);
+    }
+
+    // Test folds in both directions
+    return [foldl, foldr].map(function (f) {
+        return f(function (acc, x) {
+            return acc + (x * 2).toString() + ' ';
+        }, [], xs);
+    });
+
+})([0, 1, 2, 3, 4, 5, 6, 7, 8, 9]);

Task/Catamorphism/JavaScript/catamorphism-3.js

@@ -0,0 +1,5 @@
+var nums = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10];
+
+console.log(nums.reduce((a, b) => a + b, 0)); // sum of 1..10
+console.log(nums.reduce((a, b) => a * b, 1)); // product of 1..10
+console.log(nums.reduce((a, b) => a + b, '')); // concatenation of 1..10

Task/Catamorphism/Julia/catamorphism.julia

@@ -0,0 +1,3 @@
+println([reduce(op, 1:5) for op in [+, -, *]])
+println([foldl(op, 1:5) for op in [+, -, *]])
+println([foldr(op, 1:5) for op in [+, -, *]])

Task/Catamorphism/Kotlin/catamorphism.kotlin

@@ -0,0 +1,9 @@
+fun main(args: Array<String>) {
+    val a = intArrayOf(1, 2, 3, 4, 5)
+    println("Array       : ${a.joinToString(", ")}")
+    println("Sum         : ${a.reduce { x, y -> x + y }}")
+    println("Difference  : ${a.reduce { x, y -> x - y }}")
+    println("Product     : ${a.reduce { x, y -> x * y }}")
+    println("Minimum     : ${a.reduce { x, y -> if (x < y) x else y }}")
+    println("Maximum     : ${a.reduce { x, y -> if (x > y) x else y }}")
+}

Task/Catamorphism/LOLCODE/catamorphism.lol

@@ -0,0 +1,27 @@
+HAI 1.3
+
+HOW IZ I reducin YR array AN YR size AN YR fn
+    I HAS A val ITZ array'Z SRS 0
+    IM IN YR loop UPPIN YR i TIL BOTH SAEM i AN DIFF OF size AN 1
+        val R I IZ fn YR val AN YR array'Z SRS SUM OF i AN 1 MKAY
+    IM OUTTA YR loop
+    FOUND YR val
+IF U SAY SO
+
+O HAI IM array
+    I HAS A SRS 0 ITZ 1
+    I HAS A SRS 1 ITZ 2
+    I HAS A SRS 2 ITZ 3
+    I HAS A SRS 3 ITZ 4
+    I HAS A SRS 4 ITZ 5
+KTHX
+
+HOW IZ I add YR a AN YR b, FOUND YR     SUM OF a AN b, IF U SAY SO
+HOW IZ I sub YR a AN YR b, FOUND YR    DIFF OF a AN b, IF U SAY SO
+HOW IZ I mul YR a AN YR b, FOUND YR PRODUKT OF a AN b, IF U SAY SO
+
+VISIBLE I IZ reducin YR array AN YR 5 AN YR add MKAY
+VISIBLE I IZ reducin YR array AN YR 5 AN YR sub MKAY
+VISIBLE I IZ reducin YR array AN YR 5 AN YR mul MKAY
+
+KTHXBYE

Task/Catamorphism/Lambdatalk/catamorphism.lambdatalk

@@ -0,0 +1,12 @@
+{def nums 1 2 3 4 5}
+-> nums
+{S.reduce {lambda {:a :b} {+ :a :b}} {nums}}
+-> 15
+{S.reduce {lambda {:a :b} {- :a :b}} {nums}}
+-> -13
+{S.reduce {lambda {:a :b} {* :a :b}} {nums}}
+-> 120
+{S.reduce min {nums}}
+-> 1
+{S.reduce max {nums}}
+-> 5

Task/Catamorphism/Logtalk/catamorphism.logtalk

@@ -0,0 +1,14 @@
+:- object(folding_examples).
+
+    :- public(show/0).
+    show :-
+        integer::sequence(1, 10, List),
+        write('List: '), write(List), nl,
+        meta::fold_left([Acc,N,Sum0]>>(Sum0 is Acc+N), 0, List, Sum),
+        write('Sum of all elements: '), write(Sum), nl,
+        meta::fold_left([Acc,N,Product0]>>(Product0 is Acc*N), 1, List, Product),
+        write('Product of all elements: '), write(Product), nl,
+        meta::fold_left([Acc,N,Concat0]>>(number_codes(N,NC), atom_codes(NA,NC), atom_concat(Acc,NA,Concat0)), '', List, Concat),
+        write('Concatenation of all elements: '), write(Concat), nl.
+
+:- end_object.

Task/Catamorphism/Lua/catamorphism.lua

@@ -0,0 +1,29 @@
+table.unpack = table.unpack or unpack -- 5.1 compatibility
+local nums = {1,2,3,4,5,6,7,8,9}
+
+function add(a,b)
+   return a+b
+end
+
+function mult(a,b)
+   return a*b
+end
+
+function cat(a,b)
+   return tostring(a)..tostring(b)
+end
+
+local function reduce(fun,a,b,...)
+   if ... then
+      return reduce(fun,fun(a,b),...)
+   else
+      return fun(a,b)
+   end
+end
+
+local arithmetic_sum = function (...) return reduce(add,...) end
+local factorial5 = reduce(mult,5,4,3,2,1)
+
+print("Σ(1..9)   : ",arithmetic_sum(table.unpack(nums)))
+print("5!        : ",factorial5)
+print("cat {1..9}: ",reduce(cat,table.unpack(nums)))

Task/Catamorphism/M2000-Interpreter/catamorphism.m2000

@@ -0,0 +1,20 @@
+Module CheckIt {
+      Function Reduce (a, f) {
+            if len(a)=0 then Error "Nothing to reduce"
+            if len(a)=1 then  =Array(a) : Exit
+            k=each(a, 2, -1)
+            m=Array(a)
+            While k {
+                  m=f(m, array(k))
+            }
+            =m
+      }
+      a=(1, 2, 3, 4, 5)
+      Print "Array", a
+      Print "Sum", Reduce(a, lambda (x,y)->x+y)
+      Print "Difference", Reduce(a, lambda (x,y)->x-y)
+      Print "Product", Reduce(a, lambda (x,y)->x*y)
+      Print "Minimum", Reduce(a, lambda (x,y)->if(x<y->x, y))
+      Print "Maximum", Reduce(a, lambda (x,y)->if(x>y->x, y))
+}
+CheckIt

Task/Catamorphism/Maple/catamorphism-1.maple

@@ -0,0 +1,8 @@
+> nums := seq( 1 .. 10 );
+                          nums := 1, 2, 3, 4, 5, 6, 7, 8, 9, 10
+
+> foldl( `+`, 0, nums ); # compute sum using foldl
+                          55
+
+> foldr( `*`, 1, nums ); # compute product using foldr
+                          3628800

Task/Catamorphism/Maple/catamorphism-2.maple

@@ -0,0 +1,2 @@
+> foldl( (a,b) ->a*T+b, op(map2(op,1,[op( 72*T^5+37*T^4-23*T^3+87*T^2+44*T+29 )])));
+                    ((((72 T + 37) T - 23) T + 87) T + 44) T + 29

Task/Catamorphism/Mathematica/catamorphism.math

@@ -0,0 +1 @@
+Fold[f, x, {a, b, c, d}]

Task/Catamorphism/Maxima/catamorphism-1.maxima

@@ -0,0 +1,2 @@
+lreduce(f, [a, b, c, d], x0);
+/* (%o1)                     f(f(f(f(x0, a), b), c), d) */

Task/Catamorphism/Maxima/catamorphism-2.maxima

@@ -0,0 +1,2 @@
+lreduce("+", [1, 2, 3, 4], 100);
+/* (%o1)                                 110 */

Task/Catamorphism/Min/catamorphism.min

@@ -0,0 +1,2 @@
+(1 2 3 4) 0 '+ reduce puts! ; sum
+(1 2 3 4) 1 '* reduce puts! ; product

Task/Catamorphism/Modula-2/catamorphism.mod2

@@ -0,0 +1,40 @@
+MODULE Catamorphism;
+FROM InOut IMPORT WriteString, WriteCard, WriteLn;
+
+(* Alas, there are no generic types. This function works for
+   CARDINAL only - you would have to copy it and change the types
+   to reduce functions of other types. *)
+TYPE Reduction = PROCEDURE (CARDINAL, CARDINAL): CARDINAL;
+PROCEDURE reduce(func:  Reduction;
+                 arr:   ARRAY OF CARDINAL;
+                 first: CARDINAL): CARDINAL;
+    VAR i: CARDINAL;
+BEGIN
+    FOR i := 0 TO HIGH(arr) DO
+        first := func(first, arr[i]);
+    END;
+    RETURN first;
+END reduce;
+
+(* Demonstration *)
+PROCEDURE add(a,b: CARDINAL): CARDINAL;
+BEGIN RETURN a+b; END add;
+PROCEDURE mul(a,b: CARDINAL): CARDINAL;
+BEGIN RETURN a*b; END mul;
+
+PROCEDURE Demonstration;
+    VAR a: ARRAY [1..5] OF CARDINAL;
+        i: CARDINAL;
+BEGIN
+    FOR i := 1 TO 5 DO a[i] := i; END;
+
+    WriteString("Sum of [1..5]: ");
+    WriteCard(reduce(add, a, 0), 3);
+    WriteLn;
+    WriteString("Product of [1..5]: ");
+    WriteCard(reduce(mul, a, 1), 3);
+    WriteLn;
+END Demonstration;
+
+BEGIN Demonstration;
+END Catamorphism.

Task/Catamorphism/Nemerle/catamorphism.nemerle

@@ -0,0 +1,2 @@
+def seq = [1, 4, 6, 3, 7];
+def sum = seq.Fold(0, _ + _); // Fold takes an initial value and a function, here the + operator

Task/Catamorphism/Nim/catamorphism.nim

@@ -0,0 +1,19 @@
+import sequtils
+
+block:
+  let
+    numbers = @[5, 9, 11]
+    addition = foldl(numbers, a + b)
+    substraction = foldl(numbers, a - b)
+    multiplication = foldl(numbers, a * b)
+    words = @["nim", "is", "cool"]
+    concatenation = foldl(words, a & b)
+
+block:
+  let
+    numbers = @[5, 9, 11]
+    addition = foldr(numbers, a + b)
+    substraction = foldr(numbers, a - b)
+    multiplication = foldr(numbers, a * b)
+    words = @["nim", "is", "cool"]
+    concatenation = foldr(words, a & b)

Task/Catamorphism/OCaml/catamorphism.ocaml

@@ -0,0 +1,6 @@
+# let nums = [1;2;3;4;5;6;7;8;9;10];;
+val nums : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10]
+# let sum = List.fold_left (+) 0 nums;;
+val sum : int = 55
+# let product = List.fold_left ( * ) 1 nums;;
+val product : int = 3628800

Task/Catamorphism/Oberon-2/catamorphism.oberon

@@ -0,0 +1,72 @@
+MODULE Catamorphism;
+IMPORT
+  Object,
+  NPCT:Tools,
+  NPCT:Args,
+  IntStr,
+  Out;
+
+TYPE
+  BinaryFunc= PROCEDURE (x,y: LONGINT): LONGINT;
+
+VAR
+  data: POINTER TO ARRAY OF LONGINT;
+  i: LONGINT;
+
+  PROCEDURE Sum(x,y: LONGINT): LONGINT;
+  BEGIN
+    RETURN x + y
+  END Sum;
+
+  PROCEDURE Sub(x,y: LONGINT): LONGINT;
+  BEGIN
+    RETURN x - y;
+  END Sub;
+
+  PROCEDURE Mul(x,y: LONGINT): LONGINT;
+  BEGIN
+    RETURN x * y;
+  END Mul;
+
+  PROCEDURE Reduce(x: ARRAY OF LONGINT; f: BinaryFunc): LONGINT;
+  VAR
+    i,res: LONGINT;
+  BEGIN
+    res := x[0];i := 1;
+    WHILE (i < LEN(x)) DO;
+      res := f(res,x[i]);
+      INC(i)
+    END;
+    RETURN res
+  END Reduce;
+
+  PROCEDURE InitData(VAR x: ARRAY OF LONGINT);
+  VAR
+    i, j: LONGINT;
+    res: IntStr.ConvResults;
+    aux: Object.CharsLatin1;
+  BEGIN
+    i := 0;j := 1;
+    WHILE (j <= LEN(x)) DO
+      aux := Tools.AsString(Args.Get(j));
+      IntStr.StrToInt(aux^,x[i],res);
+      IF res # IntStr.strAllRight THEN
+        Out.String("Incorrect format for data at index ");Out.LongInt(j,0);Out.Ln;
+        HALT(1);
+      END;
+      INC(j);INC(i)
+    END
+  END InitData;
+
+BEGIN
+  IF Args.Number() = 1 THEN
+    Out.String("Invalid number of arguments. ");Out.Ln;
+    HALT(0)
+  ELSE
+    NEW(data,Args.Number() - 1);
+    InitData(data^);
+    Out.LongInt(Reduce(data^,Sum),0);Out.Ln;
+    Out.LongInt(Reduce(data^,Sub),0);Out.Ln;
+    Out.LongInt(Reduce(data^,Mul),0);Out.Ln
+  END
+END Catamorphism.

Task/Catamorphism/Objeck/catamorphism.objeck

@@ -0,0 +1,17 @@
+use Collection;
+
+class Reducer {
+  function : Main(args : String[]) ~ Nil {
+    values := IntVector->New([1, 2, 3, 4, 5]);
+    values->Reduce(Add(Int, Int) ~ Int)->PrintLine();
+    values->Reduce(Mul(Int, Int) ~ Int)->PrintLine();
+  }
+
+  function : Add(a : Int, b : Int) ~ Int {
+    return a + b;
+  }
+
+  function : Mul(a : Int, b : Int) ~ Int {
+    return a * b;
+  }
+}

Task/Catamorphism/Oforth/catamorphism.fth

@@ -0,0 +1,2 @@
+[ 1, 2, 3, 4, 5 ] reduce(#max)
+[ "abc", "def", "gfi" ] reduce(#+)

Task/Catamorphism/PARI-GP/catamorphism-1.parigp

@@ -0,0 +1,6 @@
+reduce(f, v)={
+  my(t=v[1]);
+  for(i=2,#v,t=f(t,v[i]));
+  t
+};
+reduce((a,b)->a+b, [1,2,3,4,5,6,7,8,9,10])

Task/Catamorphism/PARI-GP/catamorphism-2.parigp

@@ -0,0 +1 @@
+fold((a,b)->a+b, [1..10])

Task/Catamorphism/Pascal/catamorphism.pas

@@ -0,0 +1,53 @@
+program reduceApp;
+
+type
+//  tmyArray = array of LongInt;
+  tmyArray = array[-5..5] of LongInt;
+  tmyFunc = function (a,b:LongInt):LongInt;
+
+function add(x,y:LongInt):LongInt;
+begin
+  add := x+y;
+end;
+
+function sub(k,l:LongInt):LongInt;
+begin
+  sub := k-l;
+end;
+
+function mul(r,t:LongInt):LongInt;
+begin
+  mul := r*t;
+end;
+
+function reduce(myFunc:tmyFunc;a:tmyArray):LongInt;
+var
+  i,res : LongInt;
+begin
+  res := a[low(a)];
+  For i := low(a)+1 to high(a) do
+    res := myFunc(res,a[i]);
+  reduce := res;
+end;
+
+procedure InitMyArray(var a:tmyArray);
+var
+  i: LongInt;
+begin
+  For i := low(a) to high(a) do
+  begin
+    //no a[i] = 0
+    a[i] := i + ord(i=0);
+    write(a[i],',');
+  end;
+  writeln(#8#32);
+end;
+
+var
+  ma : tmyArray;
+BEGIN
+  InitMyArray(ma);
+  writeln(reduce(@add,ma));
+  writeln(reduce(@sub,ma));
+  writeln(reduce(@mul,ma));
+END.

Task/Catamorphism/Perl/catamorphism.pl

@@ -0,0 +1,8 @@
+use List::Util 'reduce';
+
+# note the use of the odd $a and $b globals
+print +(reduce {$a + $b} 1 .. 10), "\n";
+
+# first argument is really an anon function; you could also do this:
+sub func { $b & 1 ? "$a $b" : "$b $a" }
+print +(reduce \&func, 1 .. 10), "\n"

Task/Catamorphism/Phix/catamorphism.phix

@@ -0,0 +1,18 @@
+(phixonline)-->
+ <span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
+ <span style="color: #008080;">function</span> <span style="color: #000000;">add</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">)</span>  <span style="color: #008080;">return</span> <span style="color: #000000;">a</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">b</span>  <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+ <span style="color: #008080;">function</span> <span style="color: #000000;">sub</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">)</span>  <span style="color: #008080;">return</span> <span style="color: #000000;">a</span> <span style="color: #0000FF;">-</span> <span style="color: #000000;">b</span>  <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+ <span style="color: #008080;">function</span> <span style="color: #000000;">mul</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">)</span>  <span style="color: #008080;">return</span> <span style="color: #000000;">a</span> <span style="color: #0000FF;">*</span> <span style="color: #000000;">b</span>  <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+
+ <span style="color: #008080;">function</span> <span style="color: #000000;">reduce</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">rid</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
+     <span style="color: #004080;">object</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
+     <span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">2</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
+         <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">rid</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">])</span>
+     <span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
+     <span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+
+ <span style="color: #0000FF;">?</span><span style="color: #000000;">reduce</span><span style="color: #0000FF;">(</span><span style="color: #000000;">add</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">tagset</span><span style="color: #0000FF;">(</span><span style="color: #000000;">5</span><span style="color: #0000FF;">))</span>
+ <span style="color: #0000FF;">?</span><span style="color: #000000;">reduce</span><span style="color: #0000FF;">(</span><span style="color: #000000;">sub</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">tagset</span><span style="color: #0000FF;">(</span><span style="color: #000000;">5</span><span style="color: #0000FF;">))</span>
+ <span style="color: #0000FF;">?</span><span style="color: #000000;">reduce</span><span style="color: #0000FF;">(</span><span style="color: #000000;">mul</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">tagset</span><span style="color: #0000FF;">(</span><span style="color: #000000;">5</span><span style="color: #0000FF;">))</span>
+<!--

Task/Catamorphism/Phixmonti/catamorphism.phixmonti

@@ -0,0 +1,20 @@
+include ..\Utilitys.pmt
+
+def add + enddef
+def sub - enddef
+def mul * enddef
+
+def reduce >ps
+    1 get
+    swap len 2 swap 2 tolist for
+        get rot swap tps exec swap
+    endfor
+    ps> drop
+    swap
+enddef
+
+
+( 1 2 3 4 5 )
+getid add reduce ?
+getid sub reduce ?
+getid mul reduce ?

Task/Catamorphism/PicoLisp/catamorphism.l

@@ -0,0 +1,11 @@
+(de reduce ("Fun" "Lst")
+   (let "A" (car "Lst")
+      (for "N" (cdr "Lst")
+         (setq "A" ("Fun" "A" "N")) )
+      "A" ) )
+
+(println
+   (reduce + (1 2 3 4 5))
+   (reduce * (1 2 3 4 5)) )
+
+(bye)

Task/Catamorphism/PowerShell/catamorphism.psh

@@ -0,0 +1 @@
+1..5 | ForEach-Object -Begin {$result = 0} -Process {$result += $_} -End {$result}

Task/Catamorphism/Prolog/catamorphism-1.pro

@@ -0,0 +1,12 @@
+:- use_module(library(lambda)).
+
+catamorphism :-
+	numlist(1,10,L),
+	foldl(\XS^YS^ZS^(ZS is XS+YS), L, 0, Sum),
+	format('Sum of ~w is ~w~n', [L, Sum]),
+	foldl(\XP^YP^ZP^(ZP is XP*YP), L, 1, Prod),
+	format('Prod of ~w is ~w~n', [L, Prod]),
+	string_to_list(LV, ""),
+	foldl(\XC^YC^ZC^(string_to_atom(XS, XC),string_concat(YC,XS,ZC)),
+	      L, LV, Concat),
+	format('Concat of ~w is ~w~n', [L, Concat]).

Task/Catamorphism/Prolog/catamorphism-2.pro

@@ -0,0 +1,6 @@
+% List to be folded:
+%
+%  +---+---+---+---[]    <-- list backbone/spine, composed of nodes, terminating in the empty list
+%  |   |   |   |
+%  a   b   c   d         <-- list items/entries/elements/members
+%

Task/Catamorphism/Prolog/catamorphism-3.pro

@@ -0,0 +1,14 @@
+% Computes "Out" as:
+%
+% starter value -->--f-->--f-->--f-->--f-->-- Out
+%                    |     |     |     |
+%                    a     b     c     d
+
+
+foldl(Foldy,[Item|Items],Acc,Result) :-    % case of nonempty list
+   !,                                      % GREEN CUT for determinism
+   call(Foldy,Item,Acc,AccNext),           % call Foldy(Item,Acc,AccNext)
+   foldl(Foldy,Items,AccNext,Result).      % then recurse (open to tail call optimization)
+
+foldl(_,[],Acc,Result) :-                  % case of empty list
+   Acc=Result.                             % unification not in head for clarity

Task/Catamorphism/Prolog/catamorphism-4.pro

@@ -0,0 +1,13 @@
+% Computes "Out" as:
+%
+% Out --<--f--<--f--<--f--<--f--<-- starter value
+%          |     |     |     |
+%          a     b     c     d
+
+foldr(Foldy,[Item|Items],Starter,AccUp) :-    % case of nonempty list
+   !,                                         % GREEN CUT for determinism
+   foldr(Foldy,Items,Starter,AccUpPrev),      % recurse (NOT open to tail-call optimization)
+   call(Foldy,Item,AccUpPrev,AccUp).          % call Foldy(Item,AccupPrev,AccUp) as last action
+
+foldr(_,[],Starter,AccUp) :-                  % empty list: bounce Starter "upwards" into AccUp
+   AccUp=Starter.                             % unification not in head for clarity

Task/Catamorphism/Prolog/catamorphism-5.pro

@@ -0,0 +1,28 @@
+:- use_module(library(clpfd)). % We are using #= instead of the raw "is".
+
+foldy_len(_Item,ThreadIn,ThreadOut) :-
+   succ(ThreadIn,ThreadOut).
+
+foldy_add(Item,ThreadIn,ThreadOut) :-
+   ThreadOut #= Item+ThreadIn.
+
+foldy_mult(Item,ThreadIn,ThreadOut) :-
+   ThreadOut #= Item*ThreadIn.
+
+foldy_squadd(Item,ThreadIn,ThreadOut) :-
+   ThreadOut #= Item+(ThreadIn^2).
+
+% '[|]' is SWI-Prolog specific, replace by '.' as consbox constructor in other Prologs
+
+foldy_build(Item,ThreadIn,ThreadOut) :-
+   ThreadOut = '[|]'(Item,ThreadIn).
+
+foldy_join(Item,ThreadIn,ThreadOut) :-
+   (ThreadIn \= "")
+   -> with_output_to(string(ThreadOut),format("~w,~w",[Item,ThreadIn]))
+   ;  with_output_to(string(ThreadOut),format("~w",[Item])).
+
+% '=..' ("univ") constructs a term from a list of functor and arguments
+
+foldy_expr(Functor,Item,ThreadIn,ThreadOut) :-
+   ThreadOut =.. [Functor,Item,ThreadIn].

Task/Catamorphism/Prolog/catamorphism-6.pro

@@ -0,0 +1,52 @@
+:- begin_tests(foldr).
+
+in([1,2,3,4,5]).
+
+ffr(Foldy,List,Starter,AccUp) :- foldr(Foldy,List,Starter,AccUp).
+
+test(foo_foldr_len)    :- in(L),ffr(foldy_len     , L ,  0 , R), R=5.
+test(foo_foldr_add)    :- in(L),ffr(foldy_add     , L ,  0 , R), R=15.
+test(foo_foldr_mult)   :- in(L),ffr(foldy_mult    , L ,  1 , R), R=120.
+test(foo_foldr_build)  :- in(L),ffr(foldy_build   , L , [] , R), R=[1,2,3,4,5].
+test(foo_foldr_squadd) :- in(L),ffr(foldy_squadd  , L ,  0 , R), R=507425426245.
+test(foo_foldr_join)   :- in(L),ffr(foldy_join    , L , "" , R), R="1,2,3,4,5".
+test(foo_foldr_expr)   :- in(L),ffr(foldy_expr(*) , L ,  1 , R), R=1*(2*(3*(4*(5*1)))).
+
+test(foo_foldr_len_empty)    :- ffr(foldy_len     , [],  0 , R), R=0.
+test(foo_foldr_add_empty)    :- ffr(foldy_add     , [],  0 , R), R=0.
+test(foo_foldr_mult_empty)   :- ffr(foldy_mult    , [],  1 , R), R=1.
+test(foo_foldr_build_empty)  :- ffr(foldy_build   , [], [] , R), R=[].
+test(foo_foldr_squadd_empty) :- ffr(foldy_squadd  , [],  0 , R), R=0.
+test(foo_foldr_join_empty)   :- ffr(foldy_join    , [], "" , R), R="".
+test(foo_foldr_expr_empty)   :- ffr(foldy_expr(*) , [],  1 , R), R=1.
+
+% library(apply) has no "foldr" so no comparison tests!
+
+:- end_tests(foldr).
+
+
+:- begin_tests(foldl).
+
+in([1,2,3,4,5]).
+
+ffl(Foldy,List,Starter,Result) :- foldl(Foldy,List,Starter,Result).
+
+test(foo_foldl_len)    :- in(L),ffl(foldy_len     , L ,  0 , R), R=5.
+test(foo_foldl_add)    :- in(L),ffl(foldy_add     , L,   0 , R), R=15.
+test(foo_foldl_mult)   :- in(L),ffl(foldy_mult    , L,   1 , R), R=120.
+test(foo_foldl_build)  :- in(L),ffl(foldy_build   , L,  [] , R), R=[5,4,3,2,1].
+test(foo_foldl_squadd) :- in(L),ffl(foldy_squadd  , L,   0 , R), R=21909.
+test(foo_foldl_join)   :- in(L),ffl(foldy_join    , L,  "" , R), R="5,4,3,2,1".
+test(foo_foldl_expr)   :- in(L),ffl(foldy_expr(*) , L,   1 , R), R=5*(4*(3*(2*(1*1)))).
+
+test(foo_foldl_len_empty)    :- ffl(foldy_len     , [],  0 , R), R=0.
+test(foo_foldl_add_empty)    :- ffl(foldy_add     , [],  0 , R), R=0.
+test(foo_foldl_mult_empty)   :- ffl(foldy_mult    , [],  1 , R), R=1.
+test(foo_foldl_build_empty)  :- ffl(foldy_build   , [], [] , R), R=[].
+test(foo_foldl_squadd_empty) :- ffl(foldy_squadd  , [],  0 , R), R=0.
+test(foo_foldl_join_empty)   :- ffl(foldy_join    , [], "" , R), R="".
+test(foo_foldl_expr_empty)   :- ffl(foldy_expr(*) , [],  1 , R), R=1.
+
+:- end_tests(foldl).
+
+rt :- run_tests(foldr),run_tests(foldl).

Task/Catamorphism/PureBasic/catamorphism.basic

@@ -0,0 +1,20 @@
+Procedure.i reduce(List l(),op$="+")
+  If FirstElement(l())
+    x=l()
+    While NextElement(l())
+      Select op$
+        Case "+" : x+l()
+        Case "-" : x-l()
+        Case "*" : x*l()
+      EndSelect
+    Wend
+  EndIf
+  ProcedureReturn x
+EndProcedure
+
+NewList fold()
+For i=1 To 5 : AddElement(fold()) : fold()=i : Next
+
+Debug reduce(fold())
+Debug reduce(fold(),"-")
+Debug reduce(fold(),"*")

Task/Catamorphism/Python/catamorphism-1.py

@@ -0,0 +1,19 @@
+>>> # Python 2.X
+>>> from operator import add
+>>> listoflists = [['the', 'cat'], ['sat', 'on'], ['the', 'mat']]
+>>> help(reduce)
+Help on built-in function reduce in module __builtin__:
+
+reduce(...)
+    reduce(function, sequence[, initial]) -> value
+
+    Apply a function of two arguments cumulatively to the items of a sequence,
+    from left to right, so as to reduce the sequence to a single value.
+    For example, reduce(lambda x, y: x+y, [1, 2, 3, 4, 5]) calculates
+    ((((1+2)+3)+4)+5).  If initial is present, it is placed before the items
+    of the sequence in the calculation, and serves as a default when the
+    sequence is empty.
+
+>>> reduce(add, listoflists, [])
+['the', 'cat', 'sat', 'on', 'the', 'mat']
+>>>

Task/Catamorphism/Python/catamorphism-2.py

@@ -0,0 +1,14 @@
+# Python 3.X
+
+from functools import reduce
+from operator import add, mul
+
+nums = range(1,11)
+
+summation = reduce(add, nums)
+
+product = reduce(mul, nums)
+
+concatenation = reduce(lambda a, b: str(a) + str(b), nums)
+
+print(summation, product, concatenation)

Task/Catamorphism/QBasic/catamorphism.basic

@@ -0,0 +1,34 @@
+DIM SHARED n(10)
+FOR i = 1 TO 10: n(i) = i: NEXT i
+
+FUNCTION FNMIN (a, b)
+IF (a < b) THEN FNMIN = a ELSE FNMIN = b
+END FUNCTION
+FUNCTION FNMAX (a, b)
+IF (a < b) THEN FNMAX = b ELSE FNMAX = a
+END FUNCTION
+
+FUNCTION cat# (cont, op$)
+temp = n(1)
+FOR i = 2 TO cont
+ IF op$ = "+" THEN temp = temp + n(i)
+ IF op$ = "-" THEN temp = temp - n(i)
+ IF op$ = "*" THEN temp = temp * n(i)
+ IF op$ = "/" THEN temp = temp / n(i)
+ IF op$ = "^" THEN temp = temp ^ n(i)
+ IF op$ = "max" THEN temp = FNMAX(temp, n(i))
+ IF op$ = "min" THEN temp = FNMIN(temp, n(i))
+ IF op$ = "avg" THEN temp = temp + n(i)
+NEXT i
+IF op$ = "avg" THEN temp = temp / cont
+cat = temp
+END FUNCTION
+
+PRINT "  +: "; " "; cat(10, "+")
+PRINT "  -: "; " "; cat(10, "-")
+PRINT "  *: "; " "; cat(10, "*")
+PRINT "  /: "; " "; cat(10, "/")
+PRINT "  ^: "; " "; cat(10, "^")
+PRINT "min: "; " "; cat(10, "min")
+PRINT "max: "; " "; cat(10, "max")
+PRINT "avg: "; " "; cat(10, "avg")

Task/Catamorphism/Quackery/catamorphism.quackery

@@ -0,0 +1,5 @@
+/O> 0 ' [ 1 2 3 4 5 ] witheach +
+... 1 ' [ 1 2 3 4 5 ] witheach *
+...
+
+Stack: 15 120

Task/Catamorphism/R/catamorphism-1.r

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

Task/Catamorphism/R/catamorphism-2.r

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

Task/Catamorphism/R/catamorphism-3.r

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

Task/Catamorphism/R/catamorphism-4.r

@@ -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

Task/Catamorphism/REXX/catamorphism.rexx

@@ -0,0 +1,39 @@
+/*REXX program demonstrates a  method  for  catamorphism  for some simple functions.    */
+@list= 1 2 3 4 5 6 7 8 9 10
+                                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=='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 an arg list.*/
+      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*/
+                         end   /*k*/
+      return x
+/*──────────────────────────────────────────────────────────────────────────────────────*/
+LCM:  procedure;  $=;    do j=1  for arg();     $= $ arg(j)
+                         end   /*j*/
+      x= abs(word($, 1))                                       /* [↑] build an arg list.*/
+                         do k=2  to words($);   != abs(word($, k));  if !=0  then return 0
+                         x= x*!  /  GCD(x, !)                  /*GCD does the heavy work*/
+                         end   /*k*/
+      return x

Task/Catamorphism/Racket/catamorphism.rkt

@@ -0,0 +1,8 @@
+#lang racket
+(define (fold f xs init)
+  (if (empty? xs)
+      init
+      (f (first xs)
+         (fold f (rest xs) init))))
+
+(fold + '(1 2 3) 0)   ; the result is 6

Task/Catamorphism/Raku/catamorphism-1.raku

@@ -0,0 +1,7 @@
+my @list = 1..10;
+say [+] @list;
+say [*] @list;
+say [~] @list;
+say min @list;
+say max @list;
+say [lcm] @list;

Task/Catamorphism/Raku/catamorphism-2.raku

@@ -0,0 +1,7 @@
+my @list = 1..10;
+say reduce &infix:<+>, @list;
+say reduce &infix:<*>, @list;
+say reduce &infix:<~>, @list;
+say reduce &infix:<min>, @list;
+say reduce &infix:<max>, @list;
+say reduce &infix:<lcm>, @list;

Task/Catamorphism/Ring/catamorphism.ring

@@ -0,0 +1,34 @@
+n = list(10)
+for i = 1 to 10
+    n[i] = i
+next
+
+see "  +: " + cat(10,"+") + nl+
+    "  -: " + cat(10,"-") + nl +
+    "  *: " + cat(10,"*") + nl +
+    "  /: " + cat(10,"/") + nl+
+    "  ^: " + cat(10,"^") + nl +
+    "min: " + cat(10,"min") + nl+
+    "max: " + cat(10,"max") + nl+
+    "avg: " + cat(10,"avg") + nl +
+    "cat: " + cat(10,"cat") + nl
+
+func cat count,op
+     cat = n[1]
+     cat2 = ""
+     for i = 2 to count
+         switch op
+                on "+" cat +=  n[i]
+                on "-"  cat -=  n[i]
+                on "*" cat *=  n[i]
+                on "/" cat /=  n[i]
+                on "^" cat ^=  n[i]
+                on "max" cat = max(cat,n[i])
+                on "min" cat = min(cat,n[i])
+                on "avg" cat +=  n[i]
+                on "cat" cat2 += string(n[i])
+          off
+     next
+if op = "avg"  cat = cat / count ok
+if op = "cat"  decimals(0) cat = string(n[1])+cat2 ok
+return cat

Task/Catamorphism/Ruby/catamorphism-1.rb

@@ -0,0 +1,4 @@
+# sum:
+p (1..10).inject(:+)
+# smallest number divisible by all numbers from 1 to 20:
+p (1..20).inject(:lcm) #lcm: lowest common multiple