langs a-z

Task/Ackermann-function/NetRexx/ackermann-function.netrexx

@@ -0,0 +1,24 @@
+/* NetRexx */
+options replace format comments java crossref symbols binary
+
+numeric digits 66
+
+parse arg j_ k_ .
+if j_ = '' | j_ = '.' | \j_.datatype('w') then j_ = 3
+if k_ = '' | k_ = '.' | \k_.datatype('w') then k_ = 5
+
+loop m_ = 0 to j_
+  say
+  loop n_ = 0 to k_
+    say 'ackermann('m_','n_') =' ackermann(m_, n_).right(5)
+    end n_
+  end m_
+return
+
+method ackermann(m, n) public static
+  select
+    when m = 0 then rval = n + 1
+    when n = 0 then rval = ackermann(m - 1, 1)
+    otherwise       rval = ackermann(m - 1, ackermann(m, n - 1))
+    end
+  return rval

Task/Ackermann-function/Nial/ackermann-function.nial

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

Task/Ackermann-function/Nimrod/ackermann-function.nimrod

@@ -0,0 +1,7 @@
+proc Ackermann(m, n: int64): int64 =
+  if m == 0:
+    result = n + 1
+  elif n == 0:
+    result = Ackermann(m - 1, 1)
+  else:
+    result = Ackermann(m - 1, Ackermann(m, n - 1))

Task/Ackermann-function/OCaml/ackermann-function-1.ocaml

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

Task/Ackermann-function/OCaml/ackermann-function-2.ocaml

@@ -0,0 +1,4 @@
+let rec a = function
+  | 0, n -> (n+1)
+  | m, 0 -> a(m-1, 1)
+  | m, n -> a(m-1, a(m, n-1))

Task/Ackermann-function/OCaml/ackermann-function-3.ocaml

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

Task/Ackermann-function/OCaml/ackermann-function-4.ocaml

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

Task/Ackermann-function/OCaml/ackermann-function-5.ocaml

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

Task/Ackermann-function/OCaml/ackermann-function-6.ocaml

@@ -0,0 +1,30 @@
+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 *) ) [] [] ;;

Task/Ackermann-function/OCaml/ackermann-function-7.ocaml

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

Task/Ackermann-function/Oberon-2/ackermann-function.oberon-2

@@ -0,0 +1,26 @@
+MODULE ackerman;
+
+IMPORT  Out;
+
+VAR     m, n    : INTEGER;
+
+PROCEDURE Ackerman (x, y   : INTEGER) : INTEGER;
+
+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
+      Out.Int (Ackerman (m, n), 10);
+      Out.Char (9X)
+    END;
+    Out.Ln
+  END;
+  Out.Ln
+END ackerman.

Task/Ackermann-function/Octave/ackermann-function.octave

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

Task/Ackermann-function/Order/ackermann-function.order

@@ -0,0 +1,9 @@
+#include <order/interpreter.h>
+
+#define ORDER_PP_DEF_8ack ORDER_PP_FN(    \
+8fn(8X, 8Y,                               \
+    8cond((8is_0(8X), 8inc(8Y))           \
+          (8is_0(8Y), 8ack(8dec(8X), 1))  \
+          (8else, 8ack(8dec(8X), 8ack(8X, 8dec(8Y)))))))
+
+ORDER_PP(8to_lit(8ack(3, 4)))      // 125

Task/Ackermann-function/Oz/ackermann-function.oz

@@ -0,0 +1,12 @@
+declare
+
+  fun {Ack M N}
+     if     M == 0 then N+1
+     elseif N == 0 then {Ack M-1 1}
+     else               {Ack M-1 {Ack M N-1}}
+     end
+  end
+
+in
+
+  {Show {Ack 3 7}}

Task/Ackermann-function/PARI-GP/ackermann-function.pari

@@ -0,0 +1,11 @@
+A(m,n)={
+  if(m,
+    if(n,
+      A(m-1, A(m,n-1))
+    ,
+      A(m-1,1)
+    )
+  ,
+    n+1
+  )
+};

Task/Ackermann-function/PL-I/ackermann-function.pli

@@ -0,0 +1,7 @@
+Ackerman: procedure (m, n) returns (fixed (30)) recursive;
+   declare (m, n) fixed (30);
+   if m = 0 then return (n+1);
+   else if m > 0 & n = 0 then return (Ackerman(m-1, 1));
+   else if m > 0 & n > 0 then return (Ackerman(m-1, Ackerman(m, n-1)));
+   return (0);
+end Ackerman;

Task/Ackermann-function/Pascal/ackermann-function.pascal

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

Task/Ackermann-function/Perl-6/ackermann-function-1.pl6

@@ -0,0 +1,7 @@
+sub A(Int $m, Int $n) {
+
+	$m == 0  ??    $n + 1                   !!
+	$n == 0  ??  A($m - 1, 1            )   !!
+	             A($m - 1, A($m, $n - 1));
+
+}

Task/Ackermann-function/Perl-6/ackermann-function-2.pl6

@@ -0,0 +1,3 @@
+multi sub A(0,      Int $n) { $n + 1                   }
+multi sub A(Int $m, 0     ) { A($m - 1, 1)             }
+multi sub A(Int $m, Int $n) { A($m - 1, A($m, $n - 1)) }

Task/Ackermann-function/Perl-6/ackermann-function-3.pl6

@@ -0,0 +1,9 @@
+proto A(Int \𝑚, Int \𝑛) { (state @)[𝑚][𝑛] //= {*} }
+
+multi A(0,      Int \𝑛) { 𝑛 + 1 }
+multi A(1,      Int \𝑛) { 𝑛 + 2 }
+multi A(2,      Int \𝑛) { 3 + 2 * 𝑛 }
+multi A(3,      Int \𝑛) { 5 + 8 * (2 ** 𝑛 - 1) }
+
+multi A(Int \𝑚, 0     ) { A(𝑚 - 1, 1) }
+multi A(Int \𝑚, Int \𝑛) { A(𝑚 - 1, A(𝑚, 𝑛 - 1)) }

Task/Ackermann-function/Perl-6/ackermann-function-4.pl6

@@ -0,0 +1,2 @@
+say A(4,1);
+say .chars, " digits starting with ", .substr(0,50), "..." given A(4,2);

Task/Ackermann-function/Pike/ackermann-function.pike

@@ -0,0 +1,13 @@
+int main(){
+   write(ackermann(3,4) + "\n");
+}
+
+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));
+   }
+}

Task/Ackermann-function/PostScript/ackermann-function-1.ps

@@ -0,0 +1,14 @@
+/ackermann{
+/n exch def
+/m exch def %PostScript takes arguments in the reverse order as specified in the function definition
+m 0 eq{
+n 1 add
+}if
+m 0 gt n 0 eq and
+{
+m 1 sub 1 ackermann
+}if
+m 0 gt n 0 gt and{
+m 1 sub m n 1 sub ackermann ackermann
+}if
+}def

Task/Ackermann-function/PostScript/ackermann-function-2.ps

@@ -0,0 +1,8 @@
+/A {
+[/.m /.n] let
+{
+    {.m 0 eq} {.n succ} is?
+    {.m 0 gt .n 0 eq and} {.m pred 1 A} is?
+    {.m 0 gt .n 0 gt and} {.m pred .m .n pred A A} is?
+} cond
+end}.

Task/Ackermann-function/PowerBASIC/ackermann-function.powerbasic

@@ -0,0 +1,18 @@
+FUNCTION PBMAIN () AS LONG
+    DIM m AS QUAD, n AS QUAD
+
+    m = ABS(VAL(INPUTBOX$("Enter a whole number.")))
+    n = ABS(VAL(INPUTBOX$("Enter another whole number.")))
+
+    MSGBOX STR$(Ackermann(m, n))
+END FUNCTION
+
+FUNCTION Ackermann (m AS QUAD, n AS QUAD) AS QUAD
+    IF 0 = m THEN
+        FUNCTION = n + 1
+    ELSEIF 0 = n THEN
+        FUNCTION = Ackermann(m - 1, 1)
+    ELSE    ' m > 0; n > 0
+        FUNCTION = Ackermann(m - 1, Ackermann(m, n - 1))
+    END IF
+END FUNCTION

Task/Ackermann-function/PowerShell/ackermann-function-1.psh

@@ -0,0 +1,11 @@
+function ackermann ([long] $m, [long] $n) {
+    if ($m -eq 0) {
+        return $n + 1
+    }
+
+    if ($n -eq 0) {
+        return (ackermann ($m - 1) 1)
+    }
+
+    return (ackermann ($m - 1) (ackermann $m ($n - 1)))
+}

Task/Ackermann-function/PowerShell/ackermann-function-2.psh

@@ -0,0 +1,6 @@
+foreach ($m in 0..3) {
+    foreach ($n in 0..6) {
+        Write-Host -NoNewline ("{0,5}" -f (ackermann $m $n))
+    }
+    Write-Host
+}

Task/Ackermann-function/Pure/ackermann-function.pure

@@ -0,0 +1,3 @@
+A 0 n = n+1;
+A m 0 = A (m-1) 1 if m > 0;
+A m n = A (m-1) (A m (n-1)) if m > 0 && n > 0;

Task/Ackermann-function/PureBasic/ackermann-function.purebasic

@@ -0,0 +1,11 @@
+Procedure.q Ackermann(m, n)
+  If m = 0
+    ProcedureReturn n + 1
+  ElseIf  n = 0
+    ProcedureReturn Ackermann(m - 1, 1)
+  Else
+    ProcedureReturn Ackermann(m - 1, Ackermann(m, n - 1))
+  EndIf
+EndProcedure
+
+Debug Ackermann(3,4)

Task/Ackermann-function/Purity/ackermann-function.purity

@@ -0,0 +1,2 @@
+data Iter = f => FoldNat <const $f One, $f>
+data Ackermann = FoldNat <const Succ, Iter>

Task/Ackermann-function/Run-BASIC/ackermann-function.run

@@ -0,0 +1,9 @@
+print ackermann(1, 2)
+
+function ackermann(m, n)
+   if (m < 0) or (n < 0)  then goto [exitFunction]
+   if (m = 0)             then ackermann = (n + 1)
+   if (m > 0) and (n = 0) then ackermann = ackermann((m - 1), 1)
+   if (m > 0) and (n > 0) then ackermann = ackermann((m - 1), ackermann(m, (n - 1)))
+[exitFunction]
+end function

Task/Ackermann-function/SETL/ackermann-function.setl

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

Task/Ackermann-function/SNOBOL4/ackermann-function.sno

@@ -0,0 +1,12 @@
+define('ack(m,n)') :(ack_end)
+ack     ack = eq(m,0) n + 1 :s(return)
+        ack = eq(n,0) ack(m - 1,1) :s(return)
+        ack = ack(m - 1,ack(m,n - 1)) :(return)
+ack_end
+
+*       # Test and display ack(0,0) .. ack(3,6)
+L1      str = str ack(m,n) ' '
+        n = lt(n,6) n + 1 :s(L1)
+        output = str; str = ''
+        n = 0; m = lt(m,3) m + 1 :s(L1)
+end

Task/Ackermann-function/Seed7/ackermann-function.seed7

@@ -0,0 +1,12 @@
+const func integer: ackermann (in integer: m, in integer: n) is func
+  result
+    var integer: result is 0;
+  begin
+    if m = 0 then
+      result := succ(n);
+    elsif n = 0 then
+      result := ackermann(pred(m), 1);
+    else
+      result := ackermann(pred(m), ackermann(m, pred(n)));
+    end if;
+  end func;

Task/Ackermann-function/Slate/ackermann-function.slate

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

Task/Ackermann-function/Standard-ML/ackermann-function.ml

@@ -0,0 +1,3 @@
+fun a (0, n) = n+1
+  | a (m, 0) = a (m-1, 1)
+  | a (m, n) = a (m-1, a (m, n-1))

Task/Ackermann-function/TI-89-BASIC/ackermann-function.ti-89

@@ -0,0 +1 @@
+Define A(m,n) = when(m=0, n+1, when(n=0, A(m-1,1), A(m-1, A(m, n-1))))

Task/Ackermann-function/TSE-SAL/ackermann-function.tse

@@ -0,0 +1,18 @@
+// library: math: get: ackermann: recursive <description></description> <version>1.0.0.0.5</version> <version control></version control> (filenamemacro=getmaare.s) [kn, ri, tu, 27-12-2011 14:46:59]
+INTEGER PROC FNMathGetAckermannRecursiveI( INTEGER mI, INTEGER nI )
+ IF ( mI == 0 )
+  RETURN( nI + 1 )
+ ENDIF
+ IF ( nI == 0 )
+  RETURN( FNMathGetAckermannRecursiveI( mI - 1, 1 ) )
+ ENDIF
+ RETURN( FNMathGetAckermannRecursiveI( mI - 1, FNMathGetAckermannRecursiveI( mI, nI - 1 ) ) )
+END
+
+PROC Main()
+STRING s1[255] = "2"
+STRING s2[255] = "3"
+IF ( NOT ( Ask( "math: get: ackermann: recursive: m = ", s1, _EDIT_HISTORY_ ) ) AND ( Length( s1 ) > 0 ) ) RETURN() ENDIF
+IF ( NOT ( Ask( "math: get: ackermann: recursive: n = ", s2, _EDIT_HISTORY_ ) ) AND ( Length( s2 ) > 0 ) ) RETURN() ENDIF
+ Message( FNMathGetAckermannRecursiveI( Val( s1 ), Val( s2 ) ) ) // gives e.g. 9
+END

Task/Ackermann-function/UNIX-Shell/ackermann-function-1.sh

@@ -0,0 +1,11 @@
+ack() {
+  local m=$1
+  local n=$2
+  if [ $m -eq 0 ]; then
+    echo -n $((n+1))
+  elif [ $n -eq 0 ]; then
+    ack $((m-1)) 1
+  else
+    ack $((m-1)) $(ack $m $((n-1)))
+  fi
+}

Task/Ackermann-function/UNIX-Shell/ackermann-function-2.sh

@@ -0,0 +1,7 @@
+for ((m=0;m<=3;m++)); do
+  for ((n=0;n<=6;n++)); do
+    ack $m $n
+    echo -n " "
+  done
+  echo
+done

Task/Ackermann-function/Ursala/ackermann-function-1.ursala

@@ -0,0 +1,8 @@
+#import std
+#import nat
+
+ackermann =
+
+~&al^?\successor@ar ~&ar?(
+   ^R/~&f ^/predecessor@al ^|R/~& ^|/~& predecessor,
+   ^|R/~& ~&\1+ predecessor@l)

Task/Ackermann-function/Ursala/ackermann-function-2.ursala

@@ -0,0 +1,3 @@
+#cast %nLL
+
+test = block7 ackermann*K0 iota~~/4 7

Task/Ackermann-function/V/ackermann-function-1.v

@@ -0,0 +1,5 @@
+[ack
+       [ [pop zero?] [popd succ]
+         [zero?]     [pop pred 1 ack]
+         [true]      [[dup pred swap] dip pred ack ack ]
+       ] when].

Task/Ackermann-function/V/ackermann-function-2.v

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

Task/Ackermann-function/VBScript/ackermann-function-1.vbscript

@@ -0,0 +1,20 @@
+option explicit
+'~ dim depth
+function ack(m, n)
+	'~ wscript.stdout.write depth & " "
+	if m = 0 then
+		'~ depth = depth + 1
+		ack = n + 1
+		'~ depth = depth - 1
+	elseif m > 0 and n = 0 then
+		'~ depth = depth + 1
+		ack = ack(m - 1, 1)
+		'~ depth = depth - 1
+	'~ elseif m > 0 and n > 0 then
+	else
+		'~ depth = depth + 1
+		ack = ack(m - 1, ack(m, n - 1))
+		'~ depth = depth - 1
+	end if
+	
+end function

Task/Ackermann-function/VBScript/ackermann-function-2.vbscript

@@ -0,0 +1,5 @@
+wscript.echo ack( 1, 10 )
+'~ depth = 0
+wscript.echo ack( 2, 1 )
+'~ depth = 0
+wscript.echo ack( 4, 4 )

Task/Ackermann-function/XPL0/ackermann-function.xpl0

@@ -0,0 +1,16 @@
+include c:\cxpl\codes;
+
+func Ackermann(M, N);
+int M, N;
+[if M=0 then return N+1;
+ if N=0 then return Ackermann(M-1, 1);
+return Ackermann(M-1, Ackermann(M, N-1));
+]; \Ackermann
+
+int M, N;
+[for M:= 0 to 3 do
+    [for N:= 0 to 7 do
+        [IntOut(0, Ackermann(M, N));  ChOut(0,9\tab\)];
+    CrLf(0);
+    ];
+]

Task/Ackermann-function/Yorick/ackermann-function-1.yorick

@@ -0,0 +1,8 @@
+func ack(m, n) {
+    if(m == 0)
+        return n + 1;
+    else if(n == 0)
+        return ack(m - 1, 1);
+    else
+        return ack(m - 1, ack(m, n - 1));
+}

Task/Ackermann-function/Yorick/ackermann-function-2.yorick

@@ -0,0 +1,5 @@
+for(m = 0; m <= 3; m++) {
+    for(n = 0; n <= 6; n++)
+        write, format="%d ", ack(m, n);
+    write, "";
+}

Task/Ackermann-function/ZED/ackermann-function.zed

@@ -0,0 +1,14 @@
+("ackermann") m n
+0 3
+(zero?) m
+(add1) n
+
+("ackermann") m n
+2 0
+(and) (positive?) m (zero?) n
+("ackermann") (sub1) m 1
+
+("ackermann") m n
+2 3
+(and) (positive?) m (positive?) n
+("ackermann") (sub1) m ("ackermann") m (sub1) n