aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data update

Browse source
This commit is contained in:
Ingy döt Net 2025-02-27 18:35:13 -05:00
parent 8e4e15fa56
commit 72eb4943cb
1853 changed files with 35514 additions and 9441 deletions
Download patch file Download diff file Expand all files Collapse all files

21
Task/Nth-root/ALGOL-60/nth-root-1.alg Normal file
View file

@ -0,0 +1,21 @@
begin
comment - return the nth root of x to stated precision;
real procedure nthroot(x, n, precision);
value x, n, precision; real x, n, precision;
begin
real x0, x1;
x0 := x;
x1 := x / n;
for x0 := x0 while abs(x1 - x0) > precision do
begin
x0 := x1;
x1 := ((n-1)*x1 + x / x1 ** (n-1)) / n;
end;
nthroot := x1;
end;
outstring(1,"Cube root of 81 =");
outreal(1,nthroot(81, 3, 0.0000001));
end

5
Task/Nth-root/ALGOL-60/nth-root-2.alg Normal file
View file

@ -0,0 +1,5 @@
real procedure nthroot(x, n);
value x, n; real x, n;
begin
nthroot := exp(ln(x) / n);
end;

5
Task/Nth-root/ALGOL-60/nth-root-3.alg Normal file
View file

@ -0,0 +1,5 @@
real procedure nthroot(x, n);
value x, n; real x, n;
begin
nthroot := x ** (1/n);
end;

23
Task/Nth-root/ANSI-BASIC/nth-root.basic Normal file
View file

@ -0,0 +1,23 @@
100 REM Nth root
110 DECLARE EXTERNAL FUNCTION NthRoot
120 LET X = 144
130 PRINT "Finding the nth root of"; X; "to 6 decimal places"
140 PRINT " x n root x ^ (1 / n)"
150 PRINT "--------------------------------------"
160 FOR I = 1 TO 8
170 PRINT USING "### ": X;
180 PRINT USING "#### ": I;
190 PRINT USING "###.######": NthRoot(I, X, 1.000000E-07);
200 PRINT USING " ###.######": X ^ (1 / I)
210 NEXT I
220 END
230 EXTERNAL FUNCTION NthRoot(N, X, Precision)
240 REM Returns the Nth root of value X to stated Precision
250 LET X0 = X
260 LET X1 = X / N ! initial guess
270 DO WHILE ABS(X1 - X0) > Precision
280 LET X0 = X1
290 LET X1 = ((N - 1) * X1 + X / X1 ^ (N - 1)) / N
300 LOOP
310 LET NthRoot = X1
320 END FUNCTION

0
Task/Nth-root/AWK/nth-root.awk → Task/Nth-root/AWK/nth-root-1.awk
View file

24
Task/Nth-root/AWK/nth-root-2.awk Normal file
View file

@ -0,0 +1,24 @@
#!/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(a, n, x, y, a_n, n1_n) {
# no need for eps, the values are monotonically decreasing
# until the root is found (if the initial value is above the root)
x = 1 + a / n # starting value above the root
a_n = a/n # precompute loop invariants
n1_n = (n - 1) / n
do {
y = x
x = n1_n * x + a_n / x^(n-1)
} while (x < y)
# no harm to use average if x = y
return (x + y) / 2
}

8
Task/Nth-root/AWK/nth-root-3.awk Normal file
View file

@ -0,0 +1,8 @@
{
x = $0
do {
y = x
x = (x + $0/x)/2
} while (x < y)
print "sqrt(" a ")=" x
}

1
Task/Nth-root/BASIC/nth-root-3.basic
View file

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

23
Task/Nth-root/GW-BASIC/nth-root.basic Normal file
View file

@ -0,0 +1,23 @@
100 REM Nth root
110 X# = 144
120 PRINT "Finding the nth root of"; X#; "to 6 decimal places"
130 PRINT " x n root x ^ (1 / n)"
140 PRINT "--------------------------------------"
150 FOR I% = 1 TO 8
160 PRINT USING "### "; X#;
170 PRINT USING "#### "; I%;
180 N% = I%: PREC# = .0000001#: GOSUB 1000
190 PRINT USING "###.######"; NTH.ROOT#;
200 PRINT USING " ###.######"; X# ^ (1 / I%)
210 NEXT I%
220 END
1000 REM Calculate the N%th root of value X# to stated precision PREC#
1010 REM Result: NTH.ROOT#
1020 X0# = X#
1030 X1# = X# / N% ' initial guess
1040 WHILE ABS(X1# - X0#) > PREC#
1050 X0# = X1#
1060 X1# = ((N% - 1) * X1# + X# / X1# ^ (N% - 1)) / N%
1070 WEND
1080 NTH.ROOT# = X1#
1090 RETURN

47
Task/Nth-root/Modula-2/nth-root.mod2 Normal file
View file

@ -0,0 +1,47 @@
MODULE NthRoot;
FROM LongMath IMPORT
power;
FROM STextIO IMPORT
WriteString, WriteLn;
FROM SLongIO IMPORT
WriteFixed;
FROM SWholeIO IMPORT
WriteInt;
VAR
X: LONGREAL;
I: CARDINAL;
PROCEDURE Root(X: LONGREAL; N: CARDINAL; Precision: LONGREAL): LONGREAL;
(* Returns the Nth root of value X to stated Precision *)
VAR
X0, X1, NR: LONGREAL;
BEGIN
NR := FLOAT(N);
X0 := X;
X1 := X / NR; (* initial guess *)
WHILE ABS(X1 - X0) > Precision DO
X0 := X1;
X1 := ((NR - 1.0) * X1 + X / power(X1, NR - 1.0)) / NR
END;
RETURN X1
END Root;
BEGIN
X := 144.0;
WriteString("Finding the nth root of ");
WriteFixed(X, 1, 5);
WriteString(" to 6 decimal places");
WriteLn;
WriteString(" x n root x ^ (1 / n)");
WriteLn;
WriteString("----------------------------------------");
WriteLn;
FOR I := 1 TO 8 DO
WriteFixed(X, 1, 5);
WriteInt(I, 7);
WriteFixed(Root(X, I, 1.0E-07), 6, 14);
WriteFixed(power(X, 1. / FLOAT(I)), 6, 14);
WriteLn
END
END NthRoot.

31
Task/Nth-root/OoRexx/nth-root.rexx Normal file
View file

@ -0,0 +1,31 @@
/* REXX */
Numeric Digits 70
Call test 2,2
Call test 10,3
Call test 625,-4
Call test 100.666,47
Call test -256,8
Call test 12345678900098765432100.00987654321000123456789e333,19
Exit
test:
Parse Arg x,n
xa=abs(x)
na=abs(n)
lnx=rxmlog(xa,70)
rt=rxmexp(lnx/na,70)
Numeric Digits 65
result=rt+0
If pos('.',result)>0 Then Do -- get rid of zeroes in decimals
Parse Var result int '.' dec
If dec=0 Then
result=int
End
If sign(n)=-1 Then result=1/result
If sign(x)=-1 Then result=result'j'
Say ' x = ' x
Say ' root = ' n
Say ' digits = ' 65
Say ' answer = ' result
Say ''
Return
::REQUIRES rxm.cls

24
Task/Nth-root/QuickBASIC/nth-root.basic Normal file
View file

@ -0,0 +1,24 @@
' Nth root
DECLARE FUNCTION NthRoot# (N%, X#, Precision#)
X# = 144
PRINT "Finding the nth root of"; X#; "to 6 decimal places"
PRINT " x n root x ^ (1 / n)"
PRINT "--------------------------------------"
FOR I% = 1 TO 8
PRINT USING "### "; X#;
PRINT USING "#### "; I%;
PRINT USING "###.######"; NthRoot#(I%, X#, .0000001);
PRINT USING " ###.######"; X# ^ (1 / I%)
NEXT I%
END
FUNCTION NthRoot# (N%, X#, Precision#)
' Returns the Nth root of value X to stated Precision
X0# = X#
X1# = X# / N% ' initial guess
DO WHILE ABS(X1# - X0#) > Precision#
X0# = X1#
X1# = ((N% - 1) * X1# + X# / X1# ^ (N% - 1)) / N%
LOOP
NthRoot# = X1#
END FUNCTION

38
Task/Nth-root/REXX/nth-root-1.rexx
View file

@ -1,38 +0,0 @@
/*REXX program calculates the Nth root of X, with DIGS (decimal digits) accuracy. */
parse arg x root digs . /*obtain optional arguments from the CL*/
if x=='' | x=="," then x= 2 /*Not specified? Then use the default.*/
if root=='' | root=="," then root= 2 /* " " " " " " */
if digs=='' | digs=="," then digs=65 /* " " " " " " */
numeric digits digs /*set the decimal digits to DIGS. */
say ' x = ' x /*echo the value of X. */
say ' root = ' root /* " " " " ROOT. */
say ' digits = ' digs /* " " " " DIGS. */
say ' answer = ' root(x, root) /*show the value of ANSWER. */
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
root: procedure; parse arg x 1 Ox, r 1 Or /*arg1 ──► 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 "logarithm".*/
d=5 /*start with five decimal digits.*/
do until d==dm; d=min(d+d,dm) /*each time, precision doubles. */
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=format((rm*g**r+x)/r/g**rm,, d-2) /* ◄────── the 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 ?*/

4
Task/Nth-root/REXX/nth-root-2.rexx
View file

@ -1,4 +0,0 @@
do until old=g; old=g /*where da rubber meets da road-+*/<br>
g=format((rm*g**r+x)/r/g**rm,, d-2) /* ?------ the root computation-+*/<br>
'''say 'g' g 'old' old'''<br>
end /*until old=g*/ /*maybe until the cows come home.*/<br>

43
Task/Nth-root/REXX/nth-root-3.rexx → Task/Nth-root/REXX/nth-root.rexx
View file

@ -10,49 +10,8 @@ numeric digits digs /*set the decimal digits to
say ' x = ' x /*echo the value of X. */
say ' root = ' root /* " " " " ROOT. */
say ' digits = ' digs /* " " " " DIGS. */
say ' answer = ' nroot(x, root) /*show the value of ANSWER. */
say ' answer = ' Nroot(x, root) /*show the value of ANSWER. */
exit /*stick a fork in it, we're all done. */
/*--------------------------------------------------------------------------------------*/
Nroot:
/* Nth root function = x^(1/n) */
procedure expose glob.
arg x,n
/* Fast values */
if x = 0 then
return 0
if x = 1 then
return 1
/* Formulas using faster methods */
if n = 2 then
return Sqrt(x)
if n = 3 then
return Cbrt(x)
if n = 4 then
return Qtrt(x)
/* Calculate */
sx = Sign(x); x = Abs(x)
p1 = Digits(); p2 = p1+2
numeric digits 3
/* First guess low accuracy */
y = 1/Exp(Ln(x)/n)
numeric digits p2
/* Dynamic precision */
d = p2
do k = 1 while d > 4
d.k = d; d = d%2+1
end
d.k = 4
/* Halley */
a = 1/n; b = n+1
do j = k to 1 by -1
numeric digits d.j
y = y*a*(b-x*y**n)
end
y = 1/y
if sx < 0 then
y = -y
numeric digits p1
return y+0
include Numbers
include Functions

25
Task/Nth-root/RapidQ/nth-root.rapidq Normal file
View file

@ -0,0 +1,25 @@
' Nth root
DECLARE FUNCTION NthRoot (N%, X#, Precision#) AS DOUBLE
X# = 144
PRINT "Finding the nth root of ";X#;" to 6 decimal places"
PRINT " x n root x ^ (1 / n)"
PRINT "--------------------------------------"
FOR I% = 1 TO 8
PRINT FORMAT$("%3d ", X#);
PRINT FORMAT$("%4d ", I%);
PRINT FORMAT$("%10.6f", NthRoot(I%, X#, .0000001));
PRINT FORMAT$(" %10.6f", X# ^ (1 / I%))
NEXT I%
input X#
END
FUNCTION NthRoot (N%, X#, Precision#) AS DOUBLE
' Returns the Nth root of value X to stated Precision
X0# = X#
X1# = X# / N% ' initial guess
WHILE ABS(X1# - X0#) > Precision#
X0# = X1#
X1# = ((N% - 1) * X1# + X# / X1# ^ (N% - 1)) / N%
WEND
NthRoot = X1#
END FUNCTION

6
Task/Nth-root/S-BASIC/nth-root-1.basic
View file

@ -4,12 +4,14 @@ end = exp((1.0 / n) * log(x))
rem - exercise the routine by finding successive roots of 144
var i = integer
var x = real
print "Finding the nth root of x"
x = 144
print "Finding the nth root of"; x
print " x n root"
print "-----------------------"
for i = 1 to 8
print using "### #### ###.####"; 144; i; nthroot(144, i)
print using "### #### ###.####"; x; i; nthroot(x, i)
next i
end

13
Task/Nth-root/S-BASIC/nth-root-2.basic
View file

@ -1,8 +1,8 @@
rem - return the nth root of real.double value x to stated precision
rem - return the nth root of x to stated precision
function nthroot(n, x, precision = real.double) = real.double
var x0, x1 = real.double
x0 = x
x1 = x / n rem - initial guess
x1 = x / n rem - initial guess
while abs(x1 - x0) > precision do
begin
x0 = x1
@ -13,11 +13,14 @@ end = x1
rem -- exercise the routine
var i = integer
print "Finding the nth root of 144 to 6 decimal places"
var x = real.double
x = 144
print "Finding the nth root of"; x; " to 8 decimal places"
print " x n root"
print "------------------------"
for i = 1 to 8
print using "### #### ###.######"; 144; i; nthroot(i, 144.0, 1E-7)
for i = 2 to 8
print using "### #### ###.########"; x; i; nthroot(i, x, 1E-9)
next i
end

23
Task/Nth-root/XPL0/nth-root.xpl0
View file

@ -1,21 +1,24 @@
include c:\cxpl\stdlib;
func real NRoot(A, N); \Return the Nth root of A
real A, N;
real X, X0, Y;
func real NRoot(A, N, Prec); \Return the Nth root of A with precision Prec
real A;
int N;
real Prec;
real X, X0, Y, NF;
int I;
[X:= 1.0; \initial guess
[NF:= float(N);
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)
for I:= 1 to N-1 do Y:= Y*X0;
X:= ((NF-1.0)*X0 + A/Y) / NF;
until abs(X-X0) < Prec; \(until X=X0 doesn't always work)
return X;
];
[Format(5, 15);
RlOut(0, NRoot( 2., 2.)); CrLf(0);
RlOut(0, NRoot( 2., 2, 1.0E-15)); 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);
RlOut(0, NRoot(27., 3, 1.0E-15)); CrLf(0);
RlOut(0, NRoot(1024., 10, 1.0E-15)); CrLf(0);
]