CloudFlare suffered a massive security issue affecting all of its customers, including Rosetta Code. All passwords not changed since February 19th 2017 have been expired, and session cookie longevity will be reduced until late March.--Michael Mol (talk) 05:15, 25 February 2017 (UTC)

Catamorphism

From Rosetta Code
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.


Task

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


Cf.



Ada[edit]

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;
Output:
  1  4 10 24

ALGOL 68[edit]

# 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
Output:
        +15
       +120
        -13

AppleScript[edit]

Translation of: JavaScript


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.

-- 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)
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)
end repeat
return v
end tell
end reduce
 
 
-- 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
 
-- reduceRight :: (a -> b -> a) -> a -> [b] -> a
on reduceRight(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)
end repeat
return v
end tell
end reduceRight
 
 
-- TEST
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
 
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
 
-- 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 lambda : f
end script
end if
end mReturn
 
Output:
{55, 3628800, "10987654321"}

Bracmat[edit]

( ( 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))
);

Output:

15
120

BBC BASIC[edit]

 
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
 
Output:
        15
       -13
       120

C[edit]

#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;
}
Output:
15
-13
120

C++[edit]

#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;
}
Output:
nums_added: 15
nums_other: 30

C#[edit]

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

Clojure[edit]

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

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

Common Lisp[edit]

; 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

D[edit]

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;
}
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[edit]

$ 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
Output:
$ @catamorphism
  RESULT == 15   Hex = 0000000F  Octal = 00000000017
  RESULT == -5   Hex = FFFFFFFB  Octal = 37777777773
  RESULT == 120   Hex = 00000078  Octal = 00000000170

Déjà Vu[edit]

This is a foldl:

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
 
Output:
215
-207

EchoLisp[edit]

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

Elena[edit]

ELENA 3.x :

#import system'collections.
#import system'routines.
#import extensions.
#import extensions'text.
 
program =
[
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 product := numbers accumulate:(Variable new:1) &with:(:a:b) [ a * b ].
 
var concatenation := numbers accumulate:(String new) &with:(:a:b) [ a literal + b literal ].
 
console writeLine:summary:" ":product:" ":concatenation.
].

Elixir[edit]

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"

Erlang[edit]

Translation of: Haskell
 
-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}.
 

Output:

{55,3628800,"12345678910"}

F#[edit]

In the REPL:

> let nums = [1 .. 10];;

val nums : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10]

> let summation = List.fold (+) 0 nums;;

val summation : int = 55

> let product = List.fold (*) 1 nums;;

val product : int = 3628800

> let concatenation = List.foldBack (fun x y -> x + y) (List.map (fun i -> i.ToString()) nums) "";;

val concatenation : string = "12345678910"

Forth[edit]

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:

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

Using normal looping words:

: 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 ;

Briefly, a variation:

: 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 ;

Using dedicated looping words:

: 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 ;

Using higher-order words:

: 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 ;

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.

FreeBASIC[edit]

' 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
 
Output:
Sum is        : 15
Difference is :-13
Product is    : 120
Maximum is    : 5
Minimum is    : 1
No op is      : 0

Go[edit]

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
}
Output:
15
-13
120

Groovy[edit]

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.

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()
})
Output:
28
140
5040
7
84
abcd=10

Haskell[edit]

xs :: [Int]
xs = [1 .. 10]
 
main :: IO ()
main =
mapM_
print
[ show $ foldr (+) 0 xs -- sum
, show $ foldr (*) 1 xs -- product
, foldr ((++) . show) "" xs -- concatenation
]
Output:
55
3628800
12345678910

and the generality of folds is such that if we replace all three of these (function, identity) combinations ((+), 0), ((*), 1) ((++), "") with the Monoid operation mappend (<>) and identity mempty, we can still obtain the same results:

import Data.Monoid
 
reduced
:: (Monoid m)
=> [m] -> m
reduced = foldr (<>) mempty
 
main :: IO ()
main = do
mapM_
print
[getSum $ reduced (Sum <$> xs), getProduct $ reduced (Product <$> xs)]
mapM_
(print . reduced)
[show <$> xs, words "Love is one damned thing after each other"]
where
xs = [1 .. 10]
Output:
55
3628800
"12345678910"
"Loveisonedamnedthingaftereachother"

Also available are foldl1 and foldr1 which 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[edit]

Works in both languages:

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

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[edit]

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

Java[edit]

Works with: Java version 8
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));
}
}
Output:
15
120

JavaScript[edit]

ES5[edit]

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


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

(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]);
Output:
["0 2 4 6 8 10 12 14 16 18 ", 
"18 16 14 12 10 8 6 4 2 0 "]

ES6[edit]

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

jq[edit]

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[edit]

for op in [+, -, *] println(reduce(op, 1:5)) end
Output:
15
-13
120

Kotlin[edit]

// version 1.0.6
 
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 }}")
}
Output:
Array       : 1, 2, 3, 4, 5
Sum         : 15
Difference  : -13
Product     : 120
Minimum     : 1
Maximum     : 5

Logtalk[edit]

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.

 
:- 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.
 
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[edit]

Translation of: C
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
Output:
15
-13
120

Lua[edit]

 
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)))
 
 
Output:
Σ(1..9)   : 	45
5!        : 	120
cat {1..9}: 	123456789

Maple[edit]

The left fold operator in Maple is foldl, and foldr is the right fold operator.

> 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

Compute the horner form of a (sorted) polynomial:

> 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

Mathematica / Wolfram Language[edit]

Fold[f, x, {a, b, c, d}]
Output:
f[f[f[f[x, a], b], c], d]

Maxima[edit]

lreduce(f, [a, b, c, d], x0);
/* (%o1) f(f(f(f(x0, a), b), c), d) */
lreduce("+", [1, 2, 3, 4], 100);
/* (%o1) 110 */

Nemerle[edit]

The Nemerle.Collections namespace defines FoldLeft, FoldRight and Fold (an alias for FoldLeft) on any sequence that implements the IEnumerable[T] interface.

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

Nim[edit]

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)

Oberon-2[edit]

Works with: oo2c Version 2
 
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.
 
Output:
1
-11
-14400

Objeck[edit]

 
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;
}
}

Output

15
120

OCaml[edit]

# 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

Oforth[edit]

reduce is already defined into Collection class :

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

PARI/GP[edit]

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])
Works with: PARI/GP version 2.8.1+
fold((a,b)->a+b, [1..10])

Pascal[edit]

Works with: Free Pascal

Should work with many pascal dialects

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.

output

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

Perl[edit]

Perl's reduce function is in a standard package.

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"

Perl 6[edit]

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.

my @list = 1..10;
say [+] @list;
say [*] @list;
say [~] @list;
say [min] @list;
say [max] @list;
say [lcm] @list;
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:

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;

Phix[edit]

Translation of: C
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))
Output:
15
-13
120

PicoLisp[edit]

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

PowerShell[edit]

'Filter' is a more common sequence function in PowerShell than 'reduce' or 'map', but here is one way to accomplish 'reduce':

 
1..5 | ForEach-Object -Begin {$result = 0} -Process {$result += $_} -End {$result}
 
Output:
15

Prolog[edit]

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

:- 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]).
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[edit]

>>> 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']
>>>

Additional example[edit]

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)


Racket[edit]

 
#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
 

REXX[edit]

This REXX example is modeled after the Perl 6 example   (it is NOT a translation).

/*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)
/*──────────────────────────────────────────────────────────────────────────────────────*/
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
/*──────────────────────────────────────────────────────────────────────────────────────*/
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

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[edit]

 
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
 

Ruby[edit]

The method inject (and it's alias reduce) can be used in several ways; the simplest is to give a methodname as argument:

# sum:
p (1..10).inject(:+)
# smallest number divisible by all numbers from 1 to 20:
p (1..20).inject(:lcm) #lcm: lowest common multiple
 
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.
p row = [1]
10.times{p row = row.each_cons(2).inject([1,1]){|ar,(a,b)| ar.insert(-2, a+b)} }
 
# [1]
# [1, 1]
# [1, 2, 1]
# [1, 3, 3, 1]
# [1, 4, 6, 4, 1]
# [1, 5, 10, 10, 5, 1]
# [1, 6, 15, 20, 15, 6, 1]
# etc
 

Run BASIC[edit]

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
  +:  55
  -:  -53
  *:  3628800
  /:  2.75573205e-7
  ^:  1
min:  1
max:  10
avg:  5.5
cat:  12345678910

Scheme[edit]

Implementation[edit]

reduce implemented for a single list:

 
(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
 

Using SRFI 1[edit]

There is also an implementation of fold and fold-right in SRFI-1, for lists.

These take a two-argument procedure: (lambda (value acc) ...) where value is the next value in the list, and acc is the accumulated value. The initial value is used for the first value of acc.

> (import (srfi 1))
> (fold + 0 '(1 2 3 4 5))
15
> (fold expt 2 '(3 4)) ; => (expt 4 (expt 3 2))
262144
> (fold-right expt 2 '(3 4)) ; => (expt 3 (expt 4 2))
43046721

More than one list may be folded over, when the function is passed one item from each list plus the accumulated value:

> (fold + 0 '(1 2 3) '(4 5 6)) ; add up all the numbers in all the lists
21

Sidef[edit]

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

Standard ML[edit]

- 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

Tcl[edit]

Tcl does not come with a built-in fold command, but it is easy to construct:

proc fold {lambda zero list} {
set accumulator $zero
foreach item $list {
set accumulator [apply $lambda $accumulator $item]
}
return $accumulator
}

Demonstrating:

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]
Output:
15
120
x,1,2,3,4,5

Note that these particular operations would more conventionally be written as:

puts [::tcl::mathop::+ {*}$1to5]
puts [::tcl::mathop::* {*}$1to5]
puts x,[join $1to5 ,]

But those are not general catamorphisms.

Wortel[edit]

You can reduce an array with the !/ operator.

!/ ^+ [1 2 3] ; returns 6

If you want to reduce with an initial value, you'll need the @fold operator.

@fold ^+ 1 [1 2 3] ; returns 7

zkl[edit]

Most sequence objects in zkl have a reduce method.

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)

ZX Spectrum Basic[edit]

Translation of: BBC_BASIC
10 DIM a(5)
20 FOR i=1 TO 5
30 READ a(i)
40 NEXT i
50 DATA 1,2,3,4,5
60 LET o$="+": GO SUB 1000: PRINT tmp
70 LET o$="-": GO SUB 1000: PRINT tmp
80 LET o$="*": GO SUB 1000: PRINT tmp
90 STOP
1000 REM Reduce
1010 LET tmp=a(1)
1020 FOR i=2 TO 5
1030 LET tmp=VAL ("tmp"+o$+"a(i)")
1040 NEXT i
1050 RETURN