Ackermann function
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.
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
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>
bc
<lang bc>#! /usr/bin/bc -q 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</lang>
C
<lang c>#include <stdio.h>
- include <sys/types.h>
u_int ackermann(u_int m, u_int n) {
if ( m == 0 ) return n+1;
if ( n == 0 )
{
return ackermann(m-1, 1);
}
return ackermann(m-1, ackermann(m, n-1));
}
int main() {
int m, n;
for(n=0; n < 7; n++)
{
for(m=0; m < 4; m++)
{
printf("A(%d,%d) = %d\n", m, n, ackermann(m,n));
}
printf("\n");
}
}</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 cpp>#include <iostream> using namespace std; long ackermann(long,long);
int main() {
cout << ackermann(3,2) << endl;
}
long ackermann(long m, long n) {
if (m == 0)
return n+1;
if (n == 0)
return ackermann(m-1, 1);
return ackermann(m-1, ackermann(m, n-1));
}</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>
Clojure
<lang clojure>(defn ackermann [m n] (cond (zero? m) (+ n 1)
(zero? n) (ackermann (- m 1) 1)
(true? true) (ackermann (- m 1) (ackermann m (- n 1)))))</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>
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>
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
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>
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>// Ackermann function
- light
let rec ackermann (m : float, n : float) =
match m,n with
| 0., n -> n + 1.
| m, 0. -> ackermann(m - 1., 1.)
| m, n -> ackermann(m - 1., ackermann(m, n - 1.))
[<EntryPoint>] let main args =
if (Array.length args) <> 2 then
printfn "usage: ackermann m n"
let (b, m) = System.Double.TryParse(args.[0])
let (d, n) = System.Double.TryParse(args.[1])
printfn "%A" (ackermann (m, n))
0</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>
J
As posted at the J wiki <lang j> ack=: c1`c1`c2`c3 @. (#.@(,&*))
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))
}</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 ==
[ [ [0 =] [pop 1 +] ]
[ [swap 0 =] [popd 1 - 1 swap] [] ]
[ [dup rollup [1 -] dip] [swap 1 - ack] ] ]
condlinrec.</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>
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> No 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: <lang Mathematica>
65533 2003529930406846464979072351560255750447825475569751419265016973710894059556311453089506130880........699146577530041384717124577965048175856395072895337539755822087777506072339445587895905719156733
</lang> 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[3,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.
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
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>
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>
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>
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>
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>
Python
<lang python>def ack(M, N):
return (N + 1) if M == 0 else (
ack(M-1, 1) if N == 0 else ack(M-1, ack(M, N-1)))
</lang> Example of use: <lang python> >>> import sys >>> sys.setrecursionlimit(3000) >>> ack(0,0) 1 >>> ack(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>
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
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>
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>
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>
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.
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…
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>
- Programming Tasks
- Recursion
- Classic CS problems and programs
- ActionScript
- Ada
- ALGOL 68
- AutoHotkey
- AWK
- BASIC
- Bc
- C
- C++
- Common Lisp
- Clojure
- D
- E
- Erlang
- FALSE
- Forth
- Fortran
- F Sharp
- Groovy
- Haskell
- HaXe
- J
- Java
- Arbitrary precision
- JavaScript
- Joy
- Logo
- Lucid
- M4
- Mathematica
- MAXScript
- Modula-3
- Nial
- OCaml
- Octave
- Pascal
- Perl
- PHP
- Prolog
- Python
- R
- Ruby
- Scheme
- SETL
- Slate
- Smalltalk
- Standard ML
- SNUSP
- Tcl
- Ursala
- V
- Gnuplot/Omit
- LaTeX/Omit
- Make/Omit
- PlainTeX/Omit