Catamorphism: Difference between revisions

21,816 bytes added ,  2 months ago
m
(Add CLU)
 
(28 intermediate revisions by 15 users not shown)
Line 12:
* Wikipedia article:   [[wp:Catamorphism|Catamorphism]]
<br><br>
 
=={{header|11l}}==
<langsyntaxhighlight lang="11l">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))</langsyntaxhighlight>
{{out}}
<pre>
Line 27 ⟶ 26:
=={{header|6502 Assembly}}==
{{works with|https://skilldrick.github.io/easy6502/ Easy6502}}
<langsyntaxhighlight lang="6502asm">define catbuf $10
define catbuf_temp $12
 
Line 71 ⟶ 70:
inx
cpx #$ff
bne clear_ram</langsyntaxhighlight>
 
=={{header|ABAP}}==
This works in ABAP version 7.40 and above.
 
<syntaxhighlight lang="abap">
<lang ABAP>
report z_catamorphism.
 
Line 121 ⟶ 119:
for string in strings
next text = |{ text } { string }| ) }|, /.
</syntaxhighlight>
</lang>
 
{{out}}
Line 135 ⟶ 133:
concatenation(strings) = reduce in ABAP
</pre>
 
=={{header|Ada}}==
 
<langsyntaxhighlight Adalang="ada">with Ada.Text_IO;
 
procedure Catamorphism is
Line 166 ⟶ 163:
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;</langsyntaxhighlight>
 
{{out}}
 
<pre> 1 4 10 24</pre>
 
=={{header|Aime}}==
<langsyntaxhighlight lang="aime">integer s;
 
s = 0;
list(1, 2, 3, 4, 5, 6, 7, 8, 9).ucall(add_i, 1, s);
o_(s, "\n");</langsyntaxhighlight>
{{Out}}
<pre>45</pre>
 
=={{header|ALGOL 68}}==
<langsyntaxhighlight lang="algol68"># 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:
Line 201 ⟶ 196:
; 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</langsyntaxhighlight>
{{out}}
<pre>
Line 208 ⟶ 203:
-13
</pre>
 
=={{header|APL}}==
<em>Reduce</em> is a built-in APL operator, written as <code>/</code>.
 
<langsyntaxhighlight lang="apl"> +/ 1 2 3 4 5 6 7
28
×/ 1 2 3 4 5 6 7
5040</langsyntaxhighlight>
 
For built-in functions, the seed value is automatically chosen to make sense.
 
<langsyntaxhighlight lang="apl"> +/⍬
0
×/⍬
1
⌈/⍬ ⍝ this gives the minimum supported value
¯1.797693135E308</langsyntaxhighlight>
 
For user-supplied functions, the last element in the list is considered the seed.
Line 230 ⟶ 224:
called, and calling <code>F/</code> with the empty list is an error.
 
<langsyntaxhighlight lang="apl"> {⎕←'Input:',⍺,⍵ ⋄ ⍺+⍵}/ 1 2 3 4 5
Input: 4 5
Input: 3 9
Line 239 ⟶ 233:
1
{⎕←'Input:',⍺,⍵ ⋄ ⍺+⍵}/ ⍬
DOMAIN ERROR</langsyntaxhighlight>
 
=={{header|AppleScript}}==
{{Trans|JavaScript}}
Line 248 ⟶ 241:
(Note that to obtain first-class functions from user-defined AppleScript handlers, we have to 'lift' them into script objects).
 
<langsyntaxhighlight AppleScriptlang="applescript">-- CATAMORPHISMS ----------------------------- CATAMORPHISMS ---------------------
 
-- the arguments available to the called function f(a, x, i, l) are
Line 287 ⟶ 280:
 
 
--- OTHER FUNCTIONS DEFINED IN TERMS OF FOLDL AND FOLDR ------------
 
-- concat :: [[a]] -> [a] | [String] -> Stringstring
on concat(xs)
scriptfoldl(my append, "", xs)
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
Line 315 ⟶ 298:
foldr(result, 1, xs)
end product
 
 
-- str :: a -> String
on str(x)
x as string
end str
 
 
-- sum :: Num a => [a] -> a
Line 328 ⟶ 318:
 
 
-- TEST ---------------------------------- 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"}
Line 338 ⟶ 328:
 
 
-- GENERIC FUNCTION ---------------------------- 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
Line 350 ⟶ 361:
end script
end if
end mReturn</langsyntaxhighlight>
{{out}}
<pre>{55, 3628800, "1098765432112345678910"}</pre>
 
=={{header|Arturo}}==
 
<langsyntaxhighlight lang="rebol">; 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</langsyntaxhighlight>
 
{{out}}
Line 366 ⟶ 376:
<pre>10
24</pre>
=={{header|BASIC}}==
==={{header|BASIC256}}===
{{trans|Run BASIC}}
<syntaxhighlight lang="basic256">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</syntaxhighlight>
 
==={{header|Chipmunk Basic}}===
{{trans|Run BASIC}}
{{works with|Chipmunk Basic|3.6.4}}
<syntaxhighlight lang="qbasic">100 DIM n(10)
110 FOR i = 1 TO 10 : n(i) = i : NEXT i
120 SUB cat(cnt,op$)
130 temp = n(1)
140 FOR i = 2 TO cnt
150 IF op$ = "+" THEN temp = temp+n(i)
160 IF op$ = "-" THEN temp = temp-n(i)
170 IF op$ = "*" THEN temp = temp*n(i)
180 IF op$ = "/" THEN temp = temp/n(i)
190 IF op$ = "^" THEN temp = temp^n(i)
200 IF op$ = "max" THEN temp = FN MAX(temp,n(i))
210 IF op$ = "min" THEN temp = FN MIN(temp,n(i))
220 IF op$ = "avg" THEN temp = temp+n(i)
230 IF op$ = "cat" THEN temp$ = temp$+STR$(n(i))
240 NEXT i
250 IF op$ = "avg" THEN temp = temp/cnt
260 IF op$ = "cat" THEN temp = VAL(STR$(n(1))+temp$)
270 cat = temp
280 END SUB
290 '
300 PRINT " +: ";cat(10,"+")
310 PRINT " -: ";cat(10,"-")
320 PRINT " *: ";cat(10,"*")
330 PRINT " /: ";cat(10,"/")
340 PRINT " ^: ";cat(10,"^")
350 PRINT "min: ";cat(10,"min")
360 PRINT "max: ";cat(10,"max")
370 PRINT "avg: ";cat(10,"avg")
380 PRINT "cat: ";cat(10,"cat")
390 END</syntaxhighlight>
 
==={{header|QBasic}}===
{{works with|QBasic|1.1}}
{{trans|Run BASIC}}
<syntaxhighlight lang="qbasic">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")</syntaxhighlight>
 
==={{header|True BASIC}}===
<syntaxhighlight lang="qbasic">SHARE n(10)
FOR i = 1 to 10
LET n(i) = i
NEXT i
 
FUNCTION fnmin(a,b)
IF (a < b) then LET fnmin = a else LET fnmin = b
END FUNCTION
FUNCTION fnmax(a,b)
IF (a < b) then LET fnmax = b else LET fnmax = a
END FUNCTION
 
FUNCTION cat(cont, op$)
LET temp = n(1)
LET temp$ = ""
FOR i = 2 TO cont
IF op$ = "+" then LET temp = temp+n(i)
IF op$ = "-" then LET temp = temp-n(i)
IF op$ = "*" then LET temp = temp*n(i)
IF op$ = "/" then LET temp = temp/n(i)
IF op$ = "^" then LET temp = temp^n(i)
IF op$ = "max" then LET temp = fnmax(temp,n(i))
IF op$ = "min" then LET temp = fnmin(temp,n(i))
IF op$ = "avg" then LET temp = temp+n(i)
IF op$ = "cat" then LET temp$ = temp$ & str$(n(i))
NEXT i
IF op$ = "avg" then
LET temp = temp / cont
END IF
IF op$ = "cat" then
LET t$ = str$(n(1)) & temp$
LET temp = VAL(t$)
END IF
LET 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")
PRINT "cat: "; " "; cat(10, "cat")
END</syntaxhighlight>
 
==={{header|Yabasic}}===
{{trans|Run BASIC}}
<syntaxhighlight lang="freebasic">dim n(10)
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")
end
sub cat(cont,op$)
cat = n(1)
for i = 2 to cont
if op$ = "+" cat = cat + n(i)
if op$ = "-" cat = cat - n(i)
if op$ = "*" cat = cat * n(i)
if op$ = "/" cat = cat / n(i)
if op$ = "^" cat = cat ^ n(i)
if op$ = "max" cat = max(cat,n(i))
if op$ = "min" cat = min(cat,n(i))
if op$ = "avg" cat = cat + n(i)
next i
if op$ = "avg" cat = cat / cont
return cat
end sub</syntaxhighlight>
 
=={{header|BBC BASIC}}==
<langsyntaxhighlight lang="bbcbasic">
DIM a(4)
a() = 1, 2, 3, 4, 5
Line 384 ⟶ 588:
NEXT
= tmp
</syntaxhighlight>
</lang>
 
{{out}}
Line 390 ⟶ 594:
-13
120</pre>
 
=={{header|BCPL}}==
<langsyntaxhighlight lang="bcpl">get "libhdr"
 
let reduce(f, v, len, seed) =
Line 406 ⟶ 609:
writef("%N*N", reduce(add, nums, 7, 0))
writef("%N*N", reduce(mul, nums, 7, 1))
$)</langsyntaxhighlight>
{{out}}
<pre>28
5040</pre>
 
=={{header|Binary Lambda Calculus}}==
 
A minimal size (right) fold in lambda calculus is <code>fold = \f\z (let go = \l.l(\h\t\z.f h (go t))z in go)</code> which corresponds to the 69-bit BLC program
 
<pre>000001000110100000010110000000010111111110111001011111101111101101110</pre>
 
=={{header|BQN}}==
Line 437 ⟶ 646:
⟨ 9 7 12 ⟩</pre>
 
=={{header|Bracmat}}==
<langsyntaxhighlight lang="bracmat">( ( fold
= f xs init first rest
. !arg:(?f.?xs.?init)
Line 456 ⟶ 664:
& (product=a b.!arg:(?a.?b)&!a*!b)
& out$(fold$(product.1 2 3 4 5.1))
);</langsyntaxhighlight>
Output:
<pre>15
120</pre>
 
=={{header|C}}==
<langsyntaxhighlight Clang="c">#include <stdio.h>
 
typedef int (*intFn)(int, int);
Line 485 ⟶ 692:
printf("%d\n", reduce(mul, 5, nums));
return 0;
}</langsyntaxhighlight>
 
{{out}}
Line 491 ⟶ 698:
-13
120</pre>
=={{header|C sharp|C#}}==
 
<syntaxhighlight lang="csharp">var nums = Enumerable.Range(1, 10);
=={{header|C sharp}}==
<lang csharp>var nums = Enumerable.Range(1, 10);
 
int summation = nums.Aggregate((a, b) => a + b);
Line 501 ⟶ 707:
string concatenation = nums.Aggregate(String.Empty, (a, b) => a.ToString() + b.ToString());
 
Console.WriteLine("{0} {1} {2}", summation, product, concatenation);</langsyntaxhighlight>
 
=={{header|C++}}==
<langsyntaxhighlight lang="cpp">#include <iostream>
#include <numeric>
#include <functional>
Line 517 ⟶ 722:
std::cout << "nums_added: " << nums_added << std::endl;
std::cout << "nums_other: " << nums_other << std::endl;
}</langsyntaxhighlight>
 
{{out}}
Line 523 ⟶ 728:
<pre>nums_added: 15
nums_other: 30</pre>
 
=={{header|Clojure}}==
For more detail, check Rich Hickey's [http://clojure.com/blog/2012/05/08/reducers-a-library-and-model-for-collection-processing.html blog post on Reducers].
 
<langsyntaxhighlight lang="clojure">; Basic usage
> (reduce * '(1 2 3 4 5))
120
Line 533 ⟶ 737:
> (reduce + 100 '(1 2 3 4 5))
115
</syntaxhighlight>
</lang>
 
=={{header|CLU}}==
<langsyntaxhighlight lang="clu">% Reduction.
% First type = sequence type (must support S$elements and yield R)
% Second type = right (input) datatype
Line 570 ⟶ 773:
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</langsyntaxhighlight>
{{out}}
<pre>The sum of [1..10] is: 55
The product of [1..10] is: 3628800</pre>
 
=={{header|Common Lisp}}==
<langsyntaxhighlight lang="lisp">; Basic usage
> (reduce #'* '(1 2 3 4 5))
120
Line 593 ⟶ 795:
; Compare with
> (reduce #'expt '(2 3 4))
4096</langsyntaxhighlight>
 
=={{header|D}}==
<langsyntaxhighlight lang="d">void main() {
import std.stdio, std.algorithm, std.range, std.meta, std.numeric,
std.conv, std.typecons;
Line 608 ⟶ 809:
// std.algorithm.reduce supports multiple functions in parallel:
reduce!(ops[0], ops[3], text)(tuple(0, 0.0, ""), list).writeln;
}</langsyntaxhighlight>
{{out}}
<pre>"a + b": 55
Line 616 ⟶ 817:
gcd(T): 1
Tuple!(int,double,string)(55, 10, "12345678910")</pre>
 
=={{header|DCL}}==
<langsyntaxhighlight DCLlang="dcl">$ list = "1,2,3,4,5"
$ call reduce list "+"
$ show symbol result
Line 643 ⟶ 843:
$ result == value
$ exit
$ endsubroutine</langsyntaxhighlight>
{{out}}
<pre>$ @catamorphism
Line 649 ⟶ 849:
RESULT == -5 Hex = FFFFFFFB Octal = 37777777773
RESULT == 120 Hex = 00000078 Octal = 00000000170</pre>
=={{header|Delphi}}==
 
See [https://rosettacode.org/wiki/Catamorphism#Pascal Pascal].
=={{header|Déjà Vu}}==
This is a foldl:
<langsyntaxhighlight lang="dejavu">reduce f lst init:
if lst:
f reduce @f lst init pop-from lst
Line 660 ⟶ 861:
!. reduce @+ [ 1 10 200 ] 4
!. reduce @- [ 1 10 200 ] 4
</syntaxhighlight>
</lang>
{{out}}
<pre>215
-207</pre>
=={{header|Delphi}}==
See [https://rosettacode.org/wiki/Catamorphism#Pascal Pascal].
 
=={{header|EchoLisp}}==
<langsyntaxhighlight lang="scheme">
;; rem : the foldX family always need an initial value
;; fold left a list
Line 688 ⟶ 886:
(scanl * 1 '( 1 2 3 4 5))
→ (1 1 2 6 24 120)
</syntaxhighlight>
</lang>
 
=={{header|Elena}}==
ELENA 5.0 :
<langsyntaxhighlight lang="elena">import system'collections;
import system'routines;
import extensions;
Line 708 ⟶ 905:
console.printLine(summary," ",product," ",concatenation)
}</langsyntaxhighlight>
{{out}}
<pre>
55 362880 12345678910
</pre>
 
=={{header|Elixir}}==
<langsyntaxhighlight 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"</langsyntaxhighlight>
 
=={{header|Erlang}}==
{{trans|Haskell}}
 
<langsyntaxhighlight lang="erlang">
-module(catamorphism).
 
Line 742 ⟶ 937:
Nums),
{Summation, Product, Concatenation}.
</syntaxhighlight>
</lang>
 
Output:
Line 748 ⟶ 943:
{55,3628800,"12345678910"}
</pre>
 
=={{header|Excel}}==
===LAMBDA===
Line 779 ⟶ 973:
 
{{Works with|Office 365 betas 2021}}
<langsyntaxhighlight lang="lisp">FOLDROW
=LAMBDA(op,
LAMBDA(a,
Line 862 ⟶ 1,056:
1
)
)</langsyntaxhighlight>
 
{{Out}}
Line 968 ⟶ 1,162:
| ][ [[[ [ ]]] [[[ ]]] [[[ [] ]]] ]
|}
 
=={{header|F_Sharp|F#}}==
<p>In the REPL:</p>
Line 988 ⟶ 1,181:
val concatenation : string = "12345678910"
</pre>
 
=={{header|Factor}}==
 
<langsyntaxhighlight lang="factor">{ 1 2 4 6 10 } 0 [ + ] reduce .</langsyntaxhighlight>
{{out}}
<pre>
23
</pre>
 
=={{header|Forth}}==
Forth has three traditions for iterating over the members of a data
Line 1,027 ⟶ 1,218:
Some helper words for these examples:
 
<langsyntaxhighlight lang="forth">: lowercase? ( c -- f )
[char] a [ char z 1+ ] literal within ;
 
: char-upcase ( c -- C )
dup lowercase? if bl xor then ;</langsyntaxhighlight>
 
Using normal looping words:
 
<langsyntaxhighlight lang="forth">: string-at ( c-addr u +n -- c )
nip + c@ ;
: string-at! ( c-addr u +n c -- )
Line 1,053 ⟶ 1,244:
0 -rot dup 0 ?do
2dup i string-at lowercase? if rot 1+ -rot then
loop 2drop ;</langsyntaxhighlight>
 
Briefly, a variation:
 
<langsyntaxhighlight 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 ;
Line 1,064 ⟶ 1,255:
begin next-char while
dup lowercase? if emit else drop then
repeat ;</langsyntaxhighlight>
 
Using dedicated looping words:
 
<langsyntaxhighlight lang="forth">: each-char[ ( c-addr u -- )
postpone BOUNDS postpone ?DO
postpone I postpone C@ ; immediate
Line 1,084 ⟶ 1,275:
 
: count-lowercase ( c-addr u -- n )
0 -rot each-char[ lowercase? if 1+ then ]each-char ;</langsyntaxhighlight>
 
Using higher-order words:
 
<langsyntaxhighlight lang="forth">: each-char ( c-addr u xt -- )
{: xt :} bounds ?do
i c@ xt execute
Line 1,104 ⟶ 1,295:
 
: count-lowercase ( c-addr u -- n )
0 -rot [: lowercase? if 1+ then ;] each-char ;</langsyntaxhighlight>
 
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.
 
=={{header|Fortran}}==
If Fortran were to offer the ability to pass a parameter "by name", as is used in [[Jensen's_Device#Fortran|Jensen's device]], then the code might be something like <langsyntaxhighlight Fortranlang="fortran"> SUBROUTINE FOLD(t,F,i,ist,lst)
INTEGER t
BYNAME F
Line 1,119 ⟶ 1,309:
END SUBROUTINE FOLD !Result in temp.
 
temp = a(1); CALL FOLD(temp,temp*a(i),i,2,N)</langsyntaxhighlight>
Here, the function manifests as the expression that is the second parameter of subroutine FOLD, and the "by name" protocol for parameter F means that within the subroutine whenever there is a reference to F, its value is evaluated afresh in the caller's environment using the current values of ''temp'' and ''i'' as modified by the subroutine - they being passed by reference so that changes within the subroutine affect the originals. An evaluation for a different function requires merely another statement with a different expression.
 
Line 1,128 ⟶ 1,318:
However, only programmer diligence in devising functions with the correct type of result and the correct type and number of parameters will evade mishaps. Note that the EXTERNAL statement does not specify the number or type of parameters. If the function is invoked multiple times within a subroutine, the compiler may check for consistency. This may cause trouble when [[Leonardo_numbers#Fortran|some parameters are optional]] so that different invocations do not match.
 
The function's name is used as a working variable within the function (as well as it holding the function's value on exit) so that the expression <code>F(IFOLD,A(I))</code> is ''not'' a recursive invocation of function <code>IFOLD</code> because there are no (parameters) appended to the function's name. Earlier compilers did not allow such usage so that a separate working variable would be required. <langsyntaxhighlight Fortranlang="fortran"> INTEGER FUNCTION IFOLD(F,A,N) !"Catamorphism"...
INTEGER F !We're working only with integers.
EXTERNAL F !This is a function, not an array.
Line 1,181 ⟶ 1,371:
WRITE (MSG,*) "Ivid",IFOLD(IVID,A,ENUFF)
END PROGRAM POKE
</syntaxhighlight>
</lang>
Output:
<pre>
Line 1,191 ⟶ 1,381:
Ivid 6
</pre>
 
=={{header|FreeBASIC}}==
<langsyntaxhighlight lang="freebasic">' FB 1.05.0 Win64
 
Type IntFunc As Function(As Integer, As Integer) As Integer
Line 1,237 ⟶ 1,426:
Print "Press any key to quit"
Sleep
</syntaxhighlight>
</lang>
 
{{out}}
Line 1,248 ⟶ 1,437:
No op is : 0
</pre>
 
=={{header|Go}}==
<langsyntaxhighlight lang="go">package main
 
import (
Line 1,274 ⟶ 1,462:
}
return r
}</langsyntaxhighlight>
{{out}}
<pre>
Line 1,281 ⟶ 1,469:
120
</pre>
 
=={{header|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.
<langsyntaxhighlight 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]
Line 1,296 ⟶ 1,483:
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()
})</langsyntaxhighlight>
 
{{out}}
Line 1,305 ⟶ 1,492:
84
abcd=10</pre>
 
=={{header|Haskell}}==
<langsyntaxhighlight lang="haskell">main :: IO ()
main =
putStrLn . unlines $
Line 1,314 ⟶ 1,500:
, foldr ((++) . show) "" -- concatenation
] <*>
[[1 .. 10]]</langsyntaxhighlight>
{{Out}}
<pre>55
Line 1,322 ⟶ 1,508:
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:
 
<langsyntaxhighlight lang="haskell">import Data.Monoid
 
main :: IO ()
Line 1,333 ⟶ 1,519:
, (show . foldr (<>) mempty) (words
"Love is one damned thing after each other")
]</langsyntaxhighlight>
{{Out}}
<pre>55
Line 1,343 ⟶ 1,529:
 
''Prelude'' folds work only on lists, module ''Data.Foldable'' a typeclass for more general fold - interface remains the same.
 
=={{header|Icon}} and {{header|Unicon}}==
 
Works in both languages:
<langsyntaxhighlight lang="unicon">procedure main(A)
write(A[1],": ",curry(A[1],A[2:0]))
end
Line 1,355 ⟶ 1,540:
every r := f(r, !A[2:0])
return r
end</langsyntaxhighlight>
 
Sample runs:
Line 1,368 ⟶ 1,553:
||: 314159
</pre>
 
=={{header|J}}==
'''Solution''':<syntaxhighlight lang ="j"> /</langsyntaxhighlight>
'''Example''':<langsyntaxhighlight 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</langsyntaxhighlight>
Insert * into 1 2 3 4 5
becomes
1 * 2 * 3 * 4 * 5
evaluated right to left<langsyntaxhighlight lang="j">
1 * 2 * 3 * 20
1 * 2 * 60
1 * 120
120
</syntaxhighlight>
</lang>
What are the implications for -/ ?
For %/ ?
 
=={{header|Java}}==
{{works with|Java|8}}
<langsyntaxhighlight lang="java">import java.util.stream.Stream;
 
public class ReduceTask {
Line 1,399 ⟶ 1,582:
System.out.println(Stream.of(1, 2, 3, 4, 5).reduce(1, (a, b) -> a * b));
}
}</langsyntaxhighlight>
 
{{out}}
<pre>15
120</pre>
 
=={{header|JavaScript}}==
 
===ES5===
 
<langsyntaxhighlight lang="javascript">var nums = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10];
 
function add(a, b) {
Line 1,425 ⟶ 1,607:
var concatenation = nums.reduce(add, "");
 
console.log(summation, product, concatenation);</langsyntaxhighlight>
 
 
Note that the JavaScript Array methods include a right fold ( '''.reduceRight()''' ) as well as a left fold:
 
<langsyntaxhighlight JavaScriptlang="javascript">(function (xs) {
'use strict';
 
Line 1,450 ⟶ 1,632:
});
 
})([0, 1, 2, 3, 4, 5, 6, 7, 8, 9]);</langsyntaxhighlight>
 
{{Out}}
Line 1,459 ⟶ 1,641:
===ES6===
 
<langsyntaxhighlight lang="javascript">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</langsyntaxhighlight>
 
=={{header|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.
Line 1,479 ⟶ 1,660:
 
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.
 
=={{header|Julia}}==
{{Works with|Julia 1.2}}
<langsyntaxhighlight Julialang="julia">println([reduce(op, 1:5) for op in [+, -, *]])
println([foldl(op, 1:5) for op in [+, -, *]])
println([foldr(op, 1:5) for op in [+, -, *]])</langsyntaxhighlight>
{{out}}
<pre>[15, -13, 120]
Line 1,491 ⟶ 1,671:
 
=={{header|Kotlin}}==
<langsyntaxhighlight lang="scala">fun main(args: Array<String>) {
val a = intArrayOf(1, 2, 3, 4, 5)
println("Array : ${a.joinToString(", ")}")
Line 1,499 ⟶ 1,679:
println("Minimum : ${a.reduce { x, y -> if (x < y) x else y }}")
println("Maximum : ${a.reduce { x, y -> if (x > y) x else y }}")
}</langsyntaxhighlight>
 
{{out}}
Line 1,510 ⟶ 1,690:
Maximum : 5
</pre>
 
=={{header|Lambdatalk}}==
<syntaxhighlight lang="scheme">
{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
</syntaxhighlight>
 
=={{header|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.
<langsyntaxhighlight lang="logtalk">
:- object(folding_examples).
 
Line 1,528 ⟶ 1,724:
 
:- end_object.
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,538 ⟶ 1,734:
yes
</pre>
 
=={{header|LOLCODE}}==
 
{{trans|C}}
 
<langsyntaxhighlight LOLCODElang="lolcode">HAI 1.3
 
HOW IZ I reducin YR array AN YR size AN YR fn
Line 1,569 ⟶ 1,764:
VISIBLE I IZ reducin YR array AN YR 5 AN YR mul MKAY
 
KTHXBYE</langsyntaxhighlight>
 
{{out}}
Line 1,575 ⟶ 1,770:
-13
120</pre>
 
=={{header|Lua}}==
<syntaxhighlight lang="lua">
<lang Lua>
table.unpack = table.unpack or unpack -- 5.1 compatibility
local nums = {1,2,3,4,5,6,7,8,9}
Line 1,608 ⟶ 1,802:
print("cat {1..9}: ",reduce(cat,table.unpack(nums)))
 
</syntaxhighlight>
</lang>
 
{{out}}
Line 1,616 ⟶ 1,810:
cat {1..9}: 123456789
</pre>
 
=={{header|M2000 Interpreter}}==
<syntaxhighlight lang="m2000 interpreter">
<lang M2000 Interpreter>
Module CheckIt {
Function Reduce (a, f) {
Line 1,639 ⟶ 1,832:
}
CheckIt
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,652 ⟶ 1,845:
=={{header|Maple}}==
The left fold operator in Maple is foldl, and foldr is the right fold operator.
<langsyntaxhighlight Maplelang="maple">> nums := seq( 1 .. 10 );
nums := 1, 2, 3, 4, 5, 6, 7, 8, 9, 10
 
Line 1,659 ⟶ 1,852:
 
> foldr( `*`, 1, nums ); # compute product using foldr
3628800</langsyntaxhighlight>
Compute the horner form of a (sorted) polynomial:
<langsyntaxhighlight Maplelang="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</langsyntaxhighlight>
 
=={{header|Mathematica}} / {{header|Wolfram Language}}==
<langsyntaxhighlight lang="mathematica">Fold[f, x, {a, b, c, d}]</langsyntaxhighlight>
{{Out}}
<pre>f[f[f[f[x, a], b], c], d]</pre>
 
=={{header|Maxima}}==
<langsyntaxhighlight lang="maxima">lreduce(f, [a, b, c, d], x0);
/* (%o1) f(f(f(f(x0, a), b), c), d) */</langsyntaxhighlight>
 
<lang maxima>lreduce("+", [1, 2, 3, 4], 100);
/* (%o1) 110 */</lang>
 
<syntaxhighlight lang="maxima">lreduce("+", [1, 2, 3, 4], 100);
/* (%o1) 110 */</syntaxhighlight>
=={{header|min}}==
{{works with|min|0.19.3}}
<langsyntaxhighlight lang="min">(1 2 3 4) 0 '+ reduce puts! ; sum
(1 2 3 4) 1 '* reduce puts! ; product</langsyntaxhighlight>
{{out}}
<pre>
Line 1,685 ⟶ 1,875:
24
</pre>
 
=={{header|Modula-2}}==
<langsyntaxhighlight lang="modula2">MODULE Catamorphism;
FROM InOut IMPORT WriteString, WriteCard, WriteLn;
 
Line 1,726 ⟶ 1,915:
 
BEGIN Demonstration;
END Catamorphism.</langsyntaxhighlight>
{{out}}
<pre>Sum of [1..5]: 15
Product of [1..5]: 120</pre>
 
=={{header|Nemerle}}==
The <tt>Nemerle.Collections</tt> namespace defines <tt>FoldLeft</tt>, <tt>FoldRight</tt> and <tt>Fold</tt> (an alias for <tt>FoldLeft</tt>) on any sequence that implements the <tt>IEnumerable[T]</tt> interface.
<langsyntaxhighlight Nemerlelang="nemerle">def seq = [1, 4, 6, 3, 7];
def sum = seq.Fold(0, _ + _); // Fold takes an initial value and a function, here the + operator</langsyntaxhighlight>
 
=={{header|Nim}}==
<langsyntaxhighlight lang="nim">import sequtils
 
block:
Line 1,755 ⟶ 1,942:
multiplication = foldr(numbers, a * b)
words = @["nim", "is", "cool"]
concatenation = foldr(words, a & b)</langsyntaxhighlight>
 
=={{header|Oberon-2}}==
{{Works with| oo2c Version 2}}
<langsyntaxhighlight lang="oberon2">
MODULE Catamorphism;
IMPORT
Line 1,832 ⟶ 2,018:
END
END Catamorphism.
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,839 ⟶ 2,025:
-14400
</pre>
 
=={{header|Objeck}}==
<langsyntaxhighlight lang="objeck">
use Collection;
 
Line 1,858 ⟶ 2,043:
return a * b;
}
}</langsyntaxhighlight>
Output
<pre>
Line 1,864 ⟶ 2,049:
120
</pre>
 
=={{header|OCaml}}==
<langsyntaxhighlight 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]
# let sum = List.fold_left (+) 0 nums;;
val sum : int = 55
# let product = List.fold_left ( * ) 1 nums;;
val product : int = 3628800</langsyntaxhighlight>
 
=={{header|Oforth}}==
reduce is already defined into Collection class :
 
<langsyntaxhighlight Oforthlang="oforth">[ 1, 2, 3, 4, 5 ] reduce(#max)
[ "abc", "def", "gfi" ] reduce(#+)</langsyntaxhighlight>
 
=={{header|PARI/GP}}==
<langsyntaxhighlight 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])</langsyntaxhighlight>
 
{{works with|PARI/GP|2.8.1+}}
<langsyntaxhighlight lang="parigp">fold((a,b)->a+b, [1..10])</langsyntaxhighlight>
 
=={{header|Pascal}}==
{{works with|Free Pascal}}
Should work with many pascal dialects
<langsyntaxhighlight lang="pascal">program reduceApp;
 
type
Line 1,945 ⟶ 2,126:
writeln(reduce(@sub,ma));
writeln(reduce(@mul,ma));
END.</langsyntaxhighlight>
output
<pre>-5,-4,-3,-2,-1,1,1,2,3,4,5
Line 1,951 ⟶ 2,132:
-11
-1440</pre>
 
=={{header|Perl}}==
Perl's reduce function is in a standard package.
<langsyntaxhighlight lang="perl">use List::Util 'reduce';
 
# note the use of the odd $a and $b globals
Line 1,961 ⟶ 2,141:
# 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"</langsyntaxhighlight>
 
=={{header|Phix}}==
{{trans|C}}
<!--<syntaxhighlight lang="phix">(phixonline)-->
<lang Phix>function add(integer a, integer b)
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
return a + b
<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>
end function
<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>
function sub(integer a, integer b)
return a - b
<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>
end function
<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>
function mul(integer a, integer b)
<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>
return a * b
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
end function
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
 
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
function reduce(integer rid, sequence s)
object res = s[1]
<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>
for i=2 to length(s) do
<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>
res = call_func(rid,{res,s[i]})
<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>
end for
<!--</syntaxhighlight>-->
return res
end function
 
?reduce(routine_id("add"),tagset(5))
?reduce(routine_id("sub"),tagset(5))
?reduce(routine_id("mul"),tagset(5))</lang>
{{out}}
<pre>
Line 1,994 ⟶ 2,168:
120
</pre>
 
=={{header|Phixmonti}}==
<langsyntaxhighlight Phixmontilang="phixmonti">include ..\Utilitys.pmt
 
def add + enddef
Line 2,015 ⟶ 2,188:
getid add reduce ?
getid sub reduce ?
getid mul reduce ?</langsyntaxhighlight>
 
 
=={{header|PicoLisp}}==
<langsyntaxhighlight PicoLisplang="picolisp">(de reduce ("Fun" "Lst")
(let "A" (car "Lst")
(for "N" (cdr "Lst")
Line 2,029 ⟶ 2,200:
(reduce * (1 2 3 4 5)) )
(bye)</langsyntaxhighlight>
 
=={{header|PowerShell}}==
'Filter' is a more common sequence function in PowerShell than 'reduce' or 'map', but here is one way to accomplish 'reduce':
<syntaxhighlight lang="powershell">
<lang PowerShell>
1..5 | ForEach-Object -Begin {$result = 0} -Process {$result += $_} -End {$result}
</syntaxhighlight>
</lang>
{{Out}}
<pre>
15
</pre>
 
=={{header|Prolog}}==
 
Line 2,048 ⟶ 2,217:
* '''Ulrich Neumerkel''' wrote `library(lambda)` which can be found [http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/lambda.pl here]. (However, SWI-Prolog's Lambda Expressions are by default based on Paulo Moura's [https://www.swi-prolog.org/search?for=yall library(yall)])
 
<langsyntaxhighlight Prologlang="prolog">:- use_module(library(lambda)).
 
catamorphism :-
Line 2,059 ⟶ 2,228:
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]).</langsyntaxhighlight>
{{out}}
<pre> ?- catamorphism.
Line 2,075 ⟶ 2,244:
* The list is terminated by the special atomic thing <code>[]</code> (the empty list)
 
<syntaxhighlight lang="prolog">
<lang Prolog>
% List to be folded:
%
Line 2,082 ⟶ 2,251:
% a b c d <-- list items/entries/elements/members
%
</syntaxhighlight>
</lang>
 
====linear <code>foldl</code>====
 
<syntaxhighlight lang="prolog">
<lang Prolog>
% Computes "Out" as:
%
Line 2,101 ⟶ 2,270:
foldl(_,[],Acc,Result) :- % case of empty list
Acc=Result. % unification not in head for clarity
</syntaxhighlight>
</lang>
 
====linear <code>foldr</code>====
 
<syntaxhighlight lang="prolog">
<lang Prolog>
% Computes "Out" as:
%
Line 2,119 ⟶ 2,288:
foldr(_,[],Starter,AccUp) :- % empty list: bounce Starter "upwards" into AccUp
AccUp=Starter. % unification not in head for clarity
</syntaxhighlight>
</lang>
 
====Unit tests====
Line 2,127 ⟶ 2,296:
Functions (in predicate form) of interest for our test cases:
 
<syntaxhighlight lang="prolog">
<lang Prolog>
:- use_module(library(clpfd)). % We are using #= instead of the raw "is".
 
Line 2,156 ⟶ 2,325:
foldy_expr(Functor,Item,ThreadIn,ThreadOut) :-
ThreadOut =.. [Functor,Item,ThreadIn].
</syntaxhighlight>
</lang>
 
<syntaxhighlight lang="prolog">
<lang Prolog>
:- begin_tests(foldr).
 
Line 2,211 ⟶ 2,380:
 
rt :- run_tests(foldr),run_tests(foldl).
</syntaxhighlight>
</lang>
 
=={{header|PureBasic}}==
<langsyntaxhighlight PureBasiclang="purebasic">Procedure.i reduce(List l(),op$="+")
If FirstElement(l())
x=l()
Line 2,233 ⟶ 2,401:
Debug reduce(fold())
Debug reduce(fold(),"-")
Debug reduce(fold(),"*")</langsyntaxhighlight>
{{out}}
<pre>15
-13
120</pre>
 
=={{header|Python}}==
<langsyntaxhighlight lang="python">>>> # Python 2.X
>>> from operator import add
>>> listoflists = [['the', 'cat'], ['sat', 'on'], ['the', 'mat']]
Line 2,258 ⟶ 2,425:
>>> reduce(add, listoflists, [])
['the', 'cat', 'sat', 'on', 'the', 'mat']
>>> </langsyntaxhighlight>
===Additional example===
<langsyntaxhighlight lang="python"># Python 3.X
 
from functools import reduce
Line 2,273 ⟶ 2,440:
concatenation = reduce(lambda a, b: str(a) + str(b), nums)
 
print(summation, product, concatenation)</langsyntaxhighlight>
 
=={{header|Quackery}}==
Among its many other uses, <code>witheach</code> can act like reduce. In the Quackery shell (REPL):
<langsyntaxhighlight lang="quackery">/O> 0 ' [ 1 2 3 4 5 ] witheach +
... 1 ' [ 1 2 3 4 5 ] witheach *
...
 
Stack: 15 120</langsyntaxhighlight>
 
=={{header|R}}==
 
Sum the numbers in a vector:
 
<syntaxhighlight lang="r">
<lang R>
Reduce('+', c(2,30,400,5000))
5432
</syntaxhighlight>
</lang>
 
Put a 0 between each pair of numbers:
 
<syntaxhighlight lang="r">
<lang R>
Reduce(function(a,b){c(a,0,b)}, c(2,3,4,5))
2 0 3 0 4 0 5
</syntaxhighlight>
</lang>
 
Generate all prefixes of a string:
 
<syntaxhighlight lang="r">
<lang R>
Reduce(paste0, unlist(strsplit("freedom", NULL)), accum=T)
"f" "fr" "fre" "free" "freed" "freedo" "freedom"
</syntaxhighlight>
</lang>
 
Filter and map:
 
<syntaxhighlight lang="r">
<lang R>
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
</syntaxhighlight>
</lang>
 
=={{header|Racket}}==
<langsyntaxhighlight lang="racket">
#lang racket
(define (fold f xs init)
Line 2,324 ⟶ 2,488:
 
(fold + '(1 2 3) 0) ; the result is 6
</syntaxhighlight>
</lang>
 
=={{header|Raku}}==
(formerly Perl 6)
{{works with|Rakudo|2018.03}}
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.
<syntaxhighlight lang="raku" perl6line>my @list = 1..10;
say [+] @list;
say [*] @list;
Line 2,336 ⟶ 2,499:
say min @list;
say max @list;
say [lcm] @list;</langsyntaxhighlight>
{{out}}
<pre>55
Line 2,345 ⟶ 2,508:
2520</pre>
In addition to the reduce metaoperator, a general higher-order function, <tt>reduce</tt>, can apply any appropriate function. Reproducing the above in this form, using the function names of those operators, we have:
<syntaxhighlight lang="raku" perl6line>my @list = 1..10;
say reduce &infix:<+>, @list;
say reduce &infix:<*>, @list;
Line 2,351 ⟶ 2,514:
say reduce &infix:<min>, @list;
say reduce &infix:<max>, @list;
say reduce &infix:<lcm>, @list;</langsyntaxhighlight>
=={{header|Refal}}==
<syntaxhighlight lang="refal">$ENTRY Go {
, 1 2 3 4 5 6 7: e.List
= <Prout <Reduce Add e.List>>
<Prout <Reduce Mul e.List>>;
};
 
Reduce {
s.F t.I = t.I;
s.F t.I t.J e.X = <Reduce s.F <Mu s.F t.I t.J> e.X>;
};</syntaxhighlight>
{{out}}
<pre>28
5040</pre>
 
=={{header|REXX}}==
Line 2,359 ⟶ 2,536:
aren't a catamorphism, as they don't produce or reduce the values to a &nbsp; ''single'' &nbsp; value, but
are included here to help display the values in the list.
<langsyntaxhighlight 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 'list:' fold(@list, "list")
Line 2,397 ⟶ 2,574:
x= x*! / GCD(x, !) /*GCD does the heavy work*/
end /*k*/
return x</langsyntaxhighlight>
{{out|output|:}}
<pre>
Line 2,412 ⟶ 2,589:
 
=={{header|Ring}}==
<langsyntaxhighlight lang="ring">
n = list(10)
for i = 1 to 10
Line 2,447 ⟶ 2,624:
if op = "cat" decimals(0) cat = string(n[1])+cat2 ok
return cat
</syntaxhighlight>
</lang>
=={{header|RPL}}==
≪ → array op
≪ array 1 GET 2
'''WHILE''' DUP array SIZE ≤ '''REPEAT'''
array OVER GET ROT SWAP op EVAL
SWAP 1 +
'''END''' DROP
≫ ≫ '<span style="color:blue">REDUCE</span>' STO
 
[ 1 2 3 4 5 6 7 8 9 10 ] ≪ + ≫ <span style="color:blue">REDUCE</span>
[ 1 2 3 4 5 6 7 8 9 10 ] ≪ - ≫ <span style="color:blue">REDUCE</span>
[ 1 2 3 4 5 6 7 8 9 10 ] ≪ * ≫ <span style="color:blue">REDUCE</span>
[ 1 2 3 4 5 6 7 8 9 10 ] ≪ MAX ≫ <span style="color:blue">REDUCE</span>
[ 1 2 3 4 5 6 7 8 9 10 ] ≪ SQ + ≫ <span style="color:blue">REDUCE</span>
{{out}}
<pre>
5: 55
4: -53
3: 3628800
2: 10
1: 385
</pre>
From HP-48G models, a built-in function named <code>STREAM</code> performs exactly the same as the above <code>REDUCE</code> one, but only with lists.
 
=={{header|Ruby}}==
The method inject (and it's alias reduce) can be used in several ways; the simplest is to give a methodname as argument:
<langsyntaxhighlight lang="ruby"># sum:
p (1..10).inject(:+)
# smallest number divisible by all numbers from 1 to 20:
p (1..20).inject(:lcm) #lcm: lowest common multiple
</langsyntaxhighlight>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.
<langsyntaxhighlight lang="ruby">p row = [1]
10.times{p row = row.each_cons(2).inject([1,1]){|ar,(a,b)| ar.insert(-2, a+b)} }
 
Line 2,467 ⟶ 2,667:
# [1, 6, 15, 20, 15, 6, 1]
# etc
</syntaxhighlight>
</lang>
 
=={{header|Run BASIC}}==
<langsyntaxhighlight lang="runbasic">for i = 1 to 10 :n(i) = i:next i
 
print " +: ";" ";cat(10,"+")
Line 2,497 ⟶ 2,697:
if op$ = "avg" then cat = cat / count
if op$ = "cat" then cat = val(str$(n(1))+cat$)
end function</langsyntaxhighlight>
<pre> +: 55
-: -53
Line 2,507 ⟶ 2,707:
avg: 5.5
cat: 12345678910</pre>
 
=={{header|Rust}}==
 
<langsyntaxhighlight lang="rust">fn main() {
println!("Sum: {}", (1..10).fold(0, |acc, n| acc + n));
println!("Product: {}", (1..10).fold(1, |acc, n| acc * n));
Line 2,516 ⟶ 2,715:
println!("Concatenation: {}",
chars.iter().map(|&c| (c as u8 + 1) as char).collect::<String>());
}</langsyntaxhighlight>
 
{{out}}
Line 2,524 ⟶ 2,723:
Concatenation: bcdef
</pre>
 
=={{header|Scala}}==
<langsyntaxhighlight lang="scala">object Main extends App {
val a = Seq(1, 2, 3, 4, 5)
println(s"Array : ${a.mkString(", ")}")
Line 2,534 ⟶ 2,732:
println(s"Minimum : ${a.min}")
println(s"Maximum : ${a.max}")
}</langsyntaxhighlight>
 
=={{header|Scheme}}==
===Implementation===
reduce implemented for a single list:
<langsyntaxhighlight lang="scheme">(define (reduce fn init lst)
(do ((val init (fn (car rem) val)) ; accumulated value passed as second argument
(rem lst (cdr rem)))
Line 2,545 ⟶ 2,742:
 
(display (reduce + 0 '(1 2 3 4 5))) (newline) ; => 15
(display (reduce expt 2 '(3 4))) (newline) ; => 262144</langsyntaxhighlight>
===Using SRFI 1===
There is also an implementation of fold and fold-right in SRFI-1, for lists.
Line 2,567 ⟶ 2,764:
21
</pre>
 
=={{header|Sidef}}==
<langsyntaxhighlight lang="ruby">say (1..10 -> reduce('+'));
say (1..10 -> reduce{|a,b| a + b});</langsyntaxhighlight>
 
=={{header|Standard ML}}==
<langsyntaxhighlight 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</langsyntaxhighlight>
 
=={{header|Swift}}==
<langsyntaxhighlight lang="swift">let nums = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
 
print(nums.reduce(0, +))
print(nums.reduce(1, *))
print(nums.reduce("", { $0 + String($1) }))</langsyntaxhighlight>
 
{{out}}
Line 2,591 ⟶ 2,785:
3628800
12345678910</pre>
 
=={{header|Tailspin}}==
It is probably easier to just write the whole thing as an inline transform rather than create a utility.
<langsyntaxhighlight lang="tailspin">
[1..5] -> \(@: $(1); $(2..last)... -> @: $@ + $; $@!\) -> '$;
' -> !OUT::write
Line 2,601 ⟶ 2,794:
[1..5] -> \(@: $(1); $(2..last)... -> @: $@ * $; $@!\) -> '$;
' -> !OUT::write
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 2,610 ⟶ 2,803:
 
If you really want to make a utility, it could look like this:
<langsyntaxhighlight lang="tailspin">
templates fold&{op:}
@: $(1);
Line 2,630 ⟶ 2,823:
[1..5] -> fold&{op:mul} -> '$;
' -> !OUT::write
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 2,636 ⟶ 2,829:
120
</pre>
 
=={{header|Tcl}}==
Tcl does not come with a built-in <tt>fold</tt> command, but it is easy to construct:
<langsyntaxhighlight lang="tcl">proc fold {lambda zero list} {
set accumulator $zero
foreach item $list {
Line 2,645 ⟶ 2,837:
}
return $accumulator
}</langsyntaxhighlight>
Demonstrating:
<langsyntaxhighlight 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]</langsyntaxhighlight>
{{out}}
<pre>
Line 2,659 ⟶ 2,851:
</pre>
Note that these particular operations would more conventionally be written as:
<langsyntaxhighlight lang="tcl">puts [::tcl::mathop::+ {*}$1to5]
puts [::tcl::mathop::* {*}$1to5]
puts x,[join $1to5 ,]</langsyntaxhighlight>
But those are not general catamorphisms.
=={{header|uBasic/4tH}}==
{{trans|FreeBASIC}}
uBasic/4tH has only got one single array so passing its address makes little sense. Instead, its bounds are passed.
<syntaxhighlight lang="uBasic/4tH">For x = 1 To 5 : @(x-1) = x : Next ' initialize array
' try different reductions
Print "Sum is : "; FUNC(_Reduce(_add, 5))
Print "Difference is : "; FUNC(_Reduce(_subtract, 5))
Print "Product is : "; FUNC(_Reduce(_multiply, 5))
Print "Maximum is : "; FUNC(_Reduce(_max, 5))
Print "Minimum is : "; FUNC(_Reduce(_min, 5))
 
End
' several functions
_add Param (2) : Return (a@ + b@)
_subtract Param (2) : Return (a@ - b@)
_multiply Param (2) : Return (a@ * b@)
_min Param (2) : Return (Min (a@, b@))
_max Param (2) : Return (Max (a@, b@))
 
_Reduce
Param (2) ' function and array size
Local (2) ' loop index and result
' set result and iterate array
d@ = @(0) : For c@ = 1 To b@-1 : d@ = FUNC(a@ (d@, @(c@))) : Next
Return (d@)</syntaxhighlight>
This version incorporates a "no op" as well.
<syntaxhighlight lang="text">Push 5, 4, 3, 2, 1: s = Used() - 1
For x = 0 To s: @(x) = Pop(): Next
 
Print "Sum is : "; FUNC(_reduce(0, s, _add))
Print "Difference is : "; FUNC(_reduce(0, s, _subtract))
Print "Product is : "; FUNC(_reduce(0, s, _multiply))
Print "Maximum is : "; FUNC(_reduce(0, s, _max))
Print "Minimum is : "; FUNC(_reduce(0, s, _min))
Print "No op is : "; FUNC(_reduce(0, s, _noop))
End
 
_reduce
Param (3)
Local (2)
 
If (Line(c@) = 0) + ((b@ - a@) < 1) Then Return (0)
d@ = @(a@)
For e@ = a@ + 1 To b@
d@ = FUNC(c@ (d@, @(e@)))
Next
Return (d@)
_add Param (2) : Return (a@ + b@)
_subtract Param (2) : Return (a@ - b@)
_multiply Param (2) : Return (a@ * b@)
_max Param (2) : Return (Max(a@, b@))
_min Param (2) : Return (Min(a@, b@))</syntaxhighlight>
{{out}}
<pre>Sum is : 15
Difference is : -13
Product is : 120
Maximum is : 5
Minimum is : 1
No op is : 0
 
0 OK, 0:378
</pre>
 
=={{header|VBA}}==
<langsyntaxhighlight lang="vb">Public Sub reduce()
s = [{1,2,3,4,5}]
Debug.Print WorksheetFunction.Sum(s)
Debug.Print WorksheetFunction.Product(s)
End Sub</langsyntaxhighlight>
=={{header|V (Vlang)}}==
{{trans|go}}
<syntaxhighlight lang="v (vlang)">
fn main() {
n := [1, 2, 3, 4, 5]
println(reduce(add, n))
println(reduce(sub, n))
println(reduce(mul, n))
}
fn add(a int, b int) int { return a + b }
fn sub(a int, b int) int { return a - b }
fn mul(a int, b int) int { return a * b }
fn reduce(rf fn(int, int) int, m []int) int {
mut r := m[0]
for v in m[1..] {
r = rf(r, v)
}
return r
}</syntaxhighlight>
 
{{out}}
<pre>
15
-13
120
</pre>
 
=={{header|WDTE}}==
Translated from the JavaScript ES6 example with a few modifications.
 
<langsyntaxhighlight WDTElang="wdte">let a => import 'arrays';
let s => import 'stream';
let str => import 'strings';
Line 2,686 ⟶ 2,970:
 
# And here's a concatenation:
s.range 1 11 -> s.reduce '' (str.format '{}{}') -- io.writeln io.stdout;</langsyntaxhighlight>
 
=={{header|Wortel}}==
You can reduce an array with the <code>!/</code> operator.
<langsyntaxhighlight lang="wortel">!/ ^+ [1 2 3] ; returns 6</langsyntaxhighlight>
If you want to reduce with an initial value, you'll need the <code>@fold</code> operator.
<langsyntaxhighlight lang="wortel">@fold ^+ 1 [1 2 3] ; returns 7</langsyntaxhighlight>
 
{{out}}
Line 2,698 ⟶ 2,981:
3628800
12345678910</pre>
 
=={{header|Wren}}==
<langsyntaxhighlight ecmascriptlang="wren">var a = [1, 2, 3, 4, 5]
var sum = a.reduce { |acc, i| acc + i }
var prod = a.reduce { |acc, i| acc * i }
Line 2,707 ⟶ 2,989:
System.print("Sum is %(sum)")
System.print("Product is %(prod)")
System.print("Sum of squares is %(sumSq)")</langsyntaxhighlight>
 
{{out}}
Line 2,716 ⟶ 2,998:
Sum of squares is 55
</pre>
 
=={{header|Zig}}==
'''Works with:''' 0.10.x, 0.11.x, 0.12.0-dev.1591+3fc6a2f11
 
===Reduce a slice===
<syntaxhighlight lang="zig">/// Asserts that `array`.len >= 1.
pub fn reduce(comptime T: type, comptime applyFn: fn (T, T) T, array: []const T) T {
var val: T = array[0];
for (array[1..]) |elem| {
val = applyFn(val, elem);
}
return val;
}</syntaxhighlight>
 
Usage:
 
<syntaxhighlight lang="zig">const std = @import("std");
 
fn add(a: i32, b: i32) i32 {
return a + b;
}
 
fn mul(a: i32, b: i32) i32 {
return a * b;
}
 
fn min(a: i32, b: i32) i32 {
return @min(a, b);
}
 
fn max(a: i32, b: i32) i32 {
return @max(a, b);
}
 
pub fn main() void {
const arr: [5]i32 = .{ 1, 2, 3, 4, 5 };
std.debug.print("Array: {any}\n", .{arr});
std.debug.print(" * Reduce with add: {d}\n", .{reduce(i32, add, &arr)});
std.debug.print(" * Reduce with mul: {d}\n", .{reduce(i32, mul, &arr)});
std.debug.print(" * Reduce with min: {d}\n", .{reduce(i32, min, &arr)});
std.debug.print(" * Reduce with max: {d}\n", .{reduce(i32, max, &arr)});
}</syntaxhighlight>
 
{{out}}
<pre>
Array: { 1, 2, 3, 4, 5 }
* Reduce with add: 15
* Reduce with mul: 120
* Reduce with min: 1
* Reduce with max: 5
</pre>
 
===Reduce a vector===
 
We use @reduce builtin function here to leverage special instructions if available, but only small set of reduce operators are available.
@Vector and related builtings will use SIMD instructions if possible. If target platform does not support SIMD instructions, vectors operations will be compiled like in previous example (represented as arrays and operating with one element at a time).
 
<syntaxhighlight lang="zig">const std = @import("std");
 
pub fn main() void {
const vec: @Vector(5, i32) = .{ 1, 2, 3, 4, 5 };
std.debug.print("Vec: {any}\n", .{vec});
std.debug.print(" * Reduce with add: {d}\n", .{@reduce(.Add, vec)});
std.debug.print(" * Reduce with mul: {d}\n", .{@reduce(.Mul, vec)});
std.debug.print(" * Reduce with min: {d}\n", .{@reduce(.Min, vec)});
std.debug.print(" * Reduce with max: {d}\n", .{@reduce(.Max, vec)});
}</syntaxhighlight>
 
{{out}}
<pre>
Vec: { 1, 2, 3, 4, 5 }
* Reduce with add: 15
* Reduce with mul: 120
* Reduce with min: 1
* Reduce with max: 5
</pre>
 
Note that std.builtin.ReduceOp.Add and std.builtin.ReduceOp.Mul operators wrap on overflow and underflow, unlike regular Zig operators, where they are considered illegal behaviour and checked in safe optimize modes. This can be demonstrated by this example (ReleaseSafe optimize mode, zig 0.11.0, Linux 6.5.11 x86_64):
 
<syntaxhighlight lang="zig">const std = @import("std");
 
pub fn main() void {
const vec: @Vector(2, i32) = .{ std.math.minInt(i32), std.math.minInt(i32) + 1 };
std.debug.print("Vec: {any}\n", .{vec});
std.debug.print(" * Reduce with .Add: {d}\n", .{@reduce(.Add, vec)});
std.debug.print(" * Reduce with .Mul: {d}\n", .{@reduce(.Mul, vec)});
 
var zero: usize = 0; // Small trick to make compiler not emit compile error for overflow below:
std.debug.print(" * Reduce with regular add operator: {d}\n", .{vec[zero] + vec[1]});
std.debug.print(" * Reduce with regular mul operator: {d}\n", .{vec[zero] * vec[1]});
}</syntaxhighlight>
 
{{out}}
<pre>
Vec: { -2147483648, -2147483647 }
* Reduce with .Add: 1
* Reduce with .Mul: -2147483648
thread 5908 panic: integer overflow
/home/bratishkaerik/test/catamorphism.zig:10:79: 0x20c4b0 in main (catamorphism)
std.debug.print(" * Reduce with regular add operator: {d}\n", .{vec[zero] + vec[1]});
^
/usr/lib64/zig/0.11.0/lib/std/start.zig:564:22: 0x20bee4 in posixCallMainAndExit (catamorphism)
root.main();
^
/usr/lib64/zig/0.11.0/lib/std/start.zig:243:5: 0x20bdc1 in _start (catamorphism)
asm volatile (switch (native_arch) {
^
???:?:?: 0x0 in ??? (???)
[1] 5908 IOT instruction ./catamorphism
</pre>
 
For well-defined overflow/underflow behaviour you can use wrapping and saturating operators (for addition they are +% and +| respectively). With +% and *% (wrapping multiplication) operators, behaviour should be identical to .Add and .Mul reduce operators.
 
=={{header|zkl}}==
Most sequence objects in zkl have a reduce method.
<langsyntaxhighlight 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)</langsyntaxhighlight>
 
=={{header|ZX Spectrum Basic}}==
{{trans|BBC_BASIC}}
<langsyntaxhighlight lang="zxbasic">10 DIM a(5)
20 FOR i=1 TO 5
30 READ a(i)
Line 2,739 ⟶ 3,132:
1030 LET tmp=VAL ("tmp"+o$+"a(i)")
1040 NEXT i
1050 RETURN </langsyntaxhighlight>
56

edits