Ackermann function: Difference between revisions

From Rosetta Code
Content added Content deleted
Line 378: Line 378:


let a = a (Hashtbl.create 42 (* arbitrary *) ) [] [] ;;</ocaml>
let a = a (Hashtbl.create 42 (* arbitrary *) ) [] [] ;;</ocaml>

{{hidden|Complete Program|

This one uses the arbitrary precision, the tail-recursion, and the optimisation explain on the Wikipedia page about <code>(m,n) = (3,_)</code>. It does not use a hash-table as the previous example because Hashtbl.find uses Pervasives.compare to compare the keys and it does not work with the type big_int. (It would be possible though, with a custom version of the module Hashtbl in which we add another version of the function find with which the user could provide his own compare function.)

<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)

let rec assoc_option v = function
[] -> None
| (a,b)::tl -> if eq2 a v then (Some b) else assoc_option v tl
let rec a bounds caller todo m n =
let may_tail r =
let k = (m,n) in
match todo with
| [] -> (r)
| (m,n)::todo ->
let res = List.rev_map (fun k -> (k, r)) (k::caller) in
let bounds = List.rev_append res bounds in
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 assoc_option (m, pred n) bounds 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 [] [] [] ;;

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);
;;</ocaml>

}}


=={{header|Perl}}==
=={{header|Perl}}==

Revision as of 11:51, 30 December 2008

Task
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: 

          n+1               if m=0
A(m, n) = A(m-1, 1)         if m>0 and n=0
          A(m-1, A(m,n-1))  if m>0 and n>0

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 funciton grows so quickly), but not required.

Ada

<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; </ada> 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

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

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

C

<c>#include <stdio.h>

  1. 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");
 }

}</c>

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++

<c>include <iostream> using namespace std; //not the best solultion, but im just learning and there wasn't a C++ example double ackerman(double,double);

int main() { 

       cout << ackerman(3,2) << endl;

}

double ackerman(double m, double n) { 

       if(m == 0)
        return n += 1;

       if(m > 0 && n == 0)
        return ackerman(m - 1, 1);

       if(m > 0 && n > 0)
        return ackerman(m - 1,ackerman(m, n -1));

}</c>

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)) }
}

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)).

It can be used with 

|escript ./ack.erl 3 4
=125

Forth

: ack ( j i -- a )
  ?dup if swap ?dup if 1- over recurse
                  else 1
                  then swap 1- recurse
     else 1+ then ;

Fortran

Works with: Fortran version 90 and later
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

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

J

As posted at the J wiki 

   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

Java

<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; }</java>

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 ==
        [ [ [0 =] [pop 1 +] ] 
           [ [swap 0 =] [popd 1 - 1 swap] [] ] 
           [ [dup rollup [1 -] dip] [swap 1 - ack] ] ] 
        condlinrec.

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

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))
    )
)

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]]]
]

OCaml

<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)))</ocaml>

or: <ocaml>let rec a = function 

 | 0, n -> (n+1)
 | m, 0 -> a(m-1, 1)
 | m, n -> a(m-1, a(m, n-1))</ocaml>

with memoization using an hash-table:

<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)

</ocaml>

taking advantage of the memoization we start calling small values of m and n in order to reduce the recursion call stack: <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)</ocaml>

Arbitrary precision

With arbitrary-precision integers (Big_int module):

<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)))</ocaml>

compile with: 

ocamlopt -o acker nums.cmxa acker.ml

Tail-Recursive

Here is a tail-recursive version:

<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 *) ) [] [] ;;</ocaml>


Perl

We memoize calls to A to make A(2, n) and A(3, n) feasible for larger values of n. <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));}}</perl>

Python

Works with: Python version 2.5

<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)))</python>

Example of use<python>>>> import sys >>> sys.setrecursionlimit(3000) >>> ack(0,0) 1 >>> ack(3,4) 125</python>

Ruby

Adapted from Ada's version. 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

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.

V

Translation of: Joy
[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].
Retrieved from "https://rosettacode.org/wiki/Ackermann_function?oldid=81718"