A-M baby

Task/Ackermann-function/FALSE/ackermann-function.false

@@ -0,0 +1,12 @@
+[$$[%
+  \$$[%
+     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 }

Task/Ackermann-function/Factor/ackermann-function.factor

@@ -0,0 +1,9 @@
+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 ;

Task/Ackermann-function/Falcon/ackermann-function.falcon

@@ -0,0 +1,12 @@
+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

Task/Ackermann-function/Fantom/ackermann-function.fantom

@@ -0,0 +1,24 @@
+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)}")
+      }
+    }
+  }
+}

Task/Ackermann-function/GAP/ackermann-function.gap

@@ -0,0 +1,11 @@
+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;

Task/Ackermann-function/GML/ackermann-function.gml

@@ -0,0 +1,8 @@
+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))

Task/Ackermann-function/Genyris/ackermann-function.genyris

@@ -0,0 +1,9 @@
+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)

Task/Ackermann-function/Golfscript/ackermann-function.golf

@@ -0,0 +1,8 @@
+{
+  :_n; :_m;
+  _m 0= {_n 1+}
+        {_n 0= {_m 1- 1 ack}
+               {_m 1- _m _n 1- ack ack}
+               if}
+        if
+}:ack;

Task/Ackermann-function/Groovy/ackermann-function-1.groovy

@@ -0,0 +1,4 @@
+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))
+}

Task/Ackermann-function/Groovy/ackermann-function-2.groovy

@@ -0,0 +1,2 @@
+def ackMatrix = (0..3).collect { m -> (0..8).collect { n -> ack(m, n) } }
+ackMatrix.each { it.each { elt -> printf "%7d", elt }; println() }

Task/Ackermann-function/Haxe/ackermann-function.haxe

@@ -0,0 +1,20 @@
+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));
+    }
+}

Task/Ackermann-function/Icon/ackermann-function.icon

@@ -0,0 +1,25 @@
+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

Task/Ackermann-function/Ioke/ackermann-function.ioke

@@ -0,0 +1,6 @@
+ackermann = method(m,n,
+  cond(
+    m zero?, n succ,
+    n zero?, ackermann(m pred, 1),
+    ackermann(m pred, ackermann(m, n pred)))
+)

Task/Ackermann-function/J/ackermann-function-1.j

@@ -0,0 +1,4 @@
+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

Task/Ackermann-function/J/ackermann-function-2.j

@@ -0,0 +1,8 @@
+   0 ack 3
+4
+   1 ack 3
+5
+   2 ack 3
+9
+   3 ack 3
+61

Task/Ackermann-function/J/ackermann-function-3.j

@@ -0,0 +1 @@
+   Ack=. 3 -~ [ ({&(2 4$'>:  2x&+') ::(,&'&1'&'2x&*'@:(-&2))"0@:[ 128!:2 ]) 3 + ]

Task/Ackermann-function/J/ackermann-function-4.j

@@ -0,0 +1,15 @@
+   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

Task/Ackermann-function/J/ackermann-function-5.j

@@ -0,0 +1,27 @@
+   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 + ]

Task/Ackermann-function/Joy/ackermann-function-1.joy

@@ -0,0 +1,4 @@
+DEFINE ack == [ [ [pop null]  popd succ ]
+                [ [null]  pop pred 1 ack ]
+                [ [dup pred swap] dip pred ack ack ] ]
+              cond.

Task/Ackermann-function/Joy/ackermann-function-2.joy

@@ -0,0 +1,4 @@
+DEFINE ack == [ [ [pop null]  [popd succ] ]
+		[ [null]  [pop pred 1]  [] ]
+		[ [[dup pred swap] dip pred] [] [] ] ]
+              condnestrec.

Task/Ackermann-function/Julia/ackermann-function.julia

@@ -0,0 +1,12 @@
+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))

Task/Ackermann-function/K/ackermann-function.k

@@ -0,0 +1,2 @@
+ack:{:[0=x;y+1;0=y;_f[x-1;1];_f[x-1;_f[x;y-1]]]}
+ack[2;2]

Task/Ackermann-function/LOLCODE/ackermann-function.lol

@@ -0,0 +1,22 @@
+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

Task/Ackermann-function/Liberty-BASIC/ackermann-function.liberty

@@ -0,0 +1,14 @@
+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

Task/Ackermann-function/Logo/ackermann-function.logo

@@ -0,0 +1,5 @@
+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

Task/Ackermann-function/Logtalk/ackermann-function.logtalk

@@ -0,0 +1,12 @@
+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).

Task/Ackermann-function/Lucid/ackermann-function.lucid

@@ -0,0 +1,7 @@
+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

Task/Ackermann-function/M4/ackermann-function.m4

@@ -0,0 +1,2 @@
+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)

Task/Ackermann-function/MAXScript/ackermann-function.max

@@ -0,0 +1,15 @@
+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))
+    )
+)

Task/Ackermann-function/ML-I/ackermann-function-1.ml

@@ -0,0 +1,33 @@
+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)

Task/Ackermann-function/ML-I/ackermann-function-2.ml

@@ -0,0 +1,19 @@
+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

Task/Ackermann-function/MUMPS/ackermann-function.mumps

@@ -0,0 +1,9 @@
+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

Task/Ackermann-function/Maple/ackermann-function-1.maple

@@ -0,0 +1,10 @@
+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:

Task/Ackermann-function/Maple/ackermann-function-2.maple

@@ -0,0 +1 @@
+thisproc

Task/Ackermann-function/Maple/ackermann-function-3.maple

@@ -0,0 +1,16 @@
+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:

Task/Ackermann-function/Maple/ackermann-function-4.maple

@@ -0,0 +1,2 @@
+> map2( Ackermann, 1, [seq]( 1 .. 10 ) );
+               [3, 4, 5, 6, 7, 8, 9, 10, 11, 12]

Task/Ackermann-function/Maple/ackermann-function-5.maple

@@ -0,0 +1,2 @@
+> map2( Ackermann, 2, [seq]( 1 .. 10 ) );
+               [5, 7, 9, 11, 13, 15, 17, 19, 21, 23]

Task/Ackermann-function/Maple/ackermann-function-6.maple

@@ -0,0 +1,2 @@
+> length( Ackermann( 4, 2 ) );
+                      19729

Task/Ackermann-function/Mathematica/ackermann-function-1.mathematica

@@ -0,0 +1,11 @@
+$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]]

Task/Ackermann-function/Mathematica/ackermann-function-2.mathematica

@@ -0,0 +1 @@
+Flatten[#,1]&@Table[{"Ackermann2["<>ToString[i]<>","<>ToString[j]<>"] =",Ackermann2[i,j]},{i,3},{j,8}]//Grid

Task/Ackermann-function/Mathematica/ackermann-function-3.mathematica

@@ -0,0 +1,24 @@
+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

Task/Ackermann-function/Mathematica/ackermann-function-4.mathematica

@@ -0,0 +1,8 @@
+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]]

Task/Ackermann-function/Mathematica/ackermann-function-5.mathematica

@@ -0,0 +1,2 @@
+Ackermann3[4, 1]
+Ackermann3[4, 2]

Task/Ackermann-function/Mathematica/ackermann-function-6.mathematica

@@ -0,0 +1,2 @@
+65533
+2003529930406846464979072351560255750447825475569751419265016973710894059556311453089506130880........699146577530041384717124577965048175856395072895337539755822087777506072339445587895905719156733

Task/Ackermann-function/Maxima/ackermann-function.maxima

@@ -0,0 +1,15 @@
+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);

Task/Ackermann-function/Mercury/ackermann-function.mercury

@@ -0,0 +1,10 @@
+:- 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) ).

Task/Ackermann-function/Modula-2/ackermann-function.mod2

@@ -0,0 +1,33 @@
+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.

Task/Ackermann-function/Modula-3/ackermann-function.mod3

@@ -0,0 +1,24 @@
+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.