September 2017 Update

Task/Catamorphism/00DESCRIPTION

@@ -5,7 +5,7 @@
 Show how ''reduce'' (or ''foldl'' or ''foldr'' etc), work (or would be implemented) in your language.
 
 
-;Cf.
-* [[wp:Fold (higher-order function)|Fold]]
-* [[wp:Catamorphism|Catamorphism]]
+;See also:
+* Wikipedia article:   [[wp:Fold (higher-order function)|Fold]]
+* Wikipedia article:   [[wp:Catamorphism|Catamorphism]]
 <br><br>

Task/Catamorphism/AppleScript/catamorphism.applescript

@@ -1,21 +1,22 @@
+-- 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
 
--- reduce :: (a -> b -> a) -> a -> [b] -> a
-on reduce(f, startValue, xs)
+-- 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 lambda(v, item i of xs, i, xs)
+            set v to |λ|(v, item i of xs, i, xs)
         end repeat
         return v
     end tell
-end reduce
-
+end foldl
 
 -- the arguments available to the called function f(a, x, i, l) are
 -- a: current accumulator value
@@ -23,45 +24,71 @@ end reduce
 -- i: [ 1-based index in list ] optional
 -- l: [ a reference to the list itself ] optional
 
--- reduceRight :: (a -> b -> a) -> a -> [b] -> a
-on reduceRight(f, startValue, xs)
+-- 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 lambda(v, item i of xs, i, xs)
+            set v to |λ|(v, item i of xs, i, xs)
         end repeat
         return v
     end tell
-end reduceRight
+end foldr
 
 
--- TEST
+-- OTHER FUNCTIONS DEFINED IN TERMS OF FOLDL AND FOLDR ------------
+
+-- concat :: [[a]] -> [a] | [String] -> String
+on concat(xs)
+    script append
+        on |λ|(a, b)
+            a & b
+        end |λ|
+    end script
+
+    if length of xs > 0 and class of (item 1 of xs) is string then
+        set unit to ""
+    else
+        set unit to {}
+    end if
+    foldl(append, unit, 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
+
+-- 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 lst to {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}
+    set xs to {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}
 
-    {reduce(sum_, 0, lst), ¬
-        reduce(product_, 1, lst), ¬
-        reduceRight(append_, "", lst)}
+    {sum(xs), product(xs), concat(xs)}
 
     --> {55, 3628800, "10987654321"}
 end run
 
-on sum_(a, b)
-    a + b
-end sum_
 
-on product_(a, b)
-    a * b
-end product_
-
-on append_(a, b)
-    a & b
-end append_
-
-
-
--- GENERIC
+-- GENERIC FUNCTION -----------------------------------------------
 
 -- Lift 2nd class handler function into 1st class script wrapper
 -- mReturn :: Handler -> Script
@@ -70,7 +97,7 @@ on mReturn(f)
         f
     else
         script
-            property lambda : f
+            property |λ| : f
         end script
     end if
 end mReturn

Task/Catamorphism/D/catamorphism.d

@@ -1,9 +1,9 @@
 void main() {
-    import std.stdio, std.algorithm, std.range, std.numeric,
-           std.conv, std.typecons, std.typetuple;
+    import std.stdio, std.algorithm, std.range, std.meta, std.numeric,
+           std.conv, std.typecons;
 
     auto list = iota(1, 11);
-    alias ops = TypeTuple!(q{a + b}, q{a * b}, min, max, gcd);
+    alias ops = AliasSeq!(q{a + b}, q{a * b}, min, max, gcd);
 
     foreach (op; ops)
         writeln(op.stringof, ": ", list.reduce!op);

Task/Catamorphism/Elena/catamorphism.elena

@@ -1,18 +1,17 @@
-#import system.
-#import system'collections.
-#import system'routines.
-#import extensions.
-#import extensions'text.
+import system'collections.
+import system'routines.
+import extensions.
+import extensions'text.
 
-#symbol program =
+program =
 [
-    #var numbers := 1 repeat &till:10 &each:n [ n ] summarize:(ArrayList new).
+    var numbers := 1 repeat till:10 each(:n)( n ); summarize(ArrayList new).
 
-    #var summary := numbers accumulate:(Variable new:0) &with:(:a:b) [ a + b ].
+    var summary := numbers accumulate(Variable new:0) with(:a:b)( a + b ).
 
-    #var product := numbers accumulate:(Variable new:1) &with:(:a:b) [ a * b ].
+    var product := numbers accumulate(Variable new:1) with(:a:b)( a * b ).
 
-    #var concatenation := numbers accumulate:(String new) &with:(:a:b) [ a literal + b literal ].
+    var concatenation := numbers accumulate(String new) with(:a:b)( a literal + b literal ).
 
-    console writeLine:summary:" ":product:" ":concatenation.
+    console printLine(summary," ",product," ",concatenation).
 ].

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/Haskell/catamorphism.hs

@@ -1,5 +0,0 @@
-nums = [1..10]
-
-summation = foldl (+) 0 nums
-product = foldl (*) 1 nums
-concatenation = foldr (\num s -> show num ++ s) "" nums

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/Phix/catamorphism.phix

@@ -0,0 +1,23 @@
+function add(integer a, integer b)
+    return a + b
+end function
+
+function sub(integer a, integer b)
+    return a - b
+end function
+
+function mul(integer a, integer b)
+    return a * b
+end function
+
+function reduce(integer rid, sequence s)
+object res = s[1]
+    for i=2 to length(s) do
+        res = call_func(rid,{res,s[i]})
+    end for
+    return res
+end function
+
+?reduce(routine_id("add"),tagset(5))
+?reduce(routine_id("sub"),tagset(5))
+?reduce(routine_id("mul"),tagset(5))

Task/Catamorphism/Rust/catamorphism.rust

@@ -0,0 +1,7 @@
+fn main() {
+    println!("Sum: {}", (1..10).fold(0, |acc, n| acc + n));
+    println!("Product: {}", (1..10).fold(1, |acc, n| acc * n));
+    let chars = ['a', 'b', 'c', 'd', 'e'];
+    println!("Concatenation: {}",
+             chars.iter().map(|&c| (c as u8 + 1) as char).collect::<String>());
+}

Task/Catamorphism/Scheme/catamorphism.ss

@@ -0,0 +1,7 @@
+(define (reduce fn init lst)
+  (do ((val init (fn (car rem) val)) ; accumulated value passed as second argument
+       (rem lst (cdr rem)))
+    ((null? rem) val)))
+
+(display (reduce + 0 '(1 2 3 4 5))) (newline) ; => 15
+(display (reduce expt 2 '(3 4))) (newline)    ; => 262144

Task/Catamorphism/Zkl/catamorphism.zkl

@@ -0,0 +1,3 @@
+T("foo","bar").reduce(fcn(p,n){p+n}) //--> "foobar"
+"123four5".reduce(fcn(p,c){p+(c.matches("[0-9]") and c or 0)}, 0) //-->11
+File("foo.zkl").reduce('+(1).fpM("0-"),0) //->5 (lines in file)