Computing Ackermann's function in Basic

Originally concieved in 1928, but I'll use the 1935 Rózsa Péter version (table):

• A(0, n):= n + 1 for n ≥ 0
• A(m, 0):= A(m - 1, 1) for m > 0
• A(m, n):= A(m - 1, A(m, n - 1))  for m, n > 0

It's the classic mad benchmark. This function will either overflow the stack or the 32-bit computer word size - if the cpu doesn't burn out from prolonged strain.

Characteristics:

• Grows faster than an exponential or even multiple exponential function
• Turing computable, but not primitive recursive (requires indefinite iteration)
• The only arithmetic operations used are addition and subtraction of 1
• Its explosive properties come solely from the power of unlimited recursion
• Running time is at least proportional to the output, but mostly much larger

Main program body:

'Subject: Ackermann's function - deep recursion
'Author : Sjoerd.J.Schaper
'Date   : 05-20-2006
'Code   : FreeBasic and all QBasic's
DEFINT A-Z
DECLARE FUNCTION A (m, n)
CLEAR , , 28608 ' maximum stack space
CONST tsize = 32764 ' stack array
DIM SHARED s, d, c AS LONG

DO
  PRINT : INPUT " m, n "; m, n
  IF m < 0 OR n < 0 THEN EXIT DO
  c = 0: d = 1: s = 0: tim! = TIMER
  PRINT " A(m, n) ="; A(m, n); "  calls:"; c; "  depth:"; d
  PRINT " Timer:"; CSNG(TIMER - tim!); "s"
LOOP
END

Naive implementation with three recursive calls:

FUNCTION A (m, n)
c = c + 1
s = s + 1
IF s > d THEN d = s

   IF m = 0 THEN
      A = n + 1
   ELSEIF n = 0 THEN
      A = A(m - 1, 1)
   ELSE
      A = A(m - 1, A(m, n - 1))
   END IF

s = s - 1
END FUNCTION

A(3, 7) = 1021 calls: 693964 depth: 1023
Timer: 2.25s (QBasic 1.0, cpu 700 MHz)

Tip: compile w/FreeBasic using -t 4096 to get a 4 MB stack, and you can even compute A(4, 1) = 65533; this will easily take a quarter of an hour though.

Optimized using tail recursion:

FUNCTION A (m, n)
c = c + 1
s = s + 1
IF s > d THEN d = s

   WHILE m > 0
      c = c + 1
      IF n = 0 THEN
         n = 1
      ELSE
         t = m
         n = A(t, n - 1)
      END IF
      m = m - 1
   WEND

s = s - 1
A = n + 1
END FUNCTION

A(3, 7) = 1021 calls: 693964 depth: 1020
Timer: 1.70s (QBasic 1.0)

Iterative using a do-loop, stacking both m & n:

FUNCTION A (m, n)
DIM s(tsize + 1)

   s(0) = m
   s(1) = n: t = 1
   DO
      c = c + 1
      IF s(t - 1) = 0 THEN '  m = 0
         t = t - 1
         s(t) = s(t + 1) + 1
      ELSEIF s(t) = 0 THEN '  n = 0
         s(t) = 1
         s(t - 1) = s(t - 1) - 1
      ELSE
         s(t + 1) = s(t) - 1
         s(t) = s(t - 1)
         s(t - 1) = s(t - 1) - 1
         t = t + 1
      END IF
      IF t > d THEN
         d = t
         IF d > tsize THEN
            PRINT "failure": END
         END IF
      END IF
    LOOP UNTIL t = 0

A = s(0)
END FUNCTION

A(3, 7) = 1021 calls: 693964 depth: 1020
Timer: 2.42s (QBasic 1.0)

Iterative using a do-loop, stacking m only:

FUNCTION A (m, n)
DIM s(tsize + 1)

   t = 1: s(t) = m
   DO
      c = c + 1
      m = s(t): t = t - 1
      IF m = 0 THEN
         n = n + 1
      ELSEIF n = 0 THEN
         t = t + 1: s(t) = m - 1
         n = 1
      ELSE
         t = t + 1: s(t) = m - 1
         t = t + 1: s(t) = m
         n = n - 1
      END IF
      IF t > d THEN
         d = t
         IF d > tsize THEN
            PRINT "failure": END
         END IF
      END IF
   LOOP UNTIL t = 0

A = n
END FUNCTION

A(3, 7) = 1021 calls: 693964 depth: 1020
Timer: 2.14s (QBasic 1.0)

Cheat - direct computation for m < 4:

FUNCTION A& (m, n)
c = c + 1
s = s + 1
IF s > d THEN d = s

   SELECT CASE m
   CASE 0
      A = n + 1
   CASE 1
      A = n + 2
   CASE 2
      A = 2 * n + 3
   CASE 3
      A = 2 ^ (n + 3) - 3
   CASE ELSE
      IF n = 0 THEN
         A = A(m - 1, 1)
      ELSE
         A = A(m - 1, A(m, n - 1))
      END IF
   END SELECT

s = s - 1
END FUNCTION

A(4, 1) = 65533 calls: 4 depth: 3
Timer: 0s (QBasic 1.0)
Note that the function must be declared LONG here.

Using my large integer library, we can now evaluate A(4, 2):

'Subject: Ackermann's function
'Author : Sjoerd.J.Schaper
'Update : 01-06-2009
'Code   : FreeBasic 0.20b
#INCLUDE "largeint.bi"
DECLARE SUB Ack (byVal m AS INTEGER, byVal n AS INTEGER)
CONST a = 0, m = 1, n = 2, tsize = 8 ' stack size 3 * 2
LargeInit(tsize, "ackerman")
DIM SHARED AS INTEGER c, d, s
DIM AS INTEGER x, y
DIM tim AS SINGLE

DO
   INPUT " m, n "; x, y
   IF x < 0 OR y < 0 THEN EXIT DO
   c = 0: d = 3: s = d: tim = TIMER
   Letf(m, x): Letf(n, y): Ack(m, n)
   Printn(a, " A(" + STR$(x) + ", " + STR$(y) + ") = ", "", 0)
   Prints("  calls " + STR$(c) + "  depth " + STR$(d \ 2), 1)
   Prints(" Timer: " + STR$(CSNG(TIMER - tim)) + " s", 2)
LOOP
Term()
END

SUB Ack (byVal mu AS INTEGER, byVal nu AS INTEGER)
DIM mv AS INTEGER, nv AS INTEGER
c = c + 1

   Letf(a, 4)
   IF Cmp(mu, a) < 0 THEN '           m < 4
      SELECT CASE Getw(mu, 0)
      CASE 0
         Swp(a, nu): Inc(a, 1)
      CASE 1
         Swp(a, nu): Inc(a, 2)
      CASE 2
         Swp(a, nu)
         Lsft(a, 1): Inc(a, 3)
      CASE ELSE '3
         Letf(a, 2): Inc(nu, 3): Letf(mu, 0)
         Modpwr(a, nu, mu): Inc(a, -3)
      END SELECT

   ELSE '                             enter recursion...
      mv = s: nv = s + 1
      s = s + 2 '                     two-row stackframe
      IF s > d THEN
         d = s
         IF nv > tsize THEN
            Prints " out of stack space", 1: END
         END IF
      END IF

      Dup(mu, mv)
      IF Isf(nu, 0) THEN
         Inc(mv, -1): Letf(nv, 1)
         Ack(mv, nv)
      ELSE
         Dup(nu, nv): Inc(nv, -1)
         Ack(mv, nv)
         Inc(mv, -1): Swp(a, nv)
         Ack(mv, nv)
      END IF

      s = s - 2
   END IF
END SUB

A(4, 2) = 200352...156733 (19729 digits) calls: 6 depth: 4
Timer: 1.83s (FreeBasic 0.20b)

Note that this works only if module and largeint library are compiled with FreeBasic, as the old DOS Basic's do not allow this big memory usage.

Back