Ackermann function
From Rosetta Code
(Redirected from Ackermann Function)
You are encouraged to solve this task according to the task description, using any language you may know.
Its arguments are never negative and it always terminates. Write a function which returns the value of A(m,n). Arbitrary precision is preferred (since the function grows so quickly), but not required.
[edit] ABAP
REPORT zhuberv_ackermann.
CLASS zcl_ackermann DEFINITION.
PUBLIC SECTION.
CLASS-METHODS ackermann IMPORTING m TYPE i
n TYPE i
RETURNING value(v) TYPE i.
ENDCLASS. "zcl_ackermann DEFINITION
CLASS zcl_ackermann IMPLEMENTATION.
METHOD: ackermann.
DATA: lv_new_m TYPE i,
lv_new_n TYPE i.
IF m = 0.
v = n + 1.
ELSEIF m > 0 AND n = 0.
lv_new_m = m - 1.
lv_new_n = 1.
v = ackermann( m = lv_new_m n = lv_new_n ).
ELSEIF m > 0 AND n > 0.
lv_new_m = m - 1.
lv_new_n = n - 1.
lv_new_n = ackermann( m = m n = lv_new_n ).
v = ackermann( m = lv_new_m n = lv_new_n ).
ENDIF.
ENDMETHOD. "ackermann
ENDCLASS. "zcl_ackermann IMPLEMENTATION
PARAMETERS: pa_m TYPE i,
pa_n TYPE i.
DATA: lv_result TYPE i.
START-OF-SELECTION.
lv_result = zcl_ackermann=>ackermann( m = pa_m n = pa_n ).
WRITE: / lv_result.
[edit] 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));
}
[edit] 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;
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
[edit] ALGOL 68
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
- 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
[edit] APL
ackermann←{
0=1⊃⍵:1+2⊃⍵
0=2⊃⍵:∇(¯1+1⊃⍵)1
∇(¯1+1⊃⍵),∇(1⊃⍵),¯1+2⊃⍵
}
[edit] ATS
fun ackermann
{m,n:nat} .<m,n>.
(m: int m, n: int n): Nat =
case+ (m, n) of
| (0, _) => n+1
| (_, 0) =>> ackermann (m-1, 1)
| (_, _) =>> ackermann (m-1, ackermann (m, n-1))
// end of [ackermann]
[edit] 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))
[edit] 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)
[edit] 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)
}
}
}
[edit] Babel
main:
{((0 0) (0 1) (0 2)
(0 3) (0 4) (1 0)
(1 1) (1 2) (1 3)
(1 4) (2 0) (2 1)
(2 2) (2 3) (3 0)
(3 1) (3 2) (4 0))
{ dup
"A(" << { %d " " . << } ... ") = " <<
reverse give
ack
%d cr << } ... }
ack!:
{ dup zero?
{ <-> dup zero?
{ <->
cp
1 -
<- <- 1 - ->
ack ->
ack }
{ <->
1 -
<- 1 ->
ack }
if }
{ zap 1 + }
if }
zero?!: { 0 = }
Output:
A(0 0 ) = 1
A(0 1 ) = 2
A(0 2 ) = 3
A(0 3 ) = 4
A(0 4 ) = 5
A(1 0 ) = 2
A(1 1 ) = 3
A(1 2 ) = 4
A(1 3 ) = 5
A(1 4 ) = 6
A(2 0 ) = 3
A(2 1 ) = 5
A(2 2 ) = 7
A(2 3 ) = 9
A(3 0 ) = 5
A(3 1 ) = 13
A(3 2 ) = 29
A(4 0 ) = 13
[edit] BASIC
BASIC runs out of stack space very quickly. The call ack(3, 4) gives a stack error.
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
[edit] BASIC256
dim stack(5000, 3) # BASIC-256 lacks functions (as of ver. 0.9.6.66)
stack[0,0] = 3 # M
stack[0,1] = 7 # N
lev = 0
gosub ackermann
print "A("+stack[0,0]+","+stack[0,1]+") = "+stack[0,2]
end
ackermann:
if stack[lev,0]=0 then
stack[lev,2] = stack[lev,1]+1
return
end if
if stack[lev,1]=0 then
lev = lev+1
stack[lev,0] = stack[lev-1,0]-1
stack[lev,1] = 1
gosub ackermann
stack[lev-1,2] = stack[lev,2]
lev = lev-1
return
end if
lev = lev+1
stack[lev,0] = stack[lev-1,0]
stack[lev,1] = stack[lev-1,1]-1
gosub ackermann
stack[lev,0] = stack[lev-1,0]-1
stack[lev,1] = stack[lev,2]
gosub ackermann
stack[lev-1,2] = stack[lev,2]
lev = lev-1
return
Output:
A(3,7) = 1021
# BASIC256 since 0.9.9.1 supports functions
for m = 0 to 3
for n = 0 to 4
print m + " " + n + " " + ackermann(m,n)
next n
next m
end
function ackermann(m,n)
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))
endif
end if
end function
Output:
0 0 1 0 1 2 0 2 3 0 3 4 0 4 5 1 0 2 1 1 3 1 2 4 1 3 5 1 4 6 2 0 3 2 1 5 2 2 7 2 3 9 2 4 11 3 0 5 3 1 13 3 2 29 3 3 61 3 4 125
[edit] 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.
::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% )
Because of the exit statements, running this bare closes one's shell, so this test routine handles the calling of Ackermann.cmd
::Ack.cmd
@echo off
cmd/c ackermann.cmd %1 %2
echo Ackermann(%1, %2)=%errorlevel%
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
[edit] BBC BASIC
PRINT FNackermann(3, 7)
END
DEF FNackermann(M%, N%)
IF M% = 0 THEN = N% + 1
IF N% = 0 THEN = FNackermann(M% - 1, 1)
= FNackermann(M% - 1, FNackermann(M%, N%-1))
[edit] bc
Requires a bc that supports long names and the print statement.
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";
}
}
quit
[edit] 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
}
[edit] Befunge
r[1&&{0
>v
j
u>.@
1> \:v
^ v:\_$1+
\^v_$1\1-
u^>1-0fp:1-\0fg101-
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.
[edit] Bracmat
Three solutions are presented here. The first one is a purely recursive version, only using the formulas at the top of the page. The value of A(4,1) cannot be computed due to stack overflow. It can compute A(3,9) (4093), but probably not A(3,10)
( Ack
= m n
. !arg:(?m,?n)
& ( !m:0&!n+1
| !n:0&Ack$(!m+-1,1)
| Ack$(!m+-1,Ack$(!m,!n+-1))
)
);
The second version is a purely non-recursive solution that easily can compute A(4,1). The program uses a stack for Ackermann function calls that are to be evaluated, but that cannot be computed given the currently known function values - the "known unknowns". The currently known values are stored in a hash table. The Hash table also contains incomplete Ackermann function calls, namely those for which the second argument is not known yet - "the unknown unknowns". These function calls are associated with "known unknowns" that are going to provide the value of the second argument. As soon as such an associated known unknown becomes known, the unknown unknown becomes a known unknown and is pushed onto the stack.
Although all known values are stored in the hash table, the converse is not true: an element in the hash table is either a "known known" or an "unknown unknown" associated with an "known unknown".
( A
= m n value key eq chain
, find insert future stack va val
. ( chain
= key future skey
. !arg:(?key.?future)
& str$!key:?skey
& (cache..insert)$(!skey..!future)
&
)
& (find=.(cache..find)$(str$!arg))
& ( insert
= key value future v futureeq futurem skey
. !arg:(?key.?value)
& str$!key:?skey
& ( (cache..find)$!skey:(?key.?v.?future)
& (cache..remove)$!skey
& (cache..insert)$(!skey.!value.)
& ( !future:(?futurem.?futureeq)
& (!futurem,!value.!futureeq)
|
)
| (cache..insert)$(!skey.!value.)&
)
)
& !arg:(?m,?n)
& !n+1:?value
& :?eq:?stack
& whl
' ( (!m,!n):?key
& ( find$!key:(?.#%?value.?future)
& insert$(!eq.!value) !future
| !m:0
& !n+1:?value
& ( !eq:&insert$(!key.!value)
| insert$(!key.!value) !stack:?stack
& insert$(!eq.!value)
)
| !n:0
& (!m+-1,1.!key)
(!eq:|(!key.!eq))
| find$(!m,!n+-1):(?.?val.?)
& ( !val:#%
& ( find$(!m+-1,!val):(?.?va.?)
& !va:#%
& insert$(!key.!va)
| (!m+-1,!val.!eq)
(!m,!n.!eq)
)
|
)
| chain$(!m,!n+-1.!m+-1.!key)
& (!m,!n+-1.)
(!eq:|(!key.!eq))
)
!stack
: (?m,?n.?eq) ?stack
)
& !value
)
& new$hash:?cache
- Some results:
A$(0,0):1 A$(3,13):65533 A$(3,14):131069 A$(4,1):65533
The last solution is a recursive solution that employs some extra formulas, inspired by the Common Lisp solution further down.
( AckFormula
= m n
. !arg:(?m,?n)
& ( !m:0&!n+1
| !m:1&!n+2
| !m:2&2*!n+3
| !m:3&2^(!n+3)+-3
| !n:0&AckFormula$(!m+-1,1)
| AckFormula$(!m+-1,AckFormula$(!m,!n+-1))
)
)
AckFormula$(4,1):65533 AckFormula$(4,2):2003529930406846464979072351560255750447825475569751419265016973.....22087777506072339445587895905719156733
The last computation costs about 0,03 seconds.
[edit] 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
[edit] C
Straightforward implementation per Ackermann definition:
#include <stdio.h>
int ackermann(int m, int n)
{
if (!m) return n + 1;
if (!n) return ackermann(m - 1, 1);
return ackermann(m - 1, ackermann(m, n - 1));
}
int main()
{
int m, n;
for (m = 0; m <= 4; m++)
for (n = 0; n < 6 - m; n++)
printf("A(%d, %d) = %d\n", m, n, ackermann(m, n));
return 0;
}
- Output:
A(0, 0) = 1 A(0, 1) = 2 A(0, 2) = 3 A(0, 3) = 4 A(0, 4) = 5 A(0, 5) = 6 A(1, 0) = 2 A(1, 1) = 3 A(1, 2) = 4 A(1, 3) = 5 A(1, 4) = 6 A(2, 0) = 3 A(2, 1) = 5 A(2, 2) = 7 A(2, 3) = 9 A(3, 0) = 5 A(3, 1) = 13 A(3, 2) = 29 A(4, 0) = 13 <program chokes at this point>
Ackermann function makes a lot of recursive calls, so the above program is a bit naive. We need to be slightly less naive, by doing some simple caching:
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
int m_bits, n_bits;
int *cache;
int ackermann(int m, int n)
{
int idx, res;
if (!m) return n + 1;
if (n >= 1<<n_bits) {
printf("%d, %d\n", m, n);
idx = 0;
} else {
idx = (m << n_bits) + n;
if (cache[idx]) return cache[idx];
}
if (!n) res = ackermann(m - 1, 1);
else res = ackermann(m - 1, ackermann(m, n - 1));
if (idx) cache[idx] = res;
return res;
}
int main()
{
int m, n;
m_bits = 3;
n_bits = 20; /* can save n values up to 2**20 - 1, that's 1 meg */
cache = malloc(sizeof(int) * (1 << (m_bits + n_bits)));
memset(cache, 0, sizeof(int) * (1 << (m_bits + n_bits)));
for (m = 0; m <= 4; m++)
for (n = 0; n < 6 - m; n++) {
printf("A(%d, %d) = %d\n", m, n, ackermann(m, n));
return 0;
}
- Output:
A(0, 0) = 1 A(0, 1) = 2 A(0, 2) = 3 A(0, 3) = 4 A(0, 4) = 5 A(0, 5) = 6 A(1, 0) = 2 A(1, 1) = 3 A(1, 2) = 4 A(1, 3) = 5 A(1, 4) = 6 A(2, 0) = 3 A(2, 1) = 5 A(2, 2) = 7 A(2, 3) = 9 A(3, 0) = 5 A(3, 1) = 13 A(3, 2) = 29 A(4, 0) = 13 A(4, 1) = 65533
Whee. Well, with some extra work, we calculated one more n value, big deal, right?
But see, A(4, 2) = A(3, A(4, 1)) = A(3, 65533) = A(2, A(3, 65532)) = ... you can see how fast it blows up. In fact, no amount of caching will help you calculate large m values; on the machine I use A(4, 2) segfaults because the recursions run out of stack space--not a whole lot I can do about it. At least it runs out of stack space quickly, unlike the first solution...
[edit] C#
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));
}
}
}
}
- 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
[edit] C++
#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);
return 0;
}
[edit] Clay
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));
}
[edit] CLIPS
Functional solution
(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)))
)
)
)
- 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
(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)
)
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>
[edit] Clojure
(defn ackermann [m n]
(cond (zero? m) (inc n)
(zero? n) (ackermann (dec m) 1)
:else (ackermann (dec m) (ackermann m (dec n)))))
[edit] CoffeeScript
ackermann = (m, n) ->
if m is 0 then n + 1
else if m > 0 and n is 0 then ackermann m - 1, 1
else ackermann m - 1, ackermann m, n - 1
[edit] Common Lisp
(defun ackermann (m n)
(cond ((zerop m) (1+ n))
((zerop n) (ackermann (1- m) 1))
(t (ackermann (1- m) (ackermann m (1- n))))))
More elaborately:
(defun ackermann (m n)
(case m ((0) (1+ n))
((1) (+ 2 n))
((2) (+ n n 3))
((3) (- (expt 2 (+ 3 n)) 3))
(otherwise (ackermann (1- m) (if (zerop n) 1 (ackermann m (1- n)))))))
(loop for m from 0 to 4 do
(loop for n from (- 5 m) to (- 6 m) do
(format t "A(~d, ~d) = ~d~%" m n (ackermann m n))))
- Output:
A(0, 5) = 6A(0, 6) = 7 A(1, 4) = 6 A(1, 5) = 7 A(2, 3) = 9 A(2, 4) = 11 A(3, 2) = 29 A(3, 3) = 61 A(4, 1) = 65533
A(4, 2) = 2003529930 <... skipping a few digits ...> 56733
[edit] Coq
Require Import Arith.
Fixpoint A m := fix A_m n :=
match m with
| 0 => n + 1
| S pm =>
match n with
| 0 => A pm 1
| S pn => A pm (A_m pn)
end
end.
[edit] D
[edit] Basic version
ulong ackermann(in ulong m, in ulong n) pure nothrow {
if (m == 0)
return n + 1;
if (n == 0)
return ackermann(m - 1, 1);
return ackermann(m - 1, ackermann(m, n - 1));
}
void main() {
assert(ackermann(2, 4) == 11);
}
[edit] More efficient version
import std.stdio, std.bigint, std.conv;
/*pure nothrow*/ BigInt ipow(/*in*/ BigInt base, /*in*/ BigInt exp){
auto result = BigInt(1);
//while (exp) {
while (exp != 0) {
//if (exp & 1)
if (exp % 2)
result *= base;
exp >>= 1;
base *= base;
}
return result;
}
/*pure nothrow*/ BigInt ackermann(in int m, in int n)
in {
assert(m >= 0 && n >= 0);
} out(result) {
//assert(result >= 0);
assert(cast()result >= 0);
} body {
/*pure nothrow*/ static BigInt ack(in int m, /*in*/ BigInt n) {
switch (m) {
case 0: return n + 1;
case 1: return n + 2;
case 2: return 3 + 2 * n;
//case 3: return 5 + 8 * (2 ^^ n - 1);
case 3: return 5 + 8 * (ipow(BigInt(2), n) - 1);
default: if (n == 0)
return ack(m - 1, BigInt(1));
else
return ack(m - 1, ack(m, n - 1));
}
}
return ack(m, BigInt(n));
}
void main() {
foreach (m; 1 .. 4)
foreach (n; 1 .. 9)
writefln("ackermann(%d, %d): %s", m, n, ackermann(m, n));
writefln("ackermann(4, 1): %s", ackermann(4, 1));
auto a = text(ackermann(4, 2));
writefln("ackermann(4, 2)) (%d digits):\n%s...\n%s",
a.length, a[0 .. 94], a[$-96 .. $]);
}
- Output:
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(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(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(4, 1): 65533 ackermann(4, 2)) (19729 digits): 2003529930406846464979072351560255750447825475569751419265016973710894059556311453089506130880... 699146577530041384717124577965048175856395072895337539755822087777506072339445587895905719156733
[edit] Dart
no caching, the implementation takes ages even for A(4,1)
int A(int m, int n) => m==0 ? n+1 : n==0 ? A(m-1,1) : A(m-1,A(m,n-1));
main() {
print(A(0,0));
print(A(1,0));
print(A(0,1));
print(A(2,2));
print(A(2,3));
print(A(3,3));
print(A(3,4));
print(A(3,5));
print(A(4,0));
}
[edit] Delphi
function Ackermann(m,n:Int64):Int64;
begin
if m = 0 then
Result := n + 1
else if n = 0 then
Result := Ackermann(m-1, 1)
else
Result := Ackermann(m-1, Ackermann(m, n - 1));
end;
[edit] DWScript
function Ackermann(m, n : Integer) : Integer;
begin
if m = 0 then
Result := n+1
else if n = 0 then
Result := Ackermann(m-1, 1)
else Result := Ackermann(m-1, Ackermann(m, n-1));
end;
[edit] 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;
[edit] 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)) }
}
[edit] Eiffel
note
description: "Example of Ackerman function"
URI: "http://rosettacode.org/wiki/Ackermann_function"
class
ACKERMAN_EXAMPLE
create
make
feature {NONE} -- Initialization
make
do
print ("%N A(0,0):" + ackerman (0, 0).out)
print ("%N A(1,0):" + ackerman (1, 0).out)
print ("%N A(0,1):" + ackerman (0, 1).out)
print ("%N A(1,1):" + ackerman (1, 1).out)
print ("%N A(2,0):" + ackerman (2, 0).out)
print ("%N A(2,1):" + ackerman (2, 1).out)
print ("%N A(2,2):" + ackerman (2, 2).out)
print ("%N A(0,2):" + ackerman (0, 2).out)
print ("%N A(1,2):" + ackerman (1, 2).out)
print ("%N A(3,3):" + ackerman (3, 3).out)
print ("%N A(3,4):" + ackerman (3, 4).out)
end
feature -- Access
ackerman (m: NATURAL; n: NATURAL): NATURAL
do
if m = 0 then
Result := n + 1
elseif m > 0 and n = 0 then
Result := ackerman (m - 1, 1)
elseif m > 0 and n > 0 then
Result := ackerman (m - 1, ackerman (m, n - 1))
end
end
end
[edit] Ela
ack 0 n = n+1
ack m 0 = ack (m - 1) 1
ack m n = ack (m - 1) <| ack m <| n - 1
[edit] Elena
#define std'dictionary'*.
#define std'patterns'*.
#subject m, n.
// --- Ackermann function ---
#symbol Ackermann &m:anM &n:anN =
[
#if anM
ifequal:0 [ ^ anN + 1. ]
| greater:0 ?
[
#if anN
ifequal:0 [ ^ Ackermann &&m:(anM - 1) &n:1. ]
| greater:0 ? [ ^ Ackermann &&m:(anM - 1) &n:(Ackermann &&m:anM &n:(anN - 1)). ].
].
control fail.
].
#symbol Program =
[
loop &&from:0 &to:3 run: anM =
[
loop &&from:0 &to:5 run: anN =
[
'program'output << "A(" << anM << "," << anN << ")=" << (Ackermann &&m:anM &n:anN) << "%n".
].
].
'program'Input get.
].
[edit] Erlang
-module(ack).
-export([main/1, ack/2]).
main( [A, B] ) ->
io:fwrite( "~p~n",[ack(erlang:list_to_integer(A), erlang:list_to_integer(B))] ).
ack(0,N) -> N + 1;
ack(M,0) -> ack(M-1, 1);
ack(M,N) -> ack(M-1,ack(M,N-1)).
It can be used with
|escript ./ack.erl 3 4 =125
[edit] Euphoria
This is based on the VBScript example.
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
[edit] Euler Math Toolbox
>M=zeros(1000,1000);
>function map A(m,n) ...
$ global M;
$ if m==0 then return n+1; endif;
$ if n==0 then return A(m-1,1); endif;
$ if m<=cols(M) and n<=cols(M) then
$ M[m,n]=A(m-1,A(m,n-1));
$ return M[m,n];
$ else return A(m-1,A(m,n-1));
$ endif;
$endfunction
>shortestformat; A((0:3)',0:5)
1 2 3 4 5 6
2 3 4 5 6 7
3 5 7 9 11 13
5 13 29 61 125 253
[edit] F#
The following program implements the Ackermann function in F# but is not tail-recursive and so runs out of stack space quite fast.
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]))
Transforming this into continuation passing style avoids limited stack space by permitting tail-recursion.
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))
[edit] 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 ;
[edit] 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
The above will output the below. Formating options to make this pretty are available but for this example only basic output is used.
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
[edit] 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 }
[edit] Fantom
class Main
{
// assuming m,n are positive
static 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))
}
public static Void main ()
{
(0..3).each |m|
{
(0..6).each |n|
{
echo ("Ackerman($m, $n) = ${ackermann(m, n)}")
}
}
}
}
- Output:
Ackerman(0, 0) = 1 Ackerman(0, 1) = 2 Ackerman(0, 2) = 3 Ackerman(0, 3) = 4 Ackerman(0, 4) = 5 Ackerman(0, 5) = 6 Ackerman(0, 6) = 7 Ackerman(1, 0) = 2 Ackerman(1, 1) = 3 Ackerman(1, 2) = 4 Ackerman(1, 3) = 5 Ackerman(1, 4) = 6 Ackerman(1, 5) = 7 Ackerman(1, 6) = 8 Ackerman(2, 0) = 3 Ackerman(2, 1) = 5 Ackerman(2, 2) = 7 Ackerman(2, 3) = 9 Ackerman(2, 4) = 11 Ackerman(2, 5) = 13 Ackerman(2, 6) = 15 Ackerman(3, 0) = 5 Ackerman(3, 1) = 13 Ackerman(3, 2) = 29 Ackerman(3, 3) = 61 Ackerman(3, 4) = 125 Ackerman(3, 5) = 253 Ackerman(3, 6) = 509
[edit] FBSL
Mixed-language solution using pure FBSL, Dynamic Assembler, and Dynamic C layers of FBSL v3.5 concurrently. The following is a single script:
#APPTYPE CONSOLE
TestAckermann()
PAUSE
SUB TestAckermann()
FOR DIM m = 0 TO 3
FOR DIM n = 0 TO 10
PRINT AckermannF(m, n), " ";
NEXT
NEXT
END SUB
FUNCTION AckermannF(m AS INTEGER, n AS INTEGER) AS INTEGER
IF NOT m THEN RETURN n + 1
IF NOT n THEN RETURN AckermannA(m - 1, 1)
RETURN AckermannC(m - 1, AckermannF(m, n - 1))
END FUNCTION
DYNC AckermannC(m AS INTEGER, n AS INTEGER) AS INTEGER
int Ackermann(int m, int n)
{
if (!m) return n + 1;
if (!n) return Ackermann(m - 1, 1);
return Ackermann(m - 1, Ackermann(m, n - 1));
}
int main(int m, int n)
{
return Ackermann(m, n);
}
END DYNC
DYNASM AckermannA(m AS INTEGER, n AS INTEGER) AS INTEGER
ENTER 0, 0
INVOKE Ackermann, m, n
LEAVE
RET
@Ackermann
ENTER 0, 0
.IF DWORD PTR [m] .THEN
JMP @F
.ENDIF
MOV EAX, n
INC EAX
JMP xit
@@
.IF DWORD PTR [n] .THEN
JMP @F
.ENDIF
MOV EAX, m
DEC EAX
INVOKE Ackermann, EAX, 1
JMP xit
@@
MOV EAX, n
DEC EAX
INVOKE Ackermann, m, EAX
MOV ECX, m
DEC ECX
INVOKE Ackermann, ECX, EAX
@xit
LEAVE
RET 8
END DYNASM
Output:
1 2 3 4 5 6 7 8 9 10 11 2 3 4 5 6 7 8 9 10 11 12 3 5 7 9 11 13 15 17 19 21 23 5 13 29 61 125 253 509 1021 2045 4093 8189 Press any key to continue...
[edit] Forth
: acker ( m n -- u )
over 0= IF nip 1+ EXIT THEN
swap 1- swap ( m-1 n -- )
dup 0= IF 1+ recurse EXIT THEN
1- over 1+ swap recurse recurse ;
- Example of use:
FORTH> 0 0 acker . 1 ok FORTH> 3 4 acker . 125 ok
An optimized version:
: ackermann ( m n -- u )
over ( case statement)
0 over = if drop nip 1+ else
1 over = if drop nip 2 + else
2 over = if drop nip 2* 3 + else
3 over = if drop swap 5 + swap lshift 3 - else
drop swap 1- swap dup
if
1- over 1+ swap recurse recurse exit
else
1+ recurse exit \ allow tail recursion
then
then then then then
;
[edit] 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
[edit] 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;
[edit] 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)
[edit] GML
for a function named "ackermann":
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))
[edit] 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)
- Output:
5 6 11 stack overflow
[edit] Go
Classic version
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))
}
Expanded version
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))
}
Expanded version with arbitrary precision and demonstration program
package main
import (
"fmt"
"math/big"
"unsafe"
)
var one = big.NewInt(1)
var two = big.NewInt(2)
var three = big.NewInt(3)
var eight = big.NewInt(8)
var u uint
var uBits = int(unsafe.Sizeof(u))*8 - 1
func Ackermann2(m, n *big.Int) *big.Int {
if m.Cmp(three) <= 0 {
switch m.Int64() {
case 0:
return new(big.Int).Add(n, one)
case 1:
return new(big.Int).Add(n, two)
case 2:
r := new(big.Int).Lsh(n, 1)
return r.Add(r, three)
case 3:
if n.BitLen() > uBits {
panic("way too big")
}
r := new(big.Int).Lsh(eight, uint(n.Int64()))
return r.Sub(r, three)
}
}
if n.BitLen() == 0 {
return Ackermann2(new(big.Int).Sub(m, one), one)
}
return Ackermann2(new(big.Int).Sub(m, one),
Ackermann2(m, new(big.Int).Sub(n, one)))
}
func main() {
show(0, 0)
show(1, 2)
show(2, 4)
show(3, 100)
show(4, 1)
show(4, 3)
}
func show(m, n int64) {
fmt.Printf("A(%d, %d) = ", m, n)
fmt.Println(Ackermann2(big.NewInt(m), big.NewInt(n)))
}
- Output:
A(0, 0) = 1
A(1, 2) = 4
A(2, 4) = 11
A(3, 100) = 10141204801825835211973625643005
A(4, 1) = 65533
A(4, 3) = panic: way too big
goroutine 1 [running]:
main.Ackermann2(0xf84001a480, 0xf84001a5a0, 0xf84001a5a0, 0xf84001a4a0, 0xf84001a460, ...)
a.go:28 +0x2c3
main.Ackermann2(0xf84001a440, 0xf84001a460, 0x2b91c7e9ff50, 0x200000002, 0xa, ...)
a.go:37 +0x1fb
main.show(0x4, 0x3, 0x40cee3, 0x0)
a.go:51 +0x145
main.main()
a.go:46 +0x9b
[edit] Golfscript
{
:_n; :_m;
_m 0= {_n 1+}
{_n 0= {_m 1- 1 ack}
{_m 1- _m _n 1- ack ack}
if}
if
}:ack;
[edit] 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))
}
Test program:
def ackMatrix = (0..3).collect { m -> (0..8).collect { n -> ack(m, n) } }
ackMatrix.each { it.each { elt -> printf "%7d", elt }; println() }
- 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!
[edit] Haskell
ack 0 n = n + 1
ack m 0 = ack (m-1) 1
ack m n = ack (m-1) (ack m (n-1))
- Example of use:
Prelude> ack 0 0 1 Prelude> ack 3 4 125
Generating a list instead:
-- everything here are [Int] or [[Int]], which would overflow
-- * had it not overrun the stack first *
ackermann = iterate ack [1..] where
ack a = s where
s = a!!1 : f (tail a) (zipWith (-) s (1:s))
f a (b:bs) = (head aa) : f aa bs where
aa = drop b a
main = mapM_ print $ map (\n -> take (6 - n) $ ackermann !! n) [0..5]
[edit] Haxe
class RosettaDemo
{
static public function main()
{
Sys.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));
}
}
[edit] Icon and Unicon
Taken from the public domain Icon Programming Library's acker in memrfncs, written by Ralph E. Griswold.
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
- 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
[edit] Ioke
ackermann = method(m,n,
cond(
m zero?, n succ,
n zero?, ackermann(m pred, 1),
ackermann(m pred, ackermann(m, n pred)))
)
[edit] J
As posted at the J wiki
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
- Example use:
0 ack 3
4
1 ack 3
5
2 ack 3
9
3 ack 3
61
J's stack was too small for me to compute 4 ack 1.
[edit] Alternative Primitive Recursive Version
This version works by first generating verbs (functions) and then applying them to compute the rows of the related Buck function; then the Ackermann function is obtained in terms of the Buck function. It uses extended precision to be able to compute 4 Ack 2.
The Ackermann function derived in this fashion is primitive recursive. This is possible because in J (as in some other languages) functions, or representations of them, are first-class values.
Ack=. 3 -~ [ ({&(2 4$'>: 2x&+') ::(,&'&1'&'2x&*'@:(-&2))"0@:[ 128!:2 ]) 3 + ]
- Example use:
0 1 2 3 Ack 0 1 2 3 4 5 6 7
1 2 3 4 5 6 7 8
2 3 4 5 6 7 8 9
3 5 7 9 11 13 15 17
5 13 29 61 125 253 509 1021
3 4 Ack 0 1 2
5 13 ...
13 65533 2003529930406846464979072351560255750447825475569751419265016973710894059556311453089506130880933348101038234342907263181822949382118812668869506364761547029165041871916351587966347219442930927982084309104855990570159318959639524863372367203002916...
4 # @: ": @: Ack 2 NB. Number of digits of 4 Ack 2
19729
5 Ack 0
65533
A structured derivation of Ack follows:
o=. @: NB. Composition of verbs (functions)
x=. o[ NB. Composing the left noun (argument)
(rows2up=. ,&'&1'&'2x&*') o i. 4
2x&*
2x&*&1
2x&*&1&1
2x&*&1&1&1
NB. 2's multiplication, exponentiation, tetration, pentation, etc.
0 1 2 (BuckTruncated=. (rows2up x apply ]) f.) 0 1 2 3 4 5
0 2 4 6 8 ...
1 2 4 8 16 ...
1 2 4 16 65536 2003529930406846464979072351560255750447825475569751419265016973710894059556311453089506130880933348101038234342907263181822949382118812668869506364761547029165041871916351587966347219442930927982084309104855990570159318959639524863372367203...
NB. Buck truncated function (missing the first two rows)
BuckTruncated NB. Buck truncated function-level code
,&'&1'&'2x&*'@:[ 128!:2 ]
(rows01=. {&('>:',:'2x&+')) 0 1 NB. The missing first two rows
>:
2x&+
Buck=. (rows01 :: (rows2up o (-&2)))"0 x apply ]
(Ack=. (3 -~ [ Buck 3 + ])f.) NB. Ackermann function-level code
3 -~ [ ({&(2 4$'>: 2x&+') ::(,&'&1'&'2x&*'@:(-&2))"0@:[ 128!:2 ]) 3 + ]
[edit] Java
import java.math.BigInteger;
public static BigInteger ack(BigInteger m, BigInteger n) {
return m.equals(BigInteger.ZERO)
? n.add(BigInteger.ONE)
: ack(m.subtract(BigInteger.ONE),
n.equals(BigInteger.ZERO) ? BigInteger.ONE : ack(m, n.subtract(BigInteger.ONE)));
}
[edit] JavaScript
function ack(m, n)
{
return m === 0 ? n + 1 : ack(m - 1, n === 0 ? 1 : ack(m, n - 1));
}
[edit] Joy
From here
DEFINE ack == [ [ [pop null] popd succ ]
[ [null] pop pred 1 ack ]
[ [dup pred swap] dip pred ack ack ] ]
cond.
another using a combinator
DEFINE ack == [ [ [pop null] [popd succ] ]
[ [null] [pop pred 1] [] ]
[ [[dup pred swap] dip pred] [] [] ] ]
condnestrec.
Whenever there are two definitions with the same name, the last one is the one that is used, when invoked.
[edit] Julia
function ack(m,n)
if m == 0
return n + 1
elseif n == 0
return ack(m-1,1)
else
return ack(m-1,ack(m,n-1))
end
end
One-liner:
ack2(m,n) = m == 0 ? n + 1 : n == 0 ? ack2(m-1,1) : ack2(m-1,ack2(m,n-1))
[edit] K
See the K wiki
ack:{:[0=x;y+1;0=y;_f[x-1;1];_f[x-1;_f[x;y-1]]]}
ack[2;2]
[edit] Kdf9 Usercode
V6; W0;
YS26000;
RESTART; J999; J999;
PROGRAM; (main program);
V1 = B1212121212121212; (radix 10 for FRB);
V2 = B2020202020202020; (high bits for decimal digits);
V3 = B0741062107230637; ("A[3," in Flexowriter code);
V4 = B0727062200250007; ("7] = " in Flexowriter code);
V5 = B7777777777777777;
ZERO; NOT; =M1; (Q1 := 0/0/-1);
SETAYS0; =M2; I2=2; (Q2 := 0/2/AYS0: M2 is the stack pointer);
SET 3; =RC7; (Q7 := 3/1/0: C7 = m);
SET 7; =RC8; (Q8 := 7/1/0: C8 = n);
JSP1; (call Ackermann function);
V1; REV; FRB; (convert result to base 10);
V2; OR; (convert decimal digits to characters);
V5; REV;
SHLD+24; =V5; ERASE; (eliminate leading zeros);
SETAV5; =RM9;
SETAV3; =I9;
POAQ9; (write result to Flexowriter);
999; ZERO; OUT; (terminate run);
P1; (To compute A[m, n]);
99;
J1C7NZ; (to 1 if m ± 0);
I8; =+C8; (n := n + 1);
C8; (result to NEST);
EXIT 1; (return);
*1;
J2C8NZ; (to 2 if n ± 0);
I8; =C8; (n := 1);
DC7; (m := m - 1);
J99; (tail recursion for A[m-1, 1]);
*2;
LINK; =M0M2; (push return address);
C7; =M0M2QN; (push m);
DC8; (n := n - 1);
JSP1; (full recursion for A[m, n-1]);
=C8; (n := A[m, n-1]);
M1M2; =C7; (m := top of stack);
DC7; (m := m - 1);
M-I2; (pop stack);
M0M2; =LINK; (return address := top of stack);
J99; (tail recursion for A[m-1, A[m, n-1]]);
FINISH;
[edit] Liberty BASIC
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
[edit] 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
[edit] 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).
[edit] LOLCODE
HAI 1.3
HOW IZ I ackermann YR m AN YR n
NOT m, O RLY?
YA RLY, FOUND YR SUM OF n AN 1
OIC
NOT n, O RLY?
YA RLY, FOUND YR I IZ ackermann YR DIFF OF m AN 1 AN YR 1 MKAY
OIC
FOUND YR I IZ ackermann YR DIFF OF m AN 1 AN YR...
I IZ ackermann YR m AN YR DIFF OF n AN 1 MKAY MKAY
IF U SAY SO
IM IN YR outer UPPIN YR m TIL BOTH SAEM m AN 5
IM IN YR inner UPPIN YR n TIL BOTH SAEM n AN DIFF OF 6 AN m
VISIBLE "A(" m ", " n ") = " I IZ ackermann YR m AN YR n MKAY
IM OUTTA YR inner
IM OUTTA YR outer
KTHXBYE
[edit] 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
[edit] 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
[edit] 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)
- Output:
61
[edit] Maple
Strictly by the definition given above, we can code this as follows.
In Maple, the keyword
Ackermann := proc( m :: nonnegint, n :: nonnegint )
option remember; # optional automatic memoization
if m = 0 then
n + 1
elif n = 0 then
thisproc( m - 1, 1 )
else
thisproc( m - 1, thisproc( m, n - 1 ) )
end if
end proc:
thisprocrefers to the currently executing procedure (closure) and is used when writing recursive procedures. (You could also use the name of the procedure, Ackermann in this case, but then a concurrently executing task or thread could re-assign that name while the recursive procedure is executing, resulting in an incorrect result.)
To make this faster, you can use known expansions for small values of m. (See Wikipedia:Ackermann function)
Ackermann := proc( m :: nonnegint, n :: nonnegint )
option remember; # optional automatic memoization
if m = 0 then
n + 1
elif m = 1 then
n + 2
elif m = 2 then
2 * n + 3
elif m = 3 then
8 * 2^n - 3
elif n = 0 then
thisproc( m - 1, 1 )
else
thisproc( m - 1, thisproc( m, n - 1 ) )
end if
end proc:
This makes it possible to compute Ackermann( 4, 1 ) and Ackermann( 4, 2 ) essentially instantly, though Ackermann( 4, 3 ) is still out of reach.
To compute Ackermann( 1, i ) for i from 1 to 10 use
> map2( Ackermann, 1, [seq]( 1 .. 10 ) );
[3, 4, 5, 6, 7, 8, 9, 10, 11, 12]
To get the first 10 values for m = 2 use
> map2( Ackermann, 2, [seq]( 1 .. 10 ) );
[5, 7, 9, 11, 13, 15, 17, 19, 21, 23]
For Ackermann( 4, 2 ) we get a very long number with
> length( Ackermann( 4, 2 ) );
19729
digits.
[edit] Mathematica
Two possible implementations would be:
$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]]
Note that the second implementation is quite a bit faster, as doing 'if' comparisons is slower than the built-in pattern matching algorithms. Examples:
Flatten[#,1]&@Table[{"Ackermann2["<>ToString[i]<>","<>ToString[j]<>"] =",Ackermann2[i,j]},{i,3},{j,8}]//Grid
gives back:
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
If we would like to calculate Ackermann[4,1] or Ackermann[4,2] we have to optimize a little bit:
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]]
Now computing Ackermann[4,1] and Ackermann[4,2] can be done quickly (<0.01 sec): Examples 2:
Ackermann3[4, 1]
Ackermann3[4, 2]
gives back:
65533
2003529930406846464979072351560255750447825475569751419265016973710894059556311453089506130880........699146577530041384717124577965048175856395072895337539755822087777506072339445587895905719156733
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.
[edit] 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
[edit] Maxima
ackermann(m, n) := if integerp(m) and integerp(n) then ackermann[m, n] else 'ackermann(m, n)$
ackermann[m, n] := if m = 0 then n + 1
elseif m = 1 then 2 + (n + 3) - 3
elseif m = 2 then 2 * (n + 3) - 3
elseif m = 3 then 2^(n + 3) - 3
elseif n = 0 then ackermann[m - 1, 1]
else ackermann[m - 1, ackermann[m, n - 1]]$
tetration(a, n) := if integerp(n) then block([b: a], for i from 2 thru n do b: a^b, b) else 'tetration(a, n)$
/* this should evaluate to zero */
ackermann(4, n) - (tetration(2, n + 3) - 3);
subst(n = 2, %);
ev(%, nouns);
[edit] MAXScript
Use with caution. Will cause a stack overflow for m > 3.
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))
)
)
[edit] МК-61/52
П1 <-> П0 ПП 06 С/П ИП0 x=0 13 ИП1
1 + В/О ИП1 x=0 24 ИП0 1 П1 -
П0 ПП 06 В/О ИП0 П2 ИП1 1 - П1
ПП 06 П1 ИП2 1 - П0 ПП 06 В/О
[edit] ML/I
ML/I loves recursion, but runs out of its default amount of storage with larger numbers than those tested here!
[edit] Program
MCSKIP "WITH" NL
"" Ackermann function
"" Will overflow when it reaches implementation-defined signed integer limit
MCSKIP MT,<>
MCINS %.
MCDEF ACK WITHS ( , )
AS <MCSET T1=%A1.
MCSET T2=%A2.
MCGO L1 UNLESS T1 EN 0
%%T2.+1.MCGO L0
%L1.MCGO L2 UNLESS T2 EN 0
ACK(%%T1.-1.,1)MCGO L0
%L2.ACK(%%T1.-1.,ACK(%T1.,%%T2.-1.))>
"" Macro ACK now defined, so try it out
a(0,0) => ACK(0,0)
a(0,1) => ACK(0,1)
a(0,2) => ACK(0,2)
a(0,3) => ACK(0,3)
a(0,4) => ACK(0,4)
a(0,5) => ACK(0,5)
a(1,0) => ACK(1,0)
a(1,1) => ACK(1,1)
a(1,2) => ACK(1,2)
a(1,3) => ACK(1,3)
a(1,4) => ACK(1,4)
a(2,0) => ACK(2,0)
a(2,1) => ACK(2,1)
a(2,2) => ACK(2,2)
a(2,3) => ACK(2,3)
a(3,0) => ACK(3,0)
a(3,1) => ACK(3,1)
a(3,2) => ACK(3,2)
a(4,0) => ACK(4,0)
- Output:
a(0,0) => 1
a(0,1) => 2
a(0,2) => 3
a(0,3) => 4
a(0,4) => 5
a(0,5) => 6
a(1,0) => 2
a(1,1) => 3
a(1,2) => 4
a(1,3) => 5
a(1,4) => 6
a(2,0) => 3
a(2,1) => 5
a(2,2) => 7
a(2,3) => 9
a(3,0) => 5
a(3,1) => 13
a(3,2) => 29
a(4,0) => 13
[edit] Mercury
This is the Ackermann function with some (obvious) elements elided. The ack/3 predicate is implemented in terms of the ack/2 function. The ack/2 function is implemented in terms of the ack/3 predicate. This makes the code both more concise and easier to follow than would otherwise be the case. The integer type is used instead of int because the problem statement stipulates the use of bignum integers if possible.
:- func ack(integer, integer) = integer.
ack(M, N) = R :- ack(M, N, R).
:- pred ack(integer::in, integer::in, integer::out) is det.
ack(M, N, R) :-
( ( M < integer(0)
; N < integer(0) ) -> throw(bounds_error)
; M = integer(0) -> R = N + integer(1)
; N = integer(0) -> ack(M - integer(1), integer(1), R)
; ack(M - integer(1), ack(M, N - integer(1)), R) ).
[edit] Modula-2
MODULE ackerman;
IMPORT ASCII, NumConv, InOut;
VAR m, n : LONGCARD;
string : ARRAY [0..19] OF CHAR;
OK : BOOLEAN;
PROCEDURE Ackerman (x, y : LONGCARD) : LONGCARD;
BEGIN
IF x = 0 THEN RETURN y + 1
ELSIF y = 0 THEN RETURN Ackerman (x - 1 , 1)
ELSE
RETURN Ackerman (x - 1 , Ackerman (x , y - 1))
END
END Ackerman;
BEGIN
FOR m := 0 TO 3 DO
FOR n := 0 TO 6 DO
NumConv.Num2Str (Ackerman (m, n), 10, string, OK);
IF OK THEN
InOut.WriteString (string)
ELSE
InOut.WriteString ("* Error in number * ")
END;
InOut.Write (ASCII.HT)
END;
InOut.WriteLn
END;
InOut.WriteLn
END ackerman.
- Output:
jan@Beryllium:~/modula/rosetta$ ackerman1 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
[edit] Modula-3
The type CARDINAL is defined in Modula-3 as [0..LAST(INTEGER)], in other words, it can hold all positive integers.
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.
- 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
[edit] 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
[edit] NetRexx
/* NetRexx */
options replace format comments java crossref symbols binary
numeric digits 66
parse arg j_ k_ .
if j_ = '' | j_ = '.' | \j_.datatype('w') then j_ = 3
if k_ = '' | k_ = '.' | \k_.datatype('w') then k_ = 5
loop m_ = 0 to j_
say
loop n_ = 0 to k_
say 'ackermann('m_','n_') =' ackermann(m_, n_).right(5)
end n_
end m_
return
method ackermann(m, n) public static
select
when m = 0 then rval = n + 1
when n = 0 then rval = ackermann(m - 1, 1)
otherwise rval = ackermann(m - 1, ackermann(m, n - 1))
end
return rval
[edit] 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]]]
]
[edit] 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))
[edit] 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)))
or:
let rec a = function
| 0, n -> (n+1)
| m, 0 -> a(m-1, 1)
| m, n -> a(m-1, a(m, n-1))
with memoization using an hash-table:
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)
taking advantage of the memoization we start calling small values of m and n in order to reduce the recursion call stack:
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)
[edit] Arbitrary precision
With arbitrary-precision integers (Big_int module):
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)))
compile with:
ocamlopt -o acker nums.cmxa acker.ml
[edit] Tail-Recursive
Here is a tail-recursive version:
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 *) ) [] [] ;;
This one uses the arbitrary precision, the tail-recursion, and the optimisation explain on the Wikipedia page about (m,n) = (3,_).
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);
;;
[edit] Oberon-2
MODULE ackerman;
IMPORT Out;
VAR m, n : INTEGER;
PROCEDURE Ackerman (x, y : INTEGER) : INTEGER;
BEGIN
IF x = 0 THEN RETURN y + 1
ELSIF y = 0 THEN RETURN Ackerman (x - 1 , 1)
ELSE
RETURN Ackerman (x - 1 , Ackerman (x , y - 1))
END
END Ackerman;
BEGIN
FOR m := 0 TO 3 DO
FOR n := 0 TO 6 DO
Out.Int (Ackerman (m, n), 10);
Out.Char (9X)
END;
Out.Ln
END;
Out.Ln
END ackerman.
[edit] 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
[edit] ooRexx
loop m = 0 to 3
loop n = 0 to 6
say "Ackermann("m", "n") =" ackermann(m, n)
end
end
::routine ackermann
use strict arg m, n
-- give us some precision room
numeric digits 10000
if m = 0 then return n + 1
else if n = 0 then return ackermann(m - 1, 1)
else return ackermann(m - 1, ackermann(m, n - 1))
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(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(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(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
[edit] Order
#include <order/interpreter.h>
#define ORDER_PP_DEF_8ack ORDER_PP_FN( \
8fn(8X, 8Y, \
8cond((8is_0(8X), 8inc(8Y)) \
(8is_0(8Y), 8ack(8dec(8X), 1)) \
(8else, 8ack(8dec(8X), 8ack(8X, 8dec(8Y)))))))
ORDER_PP(8to_lit(8ack(3, 4))) // 125
[edit] Oz
Oz has arbitrary precision integers.
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}}
[edit] PARI/GP
Naive implementation.
A(m,n)={
if(m,
if(n,
A(m-1, A(m,n-1))
,
A(m-1,1)
)
,
n+1
)
};
[edit] 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.
[edit] Perl
We memoize calls to A to make A(2, n) and A(3, n) feasible for larger values of n.
{
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 )
);
}
}
An implementation using the conditional statements 'if', 'elsif' and 'else':
sub A {
my ($m, $n) = @_;
if ($m == 0) { $n + 1 }
elsif ($n == 0) { A($m - 1, 1) }
else { A($m - 1, A($m, $n - 1)) }
}
An implementation using ternary chaining:
sub A {
my ($m, $n) = @_;
$m == 0 ? $n + 1 :
$n == 0 ? A($m - 1, 1) :
A($m - 1, A($m, $n - 1))
}
[edit] Perl 6
An implementation using ternary chaining:
sub A(Int $m, Int $n) {
$m == 0 ?? $n + 1 !!
$n == 0 ?? A($m - 1, 1 ) !!
A($m - 1, A($m, $n - 1));
}
An implementation using multiple dispatch:
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)) }
Note that in either case, Int is defined to be arbitrary precision in Perl 6.
Here's a caching version of that, written in the sigilless style, with liberal use of Unicode, and the extra optimizing terms to make A(4,2) possible:
proto A(Int \𝑚, Int \𝑛) { (state @)[𝑚][𝑛] //= {*} }
multi A(0, Int \𝑛) { 𝑛 + 1 }
multi A(1, Int \𝑛) { 𝑛 + 2 }
multi A(2, Int \𝑛) { 3 + 2 * 𝑛 }
multi A(3, Int \𝑛) { 5 + 8 * (2 ** 𝑛 - 1) }
multi A(Int \𝑚, 0 ) { A(𝑚 - 1, 1) }
multi A(Int \𝑚, Int \𝑛) { A(𝑚 - 1, A(𝑚, 𝑛 - 1)) }
Testing:
say A(4,1);
say .chars, " digits starting with ", .substr(0,50), "..." given A(4,2);
- Output:
65533 19729 digits starting with 20035299304068464649790723515602557504478254755697...
[edit] 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
[edit] PicoLisp
(de ack (X Y)
(cond
((=0 X) (inc Y))
((=0 Y) (ack (dec X) 1))
(T (ack (dec X) (ack X (dec Y)))) ) )
[edit] 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));
}
}
[edit] 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;
[edit] PostScript
/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
/A {
[/.m /.n] let
{
{.m 0 eq} {.n succ} is?
{.m 0 gt .n 0 eq and} {.m pred 1 A} is?
{.m 0 gt .n 0 gt and} {.m pred .m .n pred A A} is?
} cond
end}.
[edit] 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
[edit] 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)))
}
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):
foreach ($m in 0..3) {
foreach ($n in 0..6) {
Write-Host -NoNewline ("{0,5}" -f (ackermann $m $n))
}
Write-Host
}
- 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
[edit] 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).
[edit] 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 && n > 0;
[edit] 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)
[edit] Purity
data Iter = f => FoldNat <const $f One, $f>
data Ackermann = FoldNat <const Succ, Iter>
[edit] 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)))
Another version:
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))
- Example of use:
>>> import sys
>>> sys.setrecursionlimit(3000)
>>> ack1(0,0)
1
>>> ack1(3,4)
125
>>> ack2(0,0)
1
>>> ack2(3,4)
125
From the Mathematica ack3 example:
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))))))
Results confirm those of Mathematica for ack(4,1) and ack(4,2)
[edit] 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))
}
}
for ( i in 0:3 ) {
print(ackermann(i, 4))
}
[edit] Racket
#lang racket
(define (ackermann m n)
(cond [(zero? m) (add1 n)]
[(zero? n) (ackermann (sub1 m) 1)]
[else (ackermann (sub1 m) (ackermann m (sub1 n)))]))
[edit] REBOL
ackermann: func [m n] [
case [
m = 0 [n + 1]
n = 0 [ackermann m - 1 1]
true [ackermann m - 1 ackermann m n - 1]
]
]
[edit] REXX
[edit] no optimization
/*REXX program calculates/shows some values for the Ackermann function. */
/*Note: the Ackermann function (as implemented) is */
/* higly recursive and is limited by the */
/* biggest number that can have "1" added to */
/* a number (successfully, accurately). */
high=24
do j=0 to 3; say
do k=0 to high%(max(1,j))
call Ackermann_tell j,k
end /*k*/
end /*j*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────ACKERMANN_TELL subroutine───────────*/
ackermann_tell: parse arg mm,nn; calls=0 /*display an echo message.*/
nnn=right(nn,length(high))
say 'Ackermann('mm","nnn')='right(ackermann(mm,nn),high),
left('',12) 'calls='right(calls,high)
return
/*──────────────────────────────────ACKERMANN subroutine────────────────*/
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)
return ackermann(m-1,ackermann(m,n-1))
- 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
[edit] optimized for m<3
/*REXX program calculates/shows some values for the Ackermann function. */
high=24
do j=0 to 3; say
do k=0 to high%(max(1,j))
call Ackermann_tell j,k
end /*k*/
end /*j*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────ACKERMANN_TELL subroutine───────────*/
ackermann_tell: parse arg mm,nn; calls=0 /*display an echo message.*/
nnn=right(nn,length(high))
say 'Ackermann('mm","nnn')='right(ackermann(mm,nn),high),
left('',12) 'calls='right(calls,10)
return
/*──────────────────────────────────ACKERMANN subroutine────────────────*/
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))
- 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= 1 Ackermann(2, 2)= 7 calls= 1 Ackermann(2, 3)= 9 calls= 1 Ackermann(2, 4)= 11 calls= 1 Ackermann(2, 5)= 13 calls= 1 Ackermann(2, 6)= 15 calls= 1 Ackermann(2, 7)= 17 calls= 1 Ackermann(2, 8)= 19 calls= 1 Ackermann(2, 9)= 21 calls= 1 Ackermann(2,10)= 23 calls= 1 Ackermann(2,11)= 25 calls= 1 Ackermann(2,12)= 27 calls= 1 Ackermann(3, 0)= 5 calls= 2 Ackermann(3, 1)= 13 calls= 4 Ackermann(3, 2)= 29 calls= 6 Ackermann(3, 3)= 61 calls= 8 Ackermann(3, 4)= 125 calls= 10 Ackermann(3, 5)= 253 calls= 12 Ackermann(3, 6)= 509 calls= 14 Ackermann(3, 7)= 1021 calls= 16 Ackermann(3, 8)= 2045 calls= 18
[edit] optimized for m<5
This REXX version takes advantage that some of the lower Ackermann numbers have direct formulas.
If the NUMERIC DIGITS 100 were to be increased to 20000, then Ackermann(4,2) would be presented with the full 19,729 digits.
/*REXX program calculates/shows some values for the Ackermann function. */
high=24
numeric digits 100 /*have REXX to use up to 100 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; say /*Ackermann(5,1) is a bit impractical to calc.*/
do k=0 to high%(max(1,j))
call Ackermann_tell j,k
if j==4 & k==2 then leave /*no sense in going overboard.*/
end /*k*/
end /*j*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────ACKERMANN_TELL subroutine───────────*/
ackermann_tell: parse arg mm,nn; calls=0 /*display an echo message.*/
nnn=right(nn,length(high))
say 'Ackermann('mm","nnn')='right(ackermann(mm,nn),high),
left('',12) 'calls='right(calls,10)
return
/*──────────────────────────────────ACKERMANN subroutine────────────────*/
ackermann: procedure expose calls /*compute the Ackerman function. */
parse arg m,n; calls=calls+1
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 do; a=2
do (n+3)-1 /*ugh!*/
a=2**a
end
return a-3
end
if n==0 then return ackermann(m-1,1)
return ackermann(m-1,ackermann(m,n-1))
- 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= 1 Ackermann(1, 1)= 3 calls= 1 Ackermann(1, 2)= 4 calls= 1 Ackermann(1, 3)= 5 calls= 1 Ackermann(1, 4)= 6 calls= 1 Ackermann(1, 5)= 7 calls= 1 Ackermann(1, 6)= 8 calls= 1 Ackermann(1, 7)= 9 calls= 1 Ackermann(1, 8)= 10 calls= 1 Ackermann(1, 9)= 11 calls= 1 Ackermann(1,10)= 12 calls= 1 Ackermann(1,11)= 13 calls= 1 Ackermann(1,12)= 14 calls= 1 Ackermann(1,13)= 15 calls= 1 Ackermann(1,14)= 16 calls= 1 Ackermann(1,15)= 17 calls= 1 Ackermann(1,16)= 18 calls= 1 Ackermann(1,17)= 19 calls= 1 Ackermann(1,18)= 20 calls= 1 Ackermann(1,19)= 21 calls= 1 Ackermann(1,20)= 22 calls= 1 Ackermann(1,21)= 23 calls= 1 Ackermann(1,22)= 24 calls= 1 Ackermann(1,23)= 25 calls= 1 Ackermann(1,24)= 26 calls= 1 Ackermann(2, 0)= 3 calls= 1 Ackermann(2, 1)= 5 calls= 1 Ackermann(2, 2)= 7 calls= 1 Ackermann(2, 3)= 9 calls= 1 Ackermann(2, 4)= 11 calls= 1 Ackermann(2, 5)= 13 calls= 1 Ackermann(2, 6)= 15 calls= 1 Ackermann(2, 7)= 17 calls= 1 Ackermann(2, 8)= 19 calls= 1 Ackermann(2, 9)= 21 calls= 1 Ackermann(2,10)= 23 calls= 1 Ackermann(2,11)= 25 calls= 1 Ackermann(2,12)= 27 calls= 1 Ackermann(3, 0)= 5 calls= 1 Ackermann(3, 1)= 13 calls= 1 Ackermann(3, 2)= 29 calls= 1 Ackermann(3, 3)= 61 calls= 1 Ackermann(3, 4)= 125 calls= 1 Ackermann(3, 5)= 253 calls= 1 Ackermann(3, 6)= 509 calls= 1 Ackermann(3, 7)= 1021 calls= 1 Ackermann(3, 8)= 2045 calls= 1 Ackermann(4, 0)= 13 calls= 1 Ackermann(4, 1)= 65533 calls= 1 Ackermann(4, 2)=89506130880933368E+19728 calls= 1
[edit] 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
Example:
(0..3).each do |m|
(0..6).each { |n| print ack(m, n), ' ' }
puts
end
- 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
[edit] Run BASIC
print ackermann(1, 2)
function ackermann(m, n)
if (m < 0) or (n < 0) then goto [exitFunction]
if (m = 0) then ackermann = (n + 1)
if (m > 0) and (n = 0) then ackermann = ackermann((m - 1), 1)
if (m > 0) and (n > 0) then ackermann = ackermann((m - 1), ackermann(m, (n - 1)))
[exitFunction]
end function
[edit] 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;
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.
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;
[edit] 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))
}
- Example:
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)
I saw that this was one of the problems that needed an implementation in Scala, but when I made it, there was already one.
But because ackerman is heavy recursive, I implemented it with memoization. So I still post it.
Could still be done better, but that I leave to the reader. ;-)
val maxDepth = 4
val ackMMap = scala.collection.mutable.Map[BigInt, BigInt]()
val ackNMaps = Array.fill(maxDepth + 1) { scala.collection.mutable.Map[BigInt, BigInt]() }
def ack(m: Int, n: BigInt): BigInt = {
if ((m < 0) || (n < 0)) {
throw new Exception("Negative parameters are not allowed: ack(%s, %s)".format(m, n))
}
if (m > maxDepth) {
throw new Exception("First parameter is greater as %s: ack(%s, %s)".format(maxDepth, m, n))
}
val newM = m - 1
val newN = n - 1
if (m == 0) {
n + 1
} else if (n == 0) {
ackMMap.getOrElseUpdate(newM, ack(newM, 1))
} else {
val createStep = 125
val index = m
val mapCurrent = ackNMaps(index)
val mapPrevious = ackNMaps(index - 1)
val maxRecursion = 2 * createStep
val nrOfElements : BigInt = if (mapCurrent.isEmpty) 0 else mapCurrent.max._1
if ((nrOfElements + maxRecursion) < n) {
for (i <- nrOfElements + createStep to n by createStep) {
mapCurrent.getOrElseUpdate(i, ack(m, i))
}
}
mapCurrent.getOrElseUpdate(n, {
val ackVal = mapCurrent.getOrElseUpdate(newN, ack(m, newN))
mapPrevious.getOrElseUpdate(ackVal, ack(newM, ackVal))
})
}
}
One important optimization is:
if ((nrOfElements + maxRecursion) < n) {
for (i <- nrOfElements + createStep to n by createStep) {
mapCurrent.getOrElseUpdate(i, ack(m, i))
}
}
The recursion with ackermann can become very deep indeed. In this way it is still calculable without needing a very big stack. And because memoization is used, you circumvent a stack overflow without a (real) cost.
[edit] Scheme
(define (A m n)
(cond
((= m 0) (+ n 1))
((= n 0) (A (- m 1) 1))
(else (A (- m 1) (A m (- n 1))))))
[edit] 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;
Original source: [1]
[edit] 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;
[edit] 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)]]
].
[edit] 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.
[edit] SNOBOL4
Both Snobol4+ and CSnobol stack overflow, at ack(3,3) and ack(3,4), respectively.
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
- 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
[edit] 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))
| | |
# # | | | /+<<<-\
/-<<+>>\!=/ \=====|==!/========?\>>>=?/<<#
? ? | \<<<+>+>>-/
\>>+<<-/!==========/
# #
One could employ tail recursion elimination by replacing "@/#" with "/" in two places above.
[edit] Standard ML
fun a (0, n) = n+1
| a (m, 0) = a (m-1, 1)
| a (m, n) = a (m-1, a (m, n-1))
[edit] Tcl
[edit] Simple
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}]]
}
}
[edit] 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):
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}]]
}
}
[edit] 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.
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
But even with all this, you still run into problems calculating ack(4,3) as that's kind-of large…
[edit] TSE SAL
// library: math: get: ackermann: recursive <description></description> <version>1.0.0.0.5</version> <version control></version control> (filenamemacro=getmaare.s) [kn, ri, tu, 27-12-2011 14:46:59]
INTEGER PROC FNMathGetAckermannRecursiveI( INTEGER mI, INTEGER nI )
IF ( mI == 0 )
RETURN( nI + 1 )
ENDIF
IF ( nI == 0 )
RETURN( FNMathGetAckermannRecursiveI( mI - 1, 1 ) )
ENDIF
RETURN( FNMathGetAckermannRecursiveI( mI - 1, FNMathGetAckermannRecursiveI( mI, nI - 1 ) ) )
END
PROC Main()
STRING s1[255] = "2"
STRING s2[255] = "3"
IF ( NOT ( Ask( "math: get: ackermann: recursive: m = ", s1, _EDIT_HISTORY_ ) ) AND ( Length( s1 ) > 0 ) ) RETURN() ENDIF
IF ( NOT ( Ask( "math: get: ackermann: recursive: n = ", s2, _EDIT_HISTORY_ ) ) AND ( Length( s2 ) > 0 ) ) RETURN() ENDIF
Message( FNMathGetAckermannRecursiveI( Val( s1 ), Val( s2 ) ) ) // gives e.g. 9
END
[edit] TI-89 BASIC
Define A(m,n) = when(m=0, n+1, when(n=0, A(m-1,1), A(m-1, A(m, n-1))))
[edit] UNIX Shell
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
}
Example:
for ((m=0;m<=3;m++)); do
for ((n=0;n<=6;n++)); do
ack $m $n
echo -n " "
done
echo
done
- 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
[edit] Ursala
Anonymous recursion is the usual way of doing things like this.
#import std
#import nat
ackermann =
~&al^?\successor@ar ~&ar?(
^R/~&f ^/predecessor@al ^|R/~& ^|/~& predecessor,
^|R/~& ~&\1+ predecessor@l)
test program for the first 4 by 7 numbers:
#cast %nLL
test = block7 ackermann*K0 iota~~/4 7
- 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>>
[edit] V
[ack
[ [pop zero?] [popd succ]
[zero?] [pop pred 1 ack]
[true] [[dup pred swap] dip pred ack ack ]
] when].
using destructuring view
[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].
[edit] VBScript
Based on BASIC version. Uncomment all the lines referring to depth and see just how deep the recursion goes.
- Implementation
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
- Invocation
wscript.echo ack( 1, 10 )
'~ depth = 0
wscript.echo ack( 2, 1 )
'~ depth = 0
wscript.echo ack( 4, 4 )
- Output:
12 5 C:\foo\ackermann.vbs(16, 3) Microsoft VBScript runtime error: Out of stack space: 'ack'
[edit] XPL0
include c:\cxpl\codes;
func Ackermann(M, N);
int 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));
]; \Ackermann
int M, N;
[for M:= 0 to 3 do
[for N:= 0 to 7 do
[IntOut(0, Ackermann(M, N)); ChOut(0,9\tab\)];
CrLf(0);
];
]
Recursion overflows the stack if either M or N is extended by a single count.
- Output:
1 2 3 4 5 6 7 8 2 3 4 5 6 7 8 9 3 5 7 9 11 13 15 17 5 13 29 61 125 253 509 1021
[edit] 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));
}
Example invocation:
for(m = 0; m <= 3; m++) {
for(n = 0; n <= 6; n++)
write, format="%d ", ack(m, n);
write, "";
}
- 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
[edit] ZED
(ackermann) m n
0 3
(zero?) m
(add1) n
(ackermann) m n
2 0
(and) (positive?) m (zero?) n
(ackermann) (sub1) m 1
(ackermann) m n
2 3
(and) (positive?) m (positive?) n
(ackermann) (sub1) m (ackermann) m (sub1) n
Categories:
- Programming Tasks
- Recursion
- Memoization
- Classic CS problems and programs
- ABAP
- ActionScript
- Ada
- ALGOL 68
- APL
- ATS
- Argile
- AutoHotkey
- AWK
- Babel
- BASIC
- BASIC256
- Batch File
- BBC BASIC
- Bc
- BCPL
- Befunge
- Bracmat
- Brat
- C
- C sharp
- C++
- Clay
- CLIPS
- Clojure
- CoffeeScript
- Common Lisp
- Coq
- D
- Dart
- Delphi
- DWScript
- Dylan
- E
- Eiffel
- Ela
- Elena
- Erlang
- Euphoria
- Euler Math Toolbox
- F Sharp
- Factor
- Falcon
- FALSE
- Fantom
- FBSL
- Forth
- Fortran
- GAP
- Genyris
- GML
- Gnuplot
- Go
- Golfscript
- Groovy
- Haskell
- Haxe
- Icon
- Unicon
- Icon Programming Library
- Ioke
- J
- Java
- Arbitrary precision
- JavaScript
- Joy
- Julia
- K
- Kdf9 Usercode
- Liberty BASIC
- Logo
- Logtalk
- LOLCODE
- Lua
- Lucid
- M4
- Maple
- Mathematica
- MATLAB
- Maxima
- MAXScript
- МК-61/52
- ML/I
- Mercury
- Modula-2
- Modula-3
- MUMPS
- NetRexx
- Nial
- Nimrod
- OCaml
- Oberon-2
- Octave
- OoRexx
- Order
- Oz
- PARI/GP
- Pascal
- Perl
- Perl 6
- PHP
- PicoLisp
- Pike
- PL/I
- PostScript
- Initlib
- PowerBASIC
- PowerShell
- Prolog
- Pure
- PureBasic
- Purity
- Python
- R
- Racket
- REBOL
- REXX
- Ruby
- Run BASIC
- Sather
- Scala
- Scheme
- Seed7
- SETL
- Slate
- Smalltalk
- SNOBOL4
- SNUSP
- Standard ML
- Tcl
- TSE SAL
- TI-89 BASIC
- UNIX Shell
- Ursala
- V
- VBScript
- XPL0
- Yorick
- LaTeX/Omit
- Make/Omit
- PlainTeX/Omit
- ZED
