Catamorphism: Difference between revisions
No edit summary |
|||
(80 intermediate revisions by 33 users not shown) | |||
Line 12: | Line 12: | ||
* Wikipedia article: [[wp:Catamorphism|Catamorphism]] |
* Wikipedia article: [[wp:Catamorphism|Catamorphism]] |
||
<br><br> |
<br><br> |
||
=={{header|11l}}== |
|||
<syntaxhighlight 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))</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
6 |
|||
9 |
|||
5 |
|||
7 |
|||
</pre> |
|||
=={{header|6502 Assembly}}== |
|||
{{works with|https://skilldrick.github.io/easy6502/ Easy6502}} |
|||
<syntaxhighlight lang="6502asm">define catbuf $10 |
|||
define catbuf_temp $12 |
|||
ldx #0 |
|||
ramloop: |
|||
txa |
|||
sta $00,x |
|||
inx |
|||
cpx #$10 |
|||
bne ramloop |
|||
;load zero page addresses $00-$0f with values equal |
|||
;to that address |
|||
ldx #0 ;zero X |
|||
loop_cata: |
|||
lda $00,x ;load the zeroth element |
|||
clc |
|||
adc $01,x ;add the first to it. |
|||
inx |
|||
inx ;inx twice. Otherwise the same element |
|||
;would get added twice |
|||
sta catbuf_temp ;store in temp ram |
|||
lda catbuf |
|||
clc |
|||
adc catbuf_temp ;add to previously stored value |
|||
sta catbuf ;store in result |
|||
cpx #$10 ;is the range over? |
|||
bne loop_cata ;if not, loop again |
|||
ldx #$00 |
|||
lda catbuf |
|||
sta $00,x |
|||
;store the sum in the zeroth entry of the range |
|||
inx |
|||
lda #$00 |
|||
;now clear the rest of zeropage, leaving only the sum |
|||
clear_ram: |
|||
sta $00,x |
|||
inx |
|||
cpx #$ff |
|||
bne clear_ram</syntaxhighlight> |
|||
=={{header|ABAP}}== |
|||
This works in ABAP version 7.40 and above. |
|||
<syntaxhighlight lang="abap"> |
|||
report z_catamorphism. |
|||
data(numbers) = value int4_table( ( 1 ) ( 2 ) ( 3 ) ( 4 ) ( 5 ) ). |
|||
write: |numbers = { reduce string( |
|||
init output = `[` |
|||
index = 1 |
|||
for number in numbers |
|||
next output = cond string( |
|||
when index eq lines( numbers ) |
|||
then |{ output }, { number } ]| |
|||
when index > 1 |
|||
then |{ output }, { number }| |
|||
else |{ output } { number }| ) |
|||
index = index + 1 ) }|, /. |
|||
write: |sum(numbers) = { reduce int4( |
|||
init result = 0 |
|||
for number in numbers |
|||
next result = result + number ) }|, /. |
|||
write: |product(numbers) = { reduce int4( |
|||
init result = 1 |
|||
for number in numbers |
|||
next result = result * number ) }|, /. |
|||
data(strings) = value stringtab( ( `reduce` ) ( `in` ) ( `ABAP` ) ). |
|||
write: |strings = { reduce string( |
|||
init output = `[` |
|||
index = 1 |
|||
for string in strings |
|||
next output = cond string( |
|||
when index eq lines( strings ) |
|||
then |{ output }, { string } ]| |
|||
when index > 1 |
|||
then |{ output }, { string }| |
|||
else |{ output } { string }| ) |
|||
index = index + 1 ) }|, /. |
|||
write: |concatenation(strings) = { reduce string( |
|||
init text = `` |
|||
for string in strings |
|||
next text = |{ text } { string }| ) }|, /. |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
numbers = [ 1, 2, 3, 4, 5 ] |
|||
sum(numbers) = 15 |
|||
product(numbers) = 120 |
|||
strings = [ reduce, in, ABAP ] |
|||
concatenation(strings) = reduce in ABAP |
|||
</pre> |
|||
=={{header|Ada}}== |
=={{header|Ada}}== |
||
< |
<syntaxhighlight lang="ada">with Ada.Text_IO; |
||
procedure Catamorphism is |
procedure Catamorphism is |
||
Line 43: | Line 163: | ||
NIO.Put(Fold_Left(Add'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); |
NIO.Put(Fold_Left(Mul'Access, (1,2,3,4)), Width => 3); |
||
end Catamorphism;</ |
end Catamorphism;</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre> 1 4 10 24</pre> |
<pre> 1 4 10 24</pre> |
||
=={{header|Aime}}== |
|||
<syntaxhighlight lang="aime">integer s; |
|||
s = 0; |
|||
list(1, 2, 3, 4, 5, 6, 7, 8, 9).ucall(add_i, 1, s); |
|||
o_(s, "\n");</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>45</pre> |
|||
=={{header|ALGOL 68}}== |
=={{header|ALGOL 68}}== |
||
< |
<syntaxhighlight lang="algol68"># applies fn to successive elements of the array of values # |
||
# the result is 0 if there are no values # |
# the result is 0 if there are no values # |
||
PROC reduce = ( []INT values, PROC( INT, INT )INT fn )INT: |
PROC reduce = ( []INT values, PROC( INT, INT )INT fn )INT: |
||
Line 69: | Line 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 ) ) # product # |
||
; print( ( reduce( ( 1, 2, 3, 4, 5 ), ( INT a, b )INT: a - b ), newline ) ) # difference # |
; print( ( reduce( ( 1, 2, 3, 4, 5 ), ( INT a, b )INT: a - b ), newline ) ) # difference # |
||
END</ |
END</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 76: | Line 203: | ||
-13 |
-13 |
||
</pre> |
</pre> |
||
=={{header|APL}}== |
|||
<em>Reduce</em> is a built-in APL operator, written as <code>/</code>. |
|||
<syntaxhighlight lang="apl"> +/ 1 2 3 4 5 6 7 |
|||
28 |
|||
×/ 1 2 3 4 5 6 7 |
|||
5040</syntaxhighlight> |
|||
For built-in functions, the seed value is automatically chosen to make sense. |
|||
<syntaxhighlight lang="apl"> +/⍬ |
|||
0 |
|||
×/⍬ |
|||
1 |
|||
⌈/⍬ ⍝ this gives the minimum supported value |
|||
¯1.797693135E308</syntaxhighlight> |
|||
For user-supplied functions, the last element in the list is considered the seed. |
|||
If <code>F/</code> is called with a list of only one element, <code>F</code> itself is never |
|||
called, and calling <code>F/</code> with the empty list is an error. |
|||
<syntaxhighlight lang="apl"> {⎕←'Input:',⍺,⍵ ⋄ ⍺+⍵}/ 1 2 3 4 5 |
|||
Input: 4 5 |
|||
Input: 3 9 |
|||
Input: 2 12 |
|||
Input: 1 14 |
|||
15 |
|||
{⎕←'Input:',⍺,⍵ ⋄ ⍺+⍵}/ 1 |
|||
1 |
|||
{⎕←'Input:',⍺,⍵ ⋄ ⍺+⍵}/ ⍬ |
|||
DOMAIN ERROR</syntaxhighlight> |
|||
=={{header|AppleScript}}== |
=={{header|AppleScript}}== |
||
{{Trans|JavaScript}} |
{{Trans|JavaScript}} |
||
Line 84: | Line 241: | ||
(Note that to obtain first-class functions from user-defined AppleScript handlers, we have to 'lift' them into script objects). |
(Note that to obtain first-class functions from user-defined AppleScript handlers, we have to 'lift' them into script objects). |
||
< |
<syntaxhighlight lang="applescript">---------------------- CATAMORPHISMS --------------------- |
||
-- the arguments available to the called function f(a, x, i, l) are |
-- the arguments available to the called function f(a, x, i, l) are |
||
Line 123: | Line 280: | ||
-- OTHER FUNCTIONS DEFINED IN TERMS OF FOLDL AND FOLDR |
--- OTHER FUNCTIONS DEFINED IN TERMS OF FOLDL AND FOLDR -- |
||
-- concat :: |
-- concat :: [String] -> string |
||
on concat(xs) |
on concat(xs) |
||
foldl(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 |
end concat |
||
-- product :: Num a => [a] -> a |
-- product :: Num a => [a] -> a |
||
Line 151: | Line 298: | ||
foldr(result, 1, xs) |
foldr(result, 1, xs) |
||
end product |
end product |
||
-- str :: a -> String |
|||
on str(x) |
|||
x as string |
|||
end str |
|||
-- sum :: Num a => [a] -> a |
-- sum :: Num a => [a] -> a |
||
Line 164: | Line 318: | ||
--------------------------- TEST ------------------------- |
|||
on run |
on run |
||
set xs to {1, 2, 3, 4, 5, 6, 7, 8, 9, 10} |
set xs to {1, 2, 3, 4, 5, 6, 7, 8, 9, 10} |
||
{sum(xs), product(xs), concat(xs)} |
{sum(xs), product(xs), concat(map(str, xs))} |
||
--> {55, 3628800, "10987654321"} |
--> {55, 3628800, "10987654321"} |
||
Line 174: | Line 328: | ||
-------------------- 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 |
-- Lift 2nd class handler function into 1st class script wrapper |
||
Line 186: | Line 361: | ||
end script |
end script |
||
end if |
end if |
||
end mReturn</ |
end mReturn</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre>{55, 3628800, " |
<pre>{55, 3628800, "12345678910"}</pre> |
||
=={{header|Arturo}}== |
|||
<syntaxhighlight lang="rebol">; find the sum, with seed:0 (default) |
|||
=={{header|Bracmat}}== |
|||
print fold [1 2 3 4] => add |
|||
<lang bracmat>( ( fold |
|||
= f xs init first rest |
|||
; find the product, with seed:1 |
|||
. !arg:(?f.?xs.?init) |
|||
print fold [1 2 3 4] .seed:1 => mul</syntaxhighlight> |
|||
& ( !xs:&!init |
|||
| !xs:%?first ?rest |
|||
{{out}} |
|||
& !f$(!first.fold$(!f.!rest.!init)) |
|||
) |
|||
<pre>10 |
|||
) |
|||
24</pre> |
|||
& out |
|||
=={{header|BASIC}}== |
|||
$ ( fold |
|||
==={{header|BASIC256}}=== |
|||
$ ( (=a b.!arg:(?a.?b)&!a+!b) |
|||
{{trans|Run BASIC}} |
|||
. 1 2 3 4 5 |
|||
<syntaxhighlight lang="basic256">arraybase 1 |
|||
. 0 |
|||
global n |
|||
) |
|||
dim n = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10} |
|||
) |
|||
& (product=a b.!arg:(?a.?b)&!a*!b) |
|||
print " +: "; " "; cat(10, "+") |
|||
& out$(fold$(product.1 2 3 4 5.1)) |
|||
print " -: "; " "; cat(10, "-") |
|||
);</lang> |
|||
print " *: "; " "; cat(10, "*") |
|||
Output: |
|||
print " /: "; " "; cat(10, "/") |
|||
<pre>15 |
|||
print " ^: "; " "; cat(10, "^") |
|||
120</pre> |
|||
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}}== |
=={{header|BBC BASIC}}== |
||
< |
<syntaxhighlight lang="bbcbasic"> |
||
DIM a(4) |
DIM a(4) |
||
a() = 1, 2, 3, 4, 5 |
a() = 1, 2, 3, 4, 5 |
||
Line 230: | Line 588: | ||
NEXT |
NEXT |
||
= tmp |
= tmp |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{out}} |
{{out}} |
||
Line 236: | Line 594: | ||
-13 |
-13 |
||
120</pre> |
120</pre> |
||
=={{header|BCPL}}== |
|||
<syntaxhighlight lang="bcpl">get "libhdr" |
|||
let reduce(f, v, len, seed) = |
|||
len = 0 -> seed, |
|||
reduce(f, v+1, len-1, f(!v, seed)) |
|||
let start() be |
|||
$( let add(x, y) = x+y |
|||
let mul(x, y) = x*y |
|||
let nums = table 1,2,3,4,5,6,7 |
|||
writef("%N*N", reduce(add, nums, 7, 0)) |
|||
writef("%N*N", reduce(mul, nums, 7, 1)) |
|||
$)</syntaxhighlight> |
|||
{{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}}== |
|||
BQN has two different primitives for catamorphism: |
|||
<ul> |
|||
<li>Fold(<code>´</code>): Works on lists only.</li> |
|||
<li>Insert(<code>˝</code>): Works on arrays with higher rank.</li> |
|||
</ul> |
|||
Both of these primitives take a dyadic function, and an optional initial element. |
|||
<pre>•Show +´ 30‿1‿20‿2‿10 |
|||
•Show +˝ 30‿1‿20‿2‿10 |
|||
•Show tab ← (2+↕5) |⌜ 9+↕3 |
|||
•Show +˝ tab</pre> |
|||
<pre>63 |
|||
┌· |
|||
· 63 |
|||
┘ |
|||
┌─ |
|||
╵ 1 0 1 |
|||
0 1 2 |
|||
1 2 3 |
|||
4 0 1 |
|||
3 4 5 |
|||
┘ |
|||
⟨ 9 7 12 ⟩</pre> |
|||
=={{header|Bracmat}}== |
|||
<syntaxhighlight lang="bracmat">( ( fold |
|||
= f xs init first rest |
|||
. !arg:(?f.?xs.?init) |
|||
& ( !xs:&!init |
|||
| !xs:%?first ?rest |
|||
& !f$(!first.fold$(!f.!rest.!init)) |
|||
) |
|||
) |
|||
& out |
|||
$ ( fold |
|||
$ ( (=a b.!arg:(?a.?b)&!a+!b) |
|||
. 1 2 3 4 5 |
|||
. 0 |
|||
) |
|||
) |
|||
& (product=a b.!arg:(?a.?b)&!a*!b) |
|||
& out$(fold$(product.1 2 3 4 5.1)) |
|||
);</syntaxhighlight> |
|||
Output: |
|||
<pre>15 |
|||
120</pre> |
|||
=={{header|C}}== |
=={{header|C}}== |
||
< |
<syntaxhighlight lang="c">#include <stdio.h> |
||
typedef int (*intFn)(int, int); |
typedef int (*intFn)(int, int); |
||
Line 261: | Line 692: | ||
printf("%d\n", reduce(mul, 5, nums)); |
printf("%d\n", reduce(mul, 5, nums)); |
||
return 0; |
return 0; |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
Line 267: | Line 698: | ||
-13 |
-13 |
||
120</pre> |
120</pre> |
||
=={{header|C sharp|C#}}== |
|||
<syntaxhighlight lang="csharp">var nums = Enumerable.Range(1, 10); |
|||
int summation = nums.Aggregate((a, b) => a + b); |
|||
int product = nums.Aggregate((a, b) => a * b); |
|||
string concatenation = nums.Aggregate(String.Empty, (a, b) => a.ToString() + b.ToString()); |
|||
Console.WriteLine("{0} {1} {2}", summation, product, concatenation);</syntaxhighlight> |
|||
=={{header|C++}}== |
=={{header|C++}}== |
||
< |
<syntaxhighlight lang="cpp">#include <iostream> |
||
#include <numeric> |
#include <numeric> |
||
#include <functional> |
#include <functional> |
||
Line 282: | Line 722: | ||
std::cout << "nums_added: " << nums_added << std::endl; |
std::cout << "nums_added: " << nums_added << std::endl; |
||
std::cout << "nums_other: " << nums_other << std::endl; |
std::cout << "nums_other: " << nums_other << std::endl; |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
Line 288: | Line 728: | ||
<pre>nums_added: 15 |
<pre>nums_added: 15 |
||
nums_other: 30</pre> |
nums_other: 30</pre> |
||
=={{header|C sharp}}== |
|||
<lang csharp>var nums = Enumerable.Range(1, 10); |
|||
int summation = nums.Aggregate((a, b) => a + b); |
|||
int product = nums.Aggregate((a, b) => a * b); |
|||
string concatenation = nums.Aggregate(String.Empty, (a, b) => a.ToString() + b.ToString()); |
|||
Console.WriteLine("{0} {1} {2}", summation, product, concatenation);</lang> |
|||
=={{header|Clojure}}== |
=={{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]. |
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]. |
||
< |
<syntaxhighlight lang="clojure">; Basic usage |
||
> (reduce * '(1 2 3 4 5)) |
> (reduce * '(1 2 3 4 5)) |
||
120 |
120 |
||
Line 309: | Line 737: | ||
> (reduce + 100 '(1 2 3 4 5)) |
> (reduce + 100 '(1 2 3 4 5)) |
||
115 |
115 |
||
</syntaxhighlight> |
|||
</lang> |
|||
=={{header|CLU}}== |
|||
<syntaxhighlight lang="clu">% Reduction. |
|||
% First type = sequence type (must support S$elements and yield R) |
|||
% Second type = right (input) datatype |
|||
% Third type = left (output) datatype |
|||
reduce = proc [S,R,L: type] (f: proctype (L,R) returns (L), |
|||
id: L, |
|||
seq: S) |
|||
returns (L) |
|||
where S has elements: itertype (S) yields (R) |
|||
for elem: R in S$elements(seq) do |
|||
id := f(id, elem) |
|||
end |
|||
return(id) |
|||
end reduce |
|||
% This is necessary to get rid of the exceptions |
|||
add = proc (a,b: int) returns (int) return (a+b) end add |
|||
mul = proc (a,b: int) returns (int) return (a*b) end mul |
|||
% Usage |
|||
start_up = proc () |
|||
% abbreviation - reducing int->int->int function over an array[int] |
|||
int_reduce = reduce[array[int], int, int] |
|||
po: stream := stream$primary_output() |
|||
nums: array[int] := array[int]$[1,2,3,4,5,6,7,8,9,10] |
|||
% find the sum and the product using reduce |
|||
sum: int := int_reduce(add, 0, nums) |
|||
product: int := int_reduce(mul, 1, nums) |
|||
stream$putl(po, "The sum of [1..10] is: " || int$unparse(sum)) |
|||
stream$putl(po, "The product of [1..10] is: " || int$unparse(product)) |
|||
end start_up</syntaxhighlight> |
|||
{{out}} |
|||
<pre>The sum of [1..10] is: 55 |
|||
The product of [1..10] is: 3628800</pre> |
|||
=={{header|Common Lisp}}== |
=={{header|Common Lisp}}== |
||
< |
<syntaxhighlight lang="lisp">; Basic usage |
||
> (reduce #'* '(1 2 3 4 5)) |
> (reduce #'* '(1 2 3 4 5)) |
||
120 |
120 |
||
Line 329: | Line 795: | ||
; Compare with |
; Compare with |
||
> (reduce #'expt '(2 3 4)) |
> (reduce #'expt '(2 3 4)) |
||
4096</ |
4096</syntaxhighlight> |
||
=={{header|D}}== |
=={{header|D}}== |
||
< |
<syntaxhighlight lang="d">void main() { |
||
import std.stdio, std.algorithm, std.range, std.meta, std.numeric, |
import std.stdio, std.algorithm, std.range, std.meta, std.numeric, |
||
std.conv, std.typecons; |
std.conv, std.typecons; |
||
Line 344: | Line 809: | ||
// std.algorithm.reduce supports multiple functions in parallel: |
// std.algorithm.reduce supports multiple functions in parallel: |
||
reduce!(ops[0], ops[3], text)(tuple(0, 0.0, ""), list).writeln; |
reduce!(ops[0], ops[3], text)(tuple(0, 0.0, ""), list).writeln; |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre>"a + b": 55 |
<pre>"a + b": 55 |
||
Line 352: | Line 817: | ||
gcd(T): 1 |
gcd(T): 1 |
||
Tuple!(int,double,string)(55, 10, "12345678910")</pre> |
Tuple!(int,double,string)(55, 10, "12345678910")</pre> |
||
=={{header|DCL}}== |
=={{header|DCL}}== |
||
< |
<syntaxhighlight lang="dcl">$ list = "1,2,3,4,5" |
||
$ call reduce list "+" |
$ call reduce list "+" |
||
$ show symbol result |
$ show symbol result |
||
Line 379: | Line 843: | ||
$ result == value |
$ result == value |
||
$ exit |
$ exit |
||
$ endsubroutine</ |
$ endsubroutine</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre>$ @catamorphism |
<pre>$ @catamorphism |
||
Line 385: | Line 849: | ||
RESULT == -5 Hex = FFFFFFFB Octal = 37777777773 |
RESULT == -5 Hex = FFFFFFFB Octal = 37777777773 |
||
RESULT == 120 Hex = 00000078 Octal = 00000000170</pre> |
RESULT == 120 Hex = 00000078 Octal = 00000000170</pre> |
||
=={{header|Delphi}}== |
|||
See [https://rosettacode.org/wiki/Catamorphism#Pascal Pascal]. |
|||
=={{header|Déjà Vu}}== |
=={{header|Déjà Vu}}== |
||
This is a foldl: |
This is a foldl: |
||
< |
<syntaxhighlight lang="dejavu">reduce f lst init: |
||
if lst: |
if lst: |
||
f reduce @f lst init pop-from lst |
f reduce @f lst init pop-from lst |
||
Line 396: | Line 861: | ||
!. reduce @+ [ 1 10 200 ] 4 |
!. reduce @+ [ 1 10 200 ] 4 |
||
!. reduce @- [ 1 10 200 ] 4 |
!. reduce @- [ 1 10 200 ] 4 |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{out}} |
{{out}} |
||
<pre>215 |
<pre>215 |
||
-207</pre> |
-207</pre> |
||
=={{header|EchoLisp}}== |
=={{header|EchoLisp}}== |
||
< |
<syntaxhighlight lang="scheme"> |
||
;; rem : the foldX family always need an initial value |
;; rem : the foldX family always need an initial value |
||
;; fold left a list |
;; fold left a list |
||
Line 422: | Line 886: | ||
(scanl * 1 '( 1 2 3 4 5)) |
(scanl * 1 '( 1 2 3 4 5)) |
||
→ (1 1 2 6 24 120) |
→ (1 1 2 6 24 120) |
||
</syntaxhighlight> |
|||
</lang> |
|||
=={{header|Elena}}== |
=={{header|Elena}}== |
||
ELENA |
ELENA 5.0 : |
||
< |
<syntaxhighlight lang="elena">import system'collections; |
||
import system'routines |
import system'routines; |
||
import extensions |
import extensions; |
||
import extensions'text |
import extensions'text; |
||
public program |
public program() |
||
{ |
|||
[ |
|||
var numbers := 1 |
var numbers := new Range(1,10).summarize(new ArrayList()); |
||
var summary := numbers |
var summary := numbers.accumulate(new Variable(0), (a,b => a + b)); |
||
var product := numbers |
var product := numbers.accumulate(new Variable(1), (a,b => a * b)); |
||
var concatenation := numbers |
var concatenation := numbers.accumulate(new StringWriter(), (a,b => a.toPrintable() + b.toPrintable())); |
||
console |
console.printLine(summary," ",product," ",concatenation) |
||
}</syntaxhighlight> |
|||
]</lang> |
|||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
55 362880 12345678910 |
55 362880 12345678910 |
||
</pre> |
</pre> |
||
=={{header|Elixir}}== |
=={{header|Elixir}}== |
||
< |
<syntaxhighlight lang="elixir">iex(1)> Enum.reduce(1..10, fn i,acc -> i+acc end) |
||
55 |
55 |
||
iex(2)> Enum.reduce(1..10, fn i,acc -> i*acc end) |
iex(2)> Enum.reduce(1..10, fn i,acc -> i*acc end) |
||
3628800 |
3628800 |
||
iex(3)> Enum.reduce(10..-10, "", fn i,acc -> acc <> to_string(i) end) |
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"</ |
"109876543210-1-2-3-4-5-6-7-8-9-10"</syntaxhighlight> |
||
=={{header|Erlang}}== |
=={{header|Erlang}}== |
||
{{trans|Haskell}} |
{{trans|Haskell}} |
||
< |
<syntaxhighlight lang="erlang"> |
||
-module(catamorphism). |
-module(catamorphism). |
||
Line 475: | Line 937: | ||
Nums), |
Nums), |
||
{Summation, Product, Concatenation}. |
{Summation, Product, Concatenation}. |
||
</syntaxhighlight> |
|||
</lang> |
|||
Output: |
Output: |
||
Line 481: | Line 943: | ||
{55,3628800,"12345678910"} |
{55,3628800,"12345678910"} |
||
</pre> |
</pre> |
||
=={{header|Excel}}== |
|||
===LAMBDA=== |
|||
Excel provides a good number of standard catamorphisms like SUM, PRODUCT, LEN etc out of the box, but in recent builds of Excel we can write more general catamorphisms as LAMBDA expressions, and bind names to them in the WorkBook Name Manager. |
|||
Excel's compound data type is a non-empty array, for which we could write, for example, specialised column or row instances of fold, whether rightward or leftward. |
|||
Here is an example of binding the name FOLDLROW to a left fold over a row of Excel cells. |
|||
As an example of a binary operator to fold, with an accumulator, over a series of character values, we can define a custom: |
|||
'''updateBracketDepth(accumulator)(character)''' which: |
|||
# Increments the nesting depth given a "[" character |
|||
# reduces it given a "]" character |
|||
# leaves the nesting depth unchanged for any other character |
|||
# updates the accumulator no further if the nesting depth ever becomes negative. |
|||
or for a simple bracket count, we could just define a: |
|||
'''bracketCount(accumulator)(character)''' which: |
|||
# Increments the integer accumulator value on each "[" or "]" |
|||
# Leaves the accumulator unchanged for other characters. |
|||
(See [https://www.microsoft.com/en-us/research/blog/lambda-the-ultimatae-excel-worksheet-function/ LAMBDA: The ultimate Excel worksheet function]) |
|||
{{Works with|Office 365 betas 2021}} |
|||
<syntaxhighlight lang="lisp">FOLDROW |
|||
=LAMBDA(op, |
|||
LAMBDA(a, |
|||
LAMBDA(xs, |
|||
LET( |
|||
b, op(a)(HEADROW(xs)), |
|||
IF(1 < COLUMNS(xs), |
|||
FOLDROW(op)(b)( |
|||
TAILROW(xs) |
|||
), |
|||
b |
|||
) |
|||
) |
|||
) |
|||
) |
|||
) |
|||
updatedBracketDepth |
|||
=LAMBDA(depth, |
|||
LAMBDA(c, |
|||
IF(0 <= depth, |
|||
IF("[" = c, |
|||
1 + depth, |
|||
IF("]" = c, |
|||
depth - 1, |
|||
depth |
|||
) |
|||
), |
|||
depth |
|||
) |
|||
) |
|||
) |
|||
bracketCount |
|||
=LAMBDA(a, |
|||
LAMBDA(c, |
|||
IF(ISNUMBER(FIND(c, "[]", 1)), |
|||
1 + a, |
|||
a |
|||
) |
|||
) |
|||
) |
|||
HEADROW |
|||
=LAMBDA(xs, |
|||
LET(REM, "The first item of each row in xs", |
|||
INDEX( |
|||
xs, |
|||
SEQUENCE(ROWS(xs)), |
|||
SEQUENCE(1, 1) |
|||
) |
|||
) |
|||
) |
|||
TAILROW |
|||
=LAMBDA(xs, |
|||
LET(REM,"The tail of each row in the grid", |
|||
n, COLUMNS(xs) - 1, |
|||
IF(0 < n, |
|||
INDEX( |
|||
xs, |
|||
SEQUENCE(ROWS(xs), 1, 1, 1), |
|||
SEQUENCE(1, n, 2, 1) |
|||
), |
|||
NA() |
|||
) |
|||
) |
|||
) |
|||
CHARSROW |
|||
=LAMBDA(s, |
|||
MID(s, |
|||
SEQUENCE(1, LEN(s), 1, 1), |
|||
1 |
|||
) |
|||
)</syntaxhighlight> |
|||
{{Out}} |
|||
{| class="wikitable" |
|||
|- |
|||
|||style="text-align:right; font-family:serif; font-style:italic; font-size:120%;"|fx |
|||
! colspan="3" style="text-align:left; vertical-align: bottom; font-family:Arial, Helvetica, sans-serif !important;"|=FOLDROW( updatedBracketDepth )( 0 )( CHARSROW(C2) ) |
|||
|- style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff;" |
|||
| |
|||
| A |
|||
| B |
|||
| C |
|||
|- |
|||
| style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff" | 1 |
|||
| |
|||
| style="font-weight:bold" | Final bracket nesting depth |
|||
| style="font-weight:bold" | Sample string |
|||
|- |
|||
| style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff" | 2 |
|||
| |
|||
| style="text-align:center; background-color:#cbcefb" | 0 |
|||
| [simply bracketed] |
|||
|- |
|||
| style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff" | 3 |
|||
| |
|||
| style="text-align:center" | 1 |
|||
| [[ ] |
|||
|- |
|||
| style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff" | 4 |
|||
| |
|||
| style="text-align:center" | -1 |
|||
| [ ]] |
|||
|- |
|||
| style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff" | 5 |
|||
| |
|||
| style="text-align:center" | 0 |
|||
| [[[ [] ]]] |
|||
|- |
|||
| style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff" | 6 |
|||
| |
|||
| style="text-align:center" | 0 |
|||
| [ [[[ [] ]]] [[[ ]]] [[[ [] ]]] ] |
|||
|- |
|||
| style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff" | 7 |
|||
| |
|||
| style="text-align:center" | 1 |
|||
| [ [[[ [ ]]] [[[ ]]] [[[ [] ]]] ] |
|||
|- |
|||
| style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff" | 8 |
|||
| |
|||
| style="text-align:center" | -1 |
|||
| ][ [[[ [ ]]] [[[ ]]] [[[ [] ]]] ] |
|||
|} |
|||
Or for a simple count of bracket characters, ignoring other characters: |
|||
{| class="wikitable" |
|||
|- |
|||
|||style="text-align:right; font-family:serif; font-style:italic; font-size:120%;"|fx |
|||
! colspan="3" style="text-align:left; vertical-align: bottom; font-family:Arial, Helvetica, sans-serif !important;"|=FOLDROW( bracketCount )( 0 )( CHARSROW(C2) ) |
|||
|- style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff;" |
|||
| |
|||
| A |
|||
| B |
|||
| C |
|||
|- |
|||
| style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff" | 1 |
|||
| |
|||
| style="font-weight:bold" | Bracket character count |
|||
| style="font-weight:bold" | Sample string |
|||
|- |
|||
| style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff" | 2 |
|||
| |
|||
| style="text-align:center; background-color:#cbcefb" | 2 |
|||
| [simply bracketed] |
|||
|- |
|||
| style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff" | 3 |
|||
| |
|||
| style="text-align:center" | 3 |
|||
| [[ ] |
|||
|- |
|||
| style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff" | 4 |
|||
| |
|||
| style="text-align:center" | 3 |
|||
| [ ]] |
|||
|- |
|||
| style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff" | 5 |
|||
| |
|||
| style="text-align:center" | 8 |
|||
| [[[ [] ]]] |
|||
|- |
|||
| style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff" | 6 |
|||
| |
|||
| style="text-align:center" | 24 |
|||
| [ [[[ [] ]]] [[[ ]]] [[[ [] ]]] ] |
|||
|- |
|||
| style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff" | 7 |
|||
| |
|||
| style="text-align:center" | 23 |
|||
| [ [[[ [ ]]] [[[ ]]] [[[ [] ]]] ] |
|||
|- |
|||
| style="text-align:center; font-family:Arial, Helvetica, sans-serif !important; background-color:#000000; color:#ffffff" | 8 |
|||
| |
|||
| style="text-align:center" | 24 |
|||
| ][ [[[ [ ]]] [[[ ]]] [[[ [] ]]] ] |
|||
|} |
|||
=={{header|F_Sharp|F#}}== |
=={{header|F_Sharp|F#}}== |
||
<p>In the REPL:</p> |
<p>In the REPL:</p> |
||
Line 501: | Line 1,181: | ||
val concatenation : string = "12345678910" |
val concatenation : string = "12345678910" |
||
</pre> |
</pre> |
||
=={{header|Factor}}== |
=={{header|Factor}}== |
||
< |
<syntaxhighlight lang="factor">{ 1 2 4 6 10 } 0 [ + ] reduce .</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
23 |
23 |
||
</pre> |
</pre> |
||
=={{header|Forth}}== |
=={{header|Forth}}== |
||
Forth has three traditions for iterating over the members of a data |
Forth has three traditions for iterating over the members of a data |
||
Line 540: | Line 1,218: | ||
Some helper words for these examples: |
Some helper words for these examples: |
||
< |
<syntaxhighlight lang="forth">: lowercase? ( c -- f ) |
||
[char] a [ char z 1+ ] literal within ; |
[char] a [ char z 1+ ] literal within ; |
||
: char-upcase ( c -- C ) |
: char-upcase ( c -- C ) |
||
dup lowercase? if bl xor then ;</ |
dup lowercase? if bl xor then ;</syntaxhighlight> |
||
Using normal looping words: |
Using normal looping words: |
||
< |
<syntaxhighlight lang="forth">: string-at ( c-addr u +n -- c ) |
||
nip + c@ ; |
nip + c@ ; |
||
: string-at! ( c-addr u +n c -- ) |
: string-at! ( c-addr u +n c -- ) |
||
Line 566: | Line 1,244: | ||
0 -rot dup 0 ?do |
0 -rot dup 0 ?do |
||
2dup i string-at lowercase? if rot 1+ -rot then |
2dup i string-at lowercase? if rot 1+ -rot then |
||
loop 2drop ;</ |
loop 2drop ;</syntaxhighlight> |
||
Briefly, a variation: |
Briefly, a variation: |
||
< |
<syntaxhighlight lang="forth">: next-char ( a +n -- a' n' c -1 ) ( a 0 -- 0 ) |
||
dup if 2dup 1 /string 2swap drop c@ true |
dup if 2dup 1 /string 2swap drop c@ true |
||
else 2drop 0 then ; |
else 2drop 0 then ; |
||
Line 577: | Line 1,255: | ||
begin next-char while |
begin next-char while |
||
dup lowercase? if emit else drop then |
dup lowercase? if emit else drop then |
||
repeat ;</ |
repeat ;</syntaxhighlight> |
||
Using dedicated looping words: |
Using dedicated looping words: |
||
< |
<syntaxhighlight lang="forth">: each-char[ ( c-addr u -- ) |
||
postpone BOUNDS postpone ?DO |
postpone BOUNDS postpone ?DO |
||
postpone I postpone C@ ; immediate |
postpone I postpone C@ ; immediate |
||
Line 597: | Line 1,275: | ||
: count-lowercase ( c-addr u -- n ) |
: count-lowercase ( c-addr u -- n ) |
||
0 -rot each-char[ lowercase? if 1+ then ]each-char ;</ |
0 -rot each-char[ lowercase? if 1+ then ]each-char ;</syntaxhighlight> |
||
Using higher-order words: |
Using higher-order words: |
||
< |
<syntaxhighlight lang="forth">: each-char ( c-addr u xt -- ) |
||
{: xt :} bounds ?do |
{: xt :} bounds ?do |
||
i c@ xt execute |
i c@ xt execute |
||
Line 617: | Line 1,295: | ||
: count-lowercase ( c-addr u -- n ) |
: count-lowercase ( c-addr u -- n ) |
||
0 -rot [: lowercase? if 1+ then ;] each-char ;</ |
0 -rot [: lowercase? if 1+ then ;] each-char ;</syntaxhighlight> |
||
In these examples COUNT-LOWERCASE updates an accumulator, UPCASE |
In these examples COUNT-LOWERCASE updates an accumulator, UPCASE |
||
(mostly) modifies the string in-place, and TYPE-LOWERCASE performs |
(mostly) modifies the string in-place, and TYPE-LOWERCASE performs |
||
side-effects and returns nothing to the higher-order word. |
side-effects and returns nothing to the higher-order word. |
||
=={{header|Fortran}}== |
=={{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 < |
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 <syntaxhighlight lang="fortran"> SUBROUTINE FOLD(t,F,i,ist,lst) |
||
INTEGER t |
INTEGER t |
||
BYNAME F |
BYNAME F |
||
Line 632: | Line 1,309: | ||
END SUBROUTINE FOLD !Result in temp. |
END SUBROUTINE FOLD !Result in temp. |
||
temp = a(1); CALL FOLD(temp,temp*a(i),i,2,N)</ |
temp = a(1); CALL FOLD(temp,temp*a(i),i,2,N)</syntaxhighlight> |
||
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. |
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 641: | Line 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. |
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. < |
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. <syntaxhighlight lang="fortran"> INTEGER FUNCTION IFOLD(F,A,N) !"Catamorphism"... |
||
INTEGER F !We're working only with integers. |
INTEGER F !We're working only with integers. |
||
EXTERNAL F !This is a function, not an array. |
EXTERNAL F !This is a function, not an array. |
||
Line 694: | Line 1,371: | ||
WRITE (MSG,*) "Ivid",IFOLD(IVID,A,ENUFF) |
WRITE (MSG,*) "Ivid",IFOLD(IVID,A,ENUFF) |
||
END PROGRAM POKE |
END PROGRAM POKE |
||
</syntaxhighlight> |
|||
</lang> |
|||
Output: |
Output: |
||
<pre> |
<pre> |
||
Line 704: | Line 1,381: | ||
Ivid 6 |
Ivid 6 |
||
</pre> |
</pre> |
||
=={{header|FreeBASIC}}== |
=={{header|FreeBASIC}}== |
||
< |
<syntaxhighlight lang="freebasic">' FB 1.05.0 Win64 |
||
Type IntFunc As Function(As Integer, As Integer) As Integer |
Type IntFunc As Function(As Integer, As Integer) As Integer |
||
Line 750: | Line 1,426: | ||
Print "Press any key to quit" |
Print "Press any key to quit" |
||
Sleep |
Sleep |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{out}} |
{{out}} |
||
Line 761: | Line 1,437: | ||
No op is : 0 |
No op is : 0 |
||
</pre> |
</pre> |
||
=={{header|Go}}== |
=={{header|Go}}== |
||
< |
<syntaxhighlight lang="go">package main |
||
import ( |
import ( |
||
Line 787: | Line 1,462: | ||
} |
} |
||
return r |
return r |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 794: | Line 1,469: | ||
120 |
120 |
||
</pre> |
</pre> |
||
=={{header|Groovy}}== |
=={{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. |
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. |
||
< |
<syntaxhighlight lang="groovy">def vector1 = [1,2,3,4,5,6,7] |
||
def vector2 = [7,6,5,4,3,2,1] |
def vector2 = [7,6,5,4,3,2,1] |
||
def map1 = [a:1, b:2, c:3, d:4] |
def map1 = [a:1, b:2, c:3, d:4] |
||
Line 809: | Line 1,483: | ||
println (map1.inject { Map.Entry accEntry, Map.Entry entry -> // some sort of weird map-based reduction |
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() |
[(accEntry.key + entry.key):accEntry.value + entry.value ].entrySet().toList().pop() |
||
})</ |
})</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
Line 818: | Line 1,492: | ||
84 |
84 |
||
abcd=10</pre> |
abcd=10</pre> |
||
=={{header|Haskell}}== |
=={{header|Haskell}}== |
||
< |
<syntaxhighlight lang="haskell">main :: IO () |
||
main = |
main = |
||
putStrLn . unlines $ |
putStrLn . unlines $ |
||
Line 827: | Line 1,500: | ||
, foldr ((++) . show) "" -- concatenation |
, foldr ((++) . show) "" -- concatenation |
||
] <*> |
] <*> |
||
[[1 .. 10]]</ |
[[1 .. 10]]</syntaxhighlight> |
||
{{Out}} |
{{Out}} |
||
<pre>55 |
<pre>55 |
||
Line 835: | Line 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: |
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: |
||
< |
<syntaxhighlight lang="haskell">import Data.Monoid |
||
main :: IO () |
main :: IO () |
||
Line 846: | Line 1,519: | ||
, (show . foldr (<>) mempty) (words |
, (show . foldr (<>) mempty) (words |
||
"Love is one damned thing after each other") |
"Love is one damned thing after each other") |
||
]</ |
]</syntaxhighlight> |
||
{{Out}} |
{{Out}} |
||
<pre>55 |
<pre>55 |
||
Line 856: | Line 1,529: | ||
''Prelude'' folds work only on lists, module ''Data.Foldable'' a typeclass for more general fold - interface remains the same. |
''Prelude'' folds work only on lists, module ''Data.Foldable'' a typeclass for more general fold - interface remains the same. |
||
=={{header|Icon}} and {{header|Unicon}}== |
=={{header|Icon}} and {{header|Unicon}}== |
||
Works in both languages: |
Works in both languages: |
||
< |
<syntaxhighlight lang="unicon">procedure main(A) |
||
write(A[1],": ",curry(A[1],A[2:0])) |
write(A[1],": ",curry(A[1],A[2:0])) |
||
end |
end |
||
Line 868: | Line 1,540: | ||
every r := f(r, !A[2:0]) |
every r := f(r, !A[2:0]) |
||
return r |
return r |
||
end</ |
end</syntaxhighlight> |
||
Sample runs: |
Sample runs: |
||
Line 881: | Line 1,553: | ||
||: 314159 |
||: 314159 |
||
</pre> |
</pre> |
||
=={{header|J}}== |
=={{header|J}}== |
||
'''Solution''':<lang |
'''Solution''':<syntaxhighlight lang="j"> /</syntaxhighlight> |
||
'''Example''':< |
'''Example''':<syntaxhighlight lang="j"> +/ 1 2 3 4 5 |
||
15 |
15 |
||
*/ 1 2 3 4 5 |
*/ 1 2 3 4 5 |
||
120 |
120 |
||
!/ 1 2 3 4 5 NB. "n ! k" is "n choose k" |
!/ 1 2 3 4 5 NB. "n ! k" is "n choose k" |
||
45</ |
45</syntaxhighlight> |
||
Insert * into 1 2 3 4 5 |
Insert * into 1 2 3 4 5 |
||
becomes |
becomes |
||
1 * 2 * 3 * 4 * 5 |
1 * 2 * 3 * 4 * 5 |
||
evaluated right to left< |
evaluated right to left<syntaxhighlight lang="j"> |
||
1 * 2 * 3 * 20 |
1 * 2 * 3 * 20 |
||
1 * 2 * 60 |
1 * 2 * 60 |
||
1 * 120 |
1 * 120 |
||
120 |
120 |
||
</syntaxhighlight> |
|||
</lang> |
|||
What are the implications for -/ ? |
What are the implications for -/ ? |
||
For %/ ? |
For %/ ? |
||
=={{header|Java}}== |
=={{header|Java}}== |
||
{{works with|Java|8}} |
{{works with|Java|8}} |
||
< |
<syntaxhighlight lang="java">import java.util.stream.Stream; |
||
public class ReduceTask { |
public class ReduceTask { |
||
Line 912: | Line 1,582: | ||
System.out.println(Stream.of(1, 2, 3, 4, 5).reduce(1, (a, b) -> a * b)); |
System.out.println(Stream.of(1, 2, 3, 4, 5).reduce(1, (a, b) -> a * b)); |
||
} |
} |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre>15 |
<pre>15 |
||
120</pre> |
120</pre> |
||
=={{header|JavaScript}}== |
=={{header|JavaScript}}== |
||
===ES5=== |
===ES5=== |
||
< |
<syntaxhighlight lang="javascript">var nums = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]; |
||
function add(a, b) { |
function add(a, b) { |
||
Line 938: | Line 1,607: | ||
var concatenation = nums.reduce(add, ""); |
var concatenation = nums.reduce(add, ""); |
||
console.log(summation, product, concatenation);</ |
console.log(summation, product, concatenation);</syntaxhighlight> |
||
Note that the JavaScript Array methods include a right fold ( '''.reduceRight()''' ) as well as a left fold: |
Note that the JavaScript Array methods include a right fold ( '''.reduceRight()''' ) as well as a left fold: |
||
< |
<syntaxhighlight lang="javascript">(function (xs) { |
||
'use strict'; |
'use strict'; |
||
Line 963: | Line 1,632: | ||
}); |
}); |
||
})([0, 1, 2, 3, 4, 5, 6, 7, 8, 9]);</ |
})([0, 1, 2, 3, 4, 5, 6, 7, 8, 9]);</syntaxhighlight> |
||
{{Out}} |
{{Out}} |
||
Line 972: | Line 1,641: | ||
===ES6=== |
===ES6=== |
||
< |
<syntaxhighlight 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, 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, 1)); // product of 1..10 |
||
console.log(nums.reduce((a, b) => a + b, '')); // concatenation of 1..10</ |
console.log(nums.reduce((a, b) => a + b, '')); // concatenation of 1..10</syntaxhighlight> |
||
=={{header|jq}}== |
=={{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. |
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 992: | Line 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. |
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}}== |
=={{header|Julia}}== |
||
{{Works with|Julia 1.2}} |
|||
<lang Julia>for op in [+, -, *] println(reduce(op, 1:5)) end</lang> |
|||
<syntaxhighlight lang="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 [+, -, *]])</syntaxhighlight> |
|||
{{out}} |
{{out}} |
||
<pre>15 |
<pre>[15, -13, 120] |
||
-13 |
[15, -13, 120] |
||
120</pre> |
[15, 3, 120]</pre> |
||
=={{header|Kotlin}}== |
=={{header|Kotlin}}== |
||
< |
<syntaxhighlight lang="scala">fun main(args: Array<String>) { |
||
val a = intArrayOf(1, 2, 3, 4, 5) |
val a = intArrayOf(1, 2, 3, 4, 5) |
||
println("Array : ${a.joinToString(", ")}") |
println("Array : ${a.joinToString(", ")}") |
||
Line 1,010: | Line 1,679: | ||
println("Minimum : ${a.reduce { x, y -> if (x < y) x else 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 }}") |
println("Maximum : ${a.reduce { x, y -> if (x > y) x else y }}") |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
Line 1,021: | Line 1,690: | ||
Maximum : 5 |
Maximum : 5 |
||
</pre> |
</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}}== |
=={{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. |
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. |
||
< |
<syntaxhighlight lang="logtalk"> |
||
:- object(folding_examples). |
:- object(folding_examples). |
||
Line 1,039: | Line 1,724: | ||
:- end_object. |
:- end_object. |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 1,049: | Line 1,734: | ||
yes |
yes |
||
</pre> |
</pre> |
||
=={{header|LOLCODE}}== |
=={{header|LOLCODE}}== |
||
{{trans|C}} |
{{trans|C}} |
||
< |
<syntaxhighlight lang="lolcode">HAI 1.3 |
||
HOW IZ I reducin YR array AN YR size AN YR fn |
HOW IZ I reducin YR array AN YR size AN YR fn |
||
Line 1,080: | Line 1,764: | ||
VISIBLE I IZ reducin YR array AN YR 5 AN YR mul MKAY |
VISIBLE I IZ reducin YR array AN YR 5 AN YR mul MKAY |
||
KTHXBYE</ |
KTHXBYE</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
Line 1,086: | Line 1,770: | ||
-13 |
-13 |
||
120</pre> |
120</pre> |
||
=={{header|Lua}}== |
=={{header|Lua}}== |
||
<syntaxhighlight lang="lua"> |
|||
<lang Lua> |
|||
table.unpack = table.unpack or unpack -- 5.1 compatibility |
table.unpack = table.unpack or unpack -- 5.1 compatibility |
||
local nums = {1,2,3,4,5,6,7,8,9} |
local nums = {1,2,3,4,5,6,7,8,9} |
||
Line 1,119: | Line 1,802: | ||
print("cat {1..9}: ",reduce(cat,table.unpack(nums))) |
print("cat {1..9}: ",reduce(cat,table.unpack(nums))) |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{out}} |
{{out}} |
||
Line 1,127: | Line 1,810: | ||
cat {1..9}: 123456789 |
cat {1..9}: 123456789 |
||
</pre> |
</pre> |
||
=={{header|M2000 Interpreter}}== |
=={{header|M2000 Interpreter}}== |
||
<syntaxhighlight lang="m2000 interpreter"> |
|||
<lang M2000 Interpreter> |
|||
Module CheckIt { |
Module CheckIt { |
||
Function Reduce (a, f) { |
Function Reduce (a, f) { |
||
if len(a)=0 then Error "Nothing to reduce" |
if len(a)=0 then Error "Nothing to reduce" |
||
if len(a)=1 then =Array(a) |
if len(a)=1 then =Array(a) : Exit |
||
k=each(a, 2, -1) |
k=each(a, 2, -1) |
||
m=Array(a) |
m=Array(a) |
||
Line 1,151: | Line 1,832: | ||
} |
} |
||
CheckIt |
CheckIt |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 1,164: | Line 1,845: | ||
=={{header|Maple}}== |
=={{header|Maple}}== |
||
The left fold operator in Maple is foldl, and foldr is the right fold operator. |
The left fold operator in Maple is foldl, and foldr is the right fold operator. |
||
< |
<syntaxhighlight lang="maple">> nums := seq( 1 .. 10 ); |
||
nums := 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 |
nums := 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 |
||
Line 1,171: | Line 1,852: | ||
> foldr( `*`, 1, nums ); # compute product using foldr |
> foldr( `*`, 1, nums ); # compute product using foldr |
||
3628800</ |
3628800</syntaxhighlight> |
||
Compute the horner form of a (sorted) polynomial: |
Compute the horner form of a (sorted) polynomial: |
||
< |
<syntaxhighlight lang="maple">> foldl( (a,b) ->a*T+b, op(map2(op,1,[op( 72*T^5+37*T^4-23*T^3+87*T^2+44*T+29 )]))); |
||
((((72 T + 37) T - 23) T + 87) T + 44) T + 29</ |
((((72 T + 37) T - 23) T + 87) T + 44) T + 29</syntaxhighlight> |
||
=={{header|Mathematica}} / {{header|Wolfram Language}}== |
=={{header|Mathematica}} / {{header|Wolfram Language}}== |
||
< |
<syntaxhighlight lang="mathematica">Fold[f, x, {a, b, c, d}]</syntaxhighlight> |
||
{{Out}} |
{{Out}} |
||
<pre>f[f[f[f[x, a], b], c], d]</pre> |
<pre>f[f[f[f[x, a], b], c], d]</pre> |
||
=={{header|Maxima}}== |
=={{header|Maxima}}== |
||
< |
<syntaxhighlight lang="maxima">lreduce(f, [a, b, c, d], x0); |
||
/* (%o1) f(f(f(f(x0, a), b), c), d) */</ |
/* (%o1) f(f(f(f(x0, a), b), c), d) */</syntaxhighlight> |
||
< |
<syntaxhighlight lang="maxima">lreduce("+", [1, 2, 3, 4], 100); |
||
/* (%o1) 110 */</ |
/* (%o1) 110 */</syntaxhighlight> |
||
=={{header|min}}== |
|||
{{works with|min|0.19.3}} |
|||
<syntaxhighlight lang="min">(1 2 3 4) 0 '+ reduce puts! ; sum |
|||
(1 2 3 4) 1 '* reduce puts! ; product</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
10 |
|||
24 |
|||
</pre> |
|||
=={{header|Modula-2}}== |
|||
<syntaxhighlight lang="modula2">MODULE Catamorphism; |
|||
FROM InOut IMPORT WriteString, WriteCard, WriteLn; |
|||
(* Alas, there are no generic types. This function works for |
|||
CARDINAL only - you would have to copy it and change the types |
|||
to reduce functions of other types. *) |
|||
TYPE Reduction = PROCEDURE (CARDINAL, CARDINAL): CARDINAL; |
|||
PROCEDURE reduce(func: Reduction; |
|||
arr: ARRAY OF CARDINAL; |
|||
first: CARDINAL): CARDINAL; |
|||
VAR i: CARDINAL; |
|||
BEGIN |
|||
FOR i := 0 TO HIGH(arr) DO |
|||
first := func(first, arr[i]); |
|||
END; |
|||
RETURN first; |
|||
END reduce; |
|||
(* Demonstration *) |
|||
PROCEDURE add(a,b: CARDINAL): CARDINAL; |
|||
BEGIN RETURN a+b; END add; |
|||
PROCEDURE mul(a,b: CARDINAL): CARDINAL; |
|||
BEGIN RETURN a*b; END mul; |
|||
PROCEDURE Demonstration; |
|||
VAR a: ARRAY [1..5] OF CARDINAL; |
|||
i: CARDINAL; |
|||
BEGIN |
|||
FOR i := 1 TO 5 DO a[i] := i; END; |
|||
WriteString("Sum of [1..5]: "); |
|||
WriteCard(reduce(add, a, 0), 3); |
|||
WriteLn; |
|||
WriteString("Product of [1..5]: "); |
|||
WriteCard(reduce(mul, a, 1), 3); |
|||
WriteLn; |
|||
END Demonstration; |
|||
BEGIN Demonstration; |
|||
END Catamorphism.</syntaxhighlight> |
|||
{{out}} |
|||
<pre>Sum of [1..5]: 15 |
|||
Product of [1..5]: 120</pre> |
|||
=={{header|Nemerle}}== |
=={{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. |
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. |
||
< |
<syntaxhighlight lang="nemerle">def seq = [1, 4, 6, 3, 7]; |
||
def sum = seq.Fold(0, _ + _); // Fold takes an initial value and a function, here the + operator</ |
def sum = seq.Fold(0, _ + _); // Fold takes an initial value and a function, here the + operator</syntaxhighlight> |
||
=={{header|Nim}}== |
=={{header|Nim}}== |
||
< |
<syntaxhighlight lang="nim">import sequtils |
||
block: |
block: |
||
Line 1,212: | Line 1,942: | ||
multiplication = foldr(numbers, a * b) |
multiplication = foldr(numbers, a * b) |
||
words = @["nim", "is", "cool"] |
words = @["nim", "is", "cool"] |
||
concatenation = foldr(words, a & b)</ |
concatenation = foldr(words, a & b)</syntaxhighlight> |
||
=={{header|Oberon-2}}== |
=={{header|Oberon-2}}== |
||
{{Works with| oo2c Version 2}} |
{{Works with| oo2c Version 2}} |
||
< |
<syntaxhighlight lang="oberon2"> |
||
MODULE Catamorphism; |
MODULE Catamorphism; |
||
IMPORT |
IMPORT |
||
Line 1,289: | Line 2,018: | ||
END |
END |
||
END Catamorphism. |
END Catamorphism. |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 1,296: | Line 2,025: | ||
-14400 |
-14400 |
||
</pre> |
</pre> |
||
=={{header|Objeck}}== |
=={{header|Objeck}}== |
||
< |
<syntaxhighlight lang="objeck"> |
||
use Collection; |
use Collection; |
||
Line 1,315: | Line 2,043: | ||
return a * b; |
return a * b; |
||
} |
} |
||
}</ |
}</syntaxhighlight> |
||
Output |
Output |
||
<pre> |
<pre> |
||
Line 1,321: | Line 2,049: | ||
120 |
120 |
||
</pre> |
</pre> |
||
=={{header|OCaml}}== |
=={{header|OCaml}}== |
||
< |
<syntaxhighlight 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] |
val nums : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10] |
||
# let sum = List.fold_left (+) 0 nums;; |
# let sum = List.fold_left (+) 0 nums;; |
||
val sum : int = 55 |
val sum : int = 55 |
||
# let product = List.fold_left ( * ) 1 nums;; |
# let product = List.fold_left ( * ) 1 nums;; |
||
val product : int = 3628800</ |
val product : int = 3628800</syntaxhighlight> |
||
=={{header|Oforth}}== |
=={{header|Oforth}}== |
||
reduce is already defined into Collection class : |
reduce is already defined into Collection class : |
||
< |
<syntaxhighlight lang="oforth">[ 1, 2, 3, 4, 5 ] reduce(#max) |
||
[ "abc", "def", "gfi" ] reduce(#+)</ |
[ "abc", "def", "gfi" ] reduce(#+)</syntaxhighlight> |
||
=={{header|PARI/GP}}== |
=={{header|PARI/GP}}== |
||
< |
<syntaxhighlight lang="parigp">reduce(f, v)={ |
||
my(t=v[1]); |
my(t=v[1]); |
||
for(i=2,#v,t=f(t,v[i])); |
for(i=2,#v,t=f(t,v[i])); |
||
t |
t |
||
}; |
}; |
||
reduce((a,b)->a+b, [1,2,3,4,5,6,7,8,9,10])</ |
reduce((a,b)->a+b, [1,2,3,4,5,6,7,8,9,10])</syntaxhighlight> |
||
{{works with|PARI/GP|2.8.1+}} |
{{works with|PARI/GP|2.8.1+}} |
||
< |
<syntaxhighlight lang="parigp">fold((a,b)->a+b, [1..10])</syntaxhighlight> |
||
=={{header|Pascal}}== |
=={{header|Pascal}}== |
||
{{works with|Free Pascal}} |
{{works with|Free Pascal}} |
||
Should work with many pascal dialects |
Should work with many pascal dialects |
||
< |
<syntaxhighlight lang="pascal">program reduceApp; |
||
type |
type |
||
Line 1,401: | Line 2,126: | ||
writeln(reduce(@sub,ma)); |
writeln(reduce(@sub,ma)); |
||
writeln(reduce(@mul,ma)); |
writeln(reduce(@mul,ma)); |
||
END.</ |
END.</syntaxhighlight> |
||
output |
output |
||
<pre>-5,-4,-3,-2,-1,1,1,2,3,4,5 |
<pre>-5,-4,-3,-2,-1,1,1,2,3,4,5 |
||
Line 1,407: | Line 2,132: | ||
-11 |
-11 |
||
-1440</pre> |
-1440</pre> |
||
=={{header|Perl}}== |
=={{header|Perl}}== |
||
Perl's reduce function is in a standard package. |
Perl's reduce function is in a standard package. |
||
< |
<syntaxhighlight lang="perl">use List::Util 'reduce'; |
||
# note the use of the odd $a and $b globals |
# note the use of the odd $a and $b globals |
||
Line 1,417: | Line 2,141: | ||
# first argument is really an anon function; you could also do this: |
# first argument is really an anon function; you could also do this: |
||
sub func { $b & 1 ? "$a $b" : "$b $a" } |
sub func { $b & 1 ? "$a $b" : "$b $a" } |
||
print +(reduce \&func, 1 .. 10), "\n"</ |
print +(reduce \&func, 1 .. 10), "\n"</syntaxhighlight> |
||
=={{header|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. |
|||
<lang perl6>my @list = 1..10; |
|||
say [+] @list; |
|||
say [*] @list; |
|||
say [~] @list; |
|||
say [min] @list; |
|||
say [max] @list; |
|||
say [lcm] @list;</lang> |
|||
{{out}} |
|||
<pre>55 |
|||
3628800 |
|||
12345678910 |
|||
1 |
|||
10 |
|||
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: |
|||
<lang perl6>my @list = 1..10; |
|||
say reduce &infix:<+>, @list; |
|||
say reduce &infix:<*>, @list; |
|||
say reduce &infix:<~>, @list; |
|||
say reduce &infix:<min>, @list; |
|||
say reduce &infix:<max>, @list; |
|||
say reduce &infix:<lcm>, @list;</lang> |
|||
=={{header|Phix}}== |
=={{header|Phix}}== |
||
{{trans|C}} |
{{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}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 1,476: | Line 2,168: | ||
120 |
120 |
||
</pre> |
</pre> |
||
=={{header|Phixmonti}}== |
|||
<syntaxhighlight lang="phixmonti">include ..\Utilitys.pmt |
|||
def add + enddef |
|||
def sub - enddef |
|||
def mul * enddef |
|||
def reduce >ps |
|||
1 get |
|||
swap len 2 swap 2 tolist for |
|||
get rot swap tps exec swap |
|||
endfor |
|||
ps> drop |
|||
swap |
|||
enddef |
|||
( 1 2 3 4 5 ) |
|||
getid add reduce ? |
|||
getid sub reduce ? |
|||
getid mul reduce ?</syntaxhighlight> |
|||
=={{header|PicoLisp}}== |
=={{header|PicoLisp}}== |
||
< |
<syntaxhighlight lang="picolisp">(de reduce ("Fun" "Lst") |
||
(let "A" (car "Lst") |
(let "A" (car "Lst") |
||
(for "N" (cdr "Lst") |
(for "N" (cdr "Lst") |
||
Line 1,488: | Line 2,200: | ||
(reduce * (1 2 3 4 5)) ) |
(reduce * (1 2 3 4 5)) ) |
||
(bye)</ |
(bye)</syntaxhighlight> |
||
=={{header|PowerShell}}== |
=={{header|PowerShell}}== |
||
'Filter' is a more common sequence function in PowerShell than 'reduce' or 'map', but here is one way to accomplish 'reduce': |
'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} |
1..5 | ForEach-Object -Begin {$result = 0} -Process {$result += $_} -End {$result} |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{Out}} |
{{Out}} |
||
<pre> |
<pre> |
||
15 |
15 |
||
</pre> |
</pre> |
||
=={{header|Prolog}}== |
=={{header|Prolog}}== |
||
SWI-Prolog has native foldl in version 6.3.1<br> |
|||
Module lambda was written by '''Ulrich Neumerkel''' and can be found there http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/lambda.pl |
|||
<lang Prolog>:- use_module(library(lambda)). |
|||
===Using <code>foldl</code> from <code>library(apply)</code> and Lambda-Expressions from <code>library(lambda)</code>=== |
|||
% foldl is now a predicate of SWI-Prolog 6.3.1 |
|||
% |
|||
* SWI-Prolog's [https://www.swi-prolog.org/pldoc/man?section=apply library(apply)] provides a [https://www.swi-prolog.org/pldoc/doc_for?object=foldl/4 `foldl/4`] (the source code of which can be seen [https://www.swi-prolog.org/pldoc/doc/_SWI_/library/apply.pl?show=src#foldl/4 here]). |
|||
* '''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)]) |
|||
<syntaxhighlight lang="prolog">:- use_module(library(lambda)). |
|||
catamorphism :- |
catamorphism :- |
||
numlist(1,10,L), |
numlist(1,10,L), |
||
Line 1,516: | Line 2,228: | ||
foldl(\XC^YC^ZC^(string_to_atom(XS, XC),string_concat(YC,XS,ZC)), |
foldl(\XC^YC^ZC^(string_to_atom(XS, XC),string_concat(YC,XS,ZC)), |
||
L, LV, Concat), |
L, LV, Concat), |
||
format('Concat of ~w is ~w~n', [L, Concat]).</ |
format('Concat of ~w is ~w~n', [L, Concat]).</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre> ?- catamorphism. |
<pre> ?- catamorphism. |
||
Line 1,525: | Line 2,237: | ||
</pre> |
</pre> |
||
===Bare Prolog=== |
|||
This is based on SWI Prolog 8 and has the following specificities: |
|||
* The consbox functor is <code>[|]</code> instead of <code>.</code> |
|||
* The list is terminated by the special atomic thing <code>[]</code> (the empty list) |
|||
<syntaxhighlight lang="prolog"> |
|||
% List to be folded: |
|||
% |
|||
% +---+---+---+---[] <-- list backbone/spine, composed of nodes, terminating in the empty list |
|||
% | | | | |
|||
% a b c d <-- list items/entries/elements/members |
|||
% |
|||
</syntaxhighlight> |
|||
====linear <code>foldl</code>==== |
|||
<syntaxhighlight lang="prolog"> |
|||
% Computes "Out" as: |
|||
% |
|||
% starter value -->--f-->--f-->--f-->--f-->-- Out |
|||
% | | | | |
|||
% a b c d |
|||
foldl(Foldy,[Item|Items],Acc,Result) :- % case of nonempty list |
|||
!, % GREEN CUT for determinism |
|||
call(Foldy,Item,Acc,AccNext), % call Foldy(Item,Acc,AccNext) |
|||
foldl(Foldy,Items,AccNext,Result). % then recurse (open to tail call optimization) |
|||
foldl(_,[],Acc,Result) :- % case of empty list |
|||
Acc=Result. % unification not in head for clarity |
|||
</syntaxhighlight> |
|||
====linear <code>foldr</code>==== |
|||
<syntaxhighlight lang="prolog"> |
|||
% Computes "Out" as: |
|||
% |
|||
% Out --<--f--<--f--<--f--<--f--<-- starter value |
|||
% | | | | |
|||
% a b c d |
|||
foldr(Foldy,[Item|Items],Starter,AccUp) :- % case of nonempty list |
|||
!, % GREEN CUT for determinism |
|||
foldr(Foldy,Items,Starter,AccUpPrev), % recurse (NOT open to tail-call optimization) |
|||
call(Foldy,Item,AccUpPrev,AccUp). % call Foldy(Item,AccupPrev,AccUp) as last action |
|||
foldr(_,[],Starter,AccUp) :- % empty list: bounce Starter "upwards" into AccUp |
|||
AccUp=Starter. % unification not in head for clarity |
|||
</syntaxhighlight> |
|||
====Unit tests==== |
|||
This is written using SWI-Prolog's [https://www.swi-prolog.org/pldoc/doc_for?object=section(%27packages/plunit.html%27) unit testing framework]. |
|||
Functions (in predicate form) of interest for our test cases: |
|||
<syntaxhighlight lang="prolog"> |
|||
:- use_module(library(clpfd)). % We are using #= instead of the raw "is". |
|||
foldy_len(_Item,ThreadIn,ThreadOut) :- |
|||
succ(ThreadIn,ThreadOut). |
|||
foldy_add(Item,ThreadIn,ThreadOut) :- |
|||
ThreadOut #= Item+ThreadIn. |
|||
foldy_mult(Item,ThreadIn,ThreadOut) :- |
|||
ThreadOut #= Item*ThreadIn. |
|||
foldy_squadd(Item,ThreadIn,ThreadOut) :- |
|||
ThreadOut #= Item+(ThreadIn^2). |
|||
% '[|]' is SWI-Prolog specific, replace by '.' as consbox constructor in other Prologs |
|||
foldy_build(Item,ThreadIn,ThreadOut) :- |
|||
ThreadOut = '[|]'(Item,ThreadIn). |
|||
foldy_join(Item,ThreadIn,ThreadOut) :- |
|||
(ThreadIn \= "") |
|||
-> with_output_to(string(ThreadOut),format("~w,~w",[Item,ThreadIn])) |
|||
; with_output_to(string(ThreadOut),format("~w",[Item])). |
|||
% '=..' ("univ") constructs a term from a list of functor and arguments |
|||
foldy_expr(Functor,Item,ThreadIn,ThreadOut) :- |
|||
ThreadOut =.. [Functor,Item,ThreadIn]. |
|||
</syntaxhighlight> |
|||
<syntaxhighlight lang="prolog"> |
|||
:- begin_tests(foldr). |
|||
in([1,2,3,4,5]). |
|||
ffr(Foldy,List,Starter,AccUp) :- foldr(Foldy,List,Starter,AccUp). |
|||
test(foo_foldr_len) :- in(L),ffr(foldy_len , L , 0 , R), R=5. |
|||
test(foo_foldr_add) :- in(L),ffr(foldy_add , L , 0 , R), R=15. |
|||
test(foo_foldr_mult) :- in(L),ffr(foldy_mult , L , 1 , R), R=120. |
|||
test(foo_foldr_build) :- in(L),ffr(foldy_build , L , [] , R), R=[1,2,3,4,5]. |
|||
test(foo_foldr_squadd) :- in(L),ffr(foldy_squadd , L , 0 , R), R=507425426245. |
|||
test(foo_foldr_join) :- in(L),ffr(foldy_join , L , "" , R), R="1,2,3,4,5". |
|||
test(foo_foldr_expr) :- in(L),ffr(foldy_expr(*) , L , 1 , R), R=1*(2*(3*(4*(5*1)))). |
|||
test(foo_foldr_len_empty) :- ffr(foldy_len , [], 0 , R), R=0. |
|||
test(foo_foldr_add_empty) :- ffr(foldy_add , [], 0 , R), R=0. |
|||
test(foo_foldr_mult_empty) :- ffr(foldy_mult , [], 1 , R), R=1. |
|||
test(foo_foldr_build_empty) :- ffr(foldy_build , [], [] , R), R=[]. |
|||
test(foo_foldr_squadd_empty) :- ffr(foldy_squadd , [], 0 , R), R=0. |
|||
test(foo_foldr_join_empty) :- ffr(foldy_join , [], "" , R), R="". |
|||
test(foo_foldr_expr_empty) :- ffr(foldy_expr(*) , [], 1 , R), R=1. |
|||
% library(apply) has no "foldr" so no comparison tests! |
|||
:- end_tests(foldr). |
|||
:- begin_tests(foldl). |
|||
in([1,2,3,4,5]). |
|||
ffl(Foldy,List,Starter,Result) :- foldl(Foldy,List,Starter,Result). |
|||
test(foo_foldl_len) :- in(L),ffl(foldy_len , L , 0 , R), R=5. |
|||
test(foo_foldl_add) :- in(L),ffl(foldy_add , L, 0 , R), R=15. |
|||
test(foo_foldl_mult) :- in(L),ffl(foldy_mult , L, 1 , R), R=120. |
|||
test(foo_foldl_build) :- in(L),ffl(foldy_build , L, [] , R), R=[5,4,3,2,1]. |
|||
test(foo_foldl_squadd) :- in(L),ffl(foldy_squadd , L, 0 , R), R=21909. |
|||
test(foo_foldl_join) :- in(L),ffl(foldy_join , L, "" , R), R="5,4,3,2,1". |
|||
test(foo_foldl_expr) :- in(L),ffl(foldy_expr(*) , L, 1 , R), R=5*(4*(3*(2*(1*1)))). |
|||
test(foo_foldl_len_empty) :- ffl(foldy_len , [], 0 , R), R=0. |
|||
test(foo_foldl_add_empty) :- ffl(foldy_add , [], 0 , R), R=0. |
|||
test(foo_foldl_mult_empty) :- ffl(foldy_mult , [], 1 , R), R=1. |
|||
test(foo_foldl_build_empty) :- ffl(foldy_build , [], [] , R), R=[]. |
|||
test(foo_foldl_squadd_empty) :- ffl(foldy_squadd , [], 0 , R), R=0. |
|||
test(foo_foldl_join_empty) :- ffl(foldy_join , [], "" , R), R="". |
|||
test(foo_foldl_expr_empty) :- ffl(foldy_expr(*) , [], 1 , R), R=1. |
|||
:- end_tests(foldl). |
|||
rt :- run_tests(foldr),run_tests(foldl). |
|||
</syntaxhighlight> |
|||
=={{header|PureBasic}}== |
|||
<syntaxhighlight lang="purebasic">Procedure.i reduce(List l(),op$="+") |
|||
If FirstElement(l()) |
|||
x=l() |
|||
While NextElement(l()) |
|||
Select op$ |
|||
Case "+" : x+l() |
|||
Case "-" : x-l() |
|||
Case "*" : x*l() |
|||
EndSelect |
|||
Wend |
|||
EndIf |
|||
ProcedureReturn x |
|||
EndProcedure |
|||
NewList fold() |
|||
For i=1 To 5 : AddElement(fold()) : fold()=i : Next |
|||
Debug reduce(fold()) |
|||
Debug reduce(fold(),"-") |
|||
Debug reduce(fold(),"*")</syntaxhighlight> |
|||
{{out}} |
|||
<pre>15 |
|||
-13 |
|||
120</pre> |
|||
=={{header|Python}}== |
=={{header|Python}}== |
||
< |
<syntaxhighlight lang="python">>>> # Python 2.X |
||
>>> from operator import add |
>>> from operator import add |
||
>>> listoflists = [['the', 'cat'], ['sat', 'on'], ['the', 'mat']] |
>>> listoflists = [['the', 'cat'], ['sat', 'on'], ['the', 'mat']] |
||
Line 1,544: | Line 2,425: | ||
>>> reduce(add, listoflists, []) |
>>> reduce(add, listoflists, []) |
||
['the', 'cat', 'sat', 'on', 'the', 'mat'] |
['the', 'cat', 'sat', 'on', 'the', 'mat'] |
||
>>> </ |
>>> </syntaxhighlight> |
||
===Additional example=== |
===Additional example=== |
||
< |
<syntaxhighlight lang="python"># Python 3.X |
||
from functools import reduce |
from functools import reduce |
||
Line 1,559: | Line 2,440: | ||
concatenation = reduce(lambda a, b: str(a) + str(b), nums) |
concatenation = reduce(lambda a, b: str(a) + str(b), nums) |
||
print(summation, product, concatenation)</ |
print(summation, product, concatenation)</syntaxhighlight> |
||
=={{header|Quackery}}== |
|||
Among its many other uses, <code>witheach</code> can act like reduce. In the Quackery shell (REPL): |
|||
<syntaxhighlight lang="quackery">/O> 0 ' [ 1 2 3 4 5 ] witheach + |
|||
... 1 ' [ 1 2 3 4 5 ] witheach * |
|||
... |
|||
Stack: 15 120</syntaxhighlight> |
|||
=={{header|R}}== |
=={{header|R}}== |
||
Sum the numbers in a vector: |
Sum the numbers in a vector: |
||
<syntaxhighlight lang="r"> |
|||
<lang R> |
|||
Reduce('+', c(2,30,400,5000)) |
Reduce('+', c(2,30,400,5000)) |
||
5432 |
5432 |
||
</syntaxhighlight> |
|||
</lang> |
|||
Put a 0 between each pair of numbers: |
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)) |
Reduce(function(a,b){c(a,0,b)}, c(2,3,4,5)) |
||
2 0 3 0 4 0 5 |
2 0 3 0 4 0 5 |
||
</syntaxhighlight> |
|||
</lang> |
|||
Generate all prefixes of a string: |
Generate all prefixes of a string: |
||
<syntaxhighlight lang="r"> |
|||
<lang R> |
|||
Reduce(paste0, unlist(strsplit("freedom", NULL)), accum=T) |
Reduce(paste0, unlist(strsplit("freedom", NULL)), accum=T) |
||
"f" "fr" "fre" "free" "freed" "freedo" "freedom" |
"f" "fr" "fre" "free" "freed" "freedo" "freedom" |
||
</syntaxhighlight> |
|||
</lang> |
|||
Filter and map: |
Filter and map: |
||
<syntaxhighlight lang="r"> |
|||
<lang R> |
|||
Reduce(function(x,acc){if (0==x%%3) c(x*x,acc) else acc}, 0:22, |
Reduce(function(x,acc){if (0==x%%3) c(x*x,acc) else acc}, 0:22, |
||
init=c(), right=T) |
init=c(), right=T) |
||
0 9 36 81 144 225 324 441 |
0 9 36 81 144 225 324 441 |
||
</syntaxhighlight> |
|||
</lang> |
|||
=={{header|Racket}}== |
=={{header|Racket}}== |
||
< |
<syntaxhighlight lang="racket"> |
||
#lang racket |
#lang racket |
||
(define (fold f xs init) |
(define (fold f xs init) |
||
Line 1,602: | Line 2,488: | ||
(fold + '(1 2 3) 0) ; the result is 6 |
(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" line>my @list = 1..10; |
|||
say [+] @list; |
|||
say [*] @list; |
|||
say [~] @list; |
|||
say min @list; |
|||
say max @list; |
|||
say [lcm] @list;</syntaxhighlight> |
|||
{{out}} |
|||
<pre>55 |
|||
3628800 |
|||
12345678910 |
|||
1 |
|||
10 |
|||
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" line>my @list = 1..10; |
|||
say reduce &infix:<+>, @list; |
|||
say reduce &infix:<*>, @list; |
|||
say reduce &infix:<~>, @list; |
|||
say reduce &infix:<min>, @list; |
|||
say reduce &infix:<max>, @list; |
|||
say reduce &infix:<lcm>, @list;</syntaxhighlight> |
|||
=={{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}}== |
=={{header|REXX}}== |
||
This REXX example is modeled after the |
This REXX example is modeled after the Raku example (it is NOT a translation). |
||
Also, a '''list''' and '''show''' function were added, although they |
Also, a '''list''' and '''show''' function were added, although they |
||
aren't a catamorphism, as they don't produce or reduce the values to a ''single'' value, but |
aren't a catamorphism, as they don't produce or reduce the values to a ''single'' value, but |
||
are included here to help display the values in the list. |
are included here to help display the values in the list. |
||
< |
<syntaxhighlight lang="rexx">/*REXX program demonstrates a method for catamorphism for some simple functions. */ |
||
@list= 1 2 3 4 5 6 7 8 9 10 |
@list= 1 2 3 4 5 6 7 8 9 10 |
||
say 'list:' fold(@list, "list") |
say 'list:' fold(@list, "list") |
||
Line 1,623: | Line 2,549: | ||
exit /*stick a fork in it, we're all done. */ |
exit /*stick a fork in it, we're all done. */ |
||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
||
fold: procedure; parse arg z; arg ,f; z=space(z); |
fold: procedure; parse arg z; arg ,f; z = space(z); BIFs= 'MIN MAX LCM GCD' |
||
za=translate(z, f, ' '); |
za= translate(z, f, ' '); zf= f"("translate(z, ',' , " ")')' |
||
if f=='+' | f=="*" |
if f== '+' | f=="*" then interpret "return" za |
||
if f=='||' |
if f== '||' then return space(z, 0) |
||
if f=='AVG' |
if f== 'AVG' then interpret "return" fold(z, '+') "/" words(z) |
||
if wordpos(f, BIFs)\==0 then interpret "return" zf |
if wordpos(f, BIFs)\==0 then interpret "return" zf |
||
if f=='LIST' | f=="SHOW" then return z |
if f=='LIST' | f=="SHOW" then return z |
||
return 'illegal function:' arg(2) |
return 'illegal function:' arg(2) |
||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
||
GCD: procedure; $=; |
GCD: procedure; $=; do j=1 for arg(); $= $ arg(j) |
||
end /*j*/ |
|||
parse var $ x z .; if x=0 then x= z /* [↑] build an arg list.*/ |
|||
x=abs(x) |
|||
x= abs(x) |
|||
do k=2 to words($); y=abs(word($, k)); if y=0 then iterate |
|||
do |
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 |
return x |
||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
||
LCM: procedure; $=; |
LCM: procedure; $=; do j=1 for arg(); $= $ arg(j) |
||
end /*j*/ |
|||
x= abs(word($, 1)) /* [↑] build an arg list.*/ |
|||
do k=2 to words($); != abs(word($, k)); if !=0 then return 0 |
|||
x= x*! / GCD(x, !) /*GCD does the heavy work*/ |
|||
end /*k*/ |
|||
return x</lang> |
|||
return x</syntaxhighlight> |
|||
{{out|output}} |
|||
{{out|output|:}} |
|||
<pre> |
<pre> |
||
list: 1 2 3 4 5 6 7 8 9 10 |
list: 1 2 3 4 5 6 7 8 9 10 |
||
Line 1,661: | Line 2,589: | ||
=={{header|Ring}}== |
=={{header|Ring}}== |
||
< |
<syntaxhighlight lang="ring"> |
||
n = list(10) |
n = list(10) |
||
for i = 1 to 10 |
for i = 1 to 10 |
||
Line 1,696: | Line 2,624: | ||
if op = "cat" decimals(0) cat = string(n[1])+cat2 ok |
if op = "cat" decimals(0) cat = string(n[1])+cat2 ok |
||
return cat |
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}}== |
=={{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: |
The method inject (and it's alias reduce) can be used in several ways; the simplest is to give a methodname as argument: |
||
< |
<syntaxhighlight lang="ruby"># sum: |
||
p (1..10).inject(:+) |
p (1..10).inject(:+) |
||
# smallest number divisible by all numbers from 1 to 20: |
# smallest number divisible by all numbers from 1 to 20: |
||
p (1..20).inject(:lcm) #lcm: lowest common multiple |
p (1..20).inject(:lcm) #lcm: lowest common multiple |
||
</ |
</syntaxhighlight>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. |
||
< |
<syntaxhighlight lang="ruby">p row = [1] |
||
10.times{p row = row.each_cons(2).inject([1,1]){|ar,(a,b)| ar.insert(-2, a+b)} } |
10.times{p row = row.each_cons(2).inject([1,1]){|ar,(a,b)| ar.insert(-2, a+b)} } |
||
Line 1,716: | Line 2,667: | ||
# [1, 6, 15, 20, 15, 6, 1] |
# [1, 6, 15, 20, 15, 6, 1] |
||
# etc |
# etc |
||
</syntaxhighlight> |
|||
</lang> |
|||
=={{header|Run BASIC}}== |
=={{header|Run BASIC}}== |
||
< |
<syntaxhighlight lang="runbasic">for i = 1 to 10 :n(i) = i:next i |
||
print " +: ";" ";cat(10,"+") |
print " +: ";" ";cat(10,"+") |
||
Line 1,746: | Line 2,697: | ||
if op$ = "avg" then cat = cat / count |
if op$ = "avg" then cat = cat / count |
||
if op$ = "cat" then cat = val(str$(n(1))+cat$) |
if op$ = "cat" then cat = val(str$(n(1))+cat$) |
||
end function</ |
end function</syntaxhighlight> |
||
<pre> +: 55 |
<pre> +: 55 |
||
-: -53 |
-: -53 |
||
Line 1,756: | Line 2,707: | ||
avg: 5.5 |
avg: 5.5 |
||
cat: 12345678910</pre> |
cat: 12345678910</pre> |
||
=={{header|Rust}}== |
=={{header|Rust}}== |
||
< |
<syntaxhighlight lang="rust">fn main() { |
||
println!("Sum: {}", (1..10).fold(0, |acc, n| acc + n)); |
println!("Sum: {}", (1..10).fold(0, |acc, n| acc + n)); |
||
println!("Product: {}", (1..10).fold(1, |acc, n| acc * n)); |
println!("Product: {}", (1..10).fold(1, |acc, n| acc * n)); |
||
Line 1,765: | Line 2,715: | ||
println!("Concatenation: {}", |
println!("Concatenation: {}", |
||
chars.iter().map(|&c| (c as u8 + 1) as char).collect::<String>()); |
chars.iter().map(|&c| (c as u8 + 1) as char).collect::<String>()); |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
Line 1,773: | Line 2,723: | ||
Concatenation: bcdef |
Concatenation: bcdef |
||
</pre> |
</pre> |
||
=={{header|Scala}}== |
=={{header|Scala}}== |
||
< |
<syntaxhighlight lang="scala">object Main extends App { |
||
val a = Seq(1, 2, 3, 4, 5) |
val a = Seq(1, 2, 3, 4, 5) |
||
println(s"Array : ${a.mkString(", ")}") |
println(s"Array : ${a.mkString(", ")}") |
||
Line 1,783: | Line 2,732: | ||
println(s"Minimum : ${a.min}") |
println(s"Minimum : ${a.min}") |
||
println(s"Maximum : ${a.max}") |
println(s"Maximum : ${a.max}") |
||
}</ |
}</syntaxhighlight> |
||
=={{header|Scheme}}== |
=={{header|Scheme}}== |
||
===Implementation=== |
===Implementation=== |
||
reduce implemented for a single list: |
reduce implemented for a single list: |
||
< |
<syntaxhighlight lang="scheme">(define (reduce fn init lst) |
||
(do ((val init (fn (car rem) val)) ; accumulated value passed as second argument |
(do ((val init (fn (car rem) val)) ; accumulated value passed as second argument |
||
(rem lst (cdr rem))) |
(rem lst (cdr rem))) |
||
Line 1,793: | Line 2,742: | ||
(display (reduce + 0 '(1 2 3 4 5))) (newline) ; => 15 |
(display (reduce + 0 '(1 2 3 4 5))) (newline) ; => 15 |
||
(display (reduce expt 2 '(3 4))) (newline) ; => 262144</ |
(display (reduce expt 2 '(3 4))) (newline) ; => 262144</syntaxhighlight> |
||
===Using SRFI 1=== |
===Using SRFI 1=== |
||
There is also an implementation of fold and fold-right in SRFI-1, for lists. |
There is also an implementation of fold and fold-right in SRFI-1, for lists. |
||
Line 1,815: | Line 2,764: | ||
21 |
21 |
||
</pre> |
</pre> |
||
=={{header|Sidef}}== |
=={{header|Sidef}}== |
||
< |
<syntaxhighlight lang="ruby">say (1..10 -> reduce('+')); |
||
say (1..10 -> reduce{|a,b| a + b});</ |
say (1..10 -> reduce{|a,b| a + b});</syntaxhighlight> |
||
=={{header|Standard ML}}== |
=={{header|Standard ML}}== |
||
< |
<syntaxhighlight 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 nums = [1,2,3,4,5,6,7,8,9,10] : int list |
||
- val sum = foldl op+ 0 nums; |
- val sum = foldl op+ 0 nums; |
||
val sum = 55 : int |
val sum = 55 : int |
||
- val product = foldl op* 1 nums; |
- val product = foldl op* 1 nums; |
||
val product = 3628800 : int</ |
val product = 3628800 : int</syntaxhighlight> |
||
=={{header|Swift}}== |
=={{header|Swift}}== |
||
< |
<syntaxhighlight lang="swift">let nums = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10] |
||
print(nums.reduce(0, +)) |
print(nums.reduce(0, +)) |
||
print(nums.reduce(1, *)) |
print(nums.reduce(1, *)) |
||
print(nums.reduce("", { $0 + String($1) }))</ |
print(nums.reduce("", { $0 + String($1) }))</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
Line 1,839: | Line 2,785: | ||
3628800 |
3628800 |
||
12345678910</pre> |
12345678910</pre> |
||
=={{header|Tailspin}}== |
|||
It is probably easier to just write the whole thing as an inline transform rather than create a utility. |
|||
<syntaxhighlight lang="tailspin"> |
|||
[1..5] -> \(@: $(1); $(2..last)... -> @: $@ + $; $@!\) -> '$; |
|||
' -> !OUT::write |
|||
[1..5] -> \(@: $(1); $(2..last)... -> @: $@ - $; $@!\) -> '$; |
|||
' -> !OUT::write |
|||
[1..5] -> \(@: $(1); $(2..last)... -> @: $@ * $; $@!\) -> '$; |
|||
' -> !OUT::write |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
15 |
|||
-13 |
|||
120 |
|||
</pre> |
|||
If you really want to make a utility, it could look like this: |
|||
<syntaxhighlight lang="tailspin"> |
|||
templates fold&{op:} |
|||
@: $(1); |
|||
$(2..last)... -> @: [$@, $] -> op; |
|||
$@ ! |
|||
end fold |
|||
templates add |
|||
$(1) + $(2) ! |
|||
end add |
|||
templates mul |
|||
$(1) * $(2) ! |
|||
end mul |
|||
[1..5] -> fold&{op:add} -> '$; |
|||
' -> !OUT::write |
|||
[1..5] -> fold&{op:mul} -> '$; |
|||
' -> !OUT::write |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
15 |
|||
120 |
|||
</pre> |
|||
=={{header|Tcl}}== |
=={{header|Tcl}}== |
||
Tcl does not come with a built-in <tt>fold</tt> command, but it is easy to construct: |
Tcl does not come with a built-in <tt>fold</tt> command, but it is easy to construct: |
||
< |
<syntaxhighlight lang="tcl">proc fold {lambda zero list} { |
||
set accumulator $zero |
set accumulator $zero |
||
foreach item $list { |
foreach item $list { |
||
Line 1,848: | Line 2,837: | ||
} |
} |
||
return $accumulator |
return $accumulator |
||
}</ |
}</syntaxhighlight> |
||
Demonstrating: |
Demonstrating: |
||
< |
<syntaxhighlight 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}}} 0 $1to5] |
||
puts [fold {{a b} {expr {$a*$b}}} 1 $1to5] |
puts [fold {{a b} {expr {$a*$b}}} 1 $1to5] |
||
puts [fold {{a b} {return $a,$b}} x $1to5]</ |
puts [fold {{a b} {return $a,$b}} x $1to5]</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 1,862: | Line 2,851: | ||
</pre> |
</pre> |
||
Note that these particular operations would more conventionally be written as: |
Note that these particular operations would more conventionally be written as: |
||
< |
<syntaxhighlight lang="tcl">puts [::tcl::mathop::+ {*}$1to5] |
||
puts [::tcl::mathop::* {*}$1to5] |
puts [::tcl::mathop::* {*}$1to5] |
||
puts x,[join $1to5 ,]</ |
puts x,[join $1to5 ,]</syntaxhighlight> |
||
But those are not general catamorphisms. |
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}}== |
|||
<syntaxhighlight lang="vb">Public Sub reduce() |
|||
s = [{1,2,3,4,5}] |
|||
Debug.Print WorksheetFunction.Sum(s) |
|||
Debug.Print WorksheetFunction.Product(s) |
|||
End Sub</syntaxhighlight> |
|||
=={{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. |
|||
<syntaxhighlight lang="wdte">let a => import 'arrays'; |
|||
let s => import 'stream'; |
|||
let str => import 'strings'; |
|||
# Sum of [1, 10]: |
|||
let nums => [1; 2; 3; 4; 5; 6; 7; 8; 9; 10]; |
|||
a.stream nums -> s.reduce 0 + -- io.writeln io.stdout; |
|||
# As an alternative to an array, a range stream can be used. Here's the product of [1, 11): |
|||
s.range 1 11 -> s.reduce 1 * -- io.writeln io.stdout; |
|||
# And here's a concatenation: |
|||
s.range 1 11 -> s.reduce '' (str.format '{}{}') -- io.writeln io.stdout;</syntaxhighlight> |
|||
=={{header|Wortel}}== |
=={{header|Wortel}}== |
||
You can reduce an array with the <code>!/</code> operator. |
You can reduce an array with the <code>!/</code> operator. |
||
< |
<syntaxhighlight lang="wortel">!/ ^+ [1 2 3] ; returns 6</syntaxhighlight> |
||
If you want to reduce with an initial value, you'll need the <code>@fold</code> operator. |
If you want to reduce with an initial value, you'll need the <code>@fold</code> operator. |
||
< |
<syntaxhighlight lang="wortel">@fold ^+ 1 [1 2 3] ; returns 7</syntaxhighlight> |
||
{{out}} |
|||
<pre>55 |
|||
3628800 |
|||
12345678910</pre> |
|||
=={{header|Wren}}== |
|||
<syntaxhighlight lang="wren">var a = [1, 2, 3, 4, 5] |
|||
var sum = a.reduce { |acc, i| acc + i } |
|||
var prod = a.reduce { |acc, i| acc * i } |
|||
var sumSq = a.reduce { |acc, i| acc + i*i } |
|||
System.print(a) |
|||
System.print("Sum is %(sum)") |
|||
System.print("Product is %(prod)") |
|||
System.print("Sum of squares is %(sumSq)")</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
[1, 2, 3, 4, 5] |
|||
Sum is 15 |
|||
Product is 120 |
|||
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}}== |
=={{header|zkl}}== |
||
Most sequence objects in zkl have a reduce method. |
Most sequence objects in zkl have a reduce method. |
||
< |
<syntaxhighlight 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 |
"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)</ |
File("foo.zkl").reduce('+(1).fpM("0-"),0) //->5 (lines in file)</syntaxhighlight> |
||
=={{header|ZX Spectrum Basic}}== |
=={{header|ZX Spectrum Basic}}== |
||
{{trans|BBC_BASIC}} |
{{trans|BBC_BASIC}} |
||
< |
<syntaxhighlight lang="zxbasic">10 DIM a(5) |
||
20 FOR i=1 TO 5 |
20 FOR i=1 TO 5 |
||
30 READ a(i) |
30 READ a(i) |
||
Line 1,895: | Line 3,132: | ||
1030 LET tmp=VAL ("tmp"+o$+"a(i)") |
1030 LET tmp=VAL ("tmp"+o$+"a(i)") |
||
1040 NEXT i |
1040 NEXT i |
||
1050 RETURN </ |
1050 RETURN </syntaxhighlight> |
Latest revision as of 14:31, 1 March 2024
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.
- See also
- Wikipedia article: Fold
- Wikipedia article: Catamorphism
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))
- Output:
6 9 5 7
6502 Assembly
define catbuf $10
define catbuf_temp $12
ldx #0
ramloop:
txa
sta $00,x
inx
cpx #$10
bne ramloop
;load zero page addresses $00-$0f with values equal
;to that address
ldx #0 ;zero X
loop_cata:
lda $00,x ;load the zeroth element
clc
adc $01,x ;add the first to it.
inx
inx ;inx twice. Otherwise the same element
;would get added twice
sta catbuf_temp ;store in temp ram
lda catbuf
clc
adc catbuf_temp ;add to previously stored value
sta catbuf ;store in result
cpx #$10 ;is the range over?
bne loop_cata ;if not, loop again
ldx #$00
lda catbuf
sta $00,x
;store the sum in the zeroth entry of the range
inx
lda #$00
;now clear the rest of zeropage, leaving only the sum
clear_ram:
sta $00,x
inx
cpx #$ff
bne clear_ram
ABAP
This works in ABAP version 7.40 and above.
report z_catamorphism.
data(numbers) = value int4_table( ( 1 ) ( 2 ) ( 3 ) ( 4 ) ( 5 ) ).
write: |numbers = { reduce string(
init output = `[`
index = 1
for number in numbers
next output = cond string(
when index eq lines( numbers )
then |{ output }, { number } ]|
when index > 1
then |{ output }, { number }|
else |{ output } { number }| )
index = index + 1 ) }|, /.
write: |sum(numbers) = { reduce int4(
init result = 0
for number in numbers
next result = result + number ) }|, /.
write: |product(numbers) = { reduce int4(
init result = 1
for number in numbers
next result = result * number ) }|, /.
data(strings) = value stringtab( ( `reduce` ) ( `in` ) ( `ABAP` ) ).
write: |strings = { reduce string(
init output = `[`
index = 1
for string in strings
next output = cond string(
when index eq lines( strings )
then |{ output }, { string } ]|
when index > 1
then |{ output }, { string }|
else |{ output } { string }| )
index = index + 1 ) }|, /.
write: |concatenation(strings) = { reduce string(
init text = ``
for string in strings
next text = |{ text } { string }| ) }|, /.
- Output:
numbers = [ 1, 2, 3, 4, 5 ] sum(numbers) = 15 product(numbers) = 120 strings = [ reduce, in, ABAP ] concatenation(strings) = reduce in ABAP
Ada
with Ada.Text_IO;
procedure Catamorphism is
type Fun is access function (Left, Right: Natural) return Natural;
type Arr is array(Natural range <>) of Natural;
function Fold_Left (F: Fun; A: Arr) return Natural is
Result: Natural := A(A'First);
begin
for I in A'First+1 .. A'Last loop
Result := F(Result, A(I));
end loop;
return Result;
end Fold_Left;
function Max (L, R: Natural) return Natural is (if L > R then L else R);
function Min (L, R: Natural) return Natural is (if L < R then L else R);
function Add (Left, Right: Natural) return Natural is (Left + Right);
function Mul (Left, Right: Natural) return Natural is (Left * Right);
package NIO is new Ada.Text_IO.Integer_IO(Natural);
begin
NIO.Put(Fold_Left(Min'Access, (1,2,3,4)), Width => 3);
NIO.Put(Fold_Left(Max'Access, (1,2,3,4)), Width => 3);
NIO.Put(Fold_Left(Add'Access, (1,2,3,4)), Width => 3);
NIO.Put(Fold_Left(Mul'Access, (1,2,3,4)), Width => 3);
end Catamorphism;
- Output:
1 4 10 24
Aime
integer s;
s = 0;
list(1, 2, 3, 4, 5, 6, 7, 8, 9).ucall(add_i, 1, s);
o_(s, "\n");
- Output:
45
ALGOL 68
# 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
APL
Reduce is a built-in APL operator, written as /
.
+/ 1 2 3 4 5 6 7
28
×/ 1 2 3 4 5 6 7
5040
For built-in functions, the seed value is automatically chosen to make sense.
+/⍬
0
×/⍬
1
⌈/⍬ ⍝ this gives the minimum supported value
¯1.797693135E308
For user-supplied functions, the last element in the list is considered the seed.
If F/
is called with a list of only one element, F
itself is never
called, and calling F/
with the empty list is an error.
{⎕←'Input:',⍺,⍵ ⋄ ⍺+⍵}/ 1 2 3 4 5
Input: 4 5
Input: 3 9
Input: 2 12
Input: 1 14
15
{⎕←'Input:',⍺,⍵ ⋄ ⍺+⍵}/ 1
1
{⎕←'Input:',⍺,⍵ ⋄ ⍺+⍵}/ ⍬
DOMAIN ERROR
AppleScript
Iteratively implemented foldl and foldr, using the same argument sequence as in the corresponding JavaScript array methods reduce() and reduceRight().
(Note that to obtain first-class functions from user-defined AppleScript handlers, we have to 'lift' them into script objects).
---------------------- CATAMORPHISMS ---------------------
-- the arguments available to the called function f(a, x, i, l) are
-- a: current accumulator value
-- x: current item in list
-- i: [ 1-based index in list ] optional
-- l: [ a reference to the list itself ] optional
-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
tell mReturn(f)
set v to startValue
set lng to length of xs
repeat with i from 1 to lng
set v to |λ|(v, item i of xs, i, xs)
end repeat
return v
end tell
end foldl
-- the arguments available to the called function f(a, x, i, l) are
-- a: current accumulator value
-- x: current item in list
-- i: [ 1-based index in list ] optional
-- l: [ a reference to the list itself ] optional
-- foldr :: (a -> b -> a) -> a -> [b] -> a
on foldr(f, startValue, xs)
tell mReturn(f)
set v to startValue
set lng to length of xs
repeat with i from lng to 1 by -1
set v to |λ|(v, item i of xs, i, xs)
end repeat
return v
end tell
end foldr
--- OTHER FUNCTIONS DEFINED IN TERMS OF FOLDL AND FOLDR --
-- concat :: [String] -> string
on concat(xs)
foldl(my append, "", xs)
end concat
-- product :: Num a => [a] -> a
on product(xs)
script
on |λ|(a, b)
a * b
end |λ|
end script
foldr(result, 1, xs)
end product
-- str :: a -> String
on str(x)
x as string
end str
-- sum :: Num a => [a] -> a
on sum(xs)
script
on |λ|(a, b)
a + b
end |λ|
end script
foldl(result, 0, xs)
end sum
--------------------------- TEST -------------------------
on run
set xs to {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}
{sum(xs), product(xs), concat(map(str, xs))}
--> {55, 3628800, "10987654321"}
end run
-------------------- GENERIC FUNCTIONS -------------------
-- append :: String -> String -> String
on append(a, b)
a & b
end append
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
-- The list obtained by applying f
-- to each element of xs.
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to |λ|(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
if class of f is script then
f
else
script
property |λ| : f
end script
end if
end mReturn
- Output:
{55, 3628800, "12345678910"}
Arturo
; 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
- Output:
10 24
BASIC
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
Chipmunk Basic
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
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")
True BASIC
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
Yabasic
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
BBC BASIC
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
BCPL
get "libhdr"
let reduce(f, v, len, seed) =
len = 0 -> seed,
reduce(f, v+1, len-1, f(!v, seed))
let start() be
$( let add(x, y) = x+y
let mul(x, y) = x*y
let nums = table 1,2,3,4,5,6,7
writef("%N*N", reduce(add, nums, 7, 0))
writef("%N*N", reduce(mul, nums, 7, 1))
$)
- Output:
28 5040
Binary Lambda Calculus
A minimal size (right) fold in lambda calculus is fold = \f\z (let go = \l.l(\h\t\z.f h (go t))z in go)
which corresponds to the 69-bit BLC program
000001000110100000010110000000010111111110111001011111101111101101110
BQN
BQN has two different primitives for catamorphism:
- Fold(
´
): Works on lists only. - Insert(
˝
): Works on arrays with higher rank.
Both of these primitives take a dyadic function, and an optional initial element.
•Show +´ 30‿1‿20‿2‿10 •Show +˝ 30‿1‿20‿2‿10 •Show tab ← (2+↕5) |⌜ 9+↕3 •Show +˝ tab
63 ┌· · 63 ┘ ┌─ ╵ 1 0 1 0 1 2 1 2 3 4 0 1 3 4 5 ┘ ⟨ 9 7 12 ⟩
Bracmat
( ( fold
= f xs init first rest
. !arg:(?f.?xs.?init)
& ( !xs:&!init
| !xs:%?first ?rest
& !f$(!first.fold$(!f.!rest.!init))
)
)
& out
$ ( fold
$ ( (=a b.!arg:(?a.?b)&!a+!b)
. 1 2 3 4 5
. 0
)
)
& (product=a b.!arg:(?a.?b)&!a*!b)
& out$(fold$(product.1 2 3 4 5.1))
);
Output:
15 120
C
#include <stdio.h>
typedef int (*intFn)(int, int);
int reduce(intFn fn, int size, int *elms)
{
int i, val = *elms;
for (i = 1; i < size; ++i)
val = fn(val, elms[i]);
return val;
}
int add(int a, int b) { return a + b; }
int sub(int a, int b) { return a - b; }
int mul(int a, int b) { return a * b; }
int main(void)
{
int nums[] = {1, 2, 3, 4, 5};
printf("%d\n", reduce(add, 5, nums));
printf("%d\n", reduce(sub, 5, nums));
printf("%d\n", reduce(mul, 5, nums));
return 0;
}
- Output:
15 -13 120
C#
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);
C++
#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
Clojure
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
CLU
% Reduction.
% First type = sequence type (must support S$elements and yield R)
% Second type = right (input) datatype
% Third type = left (output) datatype
reduce = proc [S,R,L: type] (f: proctype (L,R) returns (L),
id: L,
seq: S)
returns (L)
where S has elements: itertype (S) yields (R)
for elem: R in S$elements(seq) do
id := f(id, elem)
end
return(id)
end reduce
% This is necessary to get rid of the exceptions
add = proc (a,b: int) returns (int) return (a+b) end add
mul = proc (a,b: int) returns (int) return (a*b) end mul
% Usage
start_up = proc ()
% abbreviation - reducing int->int->int function over an array[int]
int_reduce = reduce[array[int], int, int]
po: stream := stream$primary_output()
nums: array[int] := array[int]$[1,2,3,4,5,6,7,8,9,10]
% find the sum and the product using reduce
sum: int := int_reduce(add, 0, nums)
product: int := int_reduce(mul, 1, nums)
stream$putl(po, "The sum of [1..10] is: " || int$unparse(sum))
stream$putl(po, "The product of [1..10] is: " || int$unparse(product))
end start_up
- Output:
The sum of [1..10] is: 55 The product of [1..10] is: 3628800
Common Lisp
; Basic usage
> (reduce #'* '(1 2 3 4 5))
120
; Using an initial value
> (reduce #'+ '(1 2 3 4 5) :initial-value 100)
115
; Using only a subsequence
> (reduce #'+ '(1 2 3 4 5) :start 1 :end 4)
9
; Apply a function to each element first
> (reduce #'+ '((a 1) (b 2) (c 3)) :key #'cadr)
6
; Right-associative reduction
> (reduce #'expt '(2 3 4) :from-end T)
2417851639229258349412352
; Compare with
> (reduce #'expt '(2 3 4))
4096
D
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
$ 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
Delphi
See Pascal.
Déjà Vu
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
;; 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
ELENA 5.0 :
import system'collections;
import system'routines;
import extensions;
import extensions'text;
public program()
{
var numbers := new Range(1,10).summarize(new ArrayList());
var summary := numbers.accumulate(new Variable(0), (a,b => a + b));
var product := numbers.accumulate(new Variable(1), (a,b => a * b));
var concatenation := numbers.accumulate(new StringWriter(), (a,b => a.toPrintable() + b.toPrintable()));
console.printLine(summary," ",product," ",concatenation)
}
- Output:
55 362880 12345678910
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"
Erlang
-module(catamorphism).
-export([test/0]).
test() ->
Nums = lists:seq(1,10),
Summation =
lists:foldl(fun(X, Acc) -> X + Acc end, 0, Nums),
Product =
lists:foldl(fun(X, Acc) -> X * Acc end, 1, Nums),
Concatenation =
lists:foldr(
fun(X, Acc) -> integer_to_list(X) ++ Acc end,
"",
Nums),
{Summation, Product, Concatenation}.
Output:
{55,3628800,"12345678910"}
Excel
LAMBDA
Excel provides a good number of standard catamorphisms like SUM, PRODUCT, LEN etc out of the box, but in recent builds of Excel we can write more general catamorphisms as LAMBDA expressions, and bind names to them in the WorkBook Name Manager.
Excel's compound data type is a non-empty array, for which we could write, for example, specialised column or row instances of fold, whether rightward or leftward.
Here is an example of binding the name FOLDLROW to a left fold over a row of Excel cells.
As an example of a binary operator to fold, with an accumulator, over a series of character values, we can define a custom:
updateBracketDepth(accumulator)(character) which:
- Increments the nesting depth given a "[" character
- reduces it given a "]" character
- leaves the nesting depth unchanged for any other character
- updates the accumulator no further if the nesting depth ever becomes negative.
or for a simple bracket count, we could just define a:
bracketCount(accumulator)(character) which:
- Increments the integer accumulator value on each "[" or "]"
- Leaves the accumulator unchanged for other characters.
(See LAMBDA: The ultimate Excel worksheet function)
FOLDROW
=LAMBDA(op,
LAMBDA(a,
LAMBDA(xs,
LET(
b, op(a)(HEADROW(xs)),
IF(1 < COLUMNS(xs),
FOLDROW(op)(b)(
TAILROW(xs)
),
b
)
)
)
)
)
updatedBracketDepth
=LAMBDA(depth,
LAMBDA(c,
IF(0 <= depth,
IF("[" = c,
1 + depth,
IF("]" = c,
depth - 1,
depth
)
),
depth
)
)
)
bracketCount
=LAMBDA(a,
LAMBDA(c,
IF(ISNUMBER(FIND(c, "[]", 1)),
1 + a,
a
)
)
)
HEADROW
=LAMBDA(xs,
LET(REM, "The first item of each row in xs",
INDEX(
xs,
SEQUENCE(ROWS(xs)),
SEQUENCE(1, 1)
)
)
)
TAILROW
=LAMBDA(xs,
LET(REM,"The tail of each row in the grid",
n, COLUMNS(xs) - 1,
IF(0 < n,
INDEX(
xs,
SEQUENCE(ROWS(xs), 1, 1, 1),
SEQUENCE(1, n, 2, 1)
),
NA()
)
)
)
CHARSROW
=LAMBDA(s,
MID(s,
SEQUENCE(1, LEN(s), 1, 1),
1
)
)
- Output:
fx | =FOLDROW( updatedBracketDepth )( 0 )( CHARSROW(C2) ) | |||
---|---|---|---|---|
A | B | C | ||
1 | Final bracket nesting depth | Sample string | ||
2 | 0 | [simply bracketed] | ||
3 | 1 | [[ ] | ||
4 | -1 | [ ]] | ||
5 | 0 | [[[ [] ]]] | ||
6 | 0 | [ [[[ [] ]]] [[[ ]]] [[[ [] ]]] ] | ||
7 | 1 | [ [[[ [ ]]] [[[ ]]] [[[ [] ]]] ] | ||
8 | -1 | ][ [[[ [ ]]] [[[ ]]] [[[ [] ]]] ] |
Or for a simple count of bracket characters, ignoring other characters:
fx | =FOLDROW( bracketCount )( 0 )( CHARSROW(C2) ) | |||
---|---|---|---|---|
A | B | C | ||
1 | Bracket character count | Sample string | ||
2 | 2 | [simply bracketed] | ||
3 | 3 | [[ ] | ||
4 | 3 | [ ]] | ||
5 | 8 | [[[ [] ]]] | ||
6 | 24 | [ [[[ [] ]]] [[[ ]]] [[[ [] ]]] ] | ||
7 | 23 | [ [[[ [ ]]] [[[ ]]] [[[ [] ]]] ] | ||
8 | 24 | ][ [[[ [ ]]] [[[ ]]] [[[ [] ]]] ] |
F#
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"
Factor
{ 1 2 4 6 10 } 0 [ + ] reduce .
- Output:
23
Forth
Forth has three traditions for iterating over the members of a data structure. Under the first, the data structure has words that help you navigate over it and normal Forth looping structures are used. Under the second, the data structure has dedicated looping words and you supply the code that's run for each member. Under the third, the data structure has a loop-over-members word that accepts a function to be run against each member.
There's no need to distinguish between the different kinds of looping ("this one collects function returns into a list; this one threads an accumulator between the function-calls; this one threads two accumulators through the function-calls; this one expects no return values whatsoever from the function-calls") because in Forth all that the looping words have to do is make the data stack available for the function's use. When that's the case, all of these variations, that are so important in other languages, are functionally equivalent.
Although it's possible to have a generic higher-order word that can operate under all kinds of data structures -- this just requires that one settle on an object system and then derive a collections library from it -- this is rarely done. Typically each data structure has its own looping words.
To demonstrate the above points we'll just loop over the bytes of a string.
Some helper words for these examples:
: 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.
Fortran
If Fortran were to offer the ability to pass a parameter "by name", as is used in Jensen's device, then the code might be something like
SUBROUTINE FOLD(t,F,i,ist,lst)
INTEGER t
BYNAME F
DO i = ist,lst
t = F
END DO
END SUBROUTINE FOLD !Result in temp.
temp = a(1); CALL FOLD(temp,temp*a(i),i,2,N)
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.
Fortran however does not provide such a facility. Any parameter that is an expression is evaluated once in the caller's environment, the result placed in temporary storage, and the address of that storage location is passed to the subroutine. Repeated references to that parameter will elicit the same value. But there is special provision for passing a function to a routine, involving the special word EXTERNAL. For every different function in mind, one must diligently supply a name, and work through the overhead of declaring each such function. There is an additional word, INTRINSIC, for use when an intrinsic function (such as SIN) is to be passed as such a parameter since it will appear as its name only, and with the absence of the (...) that would be used for the function's parameters when in an arithmetic expression, it would otherwise be taken as being the name of an ordinary variable.
Here is such an arrangement, in the style of F77 though somewhat affected by F90 in that the END statement names the routine being ended. Similarly, to abate petty complaints about the types of the functions being undeclared, explicit types are specified, though unselecting the compiler diagnostic for that would match the habits of earlier compilers. Also in F90 is the MODULE protocol which involves rather more organised checking of types and additional facilities for arrays so that N need not be passed because secret additional parameters do so.
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 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 F(IFOLD,A(I))
is not a recursive invocation of function IFOLD
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.
INTEGER FUNCTION IFOLD(F,A,N) !"Catamorphism"...
INTEGER F !We're working only with integers.
EXTERNAL F !This is a function, not an array.
INTEGER A(*) !An 1-D array, of unspecified size.
INTEGER N !The number of elements.
INTEGER I !A stepper.
IFOLD = 0 !A default value.
IF (N.LE.0) RETURN !Dodge silly invocations.
IFOLD = A(1) !The function is to have two arguments.
IF (N.EQ.1) RETURN !So, if there is only one element, silly.
DO I = 2,N !Otherwise, stutter along the array.
IFOLD = F(IFOLD,A(I)) !Applying the function.
END DO !On to the next element.
END FUNCTION IFOLD!Thus, F(A(1),A(2)), or F(F(A(1),A(2)),A(3)), or F(F(F(A(1),A(2)),A(3)),A(4)), etc.
INTEGER FUNCTION IADD(I,J)
INTEGER I,J
IADD = I + J
END FUNCTION IADD
INTEGER FUNCTION IMUL(I,J)
INTEGER I,J
IMUL = I*J
END FUNCTION IMUL
INTEGER FUNCTION IDIV(I,J)
INTEGER I,J
IDIV = I/J
END FUNCTION IDIV
INTEGER FUNCTION IVID(I,J)
INTEGER I,J
IVID = J/I
END FUNCTION IVID
PROGRAM POKE
INTEGER ENUFF
PARAMETER (ENUFF = 6)
INTEGER A(ENUFF)
PARAMETER (A = (/1,2,3,4,5,6/))
INTEGER MSG
EXTERNAL IADD,IMUL,IDIV,IVID !Warn that these are the names of functions.
MSG = 6 !Standard output.
WRITE (MSG,1) ENUFF,A
1 FORMAT ('To apply a function in the "catamorphic" style ',
1 "to the ",I0," values ",/,(20I3))
WRITE (MSG,*) "Iadd",IFOLD(IADD,A,ENUFF)
WRITE (MSG,*) "Imul",IFOLD(IMUL,A,ENUFF)
WRITE (MSG,*) "Idiv",IFOLD(IDIV,A,ENUFF)
WRITE (MSG,*) "Ivid",IFOLD(IVID,A,ENUFF)
END PROGRAM POKE
Output:
To apply a function in the "catamorphic" style to the 6 values 1 2 3 4 5 6 Iadd 21 Imul 720 Idiv 0 Ivid 6
FreeBASIC
' 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
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
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
main :: IO ()
main =
putStrLn . unlines $
[ show . foldr (+) 0 -- sum
, show . foldr (*) 1 -- product
, foldr ((++) . show) "" -- concatenation
] <*>
[[1 .. 10]]
- 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
main :: IO ()
main =
let xs = [1 .. 10]
in (putStrLn . unlines)
[ (show . getSum . foldr (<>) mempty) (Sum <$> xs)
, (show . getProduct . foldr (<>) mempty) (Product <$> xs)
, (show . foldr (<>) mempty) (show <$> xs)
, (show . foldr (<>) mempty) (words
"Love is one damned thing after each other")
]
- 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
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
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
Insert * into 1 2 3 4 5 becomes 1 * 2 * 3 * 4 * 5
evaluated right to left
1 * 2 * 3 * 20
1 * 2 * 60
1 * 120
120
What are the implications for -/ ? For %/ ?
Java
import java.util.stream.Stream;
public class ReduceTask {
public static void main(String[] args) {
System.out.println(Stream.of(1, 2, 3, 4, 5).mapToInt(i -> i).sum());
System.out.println(Stream.of(1, 2, 3, 4, 5).reduce(1, (a, b) -> a * b));
}
}
- Output:
15 120
JavaScript
ES5
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
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
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
println([reduce(op, 1:5) for op in [+, -, *]])
println([foldl(op, 1:5) for op in [+, -, *]])
println([foldr(op, 1:5) for op in [+, -, *]])
- Output:
[15, -13, 120] [15, -13, 120] [15, 3, 120]
Kotlin
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
Lambdatalk
{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
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.
:- 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
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
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
M2000 Interpreter
Module CheckIt {
Function Reduce (a, f) {
if len(a)=0 then Error "Nothing to reduce"
if len(a)=1 then =Array(a) : Exit
k=each(a, 2, -1)
m=Array(a)
While k {
m=f(m, array(k))
}
=m
}
a=(1, 2, 3, 4, 5)
Print "Array", a
Print "Sum", Reduce(a, lambda (x,y)->x+y)
Print "Difference", Reduce(a, lambda (x,y)->x-y)
Print "Product", Reduce(a, lambda (x,y)->x*y)
Print "Minimum", Reduce(a, lambda (x,y)->if(x<y->x, y))
Print "Maximum", Reduce(a, lambda (x,y)->if(x>y->x, y))
}
CheckIt
- Output:
Array 1 2 3 4 5 Sum 15 Difference -13 Product 120 Minimum 1 Maximum 5
Maple
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
Fold[f, x, {a, b, c, d}]
- Output:
f[f[f[f[x, a], b], c], d]
Maxima
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 */
min
(1 2 3 4) 0 '+ reduce puts! ; sum
(1 2 3 4) 1 '* reduce puts! ; product
- Output:
10 24
Modula-2
MODULE Catamorphism;
FROM InOut IMPORT WriteString, WriteCard, WriteLn;
(* Alas, there are no generic types. This function works for
CARDINAL only - you would have to copy it and change the types
to reduce functions of other types. *)
TYPE Reduction = PROCEDURE (CARDINAL, CARDINAL): CARDINAL;
PROCEDURE reduce(func: Reduction;
arr: ARRAY OF CARDINAL;
first: CARDINAL): CARDINAL;
VAR i: CARDINAL;
BEGIN
FOR i := 0 TO HIGH(arr) DO
first := func(first, arr[i]);
END;
RETURN first;
END reduce;
(* Demonstration *)
PROCEDURE add(a,b: CARDINAL): CARDINAL;
BEGIN RETURN a+b; END add;
PROCEDURE mul(a,b: CARDINAL): CARDINAL;
BEGIN RETURN a*b; END mul;
PROCEDURE Demonstration;
VAR a: ARRAY [1..5] OF CARDINAL;
i: CARDINAL;
BEGIN
FOR i := 1 TO 5 DO a[i] := i; END;
WriteString("Sum of [1..5]: ");
WriteCard(reduce(add, a, 0), 3);
WriteLn;
WriteString("Product of [1..5]: ");
WriteCard(reduce(mul, a, 1), 3);
WriteLn;
END Demonstration;
BEGIN Demonstration;
END Catamorphism.
- Output:
Sum of [1..5]: 15 Product of [1..5]: 120
Nemerle
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
import sequtils
block:
let
numbers = @[5, 9, 11]
addition = foldl(numbers, a + b)
substraction = foldl(numbers, a - b)
multiplication = foldl(numbers, a * b)
words = @["nim", "is", "cool"]
concatenation = foldl(words, a & b)
block:
let
numbers = @[5, 9, 11]
addition = foldr(numbers, a + b)
substraction = foldr(numbers, a - b)
multiplication = foldr(numbers, a * b)
words = @["nim", "is", "cool"]
concatenation = foldr(words, a & b)
Oberon-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
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
# 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
reduce is already defined into Collection class :
[ 1, 2, 3, 4, 5 ] reduce(#max)
[ "abc", "def", "gfi" ] reduce(#+)
PARI/GP
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])
fold((a,b)->a+b, [1..10])
Pascal
Should work with many pascal dialects
program reduceApp;
type
// tmyArray = array of LongInt;
tmyArray = array[-5..5] of LongInt;
tmyFunc = function (a,b:LongInt):LongInt;
function add(x,y:LongInt):LongInt;
begin
add := x+y;
end;
function sub(k,l:LongInt):LongInt;
begin
sub := k-l;
end;
function mul(r,t:LongInt):LongInt;
begin
mul := r*t;
end;
function reduce(myFunc:tmyFunc;a:tmyArray):LongInt;
var
i,res : LongInt;
begin
res := a[low(a)];
For i := low(a)+1 to high(a) do
res := myFunc(res,a[i]);
reduce := res;
end;
procedure InitMyArray(var a:tmyArray);
var
i: LongInt;
begin
For i := low(a) to high(a) do
begin
//no a[i] = 0
a[i] := i + ord(i=0);
write(a[i],',');
end;
writeln(#8#32);
end;
var
ma : tmyArray;
BEGIN
InitMyArray(ma);
writeln(reduce(@add,ma));
writeln(reduce(@sub,ma));
writeln(reduce(@mul,ma));
END.
output
-5,-4,-3,-2,-1,1,1,2,3,4,5 1 -11 -1440
Perl
Perl's reduce function is in a standard package.
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"
Phix
with javascript_semantics function add(integer a, b) return a + b end function function sub(integer a, b) return a - b end function function mul(integer a, b) return a * b end function function reduce(integer rid, sequence s) object res = s[1] for i=2 to length(s) do res = rid(res,s[i]) end for return res end function ?reduce(add,tagset(5)) ?reduce(sub,tagset(5)) ?reduce(mul,tagset(5))
- Output:
15 -13 120
Phixmonti
include ..\Utilitys.pmt
def add + enddef
def sub - enddef
def mul * enddef
def reduce >ps
1 get
swap len 2 swap 2 tolist for
get rot swap tps exec swap
endfor
ps> drop
swap
enddef
( 1 2 3 4 5 )
getid add reduce ?
getid sub reduce ?
getid mul reduce ?
PicoLisp
(de reduce ("Fun" "Lst")
(let "A" (car "Lst")
(for "N" (cdr "Lst")
(setq "A" ("Fun" "A" "N")) )
"A" ) )
(println
(reduce + (1 2 3 4 5))
(reduce * (1 2 3 4 5)) )
(bye)
PowerShell
'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
Using foldl
from library(apply)
and Lambda-Expressions from library(lambda)
- SWI-Prolog's library(apply) provides a `foldl/4` (the source code of which can be seen here).
- Ulrich Neumerkel wrote `library(lambda)` which can be found here. (However, SWI-Prolog's Lambda Expressions are by default based on Paulo Moura's library(yall))
:- use_module(library(lambda)).
catamorphism :-
numlist(1,10,L),
foldl(\XS^YS^ZS^(ZS is XS+YS), L, 0, Sum),
format('Sum of ~w is ~w~n', [L, Sum]),
foldl(\XP^YP^ZP^(ZP is XP*YP), L, 1, Prod),
format('Prod of ~w is ~w~n', [L, Prod]),
string_to_list(LV, ""),
foldl(\XC^YC^ZC^(string_to_atom(XS, XC),string_concat(YC,XS,ZC)),
L, LV, Concat),
format('Concat of ~w is ~w~n', [L, Concat]).
- 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.
Bare Prolog
This is based on SWI Prolog 8 and has the following specificities:
- The consbox functor is
[|]
instead of.
- The list is terminated by the special atomic thing
[]
(the empty list)
% List to be folded:
%
% +---+---+---+---[] <-- list backbone/spine, composed of nodes, terminating in the empty list
% | | | |
% a b c d <-- list items/entries/elements/members
%
linear foldl
% Computes "Out" as:
%
% starter value -->--f-->--f-->--f-->--f-->-- Out
% | | | |
% a b c d
foldl(Foldy,[Item|Items],Acc,Result) :- % case of nonempty list
!, % GREEN CUT for determinism
call(Foldy,Item,Acc,AccNext), % call Foldy(Item,Acc,AccNext)
foldl(Foldy,Items,AccNext,Result). % then recurse (open to tail call optimization)
foldl(_,[],Acc,Result) :- % case of empty list
Acc=Result. % unification not in head for clarity
linear foldr
% Computes "Out" as:
%
% Out --<--f--<--f--<--f--<--f--<-- starter value
% | | | |
% a b c d
foldr(Foldy,[Item|Items],Starter,AccUp) :- % case of nonempty list
!, % GREEN CUT for determinism
foldr(Foldy,Items,Starter,AccUpPrev), % recurse (NOT open to tail-call optimization)
call(Foldy,Item,AccUpPrev,AccUp). % call Foldy(Item,AccupPrev,AccUp) as last action
foldr(_,[],Starter,AccUp) :- % empty list: bounce Starter "upwards" into AccUp
AccUp=Starter. % unification not in head for clarity
Unit tests
This is written using SWI-Prolog's unit testing framework.
Functions (in predicate form) of interest for our test cases:
:- use_module(library(clpfd)). % We are using #= instead of the raw "is".
foldy_len(_Item,ThreadIn,ThreadOut) :-
succ(ThreadIn,ThreadOut).
foldy_add(Item,ThreadIn,ThreadOut) :-
ThreadOut #= Item+ThreadIn.
foldy_mult(Item,ThreadIn,ThreadOut) :-
ThreadOut #= Item*ThreadIn.
foldy_squadd(Item,ThreadIn,ThreadOut) :-
ThreadOut #= Item+(ThreadIn^2).
% '[|]' is SWI-Prolog specific, replace by '.' as consbox constructor in other Prologs
foldy_build(Item,ThreadIn,ThreadOut) :-
ThreadOut = '[|]'(Item,ThreadIn).
foldy_join(Item,ThreadIn,ThreadOut) :-
(ThreadIn \= "")
-> with_output_to(string(ThreadOut),format("~w,~w",[Item,ThreadIn]))
; with_output_to(string(ThreadOut),format("~w",[Item])).
% '=..' ("univ") constructs a term from a list of functor and arguments
foldy_expr(Functor,Item,ThreadIn,ThreadOut) :-
ThreadOut =.. [Functor,Item,ThreadIn].
:- begin_tests(foldr).
in([1,2,3,4,5]).
ffr(Foldy,List,Starter,AccUp) :- foldr(Foldy,List,Starter,AccUp).
test(foo_foldr_len) :- in(L),ffr(foldy_len , L , 0 , R), R=5.
test(foo_foldr_add) :- in(L),ffr(foldy_add , L , 0 , R), R=15.
test(foo_foldr_mult) :- in(L),ffr(foldy_mult , L , 1 , R), R=120.
test(foo_foldr_build) :- in(L),ffr(foldy_build , L , [] , R), R=[1,2,3,4,5].
test(foo_foldr_squadd) :- in(L),ffr(foldy_squadd , L , 0 , R), R=507425426245.
test(foo_foldr_join) :- in(L),ffr(foldy_join , L , "" , R), R="1,2,3,4,5".
test(foo_foldr_expr) :- in(L),ffr(foldy_expr(*) , L , 1 , R), R=1*(2*(3*(4*(5*1)))).
test(foo_foldr_len_empty) :- ffr(foldy_len , [], 0 , R), R=0.
test(foo_foldr_add_empty) :- ffr(foldy_add , [], 0 , R), R=0.
test(foo_foldr_mult_empty) :- ffr(foldy_mult , [], 1 , R), R=1.
test(foo_foldr_build_empty) :- ffr(foldy_build , [], [] , R), R=[].
test(foo_foldr_squadd_empty) :- ffr(foldy_squadd , [], 0 , R), R=0.
test(foo_foldr_join_empty) :- ffr(foldy_join , [], "" , R), R="".
test(foo_foldr_expr_empty) :- ffr(foldy_expr(*) , [], 1 , R), R=1.
% library(apply) has no "foldr" so no comparison tests!
:- end_tests(foldr).
:- begin_tests(foldl).
in([1,2,3,4,5]).
ffl(Foldy,List,Starter,Result) :- foldl(Foldy,List,Starter,Result).
test(foo_foldl_len) :- in(L),ffl(foldy_len , L , 0 , R), R=5.
test(foo_foldl_add) :- in(L),ffl(foldy_add , L, 0 , R), R=15.
test(foo_foldl_mult) :- in(L),ffl(foldy_mult , L, 1 , R), R=120.
test(foo_foldl_build) :- in(L),ffl(foldy_build , L, [] , R), R=[5,4,3,2,1].
test(foo_foldl_squadd) :- in(L),ffl(foldy_squadd , L, 0 , R), R=21909.
test(foo_foldl_join) :- in(L),ffl(foldy_join , L, "" , R), R="5,4,3,2,1".
test(foo_foldl_expr) :- in(L),ffl(foldy_expr(*) , L, 1 , R), R=5*(4*(3*(2*(1*1)))).
test(foo_foldl_len_empty) :- ffl(foldy_len , [], 0 , R), R=0.
test(foo_foldl_add_empty) :- ffl(foldy_add , [], 0 , R), R=0.
test(foo_foldl_mult_empty) :- ffl(foldy_mult , [], 1 , R), R=1.
test(foo_foldl_build_empty) :- ffl(foldy_build , [], [] , R), R=[].
test(foo_foldl_squadd_empty) :- ffl(foldy_squadd , [], 0 , R), R=0.
test(foo_foldl_join_empty) :- ffl(foldy_join , [], "" , R), R="".
test(foo_foldl_expr_empty) :- ffl(foldy_expr(*) , [], 1 , R), R=1.
:- end_tests(foldl).
rt :- run_tests(foldr),run_tests(foldl).
PureBasic
Procedure.i reduce(List l(),op$="+")
If FirstElement(l())
x=l()
While NextElement(l())
Select op$
Case "+" : x+l()
Case "-" : x-l()
Case "*" : x*l()
EndSelect
Wend
EndIf
ProcedureReturn x
EndProcedure
NewList fold()
For i=1 To 5 : AddElement(fold()) : fold()=i : Next
Debug reduce(fold())
Debug reduce(fold(),"-")
Debug reduce(fold(),"*")
- Output:
15 -13 120
Python
>>> # Python 2.X
>>> from operator import add
>>> listoflists = [['the', 'cat'], ['sat', 'on'], ['the', 'mat']]
>>> help(reduce)
Help on built-in function reduce in module __builtin__:
reduce(...)
reduce(function, sequence[, initial]) -> value
Apply a function of two arguments cumulatively to the items of a sequence,
from left to right, so as to reduce the sequence to a single value.
For example, reduce(lambda x, y: x+y, [1, 2, 3, 4, 5]) calculates
((((1+2)+3)+4)+5). If initial is present, it is placed before the items
of the sequence in the calculation, and serves as a default when the
sequence is empty.
>>> reduce(add, listoflists, [])
['the', 'cat', 'sat', 'on', 'the', 'mat']
>>>
Additional example
# Python 3.X
from functools import reduce
from operator import add, mul
nums = range(1,11)
summation = reduce(add, nums)
product = reduce(mul, nums)
concatenation = reduce(lambda a, b: str(a) + str(b), nums)
print(summation, product, concatenation)
Quackery
Among its many other uses, witheach
can act like reduce. In the Quackery shell (REPL):
/O> 0 ' [ 1 2 3 4 5 ] witheach +
... 1 ' [ 1 2 3 4 5 ] witheach *
...
Stack: 15 120
R
Sum the numbers in a vector:
Reduce('+', c(2,30,400,5000))
5432
Put a 0 between each pair of numbers:
Reduce(function(a,b){c(a,0,b)}, c(2,3,4,5))
2 0 3 0 4 0 5
Generate all prefixes of a string:
Reduce(paste0, unlist(strsplit("freedom", NULL)), accum=T)
"f" "fr" "fre" "free" "freed" "freedo" "freedom"
Filter and map:
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
Racket
#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
Raku
(formerly Perl 6)
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:
my @list = 1..10;
say reduce &infix:<+>, @list;
say reduce &infix:<*>, @list;
say reduce &infix:<~>, @list;
say reduce &infix:<min>, @list;
say reduce &infix:<max>, @list;
say reduce &infix:<lcm>, @list;
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>;
};
- Output:
28 5040
REXX
This REXX example is modeled after the Raku example (it is NOT a translation).
Also, a list and show function were added, although they aren't a catamorphism, as they don't produce or reduce the values to a single value, but are included here to help display the values in the list.
/*REXX program demonstrates a method for catamorphism for some simple functions. */
@list= 1 2 3 4 5 6 7 8 9 10
say 'list:' fold(@list, "list")
say ' sum:' fold(@list, "+" )
say 'prod:' fold(@list, "*" )
say ' cat:' fold(@list, "||" )
say ' min:' fold(@list, "min" )
say ' max:' fold(@list, "max" )
say ' avg:' fold(@list, "avg" )
say ' GCD:' fold(@list, "GCD" )
say ' LCM:' fold(@list, "LCM" )
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
fold: procedure; parse arg z; arg ,f; z = space(z); BIFs= 'MIN MAX LCM GCD'
za= translate(z, f, ' '); zf= f"("translate(z, ',' , " ")')'
if f== '+' | f=="*" then interpret "return" za
if f== '||' then return space(z, 0)
if f== 'AVG' then interpret "return" fold(z, '+') "/" words(z)
if wordpos(f, BIFs)\==0 then interpret "return" zf
if f=='LIST' | f=="SHOW" then return z
return 'illegal function:' arg(2)
/*──────────────────────────────────────────────────────────────────────────────────────*/
GCD: procedure; $=; do j=1 for arg(); $= $ arg(j)
end /*j*/
parse var $ x z .; if x=0 then x= z /* [↑] build an arg list.*/
x= abs(x)
do k=2 to words($); y= abs( word($, k)); if y=0 then iterate
do until _=0; _= x // y; x= y; y= _
end /*until*/
end /*k*/
return x
/*──────────────────────────────────────────────────────────────────────────────────────*/
LCM: procedure; $=; do j=1 for arg(); $= $ arg(j)
end /*j*/
x= abs(word($, 1)) /* [↑] build an arg list.*/
do k=2 to words($); != abs(word($, k)); if !=0 then return 0
x= x*! / GCD(x, !) /*GCD does the heavy work*/
end /*k*/
return x
- 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
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
RPL
≪ → array op
≪ array 1 GET 2
WHILE DUP array SIZE ≤ REPEAT
array OVER GET ROT SWAP op EVAL
SWAP 1 +
END DROP
≫ ≫ 'REDUCE' STO
[ 1 2 3 4 5 6 7 8 9 10 ] ≪ + ≫ REDUCE [ 1 2 3 4 5 6 7 8 9 10 ] ≪ - ≫ REDUCE [ 1 2 3 4 5 6 7 8 9 10 ] ≪ * ≫ REDUCE [ 1 2 3 4 5 6 7 8 9 10 ] ≪ MAX ≫ REDUCE [ 1 2 3 4 5 6 7 8 9 10 ] ≪ SQ + ≫ REDUCE
- Output:
5: 55 4: -53 3: 3628800 2: 10 1: 385
From HP-48G models, a built-in function named STREAM
performs exactly the same as the above REDUCE
one, but only with lists.
Ruby
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
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
Rust
fn main() {
println!("Sum: {}", (1..10).fold(0, |acc, n| acc + n));
println!("Product: {}", (1..10).fold(1, |acc, n| acc * n));
let chars = ['a', 'b', 'c', 'd', 'e'];
println!("Concatenation: {}",
chars.iter().map(|&c| (c as u8 + 1) as char).collect::<String>());
}
- Output:
Sum: 45 Product: 362880 Concatenation: bcdef
Scala
object Main extends App {
val a = Seq(1, 2, 3, 4, 5)
println(s"Array : ${a.mkString(", ")}")
println(s"Sum : ${a.sum}")
println(s"Difference : ${a.reduce { (x, y) => x - y }}")
println(s"Product : ${a.product}")
println(s"Minimum : ${a.min}")
println(s"Maximum : ${a.max}")
}
Scheme
Implementation
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
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
say (1..10 -> reduce('+'));
say (1..10 -> reduce{|a,b| a + b});
Standard ML
- 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
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) }))
- Output:
55 3628800 12345678910
Tailspin
It is probably easier to just write the whole thing as an inline transform rather than create a utility.
[1..5] -> \(@: $(1); $(2..last)... -> @: $@ + $; $@!\) -> '$;
' -> !OUT::write
[1..5] -> \(@: $(1); $(2..last)... -> @: $@ - $; $@!\) -> '$;
' -> !OUT::write
[1..5] -> \(@: $(1); $(2..last)... -> @: $@ * $; $@!\) -> '$;
' -> !OUT::write
- Output:
15 -13 120
If you really want to make a utility, it could look like this:
templates fold&{op:}
@: $(1);
$(2..last)... -> @: [$@, $] -> op;
$@ !
end fold
templates add
$(1) + $(2) !
end add
templates mul
$(1) * $(2) !
end mul
[1..5] -> fold&{op:add} -> '$;
' -> !OUT::write
[1..5] -> fold&{op:mul} -> '$;
' -> !OUT::write
- Output:
15 120
Tcl
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.
uBasic/4tH
uBasic/4tH has only got one single array so passing its address makes little sense. Instead, its bounds are passed.
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@)
This version incorporates a "no op" as well.
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@))
- Output:
Sum is : 15 Difference is : -13 Product is : 120 Maximum is : 5 Minimum is : 1 No op is : 0 0 OK, 0:378
VBA
Public Sub reduce()
s = [{1,2,3,4,5}]
Debug.Print WorksheetFunction.Sum(s)
Debug.Print WorksheetFunction.Product(s)
End Sub
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
}
- Output:
15 -13 120
WDTE
Translated from the JavaScript ES6 example with a few modifications.
let a => import 'arrays';
let s => import 'stream';
let str => import 'strings';
# Sum of [1, 10]:
let nums => [1; 2; 3; 4; 5; 6; 7; 8; 9; 10];
a.stream nums -> s.reduce 0 + -- io.writeln io.stdout;
# As an alternative to an array, a range stream can be used. Here's the product of [1, 11):
s.range 1 11 -> s.reduce 1 * -- io.writeln io.stdout;
# And here's a concatenation:
s.range 1 11 -> s.reduce '' (str.format '{}{}') -- io.writeln io.stdout;
Wortel
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
- Output:
55 3628800 12345678910
Wren
var a = [1, 2, 3, 4, 5]
var sum = a.reduce { |acc, i| acc + i }
var prod = a.reduce { |acc, i| acc * i }
var sumSq = a.reduce { |acc, i| acc + i*i }
System.print(a)
System.print("Sum is %(sum)")
System.print("Product is %(prod)")
System.print("Sum of squares is %(sumSq)")
- Output:
[1, 2, 3, 4, 5] Sum is 15 Product is 120 Sum of squares is 55
Zig
Works with: 0.10.x, 0.11.x, 0.12.0-dev.1591+3fc6a2f11
Reduce a slice
/// 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;
}
Usage:
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)});
}
- Output:
Array: { 1, 2, 3, 4, 5 } * Reduce with add: 15 * Reduce with mul: 120 * Reduce with min: 1 * Reduce with max: 5
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).
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)});
}
- Output:
Vec: { 1, 2, 3, 4, 5 } * Reduce with add: 15 * Reduce with mul: 120 * Reduce with min: 1 * Reduce with max: 5
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):
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]});
}
- Output:
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
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.
zkl
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
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
- Programming Tasks
- Solutions by Programming Task
- 11l
- 6502 Assembly
- ABAP
- Ada
- Aime
- ALGOL 68
- APL
- AppleScript
- Arturo
- BASIC
- BASIC256
- Chipmunk Basic
- QBasic
- True BASIC
- Yabasic
- BBC BASIC
- BCPL
- Binary Lambda Calculus
- BQN
- Bracmat
- C
- C sharp
- C++
- Clojure
- CLU
- Common Lisp
- D
- DCL
- Delphi
- Déjà Vu
- EchoLisp
- Elena
- Elixir
- Erlang
- Excel
- F Sharp
- Factor
- Forth
- Fortran
- FreeBASIC
- Go
- Groovy
- Haskell
- Icon
- Unicon
- J
- Java
- JavaScript
- Jq
- Julia
- Kotlin
- Lambdatalk
- Logtalk
- LOLCODE
- Lua
- M2000 Interpreter
- Maple
- Mathematica
- Wolfram Language
- Maxima
- Min
- Modula-2
- Nemerle
- Nim
- Oberon-2
- Objeck
- OCaml
- Oforth
- PARI/GP
- Pascal
- Perl
- Phix
- Phixmonti
- PicoLisp
- PowerShell
- Prolog
- PureBasic
- Python
- Quackery
- R
- Racket
- Raku
- Refal
- REXX
- Ring
- RPL
- Ruby
- Run BASIC
- Rust
- Scala
- Scheme
- Sidef
- Standard ML
- Swift
- Tailspin
- Tcl
- UBasic/4tH
- VBA
- V (Vlang)
- WDTE
- Wortel
- Wren
- Zig
- Zkl
- ZX Spectrum Basic