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

September Morn Update

Browse source
This commit is contained in:
Ingy döt Net 2019-09-12 10:33:56 -07:00
parent 4e2d22a71d
commit aac6731f2c
6856 changed files with 141342 additions and 21127 deletions
Download patch file Download diff file Expand all files Collapse all files

3
Task/Nth-root/00DESCRIPTION
View file

@ -1,3 +1,4 @@
;Task:
Implement the algorithm to compute the principal &nbsp; [[wp:Nth root|<big>''n''<sup>th</sup></big> &nbsp; root]] &nbsp; <big><big><big><math>\sqrt[n]A</math></big></big></big> &nbsp; of a positive real number &nbsp; <big>''A''</big>, &nbsp; as explained at the &nbsp; [[wp:Nth root algorithm|Wikipedia page]].
Implement the algorithm to compute the principal [[wp:Nth root|''n''th root]] <big><math>\sqrt[n]A</math></big> of a positive real number <big>''A''</big>, as explained at the [[wp:Nth root algorithm|Wikipedia page]].
<br><br>

25
Task/Nth-root/ALGOL-W/nth-root.alg Normal file
View file

@ -0,0 +1,25 @@
begin
% nth root algorithm %
% returns the nth root of A, A must be > 0 %
% the required precision should be specified in precision %
long real procedure nthRoot( long real value A
; integer value n
; long real value precision
) ;
begin
long real xk, xd;
integer n1;
n1 := n - 1;
xk := A / n;
while begin
xd := ( ( A / ( xk ** n1 ) ) - xk ) / n;
xk := xk + xd;
abs( xd ) > precision
end do begin end;
xk
end nthRoot ;
% test cases %
r_format := "A"; r_w := 15; r_d := 6; % set output format %
write( nthRoot( 7131.5 ** 10, 10, 1'-5 ) );
write( nthRoot( 64, 6, 1'-5 ) );
end.

101
Task/Nth-root/ARM-Assembly/nth-root.arm Normal file
View file

@ -0,0 +1,101 @@
/* ARM assembly Raspberry PI */
/* program nroot.s */
/* compile with option -mfpu=vfpv3 -mfloat-abi=hard */
/* link with gcc. Use C function for display float */
/* Constantes */
.equ EXIT, 1 @ Linux syscall
/* Initialized data */
.data
szFormat1: .asciz " %+09.15f\n"
.align 4
iNumberA: .int 1024
/* UnInitialized data */
.bss
.align 4
/* code section */
.text
.global main
main: @ entry of program
push {fp,lr} @ saves registers
/* root 10ieme de 1024 */
ldr r0,iAdriNumberA @ number address
ldr r0,[r0]
vmov s0,r0 @
vcvt.f64.s32 d0, s0 @conversion in float single précision (32 bits)
mov r0,#10 @ N
bl nthRoot
ldr r0,iAdrszFormat1 @ format
vmov r2,r3,d0
bl printf @ call C function !!!
@ Attention register dn lost !!!
/* square root of 2 */
vmov.f64 d1,#2.0 @ conversion 2 in float register d1
mov r0,#2 @ N
bl nthRoot
ldr r0,iAdrszFormat1 @ format
vmov r2,r3,d0
bl printf @ call C function !!!
100: @ standard end of the program
mov r0, #0 @ return code
pop {fp,lr} @restaur registers
mov r7, #EXIT @ request to exit program
swi 0 @ perform the system call
iAdrszFormat1: .int szFormat1
iAdriNumberA: .int iNumberA
/******************************************************************/
/* compute nth root */
/******************************************************************/
/* r0 contains N */
/* d0 contains the value */
/* d0 return result */
nthRoot:
push {r1,r2,lr} @ save registers
vpush {d1-d8} @ save float registers
FMRX r1,FPSCR @ copy FPSCR into r1
BIC r1,r1,#0x00370000 @ clears STRIDE and LEN
FMXR FPSCR,r1 @ copy r1 back into FPSCR
vmov s2,r0 @
vcvt.f64.s32 d6, s2 @ N conversion in float double précision (64 bits)
sub r1,r0,#1 @ N - 1
vmov s8,r1 @
vcvt.f64.s32 d4, s8 @conversion in float double précision (64 bits)
vmov.f64 d2,d0 @ a = A
vdiv.F64 d3,d0,d6 @ b = A/n
adr r2,dfPrec @ load précision
vldr d8,[r2]
1: @ begin loop
vmov.f64 d2,d3 @ a <- b
vmul.f64 d5,d3,d4 @ (N-1)*b
vmov.f64 d1,#1.0 @ constante 1 -> float
mov r2,#0 @ loop indice
2: @ compute pow (n-1)
vmul.f64 d1,d1,d3 @
add r2,#1
cmp r2,r1 @ n -1 ?
blt 2b @ no -> loop
vdiv.f64 d7,d0,d1 @ A / b pow (n-1)
vadd.f64 d7,d7,d5 @ + (N-1)*b
vdiv.f64 d3,d7,d6 @ / N -> new b
vsub.f64 d1,d3,d2 @ compute gap
vabs.f64 d1,d1 @ absolute value
vcmp.f64 d1,d8 @ compare float maj FPSCR
fmstat @ transfert FPSCR -> APSR
@ or use VMRS APSR_nzcv, FPSCR
bgt 1b @ if gap > précision -> loop
vmov.f64 d0,d3 @ end return result in d0
100:
vpop {d1-d8} @ restaur float registers
pop {r1,r2,lr} @ restaur arm registers
bx lr
dfPrec: .double 0f1E-10 @ précision

12
Task/Nth-root/Factor/nth-root.factor Normal file
View file

@ -0,0 +1,12 @@
USING: kernel locals math math.functions prettyprint ;
:: th-root ( a n -- a^1/n )
a [
a over n 1 - ^ /f
over n 1 - *
+ n /f
swap over 1e-5 ~ not
] loop ;
34 5 th-root . ! 2.024397458499888
34 5 recip ^ . ! 2.024397458499888

41
Task/Nth-root/FreeBASIC/nth-root.freebasic Normal file
View file

@ -0,0 +1,41 @@
' version 14-01-2019
' compile with: fbc -s console
Function nth_root(n As Integer, number As Double) As Double
Dim As Double a1 = number / n, a2 , a3
Do
a3 = Abs(a2 - a1)
a2 = ((n -1) * a1 + number / a1 ^ (n -1)) / n
Swap a1, a2
Loop Until Abs(a2 - a1) = a3
Return a1
End Function
' ------=< MAIN >=------
Dim As UInteger n
Dim As Double tmp
Print
Print " n 5643 ^ 1 / n nth_root ^ n"
Print " ------------------------------------"
For n = 3 To 11 Step 2
tmp = nth_root(n, 5643)
Print Using " ### ###.######## ####.########"; n; tmp; tmp ^ n
Next
Print
For n = 25 To 125 Step 25
tmp = nth_root(n, 5643)
Print Using " ### ###.######## ####.########"; n; tmp; tmp ^ n
Next
' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End

0
Task/Nth-root/Haskell/nth-root.hs → Task/Nth-root/Haskell/nth-root-1.hs
View file

28
Task/Nth-root/Haskell/nth-root-2.hs Normal file
View file

@ -0,0 +1,28 @@
import Control.Applicative (liftA2)
nthRoot :: Double -> Double -> Double
nthRoot n x =
fst $
until
(uncurry (==))
(((,) <*> ((/ n) . liftA2 (+) ((n - 1) *) ((x /) . (** (n - 1))))) . snd)
(x, x / n)
-- TESTS --------------------------------------------------
main :: IO ()
main =
putStrLn $
fTable
"Nth roots:"
(\(a, b) -> show a ++ " `nthRoot` " ++ show b)
show
(uncurry nthRoot)
[(2, 2), (5, 34), (10, 734 ^ 10), (0.5, 7)]
-- FORMAT OF RESULTS --------------------------------------
fTable :: String -> (a -> String) -> (b -> String) -> (a -> b) -> [a] -> String
fTable s xShow fxShow f xs =
let w = maximum (length . xShow <$> xs)
rjust n c = liftA2 drop length (replicate n c ++)
in unlines $
s : fmap (((++) . rjust w ' ' . xShow) <*> ((" -> " ++) . fxShow . f)) xs

9
Task/Nth-root/Scala/nth-root-1.scala Normal file
View file

@ -0,0 +1,9 @@
def nroot(n: Int, a: Double): Double = {
@tailrec
def rec(x0: Double) : Double = {
val x1 = ((n - 1) * x0 + a/math.pow(x0, n-1))/n
if (x0 <= x1) x0 else rec(x1)
}
rec(a)
}

2
Task/Nth-root/Scala/nth-root-2.scala Normal file
View file

@ -0,0 +1,2 @@
def fallPrefix(itr: Iterator[Double]): Iterator[Double] = itr.sliding(2).dropWhile(p => p(0) > p(1)).map(_.head)
def nrootLazy(n: Int)(a: Double): Double = fallPrefix(Iterator.iterate(a){r => (((n - 1)*r) + (a/math.pow(r, n - 1)))/n}).next

16
Task/Nth-root/Scala/nth-root.scala
View file

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

27
Task/Nth-root/VBA/nth-root.vba Normal file
View file

@ -0,0 +1,27 @@
Private Function nth_root(y As Double, n As Double)
Dim eps As Double: eps = 0.00000000000001 '-- relative accuracy
Dim x As Variant: x = 1
Do While True
d = (y / x ^ (n - 1) - x) / n
x = x + d
e = eps * x '-- absolute accuracy
If d > -e And d < e Then
Exit Do
End If
Loop
Debug.Print y; n; x; y ^ (1 / n)
End Function
Public Sub main()
nth_root 1024, 10
nth_root 27, 3
nth_root 2, 2
nth_root 5642, 125
nth_root 7, 0.5
nth_root 4913, 3
nth_root 8, 3
nth_root 16, 2
nth_root 16, 4
nth_root 125, 3
nth_root 1000000000, 3
nth_root 1000000000, 9
End Sub