Ackermann function: Difference between revisions

From Rosetta Code
Content added Content deleted
(Modula-3)
Line 296: Line 296:


=={{header|Modula-3}}==
=={{header|Modula-3}}==
The type CARDINAL is defined in Modula-3 as [0..LAST(INTEGER)], in other words, all the positive integers.
The type CARDINAL is defined in Modula-3 as [0..LAST(INTEGER)], in other words, it can hold all positive integers.
<pre>
<pre>
MODULE Ack EXPORTS Main;
MODULE Ack EXPORTS Main;

Revision as of 04:24, 2 January 2009

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>

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

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

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("A(" & Int(m) & ", " & Int(n) & ") = " & Int(Ackermann(m, n)) & "\n");
    END;
  END;
END Ack.

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