tasks a-s

Task/Nth-root/0DESCRIPTION

@@ -0,0 +1 @@
+Implement the algorithm to compute the principal [[wp:Nth root|''n''th root]] <math>\sqrt[n]A</math> of a positive real number ''A'', as explained at the [[wp:Nth root algorithm|Wikipedia page]].

Task/Nth-root/1META.yaml

@@ -0,0 +1,2 @@
+---
+note: Classic CS problems and programs

Task/Nth-root/ALGOL-68/nth-root.alg

@@ -0,0 +1,25 @@
+REAL default p = 0.001;
+
+PROC nth root = (INT n, LONG REAL a, p)LONG REAL:
+(
+  [2]LONG REAL x := (a, a/n);
+
+  WHILE ABS(x[2] - x[1]) > p DO
+    x := (x[2], ((n-1)*x[2] + a/x[2]**(n-1))/n )
+  OD;
+  x[2]
+);
+
+PRIO ROOT = 8;
+OP ROOT = (INT n, LONG REAL a)LONG REAL: nth root(n, a, default p);
+OP ROOT = (INT n, INT a)LONG REAL: nth root(n, a, default p);
+
+main:
+(
+  printf(($2(" "gl)$,
+         nth root(10, LONG 7131.5 ** 10, default p),
+         nth root(5, 34, default p)));
+  printf(($2(" "gl)$,
+         10 ROOT ( LONG 7131.5 ** 10 ),
+         5 ROOT 34))
+)

Task/Nth-root/AWK/nth-root.awk

@@ -0,0 +1,22 @@
+#!/usr/bin/awk -f
+BEGIN {
+        # test
+	print nthroot(8,3)
+	print nthroot(16,2)
+	print nthroot(16,4)
+	print nthroot(125,3)
+	print nthroot(3,3)
+	print nthroot(3,2)
+}
+
+function nthroot(y,n) {
+        eps = 1e-15;   # relative accuracy
+        x   = 1;
+	do {
+		d  = ( y / ( x^(n-1) ) - x ) / n ;
+		x += d;
+		e = eps*x;   # absolute accuracy	
+	} while ( d < -e  || d > e )
+
+	return x
+}

Task/Nth-root/Ada/nth-root.ada

@@ -0,0 +1,27 @@
+with Ada.Text_IO;  use Ada.Text_IO;
+
+procedure Test_Nth_Root is
+   generic
+      type Real is digits <>;
+   function Nth_Root (Value : Real; N : Positive) return Real;
+
+   function Nth_Root (Value : Real; N : Positive) return Real is
+      type Index is mod 2;
+      X : array (Index) of Real := (Value, Value);
+      K : Index := 0;
+   begin
+      loop
+         X (K + 1) := ( (Real (N) - 1.0) * X (K) + Value / X (K) ** (N-1) ) / Real (N);
+         exit when X (K + 1) >= X (K);
+         K := K + 1;
+      end loop;
+      return X (K + 1);
+   end Nth_Root;
+
+   function Long_Nth_Root is new Nth_Root (Long_Float);
+begin
+   Put_Line ("1024.0 10th  =" & Long_Float'Image (Long_Nth_Root (1024.0, 10)));
+   Put_Line ("  27.0 3rd   =" & Long_Float'Image (Long_Nth_Root (27.0, 3)));
+   Put_Line ("   2.0 2nd   =" & Long_Float'Image (Long_Nth_Root (2.0, 2)));
+   Put_Line ("5642.0 125th =" & Long_Float'Image (Long_Nth_Root (5642.0, 125)));
+end Test_Nth_Root;

Task/Nth-root/AutoHotkey/nth-root.ahk

@@ -0,0 +1,19 @@
+p := 0.000001
+
+MsgBox, % nthRoot( 10, 7131.5**10, p) "`n"
+        . nthRoot(  5, 34.0      , p) "`n"
+        . nthRoot(  2, 2         , p) "`n"
+        . nthRoot(0.5, 7         , p) "`n"
+
+
+;---------------------------------------------------------------------------
+nthRoot(n, A, p) { ; http://en.wikipedia.org/wiki/Nth_root_algorithm
+;---------------------------------------------------------------------------
+    x1 := A
+    x2 := A / n
+    While Abs(x1 - x2) > p {
+        x1 := x2
+        x2 := ((n-1)*x2+A/x2**(n-1))/n
+    }
+    Return, x2
+}

Task/Nth-root/AutoIt/nth-root.autoit

@@ -0,0 +1,26 @@
+;AutoIt Version: 3.2.10.0
+$A=4913
+$n=3
+$x=20
+ConsoleWrite ($n& " root of "& $A & " is " &nth_root_it($A,$n,$x))
+ConsoleWrite ($n& " root of "& $A & " is " &nth_root_rec($A,$n,$x))
+
+;Iterative
+Func nth_root_it($A,$n,$x)
+   $x0="0"
+   While StringCompare(string($x0),string($x))
+      ConsoleWrite ($x&@CRLF)
+      $x0=$x
+      $x=((($n-1)*$x)+($A/$x^($n-1)))/$n
+   WEnd
+   Return $x
+EndFunc
+
+;Recursive
+Func nth_root_rec($A,$n,$x)
+   ConsoleWrite ($x&@CRLF)
+   If $x==((($n-1)*$x)+($A/$x^($n-1)))/$n Then
+      Return $x
+   EndIf
+   Return nth_root_rec($A,$n,((($n-1)*$x)+($A/$x^($n-1)))/$n)
+EndFunc

Task/Nth-root/BASIC/nth-root-1.basic

@@ -0,0 +1,11 @@
+FUNCTION RootX (tBase AS DOUBLE, tExp AS DOUBLE, diffLimit AS DOUBLE) AS DOUBLE
+    DIM tmp1 AS DOUBLE, tmp2 AS DOUBLE
+    ' Initial guess:
+    tmp1 = tBase / tExp
+    DO
+        tmp2 = tmp1
+        ' 1# tells compiler that "1" is a double, not an integer
+        tmp1 = (((tExp - 1#) * tmp2) + (tBase / (tmp2 ^ (tExp - 1#)))) / tExp
+    LOOP WHILE (ABS(tmp1 - tmp2) > diffLimit)
+    RootX = tmp1
+END FUNCTION

Task/Nth-root/BASIC/nth-root-2.basic

@@ -0,0 +1 @@
+FUNCTION RootX# (tBase AS DOUBLE, tExp AS DOUBLE, diffLimit AS DOUBLE)

Task/Nth-root/BASIC/nth-root-3.basic

@@ -0,0 +1 @@
+PRINT "The "; e; "th root of "; b; " is "; RootX(b, e, .000001)

Task/Nth-root/BBC-BASIC/nth-root.bbc

@@ -0,0 +1,13 @@
+      *FLOAT 64
+      @% = &D0D
+      PRINT "Cube root of 5 is "; FNroot(3, 5, 0)
+      PRINT "125th root of 5643 is "; FNroot(125, 5643, 0)
+      END
+
+      DEF FNroot(n%, a, d)
+      LOCAL x0, x1 : x0 = a / n% : REM Initial guess
+      REPEAT
+        x1 = ((n% - 1)*x0 + a/x0^(n%-1)) / n%
+        SWAP x0, x1
+      UNTIL ABS (x0 - x1) <= d
+      = x0

Task/Nth-root/C++/nth-root-1.cpp

@@ -0,0 +1,12 @@
+double NthRoot(double m_nValue, double index, double guess, double pc)
+   {
+       double result = guess;
+       double result_next;
+       do
+       {
+           result_next = (1.0/index)*((index-1.0)*result+(m_nValue)/(pow(result,(index-1.0))));
+           result = result_next;
+           pc--;
+       }while(pc>1);
+       return result;
+   };

Task/Nth-root/C++/nth-root-2.cpp

@@ -0,0 +1,4 @@
+double NthRoot(double value, double degree)
+{
+    return pow(value, (double)(1 / degree));
+};

Task/Nth-root/C/nth-root.c

@@ -0,0 +1,31 @@
+#include <stdio.h>
+#include <float.h>
+
+inline double abs_(double x) { return x >= 0 ? x : -x; }
+double pow_(double x, int e)
+{
+	double ret = 1;
+	for (ret = 1; e; x *= x, e >>= 1)
+		if ((e & 1)) ret *= x;
+	return ret;
+}
+
+double root(double a, int n)
+{
+	double d, x = 1;
+	if (!a) return 0;
+	if (n < 1 || (a < 0 && !(n&1))) return 0./0.; /* NaN */
+
+	do {	d = (a / pow_(x, n - 1) - x) / n;
+		x+= d;
+	} while (abs_(d) >= abs_(x) * (DBL_EPSILON * 10));
+
+	return x;
+}
+
+int main()
+{
+	double x = pow_(-3.14159, 15);
+	printf("root(%g, 15) = %g\n", x, root(x, 15));
+	return 0;
+}

Task/Nth-root/CoffeeScript/nth-root-1.coffeescript

@@ -0,0 +1,26 @@
+nth_root = (A, n, precision=0.0000000000001) ->
+  x = 1
+  while true
+    x_new = (1 / n) * ((n - 1) * x + A / Math.pow(x, n - 1))
+    return x_new if Math.abs(x_new - x) < precision
+    x = x_new
+
+# tests
+do ->
+  tests = [
+    [8, 3]
+    [16, 4]
+    [32, 5]
+    [343, 3]
+    [1024, 10]
+    [1000000000, 3]
+    [1000000000, 9]
+    [100, 2]
+    [100, 3]
+    [100, 5]
+    [100, 10]
+  ]
+  for test in tests
+    [x, n] = test
+    root = nth_root x, n
+    console.log "#{x} root #{n} = #{root} (root^#{n} = #{Math.pow root, n})"

Task/Nth-root/CoffeeScript/nth-root-2.coffeescript

@@ -0,0 +1,12 @@
+> coffee nth_root.coffee
+8 root 3 = 2 (root^3 = 8)
+16 root 4 = 2 (root^4 = 16)
+32 root 5 = 2 (root^5 = 32)
+343 root 3 = 7 (root^3 = 343)
+1024 root 10 = 2 (root^10 = 1024)
+1000000000 root 3 = 1000 (root^3 = 1000000000)
+1000000000 root 9 = 10 (root^9 = 1000000000)
+100 root 2 = 10 (root^2 = 100)
+100 root 3 = 4.641588833612778 (root^3 = 99.99999999999997)
+100 root 5 = 2.5118864315095806 (root^5 = 100.0000000000001)
+100 root 10 = 1.5848931924611134 (root^10 = 99.99999999999993)

Task/Nth-root/Common-Lisp/nth-root-1.lisp

@@ -0,0 +1,9 @@
+(defun nth-root (n a &optional (epsilon .0001) (guess (1- n)))
+  (assert (and (> n 1) (> a 0)))
+  (flet ((next (x)
+           (/ (+ (* (1- n) x)
+                 (/ a (expt x (1- n))))
+              n)))
+    (do* ((xi guess xi+1)
+          (xi+1 (next xi) (next xi)))
+         ((< (abs (- xi+1 xi)) epsilon) xi+1))))

Task/Nth-root/Common-Lisp/nth-root-2.lisp

@@ -0,0 +1,4 @@
+(let* ((r (nth-root 3 10))
+       (rf (coerce r 'float)))
+  (print (* r r r ))
+  (print (* rf rf rf)))

Task/Nth-root/D/nth-root.d

@@ -0,0 +1,13 @@
+import std.stdio, std.math;
+
+real nthroot(in int n, in real A, in real p=0.001) pure nothrow {
+    real[2] x = [A, A / n];
+    while (abs(x[1] - x[0]) > p)
+        x = [x[1], ((n - 1) * x[1] + A / (x[1] ^^ (n-1))) / n];
+    return x[1];
+}
+
+void main() {
+    writeln(nthroot(10, 7131.5 ^^ 10));
+    writeln(nthroot(6, 64));
+}

Task/Nth-root/Delphi/nth-root.delphi

@@ -0,0 +1,15 @@
+USES
+   Math;
+
+function NthRoot(A, Precision: Double; n: Integer): Double;
+var
+   x_p, X: Double;
+begin
+   x_p := Sqrt(A);
+   while Abs(A - Power(x_p, n)) > Precision do
+   begin
+      x := (1/n) * (((n-1) * x_p) + (A/(Power(x_p, n - 1))));
+      x_p := x;
+   end;
+   Result := x_p;
+end;

Task/Nth-root/E/nth-root.e

@@ -0,0 +1,12 @@
+def nthroot(n, x) {
+  require(n > 1 && x > 0)
+  def np := n - 1
+  def iter(g) { return (np*g + x/g**np) / n }
+  var g1 := x
+  var g2 := iter(g1)
+  while (!(g1 <=> g2)) {
+    g1 := iter(g1)
+    g2 := iter(iter(g2))
+  }
+  return g1
+}

Task/Nth-root/Erlang/nth-root-1.erl

@@ -0,0 +1,6 @@
+fixed_point(F, Guess, Tolerance) ->
+    fixed_point(F, Guess, Tolerance, F(Guess)).
+fixed_point(_, Guess, Tolerance, Next) when abs(Guess - Next) < Tolerance ->
+    Next;
+fixed_point(F, _, Tolerance, Next) ->
+    fixed_point(F, Next, Tolerance, F(Next)).

Task/Nth-root/Erlang/nth-root-2.erl

@@ -0,0 +1,4 @@
+nth_root(N, X) -> nth_root(N, X, 1.0e-5).
+nth_root(N, X, Precision) ->
+    F = fun(Prev) -> ((N - 1) * Prev + X / math:pow(Prev, (N-1))) / N end,
+    fixed_point(F, X, Precision).

Task/Nth-root/Forth/nth-root.fth

@@ -0,0 +1,11 @@
+: th-root { F: a F: n -- a^1/n }
+  a
+  begin
+    a fover n 1e f- f** f/
+      fover n 1e f- f*
+    f+ n f/
+    fswap fover 1e-5 f~
+  until ;
+
+34e 5e th-root f.   \ 2.02439745849989
+34e 5e 1/f f** f.   \ 2.02439745849989

Task/Nth-root/Fortran/nth-root.f

@@ -0,0 +1,42 @@
+program NthRootTest
+  implicit none
+
+  print *, nthroot(10, 7131.5**10)
+  print *, nthroot(5, 34.0)
+
+contains
+
+  function nthroot(n, A, p)
+    real :: nthroot
+    integer, intent(in)        :: n
+    real, intent(in)           :: A
+    real, intent(in), optional :: p
+
+    real :: rp, x(2)
+
+    if ( A < 0 ) then
+       stop "A < 0"       ! we handle only real positive numbers
+    elseif ( A == 0 ) then
+       nthroot = 0
+       return
+    end if
+
+    if ( present(p) ) then
+       rp = p
+    else
+       rp = 0.001
+    end if
+
+    x(1) = A
+    x(2) = A/n   ! starting "guessed" value...
+
+    do while ( abs(x(2) - x(1)) > rp )
+       x(1) = x(2)
+       x(2) = ((n-1.0)*x(2) + A/(x(2) ** (n-1.0)))/real(n)
+    end do
+
+    nthroot = x(2)
+
+  end function nthroot
+
+end program NthRootTest

Task/Nth-root/Go/nth-root.go

@@ -0,0 +1,19 @@
+func root(a float64, n int) float64 {
+    n1 := n - 1
+    n1f, rn := float64(n1), 1/float64(n)
+    x, x0 := 1., 0.
+    for {
+        potx, t2 := 1/x, a
+        for b := n1; b > 0; b >>= 1 {
+            if b&1 == 1 {
+                t2 *= potx
+            }
+            potx *= potx
+        }
+        x0, x = x, rn*(n1f*x+t2)
+        if math.Abs(x-x0)*1e15 < x {
+            break
+        }
+    }
+    return x
+}

Task/Nth-root/Groovy/nth-root-1.groovy

@@ -0,0 +1,13 @@
+import static Constants.tolerance
+import static java.math.RoundingMode.HALF_UP
+
+def root(double base, double n) {
+    double xOld = 1
+    double xNew = 0
+    while (true) {
+        xNew = ((n - 1) * xOld + base/(xOld)**(n - 1))/n
+    if ((xNew - xOld).abs() < tolerance) { break }
+        xOld = xNew
+    }
+    (xNew as BigDecimal).setScale(7, HALF_UP)
+}

Task/Nth-root/Groovy/nth-root-2.groovy

@@ -0,0 +1,21 @@
+class Constants {
+    static final tolerance = 0.00001
+}
+
+print '''
+   Base   Power  Calc'd Root  Actual Root
+-------  ------  -----------  -----------
+'''
+def testCases = [
+    [b:32.0, n:5.0, r:2.0],
+    [b:81.0, n:4.0, r:3.0],
+    [b:Math.PI**2, n:4.0, r:Math.PI**(0.5)],
+    [b:7.0, n:0.5, r:49.0],
+]
+
+testCases.each {
+    def r = root(it.b, it.n)
+    printf('%7.4f  %6.4f  %11.4f  %11.4f\n',
+        it.b, it.n, r, it.r)
+    assert (r - it.r).abs() <= tolerance
+}

Task/Nth-root/Haskell/nth-root.hs

@@ -0,0 +1 @@
+n `nthRoot` x = fst $ until (uncurry(==)) (\(_,x0) -> (x0,((n-1)*x0+x/x0**(n-1))/n)) (x,x/n)

Task/Nth-root/HicEst/nth-root.hicest

@@ -0,0 +1,19 @@
+WRITE(Messagebox) NthRoot(5, 34)
+WRITE(Messagebox) NthRoot(10, 7131.5^10)
+
+FUNCTION NthRoot(n, A)
+   REAL :: prec = 0.001
+
+   IF( (n > 0) * (A > 0) ) THEN
+       NthRoot = A / n
+       DO i = 1, 1/prec
+         x = ((n-1)*NthRoot + A/(NthRoot^(n-1))) / n
+         IF( ABS(x - NthRoot) <= prec ) THEN
+             RETURN
+         ENDIF
+         NthRoot = x
+       ENDDO
+   ENDIF
+
+   WRITE(Messagebox, Name) 'Cannot solve problem for:', prec, n, A
+END

Task/Nth-root/Icon/nth-root.icon

@@ -0,0 +1,23 @@
+procedure main()
+   showroot(125,3)
+   showroot(27,3)
+   showroot(1024,10)
+   showroot(39.0625,4)
+   showroot(7131.5^10,10)
+end
+
+procedure showroot(a,n)
+   printf("%i-th root of %i = %i\n",n,a,root(a,n))
+end
+
+procedure root(a,n,p) #: finds the n-th root of the number a to precision p
+   if n < 0 | type(n) !== "integer" then runerr(101,n)
+   if a < 0 then runerr(205,a)
+   /p := 1e-14                  # precision
+   xn := a / real(n)            # initial guess
+   while abs(a - xn^n) > p do
+      xn := ((n - 1) * (xi := xn) + a / (xi ^ (n-1))) / real(n)
+   return xn
+end
+
+link printf

Task/Nth-root/J/nth-root.j

@@ -0,0 +1,5 @@
+   '`N X NP' =.  (0 { [)`(1 { [)`(2 { [)
+   iter      =.  N %~ (NP * ]) + X % ] ^ NP
+   nth_root  =:  (, , _1+[) iter^:_ f. ]
+   10 nth_root 7131.5^10
+7131.5

Task/Nth-root/Java/nth-root-1.java

@@ -0,0 +1,18 @@
+public static double nthroot(int n, double A) {
+	return nthroot(n, A, .001);
+}
+public static double nthroot(int n, double A, double p) {
+	if(A < 0) {
+		System.err.println("A < 0");// we handle only real positive numbers
+		return -1;
+	} else if(A == 0) {
+		return 0;
+	}
+	double x_prev = A;
+	double x = A / n;  // starting "guessed" value...
+	while(Math.abs(x - x_prev) > p) {
+		x_prev = x;
+		x = ((n - 1.0) * x + A / Math.pow(x, n - 1.0)) / n;
+	}
+	return x;
+}

Task/Nth-root/Java/nth-root-2.java

@@ -0,0 +1,15 @@
+public static double nthroot(int n, double x) {
+  assert (n > 1 && x > 0);
+  int np = n - 1;
+  double g1 = x;
+  double g2 = iter(g1, np, n, x);
+  while (g1 != g2) {
+    g1 = iter(g1, np, n, x);
+    g2 = iter(iter(g2, np, n, x), np, n, x);
+  }
+  return g1;
+}
+
+private static double iter(double g, int np, int n, double x) {
+  return (np * g + x / Math.pow(g, np)) / n;
+}

Task/Nth-root/JavaScript/nth-root.js

@@ -0,0 +1,11 @@
+function nthRoot(num, nArg, precArg) {
+  var n = nArg || 2;
+  var prec = precArg || 12;
+
+  var x = 1; // Initial guess.
+  for (var i=0; i<prec; i++) {
+    x = 1/n * ((n-1)*x + (num / Math.pow(x, n-1)));
+  }
+
+  return x;
+}

Task/Nth-root/Liberty-BASIC/nth-root.liberty

@@ -0,0 +1,21 @@
+print "First estimate is: ",        using( "#.###############",  NthRoot( 125, 5642, 0.001  ));
+print "    ... and better is: ",    using( "#.###############",  NthRoot( 125, 5642, 0.00001))
+print "125'th root of 5642 by LB's exponentiation operator is "; using( "#.###############", 5642^(1 /125))
+
+print "27^(1 / 3)",                 using( "#.###############",  NthRoot(   3,   27, 0.00001))
+print "2^(1 / 2)",                  using( "#.###############",  NthRoot(   2,    2, 0.00001))
+print "1024^(1 /10)",               using( "#.###############",  NthRoot(  10, 1024, 0.00001))
+
+wait
+
+function NthRoot( n, A, p)
+  x( 0) =A
+  x( 1) =A /n
+  while abs( x( 1) -x( 0)) >p
+    x( 0) =x( 1)
+    x( 1) =( ( n -1.0) *x( 1) +A /x( 1)^( n -1.0)) /n
+  wend
+  NthRoot =x( 1)
+end function
+
+end

Task/Nth-root/Logo/nth-root.logo

@@ -0,0 +1,11 @@
+to about :a :b
+  output and [:a - :b < 1e-5] [:a - :b > -1e-5]
+end
+
+to root :n :a [:guess :a]
+  localmake "next ((:n-1) * :guess + :a / power :guess (:n-1)) / n
+  if about :guess :next [output :next]
+  output (root :n :a :next)
+end
+
+show root 5 34   ; 2.02439745849989

Task/Nth-root/Lua/nth-root.lua

@@ -0,0 +1,3 @@
+function nth_root(num,root)
+  return num^(1/root)
+end

Task/Nth-root/MATLAB/nth-root-1.m

@@ -0,0 +1,13 @@
+function answer = nthRoot(number,root)
+
+    format long
+
+    answer = number / root;
+    guess = number;
+
+    while not(guess == answer)
+       guess = answer;
+       answer = (1/root)*( ((root - 1)*guess) + ( number/(guess^(root - 1)) ) );
+    end
+
+end

Task/Nth-root/MATLAB/nth-root-2.m

@@ -0,0 +1,5 @@
+>> nthRoot(2,2)
+
+ans =
+
+   1.414213562373095

Task/Nth-root/Mathematica/nth-root.math

@@ -0,0 +1 @@
+Root[A,n]

Task/Nth-root/Maxima/nth-root.maxima

@@ -0,0 +1,13 @@
+nth_root(a, n) := block(
+   [x, y, d, p: fpprec],
+   fpprec: p + 10,
+   x: bfloat(a),
+   eps: 10.0b0^-p,
+   y: do (
+      d: bfloat((a / x^(n - 1) - x) / n),
+      if abs(d) < eps * x then return(x),
+      x: x + d
+   ),
+   fpprec: p,
+   bfloat(y)
+)$

Task/Nth-root/Metafont/nth-root.metafont

@@ -0,0 +1,17 @@
+vardef mnthroot(expr n, A) =
+  x0 := A / n;
+  m := n - 1;
+  forever:
+    x1 := (m*x0 + A/(x0 ** m)) / n;
+    exitif abs(x1 - x0) < abs(x0 * 0.0001);
+    x0 := x1;
+  endfor;
+  x1
+enddef;
+
+primarydef n nthroot A = mnthroot(n, A) enddef;
+
+show 5 nthroot 34;  % 2.0244
+show 0.5 nthroot 7; % 49.00528
+
+bye

Task/Nth-root/NetRexx/nth-root.netrexx

@@ -0,0 +1,78 @@
+/*NetRexx program to calculate the  Nth root of  X,  with  DIGS  accuracy. */
+class nth_root
+
+  method main(args=String[]) static
+    if args.length < 2 then
+      do
+	say "at least 2 arguments expected"
+	exit
+      end
+    x = args[0]
+    root = args[1]
+    if args.length > 2 then digs = args[2]
+
+    if root=='' then root=2
+    if digs = null, digs = '' then digs=20
+    numeric digits digs
+    say '     x	= ' x
+    say '  root	= ' root
+    say 'digits	= ' digs
+    say 'answer	= ' root(x,root,digs)
+
+  method root(x,r,digs) static --procedure; parse arg x,R 1 oldR  /*assign 2nd arg-->r and rOrig.  */
+    /*this subroutine will use the   */
+    /*digits from the calling prog.  */
+    /*The default digits is  9.      */
+    R = r
+    oldR = r
+    if r=0 then do
+      say
+      say '*** error! ***'
+      say "a root of zero can't be specified."
+      say
+      return '[n/a]'
+    end
+
+    R=R.abs()                              /*use absolute value of root.    */
+
+    if x<0 & (R//2==0) then do
+      say
+      say '*** error! ***'
+      say "an even root can't be calculated for a" -
+      'negative number,'
+      say 'the result would be complex.'
+      say
+      return '[n/a]'
+    end
+
+    if x=0 | r=1 then return x/1           /*handle couple of special cases.*/
+    Rm1=R-1                                /*just a fast version of  ROOT-1 */
+    oldDigs=digs                           /*get the current number of digs.*/
+    dm=oldDigs+5                           /*we need a little guard room.   */
+    ax=x.abs()                             /*the absolute value of  X.      */
+    g=(ax+1)/r**r                          /*take a good stab at 1st guess. */
+ --   numeric fuzz 3                         /*fuzz digits for higher roots.  */
+    d=5                                    /*start with only five digits.   */
+    /*each calc doubles precision.   */
+
+    loop forever
+
+      d=d+d
+      if d>dm then d = dm                        /*double the digits, but not>DM. */
+      numeric digits d                     /*tell REXX to use   D   digits. */
+      old=0                                /*assume some kind of old guess. */
+
+      loop forever
+	_=(Rm1*g**R+ax)/R/g**rm1           /*this is the nitty-gritty stuff.*/
+	if _=g | _=old then leave          /*computed close to this before? */
+	old=g                              /*now, keep calculation for OLD. */
+	g=_                                /*set calculation to guesstimate.*/
+      end
+
+      if d==dm then leave                  /*found the root for DM digits ? */
+    end
+
+    _=g*x.sign()                           /*correct the sign (maybe).      */
+    if oldR<0 then return _=1/_            /*root < 0 ?    Reciprocal it is.*/
+    numeric digits oldDigs                 /*re-instate the original digits.*/
+    return _/1                             /*normalize the number to digs.  */

Task/Nth-root/OCaml/nth-root.ocaml

@@ -0,0 +1,12 @@
+let nthroot ~n ~a ?(tol=0.001) () =
+   let nf = float n in let nf1 = nf -. 1.0 in
+   let rec iter x =
+      let x' = (nf1 *. x +. a /. (x ** nf1)) /. nf in
+      if tol > abs_float (x -. x') then x' else iter x' in
+   iter 1.0
+;;
+
+let () =
+  Printf.printf "%g\n" (nthroot 10 (7131.5 ** 10.0) ());
+  Printf.printf "%g\n" (nthroot 5 34.0 ());
+;;

Task/Nth-root/Octave/nth-root-1.octave

@@ -0,0 +1 @@
+  r = A.^(1./n)

Task/Nth-root/Octave/nth-root-2.octave

@@ -0,0 +1,12 @@
+function r = m_nthroot(n, A)
+  x0 = A / n;
+  m  = n - 1;
+  while(1)
+    x1 = (m*x0 + A./ x0 .^ m) / n;
+    if ( abs(x1-x0) < abs(x0 * 1e-9) )
+      r = x1;
+      return
+    endif
+    x0 = x1;
+  endwhile
+endfunction

Task/Nth-root/Octave/nth-root-3.octave

@@ -0,0 +1,8 @@
+function r = m_nthroot(n, A)
+  r = A / n;
+  m = n - 1;
+  do
+    d = (A ./ r .^ m - r) / n;
+    r+= d;
+  until (abs(d) < abs(r * 1e-9))
+endfunction

Task/Nth-root/Octave/nth-root-4.octave

@@ -0,0 +1,6 @@
+m_nthroot(10, 7131.5 .^ 10)
+nthroot(7131.5 .^ 10, 10)
+m_nthroot(5, 34)
+nthroot(34, 5)
+m_nthroot(0.5, 7)
+nthroot(7, .5)

Task/Nth-root/Oz/nth-root.oz

@@ -0,0 +1,19 @@
+declare
+  fun {NthRoot NInt A}
+     N = {Int.toFloat NInt}
+
+     fun {Next X}
+        ( (N-1.0)*X + A / {Pow X N-1.0} ) / N
+     end
+  in
+     {Until Value.'==' Next A/N}
+  end
+
+  fun {Until P F X}
+     case {F X}
+     of NX andthen {P NX X} then X
+     [] NX then {Until P F NX}
+     end
+  end
+in
+  {Show {NthRoot 2 2.0}}

Task/Nth-root/PARI-GP/nth-root.pari

@@ -0,0 +1 @@
+root(n,A)=A^(1/n);

Task/Nth-root/PHP/nth-root.php

@@ -0,0 +1,11 @@
+function nthroot($number, $root, $p = P)
+{
+    $x[0] = $number;
+    $x[1] = $number/$root;
+    while(abs($x[1]-$x[0]) > $p)
+    {
+        $x[0] = $x[1];
+        $x[1] = (($root-1)*$x[1] + $number/pow($x[1], $root-1))/$root;
+    }
+    return $x[1];
+}

Task/Nth-root/PL-I/nth-root.pli

@@ -0,0 +1,13 @@
+/* Finds the N-th root of the number A */
+root: procedure (A, N) returns (float);
+   declare A float, N fixed binary;
+   declare (xi, xip1) float;
+
+   xi = 1; /* An initial guess */
+   do forever;
+      xip1 = ((n-1)*xi + A/xi**(n-1) ) / n;
+      if abs(xip1-xi) < 1e-5 then leave;
+      xi = xip1;
+   end;
+   return (xi);
+end root;

Task/Nth-root/Perl-6/nth-root.pl6

@@ -0,0 +1,11 @@
+sub nth-root ($n, $A, $p=1e-9)
+{
+    my $x0 = $A / $n;
+    loop {
+        my $x1 = (($n-1) * $x0 + $A / ($x0 ** ($n-1))) / $n;
+        return $x1 if abs($x1-$x0) < abs($x0 * $p);
+        $x0 = $x1;
+    }
+}
+
+say nth-root(3,8);

Task/Nth-root/Perl/nth-root-1.pl

@@ -0,0 +1,14 @@
+use strict;
+
+sub nthroot ($$)
+{
+    my ( $n, $A ) = @_;
+
+    my $x0 = $A / $n;
+    my $m = $n - 1.0;
+    while(1) {
+	my $x1 = ($m * $x0 + $A / ($x0 ** $m)) / $n;
+	return $x1 if abs($x1 - $x0) < abs($x0 * 1e-9);
+	$x0 = $x1;
+    }
+}

Task/Nth-root/Perl/nth-root-2.pl

@@ -0,0 +1,3 @@
+print nthroot(5, 34), "\n";
+print nthroot(10, 7131.5 ** 10), "\n";
+print nthroot(0.5, 7), "\n";

Task/Nth-root/PicoLisp/nth-root.l

@@ -0,0 +1,17 @@
+(load "@lib/math.l")
+
+(de nthRoot (N A)
+   (let (X1 A  X2 (*/ A N))
+      (until (= X1 X2)
+         (setq
+            X1 X2
+            X2 (*/
+               (+
+                  (* X1 (dec N))
+                  (*/ A 1.0 (pow X1 (* (dec N) 1.0))) )
+               N ) ) )
+      X2 ) )
+
+(prinl (format (nthroot 2  2.0) *Scl))
+(prinl (format (nthroot 3 12.3) *Scl))
+(prinl (format (nthroot 4 45.6) *Scl))

Task/Nth-root/PureBasic/nth-root.purebasic

@@ -0,0 +1,19 @@
+#Def_p=0.001
+
+Procedure.d Nth_root(n.i, A.d, p.d=#Def_p)
+  Protected Dim x.d(1)
+  x(0)=A: x(1)=A/n
+  While Abs(x(1)-x(0))>p
+    x(0)=x(1)
+    x(1)=((n-1.0)*x(1)+A/Pow(x(1),n-1.0))/n
+  Wend
+  ProcedureReturn x(1)
+EndProcedure
+
+;//////////////////////////////
+Debug "125'th root of 5642 is"
+Debug Pow(5642,1/125)
+Debug "First estimate is:"
+Debug Nth_root(125,5642)
+Debug "And better:"
+Debug Nth_root(125,5642,0.00001)

Task/Nth-root/Python/nth-root-1.py

@@ -0,0 +1,13 @@
+from decimal import Decimal, getcontext
+
+def nthroot (n, A, precision):
+    getcontext().prec = precision
+
+    n = Decimal(n)
+    x_0 = A / n #step 1: make a while guess.
+    x_1 = 1     #need it to exist before step 2
+    while True:
+        #step 2:
+        x_0, x_1 = x_1, (1 / n)*((n - 1)*x_0 + (A / (x_0 ** (n - 1))))
+        if x_0 == x_1:
+            return x_1

Task/Nth-root/Python/nth-root-2.py

@@ -0,0 +1,3 @@
+print nthroot(5, 34, 10)
+print nthroot(10,42, 20)
+print nthroot(2, 5, 400)

Task/Nth-root/R/nth-root.r

@@ -0,0 +1,12 @@
+nthroot <- function(A, n, tol=sqrt(.Machine$double.eps))
+{
+   ifelse(A < 1, x0 <- A * n, x0 <- A / n)
+   repeat
+   {
+      x1 <- ((n-1)*x0 + A / x0^(n-1))/n
+      if(abs(x1 - x0) > tol) x0 <- x1 else break
+   }
+   x1
+}
+nthroot(7131.5^10, 10)   # 7131.5
+nthroot(7, 0.5)          # 49

Task/Nth-root/REXX/nth-root.rexx

@@ -0,0 +1,39 @@
+/*REXX program calculates the  Nth root of   X,   with  DIGS  accuracy. */
+parse arg x root digs .                /*get specified args from the CL.*/
+if    x==''  then    x=2               /*Not specified? Then use default*/
+if root==''  then root=2               /* "       "       "   "     "   */
+if digs==''  then digs=65              /* "       "       "   "     "   */
+numeric digits digs                    /*set the precision to   DIGS.   */
+say '       x = '    x                 /*echo the value of  X.          */
+say '    root = '    root              /*echo the value of  ROOT.       */
+say '  digits = '    digs              /*echo the value of  DIGS.       */
+say '  answer = '    root(x,root)      /*show the value of  ANSWER.     */
+exit                                   /*stick a fork in it, we're done.*/
+/*──────────────────────────────────ROOT subroutine─────────────────────*/
+root: procedure; parse arg x 1 Ox,r . 1 Or  /*1st arg──►x&Ox, 2nd──►r&Or*/
+if r==''  then r=2                     /*Was root specified?   Assume √.*/
+if r=0    then return '[n/a]'          /*oops-ay!  Can't do zeroth root.*/
+complex= x<0 & R//2==0                 /*will the result be complex?    */
+oDigs=digits()                         /*get the current number of digs.*/
+if x=0 | r=1  then return x/1          /*handle couple of special cases.*/
+dm=oDigs+5                             /*we need a little guard room.   */
+r=abs(r);   x=abs(x)                   /*the absolute values of R and X.*/
+rm=r-1                                 /*just a fast version of  ROOT -1*/
+numeric form                           /*take a good guess at the root─┐*/
+parse value format(x,2,1,,0) 'E0' with ? 'E' _ .        /* ◄───────────┘*/
+g=(?/r'E'_%r)+(x>1)                    /*kinda uses a crude "logrithm". */
+numeric fuzz 3                         /*fuzz digits for higher roots.  */
+d=5                                    /*start with only five digits.   */
+     do until d==dm;   d=min(d+d,dm)   /*each interation doubles prec.  */
+     numeric digits d                  /*tell REXX to use   D   digits. */
+     old=-1                            /*assume some kind of old guess. */
+            do until old=g;   old=g    /*where da rubber meets da road─┐*/
+            g=(rm*g**r+x) / r / g**rm  /*nitty-gritty root computation◄┘*/
+            end   /*until old=g*/      /*maybe until the cows come home.*/
+     end          /*until d==dm*/      /*and wait for more cows to come.*/
+
+if g=0        then return 0            /*in case the jillionth root = 0.*/
+if Or<0       then g=1/g               /*root < 0 ?    Reciprocal it is!*/
+if \complex   then g=g*sign(Ox)        /*adjust the sign  (maybe).      */
+numeric digits oDigs                   /*reinstate the original digits. */
+return g/1 || left('j',complex)        /*normalize # to digs, append j ?*/

Task/Nth-root/Ruby/nth-root.rb

@@ -0,0 +1,10 @@
+def nthroot(n, a, precision = 1e-5)
+  x = Float(a)
+  begin
+    prev = x
+    x = ((n - 1) * prev + a / (prev ** (n - 1))) / n
+  end while (prev - x).abs > precision
+  x
+end
+
+p nthroot(5,34)  # => 2.02439745849989

Task/Nth-root/Run-BASIC/nth-root.run

@@ -0,0 +1,21 @@
+print "Root 125th Root of 5643 Precision .001   ";using( "#.###############",  NthRoot( 125, 5642, 0.001  ))
+print "125th Root of 5643 Precision .001   ";using( "#.###############",  NthRoot( 125, 5642, 0.001  ))
+print "125th Root of 5643 Precision .00001 ";using( "#.###############",  NthRoot( 125, 5642, 0.00001))
+print "  3rd Root of   27 Precision .00001 ";using( "#.###############",  NthRoot(   3,   27, 0.00001))
+print "  2nd Root of    2 Precision .00001 ";using( "#.###############",  NthRoot(   2,    2, 0.00001))
+print " 10th Root of 1024 Precision .00001 ";using( "#.###############",  NthRoot(  10, 1024, 0.00001))
+
+wait
+
+function NthRoot( root, A, precision)
+  x0 = A
+  x1 = A /root
+  while abs( x1 -x0) >precision
+    x0 = x1
+    x1 = x1 / 1.0                                ' force float
+    x1 = (( root -1.0) *x1 +A /x1^( root -1.0)) /root
+  wend
+  NthRoot =x1
+end function
+
+end

Task/Nth-root/Sather/nth-root-1.sa

@@ -0,0 +1,16 @@
+class MATH is
+  nthroot(n:INT, a:FLT):FLT
+    pre n > 0
+  is
+    x0 ::= a / n.flt;
+    m  ::= n - 1;
+    loop
+      x1 ::= (m.flt * x0 + a/(x0^(m.flt))) / n.flt;
+      if (x1 - x0).abs < (x0 * 1.0e-9).abs then
+        return x1;
+      end;
+      x0 := x1;
+    end;
+  end;
+
+end;

Task/Nth-root/Sather/nth-root-2.sa

@@ -0,0 +1,6 @@
+class MAIN is
+  main is
+    a:FLT := 2.5 ^ 10.0;
+    #OUT + MATH::nthroot(10, a) + "\n";
+  end;
+end;

Task/Nth-root/Scala/nth-root.scala

@@ -0,0 +1,16 @@
+object NthRoot {
+
+  def main(args: Array[String]) {
+    println(nthroot(3, 32))
+  }
+
+  def nthroot1(n: Int, a: Double): Double = {
+    def loop(x0: Double) : Double = {
+      val x1 = (1.0d/n * ((n - 1) * x0 + a/math.pow(x0, n-1)))
+      if (x0 <= x1) x0
+      else loop(x1)
+    }
+
+    return loop(a/2)
+  }
+}

Task/Nth-root/Scheme/nth-root.ss

@@ -0,0 +1,18 @@
+(define (root number degree tolerance)
+  (define (good-enough? next guess)
+    (< (abs (- next guess)) tolerance))
+  (define (improve guess)
+    (/ (+ (* (- degree 1) guess) (/ number (expt guess (- degree 1)))) degree))
+  (define (*root guess)
+    (let ((next (improve guess)))
+      (if (good-enough? next guess)
+          guess
+          (*root next))))
+  (*root 1.0))
+
+(display (root (expt 2 10) 10 0.1))
+(newline)
+(display (root (expt 2 10) 10 0.01))
+(newline)
+(display (root (expt 2 10) 10 0.001))
+(newline)

Task/Nth-root/Seed7/nth-root.seed7

@@ -0,0 +1,13 @@
+const func float: nthRoot (in integer: n, in float: a) is func
+  result
+    var float: x1 is 0.0;
+  local
+    var float: x0 is 0.0;
+  begin
+    x0 := a;
+    x1 := a / flt(n);
+    while abs(x1 - x0) >= abs(x0 * 1.0E-9) do
+      x0 := x1;
+      x1 := (flt(pred(n)) * x0 + a / x0 ** pred(n)) / flt(n);
+    end while;
+  end func;

Task/Nth-root/Smalltalk/nth-root-1.st

@@ -0,0 +1,13 @@
+Number extend [
+    nthRoot: n [
+	|x0 m x1|
+	x0 := (self / n) asFloatD.
+	m := n - 1.
+	[true] whileTrue: [
+	    x1 := ( (m * x0) + (self/(x0 raisedTo: m))) / n.
+	    ((x1 - x0) abs) < ((x0 * 1e-9) abs)
+		ifTrue: [ ^ x1 ].
+	    x0 := x1
+	]
+    ]
+].

Task/Nth-root/Smalltalk/nth-root-2.st

@@ -0,0 +1,3 @@
+(34 nthRoot: 5) displayNl.
+((7131.5 raisedTo: 10) nthRoot: 10) displayNl.
+(7 nthRoot: 0.5) displayNl.

Task/Nth-root/Tcl/nth-root-1.tcl

@@ -0,0 +1,3 @@
+proc nthroot {n A} {
+    expr {pow($A, 1.0/$n)}
+}

Task/Nth-root/Tcl/nth-root-2.tcl

@@ -0,0 +1,11 @@
+proc nthroot {n A} {
+    set x0 [expr {$A / double($n)}]
+    set m [expr {$n - 1.0}]
+    while 1 {
+        set x1 [expr {($m*$x0 + $A/$x0**$m) / $n}]
+        if {abs($x1 - $x0) < abs($x0 * 1e-9)} {
+            return $x1
+        }
+        set x0 $x1
+    }
+}

Task/Nth-root/Tcl/nth-root-3.tcl

@@ -0,0 +1,5 @@
+puts [nthroot 2 2]
+puts [nthroot 5 34]
+puts [nthroot 5 [expr {34**5}]]
+puts [nthroot 10 [expr 7131.5**10]]
+puts [nthroot 0.5 7]; # Squaring!

Task/Nth-root/Ursala/nth-root-1.ursala

@@ -0,0 +1,8 @@
+#import nat
+#import flo
+
+nthroot =
+
+-+
+   ("n","n-1"). "A". ("x". div\"n" plus/times("n-1","x") div("A",pow("x","n-1")))^== 1.,
+   float^~/~& predecessor+-

Task/Nth-root/Ursala/nth-root-2.ursala

@@ -0,0 +1,9 @@
+#cast %eL
+
+examples =
+
+<
+   nthroot2 2.,
+   nthroot5 34.,
+   nthroot5 pow(34.,5.),
+   nthroot10 pow(7131.5,10.)>

Task/Nth-root/XPL0/nth-root.xpl0

@@ -0,0 +1,21 @@
+include c:\cxpl\stdlib;
+
+func real NRoot(A, N);  \Return the Nth root of A
+real A, N;
+real X, X0, Y;
+int  I;
+[X:= 1.0;               \initial guess
+repeat  X0:= X;
+        Y:= 1.0;
+        for I:= 1 to fix(N)-1 do Y:= Y*X0;
+        X:= ((N-1.0)*X0 + A/Y) / N;
+until   abs(X-X0) < 1.0E-15;            \(until X=X0 doesn't always work)
+return X;
+];
+
+[Format(5, 15);
+RlOut(0, NRoot( 2., 2.));  CrLf(0);
+RlOut(0, Power( 2., 0.5)); CrLf(0);     \for comparison
+RlOut(0, NRoot(27., 3.));  CrLf(0);
+RlOut(0, NRoot(1024.,10.)); CrLf(0);
+]