Catamorphism: Difference between revisions

From Rosetta Code
Content added Content deleted
mNo edit summary
(Added EchoLisp)
Line 362: Line 362:
<pre>215
<pre>215
-207</pre>
-207</pre>

=={{header|EchoLisp}}==
<lang scheme>
;; 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)
</lang>


=={{header|Elixir}}==
=={{header|Elixir}}==

Revision as of 22:10, 19 March 2016

Task
Catamorphism
You are encouraged to solve this task according to the task description, using any language you may know.

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.

Show how reduce (or foldl or foldr etc), work (or would be implemented) in your language.

Cf.

Ada

<lang Ada>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;</lang>

Output:
  1  4 10 24

ALGOL 68

<lang algol68># applies fn to successive elements of the array of values #

  1. 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 #
  1. 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</lang>

Output:
        +15
       +120
        -13

AppleScript

Iteratively implemented reduce() and reduceRight(), using the same 'callBack' argument sequence as JavaScript. Note that to obtain first-class functions from user-defined AppleScript handlers we have to 'lift' them into script objects.

<lang AppleScript>on run {} 

   set lst to {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}
   
   {reduce(sum_, 0, lst), ¬
       reduce(product_, 1, lst), ¬
       reduceRight(append_, "", lst)}
   
   --> {55, 3628800, "10987654321"}

end run


-- the arguments available to the called function f(a, x, i, l) are -- v: 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) 

   set mf to mReturn(f)
   
   set v to startValue
   set lng to length of xs
   repeat with i from 1 to lng
       set v to mf's lambda(v, item i of xs, i, xs)
   end repeat
   return v

end reduce


-- the arguments available to the called function f(a, x, i, l) are -- v: current accumulator value -- x: current item in list -- 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) 

   set mf to mReturn(f)
   
   set v to startValue
   set lng to length of xs
   repeat with i from lng to 1 by -1
       set v to mf's lambda(v, item i of xs, i, xs)
   end repeat
   return v

end reduceRight


-- An ordinary AppleScript handler function -- lifted into a script which is a first-class object on mReturn(f) 

   if class of f is script then return f
   script
       property lambda : f
   end script

end mReturn

on sum_(a, b) 

   a + b

end sum_

on product_(a, b) 

   a * b

end product_

on append_(a, b) 

   a & b

end append_

</lang>

Output:
{55, 3628800, "10987654321"}

Bracmat

<lang bracmat>( ( 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)) );</lang> Output: 

15
120

BBC BASIC

<lang bbcbasic> 

     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

</lang>

Output:
        15
       -13
       120

C

<lang C>#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;

}</lang>

Output:
15
-13
120

C++

<lang cpp>#include <iostream>

  1. include <numeric>
  2. include <functional>
  3. 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; }</lang>

Output:
nums_added: 15
nums_other: 30

C#

<lang csharp>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);</lang>

Clojure

For more detail, check Rich Hickey's blog post on Reducers.

<lang clojure>; Basic usage > (reduce * '(1 2 3 4 5)) 120

Using an initial value

> (reduce + 100 '(1 2 3 4 5)) 115 </lang>

Common Lisp

<lang lisp>; 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</lang>

D

<lang d>void main() { 

   import std.stdio, std.algorithm, std.range, std.numeric,
          std.conv, std.typecons, std.typetuple;

   auto list = iota(1, 11);
   alias ops = TypeTuple!(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;

}</lang>

Output:
"a + b": 55
"a * b": 3628800
min(T1,T2,T...) if (is(typeof(a < b))): 1
max(T1,T2,T...) if (is(typeof(a < b))): 10
gcd(T): 1
Tuple!(int,double,string)(55, 10, "12345678910")

DCL

<lang DCL>$ 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</lang>

Output:
$ @catamorphism
  RESULT == 15   Hex = 0000000F  Octal = 00000000017
  RESULT == -5   Hex = FFFFFFFB  Octal = 37777777773
  RESULT == 120   Hex = 00000078  Octal = 00000000170

Déjà Vu

This is a foldl: <lang dejavu>reduce f lst init: if lst: f reduce @f lst init pop-from lst else: init

!. reduce @+ [ 1 10 200 ] 4 !. reduce @- [ 1 10 200 ] 4 </lang>

Output:
215
-207

EchoLisp

<lang scheme>

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)

</lang>

Elixir

<lang elixir>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"</lang>

Erlang

Translation of: Haskell

<lang erlang> -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}. </lang>

Output: 

{55,3628800,"12345678910"}

Forth

Forth has three traditions for iterating over the members of a data structure. Under the first, the data structure has words that help you navigate over it and normal Forth looping structures are used. Under the second, the data structure has dedicated looping words and you supply the code that's run for each member. Under the third, the data structure has a loop-over-members word that accepts a function to be run against each member.

There's no need to distinguish between the different kinds of looping ("this one collects function returns into a list; this one threads an accumulator between the function-calls; this one threads two accumulators through the function-calls; this one expects no return values whatsoever from the function-calls") because in Forth all that the looping words have to do is make the data stack available for the function's use. When that's the case, all of these variations, that are so important in other languages, are functionally equivalent.

Although it's possible to have a generic higher-order word that can operate under all kinds of data structures -- this just requires that one settle on an object system and then derive a collections library from it -- this is rarely done. Typically each data structure has its own looping words.

To demonstrate the above points we'll just loop over the bytes of a string.

Some helper words for these examples:

<lang forth>: lowercase? ( c -- f ) 

 [char] a [ char z 1+ ] literal within ;
char-upcase ( c -- C )
 dup lowercase? if bl xor then ;</lang>

Using normal looping words:

<lang forth>: 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 ;</lang>

Briefly, a variation:

<lang forth>: 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 ;</lang>

Using dedicated looping words:

<lang forth>: 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 ;</lang>

Using higher-order words:

<lang forth>: 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 ;</lang>

In these examples COUNT-LOWERCASE updates an accumulator, UPCASE (mostly) modifies the string in-place, and TYPE-LOWERCASE performs side-effects and returns nothing to the higher-order word.

Go

<lang go>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 }</lang>

Output:
15
-13
120

Groovy

Groovy provides an "inject" method for all aggregate classes that performs a classic tail-recursive reduction, driven by a closure argument. The result of each iteration (closure invocation) is used as the accumulated valued for the next iteration. If a first argument is provided as well as a second closure argument, that first argument is used as a seed accumulator for the first iteration. Otherwise, the first element of the aggregate is used as the seed accumulator, with reduction iteration proceeding across elements 2 through n. <lang groovy>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()

})</lang>

Output:
28
140
5040
7
84
abcd=10

Haskell

<lang haskell>nums = [1..10]

summation = foldl (+) 0 nums product = foldl (*) 1 nums concatenation = foldr (\num s -> show num ++ s) "" nums</lang>

There is are also foldl1 and foldr1 available that implicitly take first element as starting value. However they are not safe as they fail on empty lists.

Prelude folds work only on lists, module Data.Foldable a typeclass for more general fold - interface remains the same.

Icon and Unicon

Works in both languages: <lang unicon>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</lang>

Sample runs: 

->cata + 3 1 4 1 5 9
+: 23
->cata - 3 1 4 1 5 9
-: -17
->cata \* 3 1 4 1 5 9
*: 540
->cata "||" 3 1 4 1 5 9
||: 314159

J

Solution:<lang j> /</lang> Example:<lang j> +/ 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</lang>

Java

Works with: Java version 8

<lang java>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));
   }

}</lang>

Output:
15
120

JavaScript

<lang javascript>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);</lang>


Note that the JavaScript Array methods include a right fold ( .reduceRight() ) as well as a left fold:

<lang JavaScript>(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]);</lang>

Output:
["0 2 4 6 8 10 12 14 16 18 ", 
"18 16 14 12 10 8 6 4 2 0 "]

jq

jq has an unusual and unusually powerful "reduce" control structure. A full description is beyond the scope of this short article, but an important point is that "reduce" is stream-oriented. Reduction of arrays is however trivially achieved using the ".[]" filter for converting an array to a stream of its values.

The simplest use of "reduce" can be illustrated by this definition of "factorial": 

def factorial: reduce range(2;.+1) as $i (1; . * $i);

If the input is a non-negative integer, n, this will compute n!.

To understand how this works, consider "3|factorial". The computation starts by setting the implicit state variable to 1; range(2;4) will generate the sequence of values (2,3). The variable $i is set to each value in the stream in turn so that the state variable is multiplied by 2 (". * $i") and then by 3. Notice that since range/2 produces a stream, no array is ever constructed.

For a more complex illustration, see Strand sort.

The "reduce" operator is typically used within a map/reduce framework, but the implicit state variable can be any JSON entity, and so "reduce" is also a general-purpose iterative control structure, the only limitation being that it does not have the equivalent of "break". For that, the "foreach" control structure in recent versions of jq can be used.

Julia

<lang Julia>for op in [+, -, *] println(reduce(op, 1:5)) end</lang>

Output:
15
-13
120

Logtalk

The Logtalk standard library provides implementations of common meta-predicates such as fold left. The example that follow uses Logtalk's native support for lambda expressions to avoid the need for auxiliary predicates. <lang logtalk>

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

</lang>

Output:
| ?- folding_examples::show.
List: [1,2,3,4,5,6,7,8,9,10]
Sum of all elements: 55
Product of all elements: 3628800
Concatenation of all elements: 12345678910
yes

LOLCODE

Translation of: C

<lang LOLCODE>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</lang>

Output:
15
-13
120

Lua

<lang Lua> 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)))

</lang>

Output:
Σ(1..9)   : 	45
5!        : 	120
cat {1..9}: 	123456789

Maple

The left fold operator in Maple is foldl, and foldr is the right fold operator. <lang Maple>> 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</lang>

Compute the horner form of a (sorted) polynomial: <lang Maple>> 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</lang>

Mathematica / Wolfram Language

<lang mathematica>Fold[f, x, {a, b, c, d}]</lang>

Output:
f[f[f[f[x, a], b], c], d]

Maxima

<lang maxima>lreduce(f, [a, b, c, d], x0); /* (%o1) f(f(f(f(x0, a), b), c), d) */</lang>

<lang maxima>lreduce("+", [1, 2, 3, 4], 100); /* (%o1) 110 */</lang>

Nemerle

The Nemerle.Collections namespace defines FoldLeft, FoldRight and Fold (an alias for FoldLeft) on any sequence that implements the IEnumerable[T] interface. <lang Nemerle>def seq = [1, 4, 6, 3, 7]; def sum = seq.Fold(0, _ + _); // Fold takes an initial value and a function, here the + operator</lang>

Nim

<lang nim>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", "rod", "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", "rod", "is", "cool"]
   concatenation = foldr(words, a & b)</lang>

Oberon-2

Works with: oo2c Version 2

<lang oberon2> 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. </lang>

Output:
1
-11
-14400

OCaml

<lang ocaml># 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]

  1. let sum = List.fold_left (+) 0 nums;;

val sum : int = 55

  1. let product = List.fold_left ( * ) 1 nums;;

val product : int = 3628800</lang>

Oforth

reduce is already defined into Collection class :

<lang Oforth>[ 1, 2, 3, 4, 5 ] reduce(#max) [ "abc", "def", "gfi" ] reduce(#+)</lang>

PARI/GP

<lang parigp>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])</lang>

Works with: PARI/GP version 2.8.1+

<lang parigp>fold((a,b)->a+b, [1..10])</lang>

Pascal

Works with: Free Pascal

Should work with many pascal dialects <lang pascal>program reduce;

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.</lang> output 

-5,-4,-3,-2,-1,1,1,2,3,4,5 
1
-11
-1440

Perl

Perl's reduce function is in a standard package. <lang perl>use List::Util 'reduce';

  1. note the use of the odd $a and $b globals

print +(reduce {$a + $b} 1 .. 10), "\n";

  1. 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"</lang>

Perl 6

Works with: Rakudo version 2015.12

Any associative infix operator, either built-in or user-defined, may be turned into a reduce operator by putting it into square brackets (known as "the reduce metaoperator") and using it as a list operator. The operations will work left-to-right or right-to-left automatically depending on the natural associativity of the base operator. <lang perl6>my @list = 1..10; say [+] @list; say [*] @list; say [~] @list; say [min] @list; say [max] @list; say [lcm] @list;</lang>

Output:
55
3628800
12345678910
1
10
2520

In addition to the reduce metaoperator, a general higher-order function, reduce, can apply any appropriate function. Reproducing the above in this form, using the function names of those operators, we have: <lang perl6>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;</lang>

PicoLisp

<lang PicoLisp>(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)</lang>

Prolog

SWI-Prolog has native foldl in version 6.3.1
Module lambda was written by Ulrich Neumerkel and can be found there http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/lambda.pl <lang Prolog>:- use_module(library(lambda)).

% foldl is now a predicate of SWI-Prolog 6.3.1 % 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]).</lang>

Output:
 ?- catamorphism.
Sum of [1,2,3,4,5,6,7,8,9,10] is 55
Prod of [1,2,3,4,5,6,7,8,9,10] is 3628800
Concat of [1,2,3,4,5,6,7,8,9,10] is 12345678910
true.

Python

<lang python>>>> 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'] >>> </lang>

Additional example

<lang python>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)</lang>


Racket

<lang racket>

  1. 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 </lang>

REXX

This REXX example is modeled after the Perl 6 example (it is NOT a translation). <lang rexx>/*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' )

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)

/*──────────────────────────────────────────────────────────────────────────────────────*/ 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*/
     return x

/*──────────────────────────────────────────────────────────────────────────────────────*/ 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*/
                      end   /*k*/
     return x</lang>

output 

list: 1 2 3 4 5 6 7 8 9 10
 sum: 55
prod: 3628800
 cat: 12345678910
 min: 1
 max: 10
 avg: 5.5
 GCD: 1
 LCM: 2520

Ring

<lang ring> n = list(10) for i = 1 to 10 

   n[i] = i

next

see " +: " + cat(10,"+") + nl see " -: " + cat(10,"-") + nl see " *: " + cat(10,"*") + nl see " /: " + cat(10,"/") + nl see " ^: " + cat(10,"^") + nl see "min: " + cat(10,"min") + nl see "max: " + cat(10,"max") + nl see "avg: " + cat(10,"avg") + nl see "cat: " + cat(10,"cat") + nl

func cat count,op 

      cat = n[1]
      cat2 = ""
      for i = 2 to count 
          if op = "+" cat = cat + n[i] ok
          if op = "-"  cat = cat - n[i]  ok
          if op = "*" cat = cat * n[i] ok
          if op = "/" cat = cat / n[i] ok
          if op = "^" cat = cat ^ n[i] ok
          if op = "max" cat = max(cat,n[i]) ok
          if op = "min" cat = min(cat,n[i]) ok
          if op = "avg" cat = cat + n[i] ok
          if op = "cat" cat2 = cat2 + string(n[i]) ok
      next

if op = "avg" cat = cat / count ok if op = "cat" decimals(0) cat = string(n[1])+cat2 ok return cat </lang>

Ruby

The method inject (and it's alias reduce) can be used in several ways; the simplest is to give a methodname as argument: <lang ruby># sum: p (1..10).inject(:+)

  1. smallest number divisible by all numbers from 1 to 20:

p (1..20).inject(:lcm) #lcm: lowest common multiple </lang>The most versatile way uses a accumulator object (memo) and a block. In this example Pascal's triangle is generated by using an array [1,1] and inserting the sum of each consecutive pair of numbers from the previous row. <lang ruby>p row = [1] 10.times{p row = row.each_cons(2).inject([1,1]){|ar,(a,b)| ar.insert(-2, a+b)} }

  1. [1]
  2. [1, 1]
  3. [1, 2, 1]
  4. [1, 3, 3, 1]
  5. [1, 4, 6, 4, 1]
  6. [1, 5, 10, 10, 5, 1]
  7. [1, 6, 15, 20, 15, 6, 1]
  8. etc

</lang>

Run BASIC

<lang runbasic>for i = 1 to 10 :n(i) = i:next i

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") print "cat: ";" ";cat(10,"cat")

function cat(count,op$) cat = n(1) for i = 2 to count 

if op$ = "+" 	then cat = cat + n(i)
if op$ = "-" 	then cat = cat - n(i)
if op$ = "*" 	then cat = cat * n(i) 
if op$ = "/" 	then cat = cat / n(i)
if op$ = "^" 	then cat = cat ^ n(i)
if op$ = "max"	then cat = max(cat,n(i))
if op$ = "min"	then cat = min(cat,n(i))
if op$ = "avg"	then cat = cat + n(i)
if op$ = "cat"	then cat$ = cat$ + str$(n(i))

next i if op$ = "avg" then cat = cat / count if op$ = "cat" then cat = val(str$(n(1))+cat$) end function</lang> 

  +:  55
  -:  -53
  *:  3628800
  /:  2.75573205e-7
  ^:  1
min:  1
max:  10
avg:  5.5
cat:  12345678910

Sidef

<lang ruby>say (1..10 -> reduce('+')); say (1..10 -> reduce{|a,b| a + b});</lang>

Standard ML

<lang sml>- val nums = [1,2,3,4,5,6,7,8,9,10]; val nums = [1,2,3,4,5,6,7,8,9,10] : int list - val sum = foldl op+ 0 nums; val sum = 55 : int - val product = foldl op* 1 nums; val product = 3628800 : int</lang>

Tcl

Tcl does not come with a built-in fold command, but it is easy to construct: <lang tcl>proc fold {lambda zero list} { 

   set accumulator $zero
   foreach item $list {

set accumulator [apply $lambda $accumulator $item] 

   }
   return $accumulator

}</lang> Demonstrating: <lang tcl>set 1to5 {1 2 3 4 5}

puts [fold {{a b} {expr {$a+$b}}} 0 $1to5] puts [fold {{a b} {expr {$a*$b}}} 1 $1to5] puts [fold {{a b} {return $a,$b}} x $1to5]</lang>

Output:
15
120
x,1,2,3,4,5

Note that these particular operations would more conventionally be written as: <lang tcl>puts [::tcl::mathop::+ {*}$1to5] puts [::tcl::mathop::* {*}$1to5] puts x,[join $1to5 ,]</lang> But those are not general catamorphisms.

Wortel

You can reduce an array with the !/ operator. <lang wortel>!/ ^+ [1 2 3] ; returns 6</lang> If you want to reduce with an initial value, you'll need the @fold operator. <lang wortel>@fold ^+ 1 [1 2 3] ; returns 7</lang>

zkl

Most sequence objects in zkl have a reduce method. <lang zkl>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)</lang>

Retrieved from "https://rosettacode.org/wiki/Catamorphism?oldid=219681"