Ackermann function: Difference between revisions
| Line 319: | Line 319: | ||
static uint32_t ackermann(uint32_t m, uint32_t n) |
static uint32_t ackermann(uint32_t m, uint32_t n) |
||
{ |
{ |
||
return m == 0 ? n + 1 : |
return m == 0 ? n + 1 : ackermann(m - 1, n == 0 ? 1 : ackermann(m, n - 1)); |
||
} |
} |
||
Revision as of 22:12, 1 February 2011
You are encouraged to solve this task according to the task description, using any language you may know.
The Ackermann function is a classic recursive example in computer science. It is a function that grows very quickly (in its value and in the size of its call tree). It is defined as follows:
Its arguments are never negative and it always terminates. Write a function which returns the value of . Arbitrary precision is preferred (since the function grows so quickly), but not required.
ABAP
<lang ABAP>report z_ackermann data: lv_local type i,
lv_y type i,
lv_x type i.
do 7 times.
lv_y = sy-index - 1.
do 5 times.
lv_x = sy-index - 1.
perform ackermann using lv_y lv_x changing lv_local.
write : / 'A(', (1) lv_x, ',', (1) lv_y, ') = ', (4) lv_local left-justified.
enddo.
enddo.
form ackermann using iv_x type i iv_y type i changing ev_out type i.
data: lv_x type i,
lv_y type i.
if iv_x is initial. ev_out = iv_y + 1. return. endif.
lv_x = iv_x - 1.
if iv_y is initial. perform ackermann using lv_x 1 changing ev_out. return. endif.
lv_y = iv_y - 1.
perform ackermann using iv_x lv_y changing lv_y. perform ackermann using lv_x lv_y changing ev_out.
endform.</lang>
Output Excerpt:
A( 0 , 3 ) = 5 A( 1 , 3 ) = 13 A( 2 , 3 ) = 29 A( 3 , 3 ) = 61 A( 4 , 3 ) = 125
ActionScript
<lang actionscript>public function ackermann(m:uint, n:uint):uint {
if (m == 0)
{
return n + 1;
}
if (n == 0)
{
return ackermann(m - 1, 1);
}
return ackermann(m - 1, ackermann(m, n - 1));
}</lang>
Ada
<lang ada>with Ada.Text_IO; use Ada.Text_IO;
procedure Test_Ackermann is
function Ackermann (M, N : Natural) return Natural is
begin
if M = 0 then
return N + 1;
elsif N = 0 then
return Ackermann (M - 1, 1);
else
return Ackermann (M - 1, Ackermann (M, N - 1));
end if;
end Ackermann;
begin
for M in 0..3 loop
for N in 0..6 loop
Put (Natural'Image (Ackermann (M, N)));
end loop;
New_Line;
end loop;
end Test_Ackermann;</lang> The implementation does not care about arbitrary precision numbers because the Ackermann function does not only grow, but also slow quickly, when computed recursively. The example outputs first 4x7 Ackermann's numbers:
1 2 3 4 5 6 7 2 3 4 5 6 7 8 3 5 7 9 11 13 15 5 13 29 61 125 253 509
ALGOL 68
<lang algol68>PROC test ackermann = VOID: BEGIN
PROC ackermann = (INT m, n)INT:
BEGIN
IF m = 0 THEN
n + 1
ELIF n = 0 THEN
ackermann (m - 1, 1)
ELSE
ackermann (m - 1, ackermann (m, n - 1))
FI
END # ackermann #;
FOR m FROM 0 TO 3 DO
FOR n FROM 0 TO 6 DO
print(ackermann (m, n))
OD;
new line(stand out)
OD
END # test ackermann #; test ackermann</lang>
Output:
+1 +2 +3 +4 +5 +6 +7
+2 +3 +4 +5 +6 +7 +8
+3 +5 +7 +9 +11 +13 +15
+5 +13 +29 +61 +125 +253 +509
APL
<lang APL> ackermann←{
0=1⊃⍵:1+2⊃⍵
0=2⊃⍵:∇(¯1+1⊃⍵)1
∇(¯1+1⊃⍵),∇(1⊃⍵),¯1+2⊃⍵
}</lang>
Argile
<lang Argile>use std
for each (val nat n) from 0 to 6
for each (val nat m) from 0 to 3
print "A("m","n") = "(A m n)
.:A <nat m, nat n>:. -> nat
return (n+1) if m == 0 return (A (m - 1) 1) if n == 0 A (m - 1) (A m (n - 1))</lang>
AutoHotkey
<lang AutoHotkey>A(m, n) {
If (m > 0) && (n = 0) Return A(m-1,1) Else If (m > 0) && (n > 0) Return A(m-1,A(m, n-1)) Else If (m=0) Return n+1
}
- Example
MsgBox, % "A(1,2) = " A(1,2)</lang>
AWK
<lang awk>function ackermann(m, n) {
if ( m == 0 ) {
return n+1
}
if ( n == 0 ) {
return ackermann(m-1, 1)
}
return ackermann(m-1, ackermann(m, n-1))
}
BEGIN {
for(n=0; n < 7; n++) {
for(m=0; m < 4; m++) {
print "A(" m "," n ") = " ackermann(m,n)
}
}
}</lang>
BASIC
BASIC runs out of stack space very quickly. The call ack(3, 4) gives a stack error. <lang qbasic>DECLARE FUNCTION ack! (m!, n!)
FUNCTION ack (m!, n!)
IF m = 0 THEN ack = n + 1
IF m > 0 AND n = 0 THEN
ack = ack(m - 1, 1)
END IF
IF m > 0 AND n > 0 THEN
ack = ack(m - 1, ack(m, n - 1))
END IF
END FUNCTION</lang>
Batch File
Had trouble with this, so called in the gurus at StackOverflow. Thanks to Patrick Cuff for pointing out where I was going wrong.
<lang dos>::Ackermann.cmd @echo off set depth=0
- ack
if %1==0 goto m0 if %2==0 goto n0
- else
set /a n=%2-1 set /a depth+=1 call :ack %1 %n% set t=%errorlevel% set /a depth-=1 set /a m=%1-1 set /a depth+=1 call :ack %m% %t% set t=%errorlevel% set /a depth-=1 if %depth%==0 ( exit %t% ) else ( exit /b %t% )
- m0
set/a n=%2+1 if %depth%==0 ( exit %n% ) else ( exit /b %n% )
- n0
set /a m=%1-1 set /a depth+=1 call :ack %m% 1 set t=%errorlevel% set /a depth-=1 if %depth%==0 ( exit %t% ) else ( exit /b %t% )</lang>
Because of the exit statements, running this bare closes one's shell, so this test routine handles the calling of Ackermann.cmd
<lang dos>::Ack.cmd @echo off cmd/c ackermann.cmd %1 %2 echo Ackermann(%1, %2)=%errorlevel%</lang>
A few test runs:
D:\Documents and Settings\Bruce>ack 0 4 Ackermann(0, 4)=5 D:\Documents and Settings\Bruce>ack 1 4 Ackermann(1, 4)=6 D:\Documents and Settings\Bruce>ack 2 4 Ackermann(2, 4)=11 D:\Documents and Settings\Bruce>ack 3 4 Ackermann(3, 4)=125
bc
<lang bc>define ack(m, n) {
if ( m == 0 ) return (n+1); if ( n == 0 ) return (ack(m-1, 1)); return (ack(m-1, ack(m, n-1)));
}
for(n=0; n<7; n++) {
for(m=0; m<4; m++)
{
print "A(", m, ",", n, ") = ", ack(m,n), "\n";
}
}</lang>
BCPL
<lang BCPL>GET "libhdr"
LET ack(m, n) = m=0 -> n+1,
n=0 -> ack(m-1, 1),
ack(m-1, ack(m, n-1))
LET start() = VALOF { FOR i = 0 TO 6 FOR m = 0 TO 3 DO
writef("ack(%n, %n) = %n*n", m, n, ack(m,n))
RESULTIS 0
}</lang>
Befunge
<lang befunge>r[1&&{0 >v
j
u>.@ 1> \:v ^ v:\_$1+ \^v_$1\1- u^>1-0fp:1-\0fg101-</lang>
The program reads two integers (first m, then n) from command line, idles around funge space, then outputs the result of the Ackerman function. Since the latter is calculated truly recursively, the execution time becomes unwieldy for most m>3.
Brat
<lang brat>ackermann = { m, n | when { m == 0 } { n + 1 } { m > 0 && n == 0 } { ackermann(m - 1, 1) } { m > 0 && n > 0 } { ackermann(m - 1, ackermann(m, n - 1)) } }
p ackermann 3, 4 #Prints 125</lang>
C
<lang c>#include <stdio.h>
- include <stdlib.h>
- include <inttypes.h>
static uint32_t ackermann(uint32_t m, uint32_t n) {
return m == 0 ? n + 1 : ackermann(m - 1, n == 0 ? 1 : ackermann(m, n - 1));
}
int main(void) {
unsigned int m, n;
for (n = 0; n < 7; n++)
{
for(m = 0; m <= 4; m++)
{
(void) fprintf(stdout,"A(%u,%u) = %ju\n", m, n,
(uintmax_t) ackermann((uint32_t) m, (uint32_t) n));
}
(void) fprintf(stdout,"\n");
}
return EXIT_SUCCESS;
}</lang>
Output excerpt:
A(0,4) = 5 A(1,4) = 6 A(2,4) = 11 A(3,4) = 125
An arbitrary precision version could be implemented using the GMP library; but my fan is still spinning because of trying to compute A(4,3)...
C#
<lang csharp>using System; class Program {
public static long Ackermann(long m, long n)
{
if(m > 0)
{
if (n > 0)
return Ackermann(m - 1, Ackermann(m, n - 1));
else if (n == 0)
return Ackermann(m - 1, 1);
}
else if(m == 0)
{
if(n >= 0)
return n + 1;
}
throw new System.ArgumentOutOfRangeException();
}
static void Main()
{
for (long m = 0; m <= 3; ++m)
{
for (long n = 0; n <= 4; ++n)
{
Console.WriteLine("Ackermann({0}, {1}) = {2}", m, n, Ackermann(m, n));
}
}
}
}</lang>
Output:
Ackermann(0, 0) = 1 Ackermann(0, 1) = 2 Ackermann(0, 2) = 3 Ackermann(0, 3) = 4 Ackermann(0, 4) = 5 Ackermann(1, 0) = 2 Ackermann(1, 1) = 3 Ackermann(1, 2) = 4 Ackermann(1, 3) = 5 Ackermann(1, 4) = 6 Ackermann(2, 0) = 3 Ackermann(2, 1) = 5 Ackermann(2, 2) = 7 Ackermann(2, 3) = 9 Ackermann(2, 4) = 11 Ackermann(3, 0) = 5 Ackermann(3, 1) = 13 Ackermann(3, 2) = 29 Ackermann(3, 3) = 61 Ackermann(3, 4) = 125
C++
<lang cpp>#include <iostream> using namespace std; long ackermann(long x, long y) {
if (x == 0) return y+1;
else if (y == 0) return ackermann(x-1, 1);
else return ackermann(x-1, ackermann(x, y-1));
}
int main() {
long x,y;
cout << "x ve y..:";
cin>>x;
cin>>y;
cout<<ackermann(x,y);
system("pause");
return 0;
}</lang>
CLIPS
Functional solution
<lang clips>(deffunction ackerman
(?m ?n)
(if (= 0 ?m)
then (+ ?n 1)
else (if (= 0 ?n)
then (ackerman (- ?m 1) 1)
else (ackerman (- ?m 1) (ackerman ?m (- ?n 1)))
)
)
)</lang>
Example usage:
CLIPS> (ackerman 0 4) 5 CLIPS> (ackerman 1 4) 6 CLIPS> (ackerman 2 4) 11 CLIPS> (ackerman 3 4) 125
Fact-based solution
<lang clips>(deffacts solve-items
(solve 0 4) (solve 1 4) (solve 2 4) (solve 3 4)
)
(defrule acker-m-0
?compute <- (compute 0 ?n) => (retract ?compute) (assert (ackerman 0 ?n (+ ?n 1)))
)
(defrule acker-n-0-pre
(compute ?m&:(> ?m 0) 0) (not (ackerman =(- ?m 1) 1 ?)) => (assert (compute (- ?m 1) 1))
)
(defrule acker-n-0
?compute <- (compute ?m&:(> ?m 0) 0) (ackerman =(- ?m 1) 1 ?val) => (retract ?compute) (assert (ackerman ?m 0 ?val))
)
(defrule acker-m-n-pre-1
(compute ?m&:(> ?m 0) ?n&:(> ?n 0)) (not (ackerman ?m =(- ?n 1) ?)) => (assert (compute ?m (- ?n 1)))
)
(defrule acker-m-n-pre-2
(compute ?m&:(> ?m 0) ?n&:(> ?n 0)) (ackerman ?m =(- ?n 1) ?newn) (not (ackerman =(- ?m 1) ?newn ?)) => (assert (compute (- ?m 1) ?newn))
)
(defrule acker-m-n
?compute <- (compute ?m&:(> ?m 0) ?n&:(> ?n 0)) (ackerman ?m =(- ?n 1) ?newn) (ackerman =(- ?m 1) ?newn ?val) => (retract ?compute) (assert (ackerman ?m ?n ?val))
)
(defrule acker-solve
(solve ?m ?n) (not (compute ?m ?n)) (not (ackerman ?m ?n ?)) => (assert (compute ?m ?n))
)
(defrule acker-solved
?solve <- (solve ?m ?n)
(ackerman ?m ?n ?result)
=>
(retract ?solve)
(printout t "A(" ?m "," ?n ") = " ?result crlf)
)</lang>
When invoked, each required A(m,n) needed to solve the requested (solve ?m ?n) facts gets generated as its own fact. Below shows the invocation of the above, as well as an excerpt of the final facts list. Regardless of how many input (solve ?m ?n) requests are made, each possible A(m,n) is only solved once.
CLIPS> (reset) CLIPS> (facts) f-0 (initial-fact) f-1 (solve 0 4) f-2 (solve 1 4) f-3 (solve 2 4) f-4 (solve 3 4) For a total of 5 facts. CLIPS> (run) A(3,4) = 125 A(2,4) = 11 A(1,4) = 6 A(0,4) = 5 CLIPS> (facts) f-0 (initial-fact) f-15 (ackerman 0 1 2) f-16 (ackerman 1 0 2) f-18 (ackerman 0 2 3) ... f-632 (ackerman 1 123 125) f-633 (ackerman 2 61 125) f-634 (ackerman 3 4 125) For a total of 316 facts. CLIPS>
Clojure
<lang clojure>(defn ackermann [m n]
(cond (zero? m) (inc n)
(zero? n) (ackermann (dec m) 1)
:else (ackermann (dec m) (ackermann m (dec n)))))
</lang>
Common Lisp
<lang lisp>(defun ackermann (m n)
(cond ((zerop m) (1+ n))
((zerop n) (ackermann (1- m) 1))
(t (ackermann (1- m) (ackermann m (1- n))))))</lang>
D
Run-time use of ackermann function <lang d>ulong ackermann(ulong m, ulong n) {
if ( m == 0 ) return n+1; if ( n == 0 ) return ackermann(m-1, 1); return ackermann(m-1, ackermann(m, n-1));
}
unittest{ assert(ackermann(2,4) == 11); }</lang>
Compile-time use of ackermann function <lang d>ulong ackermann(ulong m, ulong n) {
if ( m == 0 ) return n+1; if ( n == 0 ) return ackermann(m-1, 1); return ackermann(m-1, ackermann(m, n-1));
}
int[ackermann(2,4)] x; static assert(x.length == 11);</lang>
Dylan
<lang dylan>define method ack(m == 0, n :: <integer>)
n + 1
end; define method ack(m :: <integer>, n :: <integer>)
ack(m - 1, if (n == 0) 1 else ack(m, n - 1) end)
end;</lang>
E
<lang e>def A(m, n) {
return if (m <=> 0) { n+1 } \
else if (m > 0 && n <=> 0) { A(m-1, 1) } \
else { A(m-1, A(m,n-1)) }
}</lang>
Elena
<lang elena>#subject ackermann.
- subject std'dictionary'math'*.
// --- Ackermann ---
- symbol Ackermann =
{
evaluate &m:anM &n:anN
[
#if (anM == 0)?
[ ^ anN + 1. ].
#if (anM > 0)?
[
#if (anN == 0)?
[ ^ self evaluate &m:(anM - 1) &n:1. ].
#if (anN > 0)?
[ ^ self evaluate &m:(anM - 1) &n:(self evaluate &m:anM &n:(anN - 1)). ].
].
self fail.
]
}.
// --- Arguments ---
- hint(signature:(ackermann, m, n))
- class AckermanValue
{
#hint(arg:m)
#field theM.
#hint(arg:n)
#field theN.
#method m'get = theM.
#method n'get = theN.
#method int'get
[
^ Ackermann evaluate:self.
]
#hint(disp)
#method save : aWriter
[
aWriter << self int.
]
#method __textwriter'save : aWriter
[
aWriter << "A(" << theM << "," << theN << ")=" << self int.
]
}
- symbol Program =>
[
'program'Output << (&ackermann &m:0 &n:3) << "%n". 'program'Output << (&ackermann &m:1 &n:4) << "%n". 'program'Output << (&ackermann &m:2 &n:4) << "%n". 'program'Output << (&ackermann &m:3 &n:4) << "%n".
].</lang>
Erlang
<lang erlang>-module(main). -export([main/1]).
main( [ A | [ B |[]]]) ->
io:fwrite("~p~n",[ack(toi(A),toi(B))]).
toi(E) -> element(1,string:to_integer(E)).
ack(0,N) -> N + 1; ack(M,0) -> ack(M-1, 1); ack(M,N) -> ack(M-1,ack(M,N-1)).</lang>
It can be used with
|escript ./ack.erl 3 4 =125
Euphoria
This is based on the VBScript example. <lang Euphoria> include std/console.e
function ack(atom m, atom n) if m = 0 then return n + 1 elsif m > 0 and n = 0 then return ack(m - 1, 1) else return ack(m - 1, ack(m, n - 1)) end if end function
for i = 0 to 3 do for j = 0 to 6 do printf( 1, "%5d", ack( i, j ) ) end for puts( 1, "\n" ) end for</lang>
F#
The following program implements the Ackermann function in F# but is not tail-recursive and so runs out of stack space quite fast. <lang fsharp> let rec ackermann m n =
match m, n with | 0, n -> n + 1 | m, 0 -> ackermann (m - 1) 1 | m, n -> ackermann (m - 1) ackermann m (n - 1)
do
printfn "%A" (ackermann (int fsi.CommandLineArgs.[1]) (int fsi.CommandLineArgs.[2]))
</lang> Transforming this into continuation passing style avoids limited stack space by permitting tail-recursion. <lang fsharp>let ackermann M N =
let rec acker (m, n, k) =
match m,n with
| 0, n -> k(n + 1)
| m, 0 -> acker ((m - 1), 1, k)
| m, n -> acker (m, (n - 1), (fun x -> acker ((m - 1), x, k)))
acker (M, N, (fun x -> x))
</lang>
Factor
<lang factor>USING: kernel math locals combinators ; IN: ackermann
- ackermann ( m n -- u )
{
{ [ m 0 = ] [ n 1 + ] }
{ [ n 0 = ] [ m 1 - 1 ackermann ] }
[ m 1 - m n 1 - ackermann ackermann ]
} cond ;
</lang>
Falcon
<lang falcon>function ackermann( m, n )
if m == 0: return( n + 1 ) if n == 0: return( ackermann( m - 1, 1 ) ) return( ackermann( m - 1, ackermann( m, n - 1 ) ) )
end
for M in [ 0:4 ]
for N in [ 0:7 ] >> ackermann( M, N ), " " end >
end</lang> The above will output the below. Formating options to make this pretty are available but for this example only basic output is used. <lang falcon> 1 2 3 4 5 6 7 2 3 4 5 6 7 8 3 5 7 9 11 13 15 5 13 29 61 125 253 509 </lang>
FALSE
<lang false>[$$[%
\$$[%
1-\$@@a;! { i j -> A(i-1, A(i, j-1)) }
1]?0=[
%1 { i 0 -> A(i-1, 1) }
]?
\1-a;!
1]?0=[
%1+ { 0 j -> j+1 }
]?]a: { j i }
3 3 a;! . { 61 }</lang>
Forth
<lang forth>: acker ( m n -- u ) over 0= IF nip 1+ EXIT ENDIF swap 1- swap ( m-1 n -- ) dup 0= IF 1+ recurse EXIT ENDIF 1- over 1+ swap recurse recurse ;</lang>
Example of use:
FORTH> 0 0 acker . 1 ok FORTH> 3 4 acker . 125 ok
Fortran
<lang fortran>PROGRAM EXAMPLE
IMPLICIT NONE
INTEGER :: i, j
DO i = 0, 3
DO j = 0, 6
WRITE(*, "(I10)", ADVANCE="NO") Ackermann(i, j)
END DO
WRITE(*,*)
END DO
CONTAINS
RECURSIVE FUNCTION Ackermann(m, n) RESULT(ack) INTEGER :: ack, m, n
IF (m == 0) THEN
ack = n + 1
ELSE IF (n == 0) THEN
ack = Ackermann(m - 1, 1)
ELSE
ack = Ackermann(m - 1, Ackermann(m, n - 1))
END IF
END FUNCTION Ackermann
END PROGRAM EXAMPLE</lang>
GAP
<lang gap>ack := function(m, n)
if m = 0 then return n + 1; elif (m > 0) and (n = 0) then return ack(m - 1, 1); elif (m > 0) and (n > 0) then return ack(m - 1, ack(m, n - 1)); else return fail; fi;
end;</lang>
Genyris
<lang genyris>def A (m n)
cond
(equal? m 0)
+ n 1
(equal? n 0)
A (- m 1) 1
else
A (- m 1)
A m (- n 1)</lang>
GML
for a function named "ackermann": <lang GML>m=argument0 n=argument1 if(m=0)
return (n+1)
else if(n=0)
return (ackermann(m-1,1,1))
else
return (ackermann(m-1,ackermann(m,n-1,2),1))</lang>
gnuplot
<lang gnuplot>A (m, n) = m == 0 ? n + 1 : n == 0 ? A (m - 1, 1) : A (m - 1, A (m, n - 1)) print A (0, 4) print A (1, 4) print A (2, 4) print A (3, 4)</lang> Output:
5 6 11 stack overflow
Go
Classic version <lang go>func Ackermann(m, n uint) uint {
switch {
case m == 0:
return n + 1
case n == 0:
return Ackermann(m - 1, 1)
}
return Ackermann(m - 1, Ackermann(m, n - 1))
}</lang> Expanded version <lang go>func Ackermann2(m, n uint) uint {
switch {
case m == 0:
return n + 1
case m == 1:
return n + 2
case m == 2:
return 2*n + 3
case m == 3:
return 8 << n - 3
case n == 0:
return Ackermann2(m - 1, 1)
}
return Ackermann2(m - 1, Ackermann2(m, n - 1))
}</lang>
Groovy
<lang groovy>def ack ( m, n ) {
assert m >= 0 && n >= 0 : 'both arguments must be non-negative' m == 0 ? n + 1 : n == 0 ? ack(m-1, 1) : ack(m-1, ack(m, n-1))
}</lang>
Test program: <lang groovy>def ackMatrix = (0..3).collect { m -> (0..8).collect { n -> ack(m, n) } } ackMatrix.each { it.each { elt -> printf "%7d", elt }; println() }</lang>
Output:
1 2 3 4 5 6 7 8 9
2 3 4 5 6 7 8 9 10
3 5 7 9 11 13 15 17 19
5 13 29 61 125 253 509 1021 2045
Note: In the default groovyConsole configuration for WinXP, "ack(4,1)" caused a stack overflow error!
Haskell
<lang haskell>ack 0 n = n + 1 ack m 0 = ack (m-1) 1 ack m n = ack (m-1) (ack m (n-1))</lang> Example of use
Prelude> ack 0 0 1 Prelude> ack 3 4 125
haXe
<lang haXe>class RosettaDemo {
static public function main()
{
neko.Lib.print(ackermann(3, 4));
}
static function ackermann(m : Int, n : Int)
{
if (m == 0)
{
return n + 1;
}
else if (n == 0)
{
return ackermann(m-1, 1);
}
return ackermann(m-1, ackermann(m, n-1));
}
}</lang>
Icon and Unicon
Taken from the public domain Icon Programming Library's acker in memrfncs Written by Ralph E. Griswold.
<lang Icon>procedure acker(i, j)
static memory
initial {
memory := table()
every memory[0 to 100] := table()
}
if i = 0 then return j + 1
if j = 0 then /memory[i][j] := acker(i - 1, 1) else /memory[i][j] := acker(i - 1, acker(i, j - 1))
return memory[i][j]
end
procedure main()
every m := 0 to 3 do {
every n := 0 to 8 do {
writes(acker(m, n) || " ")
}
write()
}
end</lang>
Output:
1 2 3 4 5 6 7 8 9 2 3 4 5 6 7 8 9 10 3 5 7 9 11 13 15 17 19 5 13 29 61 125 253 509 1021 2045
Ioke
<lang ioke>ackermann = method(m,n,
cond( m zero?, n succ, n zero?, ackermann(m pred, 1), ackermann(m pred, ackermann(m, n pred)))
)</lang>
J
As posted at the J wiki <lang j>ack=: c1`c1`c2`c3 @. (#.@,&*) M. c1=: >:@] NB. if 0=x, 1+y c2=: <:@[ ack 1: NB. if 0=y, (x-1) ack 1 c3=: <:@[ ack [ ack <:@] NB. else, (x-1) ack x ack y-1</lang>
Java
<lang java>public static BigInteger ack(BigInteger m, BigInteger n){ if(m.equals(BigInteger.ZERO)) return n.add(BigInteger.ONE);
if(m.compareTo(BigInteger.ZERO) > 0 && n.equals(BigInteger.ZERO)) return ack(m.subtract(BigInteger.ONE), BigInteger.ONE);
if(m.compareTo(BigInteger.ZERO) > 0 && n.compareTo(BigInteger.ZERO) > 0) return ack(m.subtract(BigInteger.ONE), ack(m, n.subtract(BigInteger.ONE)));
return null; }</lang>
JavaScript
<lang javascript>function ack(i,j) {
return i==0 ? j+1 : ack(i-1, j==0 ? 1 : ack(i, j-1)) // uses short if notation with the '?' operator
}</lang>
Joy
From here <lang joy>DEFINE ack == [ [ [pop null] popd succ ]
[ [null] pop pred 1 ack ]
[ [dup pred swap] dip pred ack ack ] ]
cond.</lang>
another using a combinator <lang joy>DEFINE ack == [ [ [pop null] [popd succ] ] [ [null] [pop pred 1] [] ] [ [[dup pred swap] dip pred] [] [] ] ]
condnestrec.</lang>
Whenever there are two definitions with the same name, the last one is the one that is used, when invoked.
Liberty BASIC
<lang lb>Print Ackermann(1, 2)
Function Ackermann(m, n)
Select Case
Case (m < 0) Or (n < 0)
Exit Function
Case (m = 0)
Ackermann = (n + 1)
Case (m > 0) And (n = 0)
Ackermann = Ackermann((m - 1), 1)
Case (m > 0) And (n > 0)
Ackermann = Ackermann((m - 1), Ackermann(m, (n - 1)))
End Select
End Function</lang>
Logo
<lang logo>to ack :i :j
if :i = 0 [output :j+1] if :j = 0 [output ack :i-1 1] output ack :i-1 ack :i :j-1
end</lang>
Logtalk
<lang logtalk>ack(0, N, V) :-
!, V is N + 1.
ack(M, 0, V) :-
!, M2 is M - 1, ack(M2, 1, V).
ack(M, N, V) :-
M2 is M - 1, N2 is N - 1, ack(M, N2, V2), ack(M2, V2, V).</lang>
Lua
<lang lua>function ack(M,N)
if M == 0 then return N + 1 end if N == 0 then return ack(M-1,1) end return ack(M-1,ack(M, N-1))
end</lang>
Lucid
<lang lucid>ack(m,n)
where
ack(m,n) = if m eq 0 then n+1
else if n eq 0 then ack(m-1,1)
else ack(m-1, ack(m, n-1)) fi
fi;
end</lang>
M4
<lang M4>define(`ack',`ifelse($1,0,`incr($2)',`ifelse($2,0,`ack(decr($1),1)',`ack(decr($1),ack($1,decr($2)))')')')dnl ack(3,3)</lang>
Output:
61
Mathematica
Two possible implementations would be: <lang Mathematica>$RecursionLimit=Infinity Ackermann1[m_,n_]:=
If[m==0,n+1, If[ n==0,Ackermann1[m-1,1], Ackermann1[m-1,Ackermann1[m,n-1]] ] ]
Ackermann2[0,n_]:=n+1; Ackermann2[m_,0]:=Ackermann1[m-1,1]; Ackermann2[m_,n_]:=Ackermann1[m-1,Ackermann1[m,n-1]]</lang>
Note that the second implementation is quite a bit faster, as doing 'if' comparisons is slower than the built-in pattern matching algorithms. Examples: <lang Mathematica>Flatten[#,1]&@Table[{"Ackermann2["<>ToString[i]<>","<>ToString[j]<>"] =",Ackermann2[i,j]},{i,3},{j,8}]//Grid</lang> gives back: <lang Mathematica>Ackermann2[1,1] = 3 Ackermann2[1,2] = 4 Ackermann2[1,3] = 5 Ackermann2[1,4] = 6 Ackermann2[1,5] = 7 Ackermann2[1,6] = 8 Ackermann2[1,7] = 9 Ackermann2[1,8] = 10 Ackermann2[2,1] = 5 Ackermann2[2,2] = 7 Ackermann2[2,3] = 9 Ackermann2[2,4] = 11 Ackermann2[2,5] = 13 Ackermann2[2,6] = 15 Ackermann2[2,7] = 17 Ackermann2[2,8] = 19 Ackermann2[3,1] = 13 Ackermann2[3,2] = 29 Ackermann2[3,3] = 61 Ackermann2[3,4] = 125 Ackermann2[3,5] = 253 Ackermann2[3,6] = 509 Ackermann2[3,7] = 1021 Ackermann2[3,8] = 2045</lang> If we would like to calculate Ackermann[4,1] or Ackermann[4,2] we have to optimize a little bit: <lang Mathematica>Clear[Ackermann3] $RecursionLimit=Infinity; Ackermann3[0,n_]:=n+1; Ackermann3[1,n_]:=n+2; Ackermann3[2,n_]:=3+2n; Ackermann3[3,n_]:=5+8 (2^n-1); Ackermann3[m_,0]:=Ackermann3[m-1,1]; Ackermann3[m_,n_]:=Ackermann3[m-1,Ackermann3[m,n-1]]</lang> Now computing Ackermann[4,1] and Ackermann[4,2] can be done quickly (<0.01 sec): Examples 2: <lang Mathematica>Ackermann3[4, 1] Ackermann3[4, 2]</lang> gives back:
Ackermann[4,2] has 19729 digits, several thousands of digits omitted in the result above for obvious reasons. Ackermann[5,0] can be computed also quite fast, and is equal to 65533. Summarizing Ackermann[0,n_], Ackermann[1,n_], Ackermann[2,n_], and Ackermann[3,n_] can all be calculated for n>>1000. Ackermann[4,0], Ackermann[4,1], Ackermann[4,2] and Ackermann[5,0] are only possible now. Maybe in the future we can calculate higher Ackermann numbers efficiently and fast. Although showing the results will always be a problem.
MATLAB
<lang MATLAB>function A = ackermannFunction(m,n)
if m == 0
A = n+1;
elseif (m > 0) && (n == 0)
A = ackermannFunction(m-1,1);
else
A = ackermannFunction( m-1,ackermannFunction(m,n-1) );
end
end</lang>
MAXScript
Use with caution. Will cause a stack overflow for m > 3. <lang maxscript>fn ackermann m n = (
if m == 0 then
(
return n + 1
)
else if n == 0 then
(
ackermann (m-1) 1
)
else
(
ackermann (m-1) (ackermann m (n-1))
)
)</lang>
Modula-3
The type CARDINAL is defined in Modula-3 as [0..LAST(INTEGER)], in other words, it can hold all positive integers.
<lang modula3>MODULE Ack EXPORTS Main;
FROM IO IMPORT Put; FROM Fmt IMPORT Int;
PROCEDURE Ackermann(m, n: CARDINAL): CARDINAL =
BEGIN
IF m = 0 THEN
RETURN n + 1;
ELSIF n = 0 THEN
RETURN Ackermann(m - 1, 1);
ELSE
RETURN Ackermann(m - 1, Ackermann(m, n - 1));
END;
END Ackermann;
BEGIN
FOR m := 0 TO 3 DO
FOR n := 0 TO 6 DO
Put(Int(Ackermann(m, n)) & " ");
END;
Put("\n");
END;
END Ack.</lang>
Output:
1 2 3 4 5 6 7 2 3 4 5 6 7 8 3 5 7 9 11 13 15 5 13 29 61 125 253 509
MUMPS
<lang MUMPS>Ackermann(m,n) ; If m=0 Quit n+1 If m>0,n=0 Quit $$Ackermann(m-1,1) If m>0,n>0 Quit $$Ackermann(m-1,$$Ackermann(m,n-1)) Set $Ecode=",U13-Invalid parameter for Ackermann: m="_m_", n="_n_","
Write $$Ackermann(1,8) ; 10 Write $$Ackermann(2,8) ; 19 Write $$Ackermann(3,5) ; 253</lang>
Nial
<lang nial>ack is fork [
= [0 first, first], +[last, 1 first], = [0 first, last], ack [ -[first, 1 first], 1 first], ack[ -[first,1 first], ack[first, -[last,1 first]]]
]</lang>
Nimrod
<lang nimrod>proc Ackermann(m, n: int64): int64 =
if m == 0: result = n + 1 elif n == 0: result = Ackermann(m - 1, 1) else: result = Ackermann(m - 1, Ackermann(m, n - 1))</lang>
OCaml
<lang ocaml>let rec a m n =
if m=0 then (n+1) else if n=0 then (a (m-1) 1) else (a (m-1) (a m (n-1)))</lang>
or: <lang ocaml>let rec a = function
| 0, n -> (n+1) | m, 0 -> a(m-1, 1) | m, n -> a(m-1, a(m, n-1))</lang>
with memoization using an hash-table:
<lang ocaml>let h = Hashtbl.create 4001
let a m n =
try Hashtbl.find h (m, n) with Not_found -> let res = a (m, n) in Hashtbl.add h (m, n) res; (res)</lang>
taking advantage of the memoization we start calling small values of m and n in order to reduce the recursion call stack: <lang ocaml>let a m n =
for _m = 0 to m do
for _n = 0 to n do
ignore(a _m _n);
done;
done;
(a m n)</lang>
Arbitrary precision
With arbitrary-precision integers (Big_int module):
<lang ocaml>open Big_int let one = unit_big_int let zero = zero_big_int let succ = succ_big_int let pred = pred_big_int let eq = eq_big_int
let rec a m n =
if eq m zero then (succ n) else if eq n zero then (a (pred m) one) else (a (pred m) (a m (pred n)))</lang>
compile with:
ocamlopt -o acker nums.cmxa acker.ml
Tail-Recursive
Here is a tail-recursive version:
<lang ocaml>let rec find_option h v =
try Some(Hashtbl.find h v) with Not_found -> None
let rec a bounds caller todo m n =
match m, n with
| 0, n ->
let r = (n+1) in
( match todo with
| [] -> r
| (m,n)::todo ->
List.iter (fun k ->
if not(Hashtbl.mem bounds k)
then Hashtbl.add bounds k r) caller;
a bounds [] todo m n )
| m, 0 ->
a bounds caller todo (m-1) 1
| m, n ->
match find_option bounds (m, n-1) with
| Some a_rec ->
let caller = (m,n)::caller in
a bounds caller todo (m-1) a_rec
| None ->
let todo = (m,n)::todo
and caller = [(m, n-1)] in
a bounds caller todo m (n-1)
let a = a (Hashtbl.create 42 (* arbitrary *) ) [] [] ;;</lang>
This one uses the arbitrary precision, the tail-recursion, and the optimisation explain on the Wikipedia page about (m,n) = (3,_).
<lang ocaml>open Big_int let one = unit_big_int let zero = zero_big_int let succ = succ_big_int let pred = pred_big_int let add = add_big_int let sub = sub_big_int let eq = eq_big_int let three = succ(succ one) let power = power_int_positive_big_int
let eq2 (a1,a2) (b1,b2) =
(eq a1 b1) && (eq a2 b2)
module H = Hashtbl.Make
(struct
type t = Big_int.big_int * Big_int.big_int
let equal = eq2
let hash (x,y) = Hashtbl.hash
(Big_int.string_of_big_int x ^ "," ^
Big_int.string_of_big_int y)
(* probably not a very good hash function *)
end)
let rec find_option h v =
try Some (H.find h v) with Not_found -> None
let rec a bounds caller todo m n =
let may_tail r =
let k = (m,n) in
match todo with
| [] -> r
| (m,n)::todo ->
List.iter (fun k ->
if not (H.mem bounds k)
then H.add bounds k r) (k::caller);
a bounds [] todo m n
in
match m, n with
| m, n when eq m zero ->
let r = (succ n) in
may_tail r
| m, n when eq n zero ->
let caller = (m,n)::caller in
a bounds caller todo (pred m) one
| m, n when eq m three ->
let r = sub (power 2 (add n three)) three in
may_tail r
| m, n ->
match find_option bounds (m, pred n) with
| Some a_rec ->
let caller = (m,n)::caller in
a bounds caller todo (pred m) a_rec
| None ->
let todo = (m,n)::todo in
let caller = [(m, pred n)] in
a bounds caller todo m (pred n)
let a = a (H.create 42 (* arbitrary *)) [] [] ;;
let () =
let m, n =
try
big_int_of_string Sys.argv.(1),
big_int_of_string Sys.argv.(2)
with _ ->
Printf.eprintf "usage: %s <int> <int>\n" Sys.argv.(0);
exit 1
in
let r = a m n in
Printf.printf "(a %s %s) = %s\n"
(string_of_big_int m)
(string_of_big_int n)
(string_of_big_int r);
- </lang>
Octave
<lang octave>function r = ackerman(m, n)
if ( m == 0 ) r = n + 1; elseif ( n == 0 ) r = ackerman(m-1, 1); else r = ackerman(m-1, ackerman(m, n-1)); endif
endfunction
for i = 0:3
disp(ackerman(i, 4));
endfor</lang>
Oz
Oz has arbitrary precision integers. <lang oz>declare
fun {Ack M N}
if M == 0 then N+1
elseif N == 0 then {Ack M-1 1}
else {Ack M-1 {Ack M N-1}}
end
end
in
{Show {Ack 3 7}}</lang>
PARI/GP
Naive implementation. <lang>A(m,n)={
if(m,
if(n,
A(m-1, A(m,n-1))
,
A(m-1,1)
)
,
n+1
)
};</lang>
Pascal
<lang pascal>Program Ackerman;
function ackermann(m, n: Integer) : Integer; begin
if m = 0 then
ackermann := n+1
else if n = 0 then
ackermann := ackermann(m-1, 1)
else
ackermann := ackermann(m-1, ackermann(m, n-1));
end;
var
m, n : Integer;
begin
for n := 0 to 6 do
for m := 0 to 3 do
WriteLn('A(', m, ',', n, ') = ', ackermann(m,n)); end.</lang>
Perl
We memoize calls to A to make A(2, n) and A(3, n) feasible for larger values of n. <lang perl> {
my @memo;
sub A {
my( $m, $n ) = @_;
$memo[ $m ][ $n ] and return $memo[ $m ][ $n ];
$m or return $n + 1;
return $memo[ $m ][ $n ] = (
$n
? A( $m - 1, A( $m, $n - 1 ) )
: A( $m - 1, 1 )
);
}
} </lang>
Perl 6
An implementation using ternary chaining:
<lang perl6>sub A(Int $m, Int $n) {
$m == 0 ?? $n + 1 !! $n == 0 ?? A($m - 1, 1 ) !! A($m - 1, A($m, $n - 1));
}</lang>
An implementation using multiple dispatch:
<lang perl6>multi sub A(0, Int $n) { $n + 1 } multi sub A(Int $m, 0 ) { A($m - 1, 1) } multi sub A(Int $m, Int $n) { A($m - 1, A($m, $n - 1)) }</lang> Note that in either case, Int is defined to be arbitrary precision in Perl 6.
PHP
<lang php>function ackermann( $m , $n ) {
if ( $m==0 )
{
return $n + 1;
}
elseif ( $n==0 )
{
return ackermann( $m-1 , 1 );
}
return ackermann( $m-1, ackermann( $m , $n-1 ) );
}
echo ackermann( 3, 4 ); // prints 125</lang>
PicoLisp
<lang PicoLisp>(de ack (X Y)
(cond
((=0 X) (inc Y))
((=0 Y) (ack (dec X) 1))
(T (ack (dec X) (ack X (dec Y)))) ) )</lang>
Pike
<lang pike>int main(){
write(ackermann(3,4) + "\n");
}
int ackermann(int m, int n){
if(m == 0){
return n + 1;
} else if(n == 0){
return ackermann(m-1, 1);
} else {
return ackermann(m-1, ackermann(m, n-1));
}
}</lang>
PL/I
<lang PL/I> Ackerman: procedure (m, n) returns (fixed (30)) recursive;
declare (m, n) fixed (30); if m = 0 then return (n+1); else if m > 0 & n = 0 then return (Ackerman(m-1, 1)); else if m > 0 & n > 0 then return (Ackerman(m-1, Ackerman(m, n-1))); return (0);
end Ackerman; </lang>
PostScript
<lang> /ackermann{ /n exch def /m exch def %PostScript takes arguments in the reverse order as specified in the function definition m 0 eq{ n 1 add }if m 0 gt n 0 eq and { m 1 sub 1 ackermann }if m 0 gt n 0 gt and{ m 1 sub m n 1 sub ackermann ackermann }if }def </lang>
PowerBASIC
<lang powerbasic>FUNCTION PBMAIN () AS LONG
DIM m AS QUAD, n AS QUAD
m = ABS(VAL(INPUTBOX$("Enter a whole number.")))
n = ABS(VAL(INPUTBOX$("Enter another whole number.")))
MSGBOX STR$(Ackermann(m, n))
END FUNCTION
FUNCTION Ackermann (m AS QUAD, n AS QUAD) AS QUAD
IF 0 = m THEN
FUNCTION = n + 1
ELSEIF 0 = n THEN
FUNCTION = Ackermann(m - 1, 1)
ELSE ' m > 0; n > 0
FUNCTION = Ackermann(m - 1, Ackermann(m, n - 1))
END IF
END FUNCTION</lang>
PowerShell
<lang powershell>function ackermann ([long] $m, [long] $n) {
if ($m -eq 0) {
return $n + 1
}
if ($n -eq 0) {
return (ackermann ($m - 1) 1)
}
return (ackermann ($m - 1) (ackermann $m ($n - 1)))
}</lang>
Building an example table (takes a while to compute, though, especially for the last three numbers; also it fails with the last line in Powershell v1 since the maximum recursion depth is only 100 there):
<lang powershell>foreach ($m in 0..3) {
foreach ($n in 0..6) {
Write-Host -NoNewline ("{0,5}" -f (ackermann $m $n))
}
Write-Host
}</lang>
Output:
1 2 3 4 5 6 7
2 3 4 5 6 7 8
3 5 7 9 11 13 15
5 13 29 61 125 253 509
Prolog
<lang prolog>ack(0, N, Ans) :- Ans is N+1. ack(M, 0, Ans) :- M>0, X is M-1, ack(X, 1, Ans). ack(M, N, Ans) :- M>0, N>0, X is M-1, Y is N-1, ack(M, Y, Ans2), ack(X, Ans2, Ans).</lang>
Pure
<lang pure>A 0 n = n+1; A m 0 = A (m-1) 1 if (m > 0); A m n = A (m-1) (A m (n-1)) if (m > 0) and (n > 0);</lang>
PureBasic
<lang PureBasic>Procedure.q Ackermann(m, n)
If m = 0 ProcedureReturn n + 1 ElseIf n = 0 ProcedureReturn Ackermann(m - 1, 1) Else ProcedureReturn Ackermann(m - 1, Ackermann(m, n - 1)) EndIf
EndProcedure
Debug Ackermann(3,4)</lang>
Python
<lang python>def ack1(M, N):
return (N + 1) if M == 0 else (
ack1(M-1, 1) if N == 0 else ack1(M-1, ack1(M, N-1)))</lang>
Another version: <lang python>def ack2(M, N):
if M == 0:
return N + 1
elif N == 0:
return ack1(M - 1, 1)
else:
return ack1(M - 1, ack1(M, N - 1))</lang>
Example of use: <lang python>>>> import sys >>> sys.setrecursionlimit(3000) >>> ack1(0,0) 1 >>> ack1(3,4) 125 >>> ack2(0,0) 1 >>> ack2(3,4) 125</lang>
From the Mathematica ack3 example: <lang python>def ack2(M, N):
return (N + 1) if M == 0 else (
(N + 2) if M == 1 else (
(2*N + 3) if M == 2 else (
(8*(2**N - 1) + 5) if M == 3 else (
ack2(M-1, 1) if N == 0 else ack2(M-1, ack2(M, N-1))))))</lang>
Results confirm those of Mathematica for ack(4,1) and ack(4,2)
R
<lang R>ackermann <- function(m, n) {
if ( m == 0 ) {
n+1
} else if ( n == 0 ) {
ackermann(m-1, 1)
} else {
ackermann(m-1, ackermann(m, n-1))
}
}</lang>
<lang R>for ( i in 0:3 ) {
print(ackermann(i, 4))
}</lang>
REBOL
ackermann: func [m n] [
case [
m = 0 [n + 1]
n = 0 [ackermann m - 1 1]
true [ackermann m - 1 ackermann m n - 1]
]
]
REXX
version 1
<lang rexx> ackermann: procedure arg m,n if m = 0 then return n+1 if n = 0 then return ackermann(m-1,1) return ackermann(m-1,ackermann(m,n-1)) </lang>
version 2
<lang> /*REXX program to calculate the Ackermann function. */
/*Note: the Ackermann function (as implemented */
/* is higly recursive and is limited by */
/* the highest number that can have "1" */
/* added to a number (N). */
high=24
do j=0 to 3 say
do k=0 to high%(max(1,j)) call Ackermann_tell j,k end end
exit
/*------------------------------------ACKERMANN_TELL subroutine (echo). */
ackermann_tell: parse arg mm,nn /*display an echo message.*/
calls=0
nnn=right(nn,length(high))
say 'Ackermann('mm","nn')='right(ackermann(mm,nn),digits()),
' calls='right(calls,digits())
return
/*------------------------------------ACKERMANN subroutine (recusive). */
ackermann: procedure expose calls /*compute the Ackerman function.*/
parse arg m,n
calls=calls+1
if m==0 then return n+1
if n==0 then return ackermann(m-1,1)
if m==2 then return n*2+3
return ackermann(m-1,ackermann(m,n-1))
</lang> Output: Output:
Ackermann(0, 0)= 1 calls= 1 Ackermann(0, 1)= 2 calls= 1 Ackermann(0, 2)= 3 calls= 1 Ackermann(0, 3)= 4 calls= 1 Ackermann(0, 4)= 5 calls= 1 Ackermann(0, 5)= 6 calls= 1 Ackermann(0, 6)= 7 calls= 1 Ackermann(0, 7)= 8 calls= 1 Ackermann(0, 8)= 9 calls= 1 Ackermann(0, 9)= 10 calls= 1 Ackermann(0,10)= 11 calls= 1 Ackermann(0,11)= 12 calls= 1 Ackermann(0,12)= 13 calls= 1 Ackermann(0,13)= 14 calls= 1 Ackermann(0,14)= 15 calls= 1 Ackermann(0,15)= 16 calls= 1 Ackermann(0,16)= 17 calls= 1 Ackermann(0,17)= 18 calls= 1 Ackermann(0,18)= 19 calls= 1 Ackermann(0,19)= 20 calls= 1 Ackermann(0,20)= 21 calls= 1 Ackermann(0,21)= 22 calls= 1 Ackermann(0,22)= 23 calls= 1 Ackermann(0,23)= 24 calls= 1 Ackermann(0,24)= 25 calls= 1 Ackermann(1, 0)= 2 calls= 2 Ackermann(1, 1)= 3 calls= 4 Ackermann(1, 2)= 4 calls= 6 Ackermann(1, 3)= 5 calls= 8 Ackermann(1, 4)= 6 calls= 10 Ackermann(1, 5)= 7 calls= 12 Ackermann(1, 6)= 8 calls= 14 Ackermann(1, 7)= 9 calls= 16 Ackermann(1, 8)= 10 calls= 18 Ackermann(1, 9)= 11 calls= 20 Ackermann(1,10)= 12 calls= 22 Ackermann(1,11)= 13 calls= 24 Ackermann(1,12)= 14 calls= 26 Ackermann(1,13)= 15 calls= 28 Ackermann(1,14)= 16 calls= 30 Ackermann(1,15)= 17 calls= 32 Ackermann(1,16)= 18 calls= 34 Ackermann(1,17)= 19 calls= 36 Ackermann(1,18)= 20 calls= 38 Ackermann(1,19)= 21 calls= 40 Ackermann(1,20)= 22 calls= 42 Ackermann(1,21)= 23 calls= 44 Ackermann(1,22)= 24 calls= 46 Ackermann(1,23)= 25 calls= 48 Ackermann(1,24)= 26 calls= 50 Ackermann(2, 0)= 3 calls= 5 Ackermann(2, 1)= 5 calls= 14 Ackermann(2, 2)= 7 calls= 27 Ackermann(2, 3)= 9 calls= 44 Ackermann(2, 4)= 11 calls= 65 Ackermann(2, 5)= 13 calls= 90 Ackermann(2, 6)= 15 calls= 119 Ackermann(2, 7)= 17 calls= 152 Ackermann(2, 8)= 19 calls= 189 Ackermann(2, 9)= 21 calls= 230 Ackermann(2,10)= 23 calls= 275 Ackermann(2,11)= 25 calls= 324 Ackermann(2,12)= 27 calls= 377 Ackermann(3, 0)= 5 calls= 15 Ackermann(3, 1)= 13 calls= 106 Ackermann(3, 2)= 29 calls= 541 Ackermann(3, 3)= 61 calls= 2432 Ackermann(3, 4)= 125 calls= 10307 Ackermann(3, 5)= 253 calls= 42438 Ackermann(3, 6)= 509 calls= 172233 Ackermann(3, 7)= 1021 calls= 693964 Ackermann(3, 8)= 2045 calls= 2785999
version 3
<lang rexx> /*REXX program to calculate the Ackermann function. */
/*Note: the Ackermann function (as implemented */
/* is higly recursive and is limited by */
/* the highest number that can have "1" */
/* added to a number (N). */
numeric digits 10000 /*tell REXX to use up to 10,000 digit integers.*/
/*When REXX raises a number to a power */
/* (via the ** operator), the power must be */
/* an integer (positive, zero, or negative). */
do j=0 to 4 /*Ackermann(5,1) is a bit impractical to calc.*/
say /*display a blank (separator) line. */
do k=0 to 10
call Ackermann_tell j,k
end
end
exit
/*------------------------------------ACKERMANN_TELL subroutine (echo). */
ackermann_tell: parse arg mm,nn /*display an echo message.*/
say 'Ackermann('mm","nn')='ackermann(mm,nn)
return
/*------------------------------------ACKERMANN subroutine (recusive). */
ackermann: procedure /*compute the Ackerman function.*/
parse arg m,n
if m==0 then return n+1
if m==1 then return n+2
if m==2 then return n+n+3
if m==3 then return 2**(n+3)-3
if m==4 then return 2**(2**n+3)-3 /*ugh.*/
if n==0 then return ackermann(m-1,1)
return ackermann(m-1,ackermann(m,n-1))
</lang> Output:
Ackermann(0,0)=1 Ackermann(0,1)=2 Ackermann(0,2)=3 Ackermann(0,3)=4 Ackermann(0,4)=5 Ackermann(0,5)=6 Ackermann(0,6)=7 Ackermann(0,7)=8 Ackermann(0,8)=9 Ackermann(0,9)=10 Ackermann(0,10)=11 Ackermann(1,0)=2 Ackermann(1,1)=3 Ackermann(1,2)=4 Ackermann(1,3)=5 Ackermann(1,4)=6 Ackermann(1,5)=7 Ackermann(1,6)=8 Ackermann(1,7)=9 Ackermann(1,8)=10 Ackermann(1,9)=11 Ackermann(1,10)=12 Ackermann(2,0)=3 Ackermann(2,1)=5 Ackermann(2,2)=7 Ackermann(2,3)=9 Ackermann(2,4)=11 Ackermann(2,5)=13 Ackermann(2,6)=15 Ackermann(2,7)=17 Ackermann(2,8)=19 Ackermann(2,9)=21 Ackermann(2,10)=23 Ackermann(3,0)=5 Ackermann(3,1)=13 Ackermann(3,2)=29 Ackermann(3,3)=61 Ackermann(3,4)=125 Ackermann(3,5)=253 Ackermann(3,6)=509 Ackermann(3,7)=1021 Ackermann(3,8)=2045 Ackermann(3,9)=4093 Ackermann(3,10)=8189 Ackermann(4,0)=13 Ackermann(4,1)=29 Ackermann(4,2)=125 Ackermann(4,3)=2045 Ackermann(4,4)=524285 Ackermann(4,5)=34359738365 Ackermann(4,6)=147573952589676412925 Ackermann(4,7)=2722258935367507707706996859454145691645 Ackermann(4,8)=926336713898529563388567880069503262826159877325124512315660672063305037119485 Ackermann(4,9)=107262463439540776796592199985646769019834926564739147021788491549774112240588375814414994385335227421520254865491888406830031062495572559571469192048672765 Ackermann(4,10)=1438154507889852726183444152631219786894381583153845258187440649261861406444007705061667818579260288168960911038971146861270318150515332979942779445115792995022143147398923882210417756809968752955624663616680046150705205458739703051791304884326617897306804085476690385919577967507837730438682850636993793097725
Ruby
Adapted from Ada's version. <lang ruby>def ack(m, n)
if m == 0 n + 1 elsif n == 0 ack(m-1, 1) else ack(m-1, ack(m, n-1)) end
end</lang> Example: <lang ruby>(0..3).each do |m|
(0..6).each { |n| print ack(m, n), ' ' }
puts
end</lang> Output:
1 2 3 4 5 6 7 2 3 4 5 6 7 8 3 5 7 9 11 13 15 5 13 29 61 125 253 509
Sather
<lang sather>class MAIN is
ackermann(m, n:INT):INT pre m >= 0 and n >= 0 is if m = 0 then return n + 1; end; if n = 0 then return ackermann(m-1, 1); end; return ackermann(m-1, ackermann(m, n-1)); end;
main is
n, m :INT;
loop n := 0.upto!(6);
loop m := 0.upto!(3);
#OUT + "A(" + m + ", " + n + ") = " + ackermann(m, n) + "\n";
end;
end;
end;
end;</lang>
Instead of INT, the class INTI could be used, even though we need to use a workaround since in the GNU Sather v1.2.3 compiler the INTI literals are not implemented yet.
<lang sather>class MAIN is
ackermann(m, n:INTI):INTI is zero ::= 0.inti; -- to avoid type conversion each time one ::= 1.inti; if m = zero then return n + one; end; if n = zero then return ackermann(m-one, one); end; return ackermann(m-one, ackermann(m, n-one)); end;
main is
n, m :INT;
loop n := 0.upto!(6);
loop m := 0.upto!(3);
#OUT + "A(" + m + ", " + n + ") = " + ackermann(m.inti, n.inti) + "\n";
end;
end;
end;
end;</lang>
Scala
<lang scala>def ack(m: BigInt, n: BigInt): BigInt = {
if (m==0) n+1 else if (n==0) ack(m-1, 1) else ack(m-1, ack(m, n-1))
}</lang>
Example <lang scala>scala> for ( m <- 0 to 3; n <- 0 to 6 ) yield ack(m,n) res0: Seq.Projection[BigInt] = RangeG(1, 2, 3, 4, 5, 6, 7, 2, 3, 4, 5, 6, 7, 8, 3, 5, 7, 9, 11, 13, 15, 5, 13, 29, 61, 125, 253, 509)</lang>
Scheme
<lang scheme>(define (A m n)
(cond
((= m 0) (+ n 1))
((= n 0) (A (- m 1) 1))
(else (A (- m 1) (A m (- n 1))))))</lang>
Seed7
<lang seed7>const func integer: ackermann (in integer: m, in integer: n) is func
result
var integer: result is 0;
begin
if m = 0 then
result := succ(n);
elsif n = 0 then
result := ackermann(pred(m), 1);
else
result := ackermann(pred(m), ackermann(m, pred(n)));
end if;
end func;</lang>
Original source: [1]
SETL
<lang SETL>program ackermann;
(for m in [0..3])
print(+/ [rpad( + ack(m, n), 4): n in [0..6]]);
end;
proc ack(m, n);
return {[0,n+1]}(m) ? ack(m-1, {[0,1]}(n) ? ack(m, n-1));
end proc;
end program;</lang>
Slate
<lang slate>m@(Integer traits) ackermann: n@(Integer traits) [
m isZero
ifTrue: [n + 1]
ifFalse:
[n isZero
ifTrue: [m - 1 ackermann: n] ifFalse: [m - 1 ackermann: (m ackermann: n - 1)]] ].</lang>
Smalltalk
<lang smalltalk>|ackermann| ackermann := [ :n :m |
(n = 0) ifTrue: [ (m + 1) ]
ifFalse: [
(m = 0) ifTrue: [ ackermann value: (n-1) value: 1 ]
ifFalse: [
ackermann value: (n-1)
value: ( ackermann value: n
value: (m-1) )
]
]
].
(ackermann value: 0 value: 0) displayNl. (ackermann value: 3 value: 4) displayNl.</lang>
SNOBOL4
Both Snobol4+ and CSnobol stack overflow, at ack(3,3) and ack(3,4), respectively.
<lang SNOBOL4>define('ack(m,n)') :(ack_end) ack ack = eq(m,0) n + 1 :s(return)
ack = eq(n,0) ack(m - 1,1) :s(return)
ack = ack(m - 1,ack(m,n - 1)) :(return)
ack_end
- # Test and display ack(0,0) .. ack(3,6)
L1 str = str ack(m,n) ' '
n = lt(n,6) n + 1 :s(L1)
output = str; str =
n = 0; m = lt(m,3) m + 1 :s(L1)
end</lang>
Output:
1 2 3 4 5 6 7 2 3 4 5 6 7 8 3 5 7 9 11 13 15 5 13 29 61 125 253 509
SNUSP
<lang snusp> /==!/==atoi=@@@-@-----#
| | Ackermann function | | /=========\!==\!====\ recursion:
$,@/>,@/==ack=!\?\<+# | | | A(0,j) -> j+1
j i \<?\+>-@/# | | A(i,0) -> A(i-1,1)
\@\>@\->@/@\<-@/# A(i,j) -> A(i-1,A(i,j-1))
| | |
# # | | | /+<<<-\
/-<<+>>\!=/ \=====|==!/========?\>>>=?/<<#
? ? | \<<<+>+>>-/
\>>+<<-/!==========/
# #</lang>
One could employ tail recursion elimination by replacing "@/#" with "/" in two places above.
Standard ML
<lang sml>fun a (0, n) = n+1
| a (m, 0) = a (m-1, 1) | a (m, n) = a (m-1, a (m, n-1))</lang>
Tcl
Simple
<lang tcl>proc ack {m n} {
if {$m == 0} {
expr {$n + 1}
} elseif {$n == 0} {
ack [expr {$m - 1}] 1
} else {
ack [expr {$m - 1}] [ack $m [expr {$n - 1}]]
}
}</lang>
With Tail Recursion
With Tcl 8.6, this version is preferred (though the language supports tailcall optimization, it does not apply it automatically in order to preserve stack frame semantics): <lang tcl>proc ack {m n} {
if {$m == 0} {
expr {$n + 1}
} elseif {$n == 0} {
tailcall ack [expr {$m - 1}] 1
} else {
tailcall ack [expr {$m - 1}] [ack $m [expr {$n - 1}]]
}
}</lang>
To Infinity… and Beyond!
If we want to explore the higher reaches of the world of Ackermann's function, we need techniques to really cut the amount of computation being done.
<lang tcl>package require Tcl 8.6
- A memoization engine, from http://wiki.tcl.tk/18152
oo::class create cache {
filter Memoize
variable ValueCache
method Memoize args {
# Do not filter the core method implementations
if {[lindex [self target] 0] eq "::oo::object"} {
return [next {*}$args]
}
# Check if the value is already in the cache
set key [self target],$args
if {[info exist ValueCache($key)]} {
return $ValueCache($key)
}
# Compute value, insert into cache, and return it
return [set ValueCache($key) [next {*}$args]]
}
method flushCache {} {
unset ValueCache
# Skip the cacheing
return -level 2 ""
}
}
- Make an object, attach the cache engine to it, and define ack as a method
oo::object create cached oo::objdefine cached {
mixin cache
method ack {m n} {
if {$m==0} {
expr {$n+1}
} elseif {$m==1} {
# From the Mathematica version
expr {$m+2}
} elseif {$m==2} {
# From the Mathematica version
expr {2*$n+3}
} elseif {$m==3} {
# From the Mathematica version
expr {8*(2**$n-1)+5}
} elseif {$n==0} {
tailcall my ack [expr {$m-1}] 1
} else {
tailcall my ack [expr {$m-1}] [my ack $m [expr {$n-1}]]
}
}
}
- Some small tweaks...
interp recursionlimit {} 100000 interp alias {} ack {} cacheable ack</lang> But even with all this, you still run into problems calculating as that's kind-of large…
TI-89 BASIC
<lang ti89b>Define A(m,n) = when(m=0, n+1, when(n=0, A(m-1,1), A(m-1, A(m, n-1))))</lang>
UNIX Shell
<lang bash>ack() {
local m=$1 local n=$2 if [ $m -eq 0 ]; then echo -n $((n+1)) elif [ $n -eq 0 ]; then ack $((m-1)) 1 else ack $((m-1)) $(ack $m $((n-1))) fi
}</lang> Example: <lang bash>for ((m=0;m<=3;m++)); do
for ((n=0;n<=6;n++)); do ack $m $n echo -n " " done echo
done</lang> Output:
1 2 3 4 5 6 7 2 3 4 5 6 7 8 3 5 7 9 11 13 15 5 13 29 61 125 253 509
Ursala
Anonymous recursion is the usual way of doing things like this.
<lang Ursala>#import std
- import nat
ackermann =
~&al^?\successor@ar ~&ar?(
^R/~&f ^/predecessor@al ^|R/~& ^|/~& predecessor, ^|R/~& ~&\1+ predecessor@l)</lang>
test program for the first 4 by 7 numbers: <lang Ursala>#cast %nLL
test = block7 ackermann*K0 iota~~/4 7</lang> output:
< <1,2,3,4,5,6,7>, <2,3,4,5,6,7,8>, <3,5,7,9,11,13,15>, <5,13,29,61,125,253,509>>
V
<lang v>[ack
[ [pop zero?] [popd succ]
[zero?] [pop pred 1 ack]
[true] [[dup pred swap] dip pred ack ack ]
] when].</lang>
using destructuring view <lang v>[ack
[ [pop zero?] [ [m n : [n succ]] view i]
[zero?] [ [m n : [m pred 1 ack]] view i]
[true] [ [m n : [m pred m n pred ack ack]] view i]
] when].</lang>
VBScript
Based on BASIC version. Uncomment all the lines referring to depth and see just how deep the recursion goes.
Implementation
<lang vb>
option explicit '~ dim depth function ack(m, n) '~ wscript.stdout.write depth & " " if m = 0 then '~ depth = depth + 1 ack = n + 1 '~ depth = depth - 1 elseif m > 0 and n = 0 then '~ depth = depth + 1 ack = ack(m - 1, 1) '~ depth = depth - 1 '~ elseif m > 0 and n > 0 then else '~ depth = depth + 1 ack = ack(m - 1, ack(m, n - 1)) '~ depth = depth - 1 end if
end function </lang>
Invocation
<lang vb> wscript.echo ack( 1, 10 ) '~ depth = 0 wscript.echo ack( 2, 1 ) '~ depth = 0 wscript.echo ack( 4, 4 ) </lang>
Output
12 5 C:\foo\ackermann.vbs(16, 3) Microsoft VBScript runtime error: Out of stack space: 'ack'
Yorick
<lang yorick>func ack(m, n) {
if(m == 0)
return n + 1;
else if(n == 0)
return ack(m - 1, 1);
else
return ack(m - 1, ack(m, n - 1));
}</lang>
Example invocation: <lang yorick>for(m = 0; m <= 3; m++) {
for(n = 0; n <= 6; n++)
write, format="%d ", ack(m, n);
write, "";
}</lang>
Output:
1 2 3 4 5 6 7 2 3 4 5 6 7 8 3 5 7 9 11 13 15 5 13 29 61 125 253 509
- Programming Tasks
- Recursion
- Classic CS problems and programs
- ABAP
- ActionScript
- Ada
- ALGOL 68
- APL
- Argile
- AutoHotkey
- AWK
- BASIC
- Batch File
- Bc
- BCPL
- Befunge
- Brat
- C
- C sharp
- C++
- CLIPS
- Clojure
- Common Lisp
- D
- Dylan
- E
- Elena
- Erlang
- Euphoria
- F Sharp
- Factor
- Falcon
- FALSE
- Forth
- Fortran
- GAP
- Genyris
- GML
- Gnuplot
- Go
- Groovy
- Haskell
- HaXe
- Icon
- Unicon
- Icon Programming Library
- Ioke
- J
- Java
- Arbitrary precision
- JavaScript
- Joy
- Liberty BASIC
- Logo
- Logtalk
- Lua
- Lucid
- M4
- Mathematica
- MATLAB
- MAXScript
- Modula-3
- MUMPS
- Nial
- Nimrod
- OCaml
- Octave
- Oz
- PARI/GP
- Pascal
- Perl
- Perl 6
- PHP
- PicoLisp
- Pike
- PL/I
- PostScript
- PowerBASIC
- PowerShell
- Prolog
- Pure
- PureBasic
- Python
- R
- REBOL
- REXX
- Ruby
- Sather
- Scala
- Scheme
- Seed7
- SETL
- Slate
- Smalltalk
- SNOBOL4
- SNUSP
- Standard ML
- Tcl
- TI-89 BASIC
- UNIX Shell
- Ursala
- V
- LaTeX/Omit
- Make/Omit
- PlainTeX/Omit
- VBScript
- Yorick