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

June 2018 Update

Browse source
This commit is contained in:
Ingy döt Net 2018-06-22 20:57:24 +00:00
parent ba8067c3b7
commit 22f33d4004
5278 changed files with 84726 additions and 14379 deletions
Download patch file Download diff file Expand all files Collapse all files

44
Task/Runge-Kutta-method/REXX/runge-kutta-method.rexx
View file

@ -1,32 +1,28 @@
/*REXX program uses the Runge─Kutta method to solve the equation: y'(t)=t² √[y(t)] */
numeric digits 40; f=digits()%4 /*use 40 digits, but only show 1/4 that*/
x0=0; x1=10; w=digits()%2; dx= .1 /*set X0 & X1; calculate W & DX */
numeric digits 40; f=digits() % 4 /*use 40 decimal digs, but only show 10*/
x0=0; x1=10; dx= .1 /*define variables: X0 X1 DX */
n=1 + (x1-x0) / dx
y.=1; do m=1 for n-1; mm=m-1
y.m=RK4(dx, x0+dx*mm, y.mm) /*use 4th order Runge─Kutta.*/
end /*m*/
y.=1; do m=1 for n-1; p=m-1; y.m=RK4(dx, x0 + dx*p, y.p)
end /*m*/ /* [↑] use 4th order Runge─Kutta. */
w=digits() % 2 /*W: width used for displaying numbers.*/
say center('X', f, "═") center('Y', w+2, "═") center("relative error", w+8, '═') /*hdr*/
say center('X', f, "═") center('Y', w+2, "═") center("relative error", w+8, '═')
do i=0 to n-1 by 10; x=(x0+dx*i)/1; $=y.i / (x*x/4+1)**2 - 1
say center(x,f) fmt(y.i) left('', 2 + ($>=0)) fmt($)
end /*i*/
do i=0 to n-1 by 10; x=(x0 + dx*i) / 1; $=y.i/(x*x/4+1)**2 -1
say center(x, f) fmt(y.i) left('', 2 + ($>=0) ) fmt($)
end /*i*/ /*└┴┴┴───◄─────── aligns positive #'s. */
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
fmt: z=right( format( arg(1), w, f), w); hasE=pos('E', z)\==0 /*right adjust number.*/
if pos(.,z)\==0 & \hasE then z=left( strip( strip(z, 'T', 0), "T", .), w)
return translate(right(z, (z>=0) + w + 5*hasE), 'e', "E") /*Positive | E, adjust*/
fmt: z=right( format( arg(1), w, f), w); hasE=pos('E', z)\==0; has.=pos(., z)\==0
jus=has. & \hasE; if jus then z=left( strip( strip(z, 'T', 0), "T", .), w)
return translate(right(z, (z>=0) + w + 5*hasE + 2*(jus & (z<0) ) ), 'e', "E")
/*──────────────────────────────────────────────────────────────────────────────────────*/
rate: return arg(1) * sqrt( arg(2) ) /*compute the rate. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
RK4: procedure; parse arg dx,x,y; k1= dx * rate( x , y )
k2= dx * rate( x +dx/2 , y +k1/2 )
k3= dx * rate( x +dx/2 , y +k2/2 )
k4= dx * rate( x +dx , y +k3 )
return y + (k1 + k2+k2 + k3+k3 + k4) / 6
RK4: procedure; parse arg dx,x,y; dxH=dx/2; k1= dx * (x ) * sqrt(y )
k2= dx * (x + dxH) * sqrt(y + k1/2)
k3= dx * (x + dxH) * sqrt(y + k2/2)
k4= dx * (x + dx ) * sqrt(y + k3 )
return y + (k1 + k2*2 + k3*2 + k4) / 6
/*──────────────────────────────────────────────────────────────────────────────────────*/
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); m.=9; numeric form; h=d+6
numeric digits; parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_ %2
do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/
do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/
numeric digits d; return g/1
numeric digits; parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g * .5'e'_ % 2
do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/
do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/; return g