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

Update all new Tasks

Browse source
This commit is contained in:
Ingy döt Net 2015-02-20 09:02:09 -05:00
parent 00a190b0a6
commit 91df62d461
5697 changed files with 93386 additions and 804 deletions
Download patch file Download diff file Expand all files Collapse all files

19
Task/Runge-Kutta-method/00DESCRIPTION Normal file
View file

@ -0,0 +1,19 @@
Given the example Differential equation:
:<math>y'(t) = t \times \sqrt {y(t)}</math>
With initial condition:
:<math>t_0 = 0</math> and <math>y_0 = y(t_0) = y(0) = 1</math>
This equation has an exact solution:
:<math>y(t) = \tfrac{1}{16}(t^2 +4)^2</math>
;Task
Demonstrate the commonly used explicit [[wp:Runge–Kutta_methods#Common_fourth-order_Runge.E2.80.93Kutta_method|fourth-order Runge–Kutta method]] to solve the above differential equation.
* Solve the given differential equation over the range <math>t = 0 \ldots 10</math> with a step value of <math>\delta t=0.1</math> (101 total points, the first being given)
* Print the calculated values of <math>y</math> at whole numbered <math>t</math>'s (<math>0.0, 1.0, \ldots 10.0</math>) along with error as compared to the exact solution.
;Method summary
Starting with a given <math>y_n</math> and <math>t_n</math> calculate:
:<math>\delta y_1 = \delta t\times y'(t_n, y_n)\quad</math>
:<math>\delta y_2 = \delta t\times y'(t_n + \tfrac{1}{2}\delta t , y_n + \tfrac{1}{2}\delta y_1)</math>
:<math>\delta y_3 = \delta t\times y'(t_n + \tfrac{1}{2}\delta t , y_n + \tfrac{1}{2}\delta y_2)</math>
:<math>\delta y_4 = \delta t\times y'(t_n + \delta t , y_n + \delta y_3)\quad</math>
then:
:<math>y_{n+1} = y_n + \tfrac{1}{6} (\delta y_1 + 2\delta y_2 + 2\delta y_3 + \delta y_4)</math>
:<math>t_{n+1} = t_n + \delta t\quad</math>

2
Task/Runge-Kutta-method/00META.yaml Normal file
View file

@ -0,0 +1,2 @@
---
note: Runge-Kutta method

19
Task/Runge-Kutta-method/AWK/runge-kutta-method.awk Normal file
View file

@ -0,0 +1,19 @@
# syntax: GAWK -f RUNGE-KUTTA_METHOD.AWK
# converted from BBC BASIC
BEGIN {
print(" t y error")
y = 1
for (i=0; i<=100; i++) {
t = i / 10
if (t == int(t)) {
actual = ((t^2+4)^2) / 16
printf("%2d %12.7f %g\n",t,y,actual-y)
}
k1 = t * sqrt(y)
k2 = (t + 0.05) * sqrt(y + 0.05 * k1)
k3 = (t + 0.05) * sqrt(y + 0.05 * k2)
k4 = (t + 0.10) * sqrt(y + 0.10 * k3)
y += 0.1 * (k1 + 2 * (k2 + k3) + k4) / 6
}
exit(0)
}

52
Task/Runge-Kutta-method/Ada/runge-kutta-method.ada Normal file
View file

@ -0,0 +1,52 @@
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Numerics.Generic_Elementary_Functions;
procedure RungeKutta is
type Floaty is digits 15;
type Floaty_Array is array (Natural range <>) of Floaty;
package FIO is new Ada.Text_IO.Float_IO(Floaty); use FIO;
type Derivative is access function(t, y : Floaty) return Floaty;
package Math is new Ada.Numerics.Generic_Elementary_Functions (Floaty);
function calc_err (t, calc : Floaty) return Floaty;
procedure Runge (yp_func : Derivative; t, y : in out Floaty_Array;
dt : Floaty) is
dy1, dy2, dy3, dy4 : Floaty;
begin
for n in t'First .. t'Last-1 loop
dy1 := dt * yp_func(t(n), y(n));
dy2 := dt * yp_func(t(n) + dt / 2.0, y(n) + dy1 / 2.0);
dy3 := dt * yp_func(t(n) + dt / 2.0, y(n) + dy2 / 2.0);
dy4 := dt * yp_func(t(n) + dt, y(n) + dy3);
t(n+1) := t(n) + dt;
y(n+1) := y(n) + (dy1 + 2.0 * (dy2 + dy3) + dy4) / 6.0;
end loop;
end Runge;
procedure Print (t, y : Floaty_Array; modnum : Positive) is begin
for i in t'Range loop
if i mod modnum = 0 then
Put("y("); Put (t(i), Exp=>0, Fore=>0, Aft=>1);
Put(") = "); Put (y(i), Exp=>0, Fore=>0, Aft=>8);
Put(" Error:"); Put (calc_err(t(i),y(i)), Aft=>5);
New_Line;
end if;
end loop;
end Print;
function yprime (t, y : Floaty) return Floaty is begin
return t * Math.Sqrt (y);
end yprime;
function calc_err (t, calc : Floaty) return Floaty is
actual : constant Floaty := (t**2 + 4.0)**2 / 16.0;
begin return abs(actual-calc);
end calc_err;
dt : constant Floaty := 0.10;
N : constant Positive := 100;
t_arr, y_arr : Floaty_Array(0 .. N);
begin
t_arr(0) := 0.0;
y_arr(0) := 1.0;
Runge (yprime'Access, t_arr, y_arr, dt);
Print (t_arr, y_arr, 10);
end RungeKutta;

15
Task/Runge-Kutta-method/BASIC/runge-kutta-method.basic Normal file
View file

@ -0,0 +1,15 @@
y = 1.0
FOR i% = 0 TO 100
t = i% / 10
IF t = INT(t) THEN
actual = ((t^2 + 4)^2) / 16
PRINT "y("; t ") = "; y TAB(20) "Error = "; actual - y
ENDIF
k1 = t * SQR(y)
k2 = (t + 0.05) * SQR(y + 0.05 * k1)
k3 = (t + 0.05) * SQR(y + 0.05 * k2)
k4 = (t + 0.10) * SQR(y + 0.10 * k3)
y += 0.1 * (k1 + 2 * (k2 + k3) + k4) / 6
NEXT i%

37
Task/Runge-Kutta-method/C/runge-kutta-method.c Normal file
View file

@ -0,0 +1,37 @@
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
double rk4(double(*f)(double, double), double dx, double x, double y)
{
double k1 = dx * f(x, y),
k2 = dx * f(x + dx / 2, y + k1 / 2),
k3 = dx * f(x + dx / 2, y + k2 / 2),
k4 = dx * f(x + dx, y + k3);
return y + (k1 + 2 * k2 + 2 * k3 + k4) / 6;
}
double rate(double x, double y)
{
return x * sqrt(y);
}
int main(void)
{
double *y, x, y2;
double x0 = 0, x1 = 10, dx = .1;
int i, n = 1 + (x1 - x0)/dx;
y = malloc(sizeof(double) * n);
for (y[0] = 1, i = 1; i < n; i++)
y[i] = rk4(rate, dx, x0 + dx * (i - 1), y[i-1]);
printf("x\ty\trel. err.\n------------\n");
for (i = 0; i < n; i += 10) {
x = x0 + dx * i;
y2 = pow(x * x / 4 + 1, 2);
printf("%g\t%g\t%g\n", x, y[i], y[i]/y2 - 1);
}
return 0;
}

38
Task/Runge-Kutta-method/D/runge-kutta-method.d Normal file
View file

@ -0,0 +1,38 @@
import std.stdio, std.math, std.typecons;
alias FP = real;
alias FPs = Typedef!(FP[101]);
void runge(in FP function(in FP, in FP)
pure nothrow @safe @nogc yp_func,
ref FPs t, ref FPs y, in FP dt) pure nothrow @safe @nogc {
foreach (immutable n; 0 .. t.length - 1) {
immutable FP
dy1 = dt * yp_func(t[n], y[n]),
dy2 = dt * yp_func(t[n] + dt / 2.0, y[n] + dy1 / 2.0),
dy3 = dt * yp_func(t[n] + dt / 2.0, y[n] + dy2 / 2.0),
dy4 = dt * yp_func(t[n] + dt, y[n] + dy3);
t[n + 1] = t[n] + dt;
y[n + 1] = y[n] + (dy1 + 2.0 * (dy2 + dy3) + dy4) / 6.0;
}
}
FP calc_err(in FP t, in FP calc) pure nothrow @safe @nogc {
immutable FP actual = (t ^^ 2 + 4.0) ^^ 2 / 16.0;
return abs(actual - calc);
}
void main() {
enum FP dt = 0.10;
FPs t_arr, y_arr;
t_arr[0] = 0.0;
y_arr[0] = 1.0;
runge((t, y) => t * y.sqrt, t_arr, y_arr, dt);
foreach (immutable i; 0 .. t_arr.length)
if (i % 10 == 0)
writefln("y(%.1f) = %.8f Error: %.6g",
t_arr[i], y_arr[i],
calc_err(t_arr[i], y_arr[i]));
}

27
Task/Runge-Kutta-method/Dart/runge-kutta-method.dart Normal file
View file

@ -0,0 +1,27 @@
import 'dart:math' as Math;
num RungeKutta4(Function f, num t, num y, num dt){
num k1 = dt * f(t,y);
num k2 = dt * f(t+0.5*dt, y + 0.5*k1);
num k3 = dt * f(t+0.5*dt, y + 0.5*k2);
num k4 = dt * f(t + dt, y + k3);
return y + (1/6) * (k1 + 2*k2 + 2*k3 + k4);
}
void main(){
num t = 0;
num dt = 0.1;
num tf = 10;
num totalPoints = ((tf-t)/dt).floor()+1;
num y = 1;
Function f = (num t, num y) => t * Math.sqrt(y);
Function actual = (num t) => (1/16) * (t*t+4)*(t*t+4);
for (num i = 0; i <= totalPoints; i++){
num relativeError = (actual(t) - y)/actual(t);
if (i%10 == 0){
print('y(${t.round().toStringAsPrecision(3)}) = ${y.toStringAsPrecision(11)} Error = ${relativeError.toStringAsPrecision(11)}');
}
y = RungeKutta4(f, t, y, dt);
t += dt;
}
}

21
Task/Runge-Kutta-method/F-Sharp/runge-kutta-method.fs Normal file
View file

@ -0,0 +1,21 @@
open System
let y'(t,y) = t * sqrt(y)
let RungeKutta4 t0 y0 t_max dt =
let dy1(t,y) = dt * y'(t,y)
let dy2(t,y) = dt * y'(t+dt/2.0, y+dy1(t,y)/2.0)
let dy3(t,y) = dt * y'(t+dt/2.0, y+dy2(t,y)/2.0)
let dy4(t,y) = dt * y'(t+dt, y+dy3(t,y))
(t0,y0) |> Seq.unfold (fun (t,y) ->
if ( t <= t_max) then Some((t,y), (Math.Round(t+dt, 6), y + ( dy1(t,y) + 2.0*dy2(t,y) + 2.0*dy3(t,y) + dy4(t,y))/6.0))
else None
)
let y_exact t = (pown (pown t 2 + 4.0) 2)/16.0
RungeKutta4 0.0 1.0 10.0 0.1
|> Seq.filter (fun (t,y) -> t % 1.0 = 0.0 )
|> Seq.iter (fun (t,y) -> Console.WriteLine("y({0})={1}\t(relative error:{2})", t, y, (y / y_exact(t))-1.0) )

29
Task/Runge-Kutta-method/Fortran/runge-kutta-method.f Normal file
View file

@ -0,0 +1,29 @@
program rungekutta
implicit none
real(kind=kind(1.0D0)) :: t,dt,tstart,tstop
real(kind=kind(1.0D0)) :: y,k1,k2,k3,k4
tstart =0.0D0 ; tstop =10.0D0 ; dt = 0.1D0
y = 1.0D0
t = tstart
write(6,'(A,f4.1,A,f12.8,A,es13.6)') 'y(',t,') = ',y,' Error = '&
&,abs(y-(t**2+4.0d0)**2/16.0d0)
do; if ( t .ge. tstop ) exit
k1 = f (t , y )
k2 = f (t+0.5D0 * dt, y +0.5D0 * dt * k1)
k3 = f (t+0.5D0 * dt, y +0.5D0 * dt * k2)
k4 = f (t+ dt, y + dt * k3)
y = y + dt *( k1 + 2.0D0 *( k2 + k3 ) + k4 )/6.0D0
t = t + dt
if(abs(real(nint(t))-t) .le. 1.0D-12) then
write(6,'(A,f4.1,A,f12.8,A,es13.6)') 'y(',t,') = ',y,' Error = '&
&,abs(y-(t**2+4.0d0)**2/16.0d0)
end if
end do
contains
function f (t,y)
implicit none
real(kind=kind(1.0D0)),intent(in) :: y,t
real(kind=kind(1.0D0)) :: f
f = t*sqrt(y)
end function f
end program rungekutta

57
Task/Runge-Kutta-method/Go/runge-kutta-method.go Normal file
View file

@ -0,0 +1,57 @@
package main
import (
"fmt"
"math"
)
type ypFunc func(t, y float64) float64
type ypStepFunc func(t, y, dt float64) float64
// newRKStep takes a function representing a differential equation
// and returns a function that performs a single step of the forth-order
// Runge-Kutta method.
func newRK4Step(yp ypFunc) ypStepFunc {
return func(t, y, dt float64) float64 {
dy1 := dt * yp(t, y)
dy2 := dt * yp(t+dt/2, y+dy1/2)
dy3 := dt * yp(t+dt/2, y+dy2/2)
dy4 := dt * yp(t+dt, y+dy3)
return y + (dy1+2*(dy2+dy3)+dy4)/6
}
}
// example differential equation
func yprime(t, y float64) float64 {
return t * math.Sqrt(y)
}
// exact solution of example
func actual(t float64) float64 {
t = t*t + 4
return t * t / 16
}
func main() {
t0, tFinal := 0, 10 // task specifies times as integers,
dtPrint := 1 // and to print at whole numbers.
y0 := 1. // initial y.
dtStep := .1 // step value.
t, y := float64(t0), y0
ypStep := newRK4Step(yprime)
for t1 := t0 + dtPrint; t1 <= tFinal; t1 += dtPrint {
printErr(t, y) // print intermediate result
for steps := int(float64(dtPrint)/dtStep + .5); steps > 1; steps-- {
y = ypStep(t, y, dtStep)
t += dtStep
}
y = ypStep(t, y, float64(t1)-t) // adjust step to integer time
t = float64(t1)
}
printErr(t, y) // print final result
}
func printErr(t, y float64) {
fmt.Printf("y(%.1f) = %f Error: %e\n", t, y, math.Abs(actual(t)-y))
}

17
Task/Runge-Kutta-method/Haskell/runge-kutta-method-1.hs Normal file
View file

@ -0,0 +1,17 @@
import Data.List
dv :: Floating a => a -> a -> a
dv = (. sqrt). (*)
fy t = 1/16 * (4+t^2)^2
rk4 :: (Enum a, Fractional a)=> (a -> a -> a) -> a -> a -> a -> [(a,a)]
rk4 fd y0 a h = zip ts $ scanl (flip fc) y0 ts where
ts = [a,h ..]
fc t y = sum. (y:). zipWith (*) [1/6,1/3,1/3,1/6]
$ scanl (\k f -> h * fd (t+f*h) (y+f*k)) (h * fd t y) [1/2,1/2,1]
task = mapM_ print
$ map (\(x,y)-> (truncate x,y,fy x - y))
$ filter (\(x,_) -> 0== mod (truncate $ 10*x) 10)
$ take 101 $ rk4 dv 1.0 0 0.1

12
Task/Runge-Kutta-method/Haskell/runge-kutta-method-2.hs Normal file
View file

@ -0,0 +1,12 @@
*Main> task
(0,1.0,0.0)
(1,1.5624998542781088,1.4572189122041834e-7)
(2,3.9999990805208006,9.194792029987298e-7)
(3,10.562497090437557,2.909562461184123e-6)
(4,24.999993765090654,6.234909399438493e-6)
(5,52.56248918030265,1.0819697635611192e-5)
(6,99.99998340540378,1.6594596999652822e-5)
(7,175.56247648227165,2.3517730085131916e-5)
(8,288.99996843479926,3.1565204153594095e-5)
(9,451.562459276841,4.0723166534917254e-5)
(10,675.9999490167125,5.098330132113915e-5)

18
Task/Runge-Kutta-method/J/runge-kutta-method-1.j Normal file
View file

@ -0,0 +1,18 @@
NB.*rk4 a Solve function using Runge-Kutta method
NB. y is: y(ta) , ta , tb , tstep
NB. u is: function to solve
NB. eg: fyp rk4 1 0 10 0.1
rk4=: adverb define
'Y0 a b h'=. 4{. y
T=. a + i.@>:&.(%&h) b - a
Y=. Yt=. Y0
for_t. }: T do.
ty=. t,Yt
k1=. h * u ty
k2=. h * u ty + -: h,k1
k3=. h * u ty + -: h,k2
k4=. h * u ty + h,k3
Y=. Y, Yt=. Yt + (%6) * 1 2 2 1 +/@:* k1, k2, k3, k4
end.
T ,. Y
)

17
Task/Runge-Kutta-method/J/runge-kutta-method-2.j Normal file
View file

@ -0,0 +1,17 @@
fy=: (%16) * [: *: 4 + *: NB. f(t,y)
fyp=: (* %:)/ NB. f'(t,y)
report_whole=: (10 * i. >:10)&{ NB. report at whole-numbered t values
report_err=: (, {: - [: fy {.)"1 NB. report errors
report_err report_whole fyp rk4 1 0 10 0.1
0 1 0
1 1.5625 _1.45722e_7
2 4 _9.19479e_7
3 10.5625 _2.90956e_6
4 25 _6.23491e_6
5 52.5625 _1.08197e_5
6 100 _1.65946e_5
7 175.562 _2.35177e_5
8 289 _3.15652e_5
9 451.562 _4.07232e_5
10 676 _5.09833e_5

17
Task/Runge-Kutta-method/J/runge-kutta-method-3.j Normal file
View file

@ -0,0 +1,17 @@
rk4=: adverb define
'Y0 a b h'=. 4{. y
T=. a + i.@>:&.(%&h) b-a
(,. [: h&(u nextY)@,/\. Y0 ,~ }.)&.|. T
)
NB. nextY a Calculate Yn+1 of a function using Runge-Kutta method
NB. y is: 2-item numeric list of time t and y(t)
NB. u is: function to use
NB. x is: step size
NB. eg: 0.001 fyp nextY 0 1
nextY=: adverb define
:
tableau=. 1 0.5 0.5, x * u y
ks=. (x * [: u y + (* x&,))/\. tableau
({:y) + 6 %~ +/ 1 2 2 1 * ks
)

36
Task/Runge-Kutta-method/JavaScript/runge-kutta-method.js Normal file
View file

@ -0,0 +1,36 @@
function rk4(y, x, dx, f) {
var k1 = dx * f(x, y),
k2 = dx * f(x + dx / 2.0, +y + k1 / 2.0),
k3 = dx * f(x + dx / 2.0, +y + k2 / 2.0),
k4 = dx * f(x + dx, +y + k3);
return y + (k1 + 2.0 * k2 + 2.0 * k3 + k4) / 6.0;
}
function f(x, y) {
return x * Math.sqrt(y);
}
function actual(x) {
return (1/16) * (x*x+4)*(x*x+4);
}
var y = 1.0,
x = 0.0,
step = 0.1,
steps = 0,
maxSteps = 101,
sampleEveryN = 10;
while (steps < maxSteps) {
if (steps%sampleEveryN === 0) {
console.log("y(" + x + ") = \t" + y + "\t ± " + (actual(x) - y).toExponential());
}
y = rk4(y, x, step, f);
// using integer math for the step addition
// to prevent floating point errors as 0.2 + 0.1 != 0.3
x = ((x * 10) + (step * 10)) / 10;
steps += 1;
}

33
Task/Runge-Kutta-method/Julia/runge-kutta-method.julia Normal file
View file

@ -0,0 +1,33 @@
function rk4(f)
return (t,y,dt)->
( (dy1 )->
( (dy2 )->
( (dy3 )->
( (dy4 )->( dy1 + 2*dy2 + 2*dy3 + dy4 ) / 6
)( dt * f( t +dt , y + dy3 ) )
)( dt * f( t +dt/2, y + dy2/2 ) )
)( dt * f( t +dt/2, y + dy1/2 ) )
)( dt * f( t , y ) )
end
theory(t) = (t^2 + 4.0)^2 / 16.0
tmax = 10.0
ttol = 1.e-5
t0 = 0.0
y0 = 1.0
dt = 0.1
dy = rk4( (t,y) -> t*sqrt(y) )
t = t0
y = y0
while t <= tmax
if abs(round(t) - t) < ttol
@printf( STDOUT,"y(%4.1f)\t= %12.6f \t error: %12.6e\n",t,y,abs(y-theory(t)) )
end
y = y + dy(t,y,dt)
t = t + dt
end

37
Task/Runge-Kutta-method/MATLAB/runge-kutta-method.m Normal file
View file

@ -0,0 +1,37 @@
function testRK4Programs
figure
hold on
t = 0:0.1:10;
y = 0.0625.*(t.^2+4).^2;
plot(t, y, '-k')
[tode4, yode4] = testODE4(t);
plot(tode4, yode4, '--b')
[trk4, yrk4] = testRK4(t);
plot(trk4, yrk4, ':r')
legend('Exact', 'ODE4', 'RK4')
hold off
fprintf('Time\tExactVal\tODE4Val\tODE4Error\tRK4Val\tRK4Error\n')
for k = 1:10:length(t)
fprintf('%.f\t\t%7.3f\t\t%7.3f\t%7.3g\t%7.3f\t%7.3g\n', t(k), y(k), ...
yode4(k), abs(y(k)-yode4(k)), yrk4(k), abs(y(k)-yrk4(k)))
end
end
function [t, y] = testODE4(t)
y0 = 1;
y = ode4(@(tVal,yVal)tVal*sqrt(yVal), t, y0);
end
function [t, y] = testRK4(t)
dydt = @(tVal,yVal)tVal*sqrt(yVal);
y = zeros(size(t));
y(1) = 1;
for k = 1:length(t)-1
dt = t(k+1)-t(k);
dy1 = dt*dydt(t(k), y(k));
dy2 = dt*dydt(t(k)+0.5*dt, y(k)+0.5*dy1);
dy3 = dt*dydt(t(k)+0.5*dt, y(k)+0.5*dy2);
dy4 = dt*dydt(t(k)+dt, y(k)+dy3);
y(k+1) = y(k)+(dy1+2*dy2+2*dy3+dy4)/6;
end
end

20
Task/Runge-Kutta-method/Mathematica/runge-kutta-method.math Normal file
View file

@ -0,0 +1,20 @@
(* Symbolic solution *)
DSolve[{y'[t] == t*Sqrt[y[t]], y[0] == 1}, y, t]
Table[{t, 1/16 (4 + t^2)^2}, {t, 0, 10}]
(* Numerical solution I (not RK4) *)
Table[{t, y[t], Abs[y[t] - 1/16*(4 + t^2)^2]}, {t, 0, 10}] /.
First@NDSolve[{y'[t] == t*Sqrt[y[t]], y[0] == 1}, y, {t, 0, 10}]
(* Numerical solution II (RK4) *)
f[{t_, y_}] := {1, t Sqrt[y]}
h = 0.1;
phi[y_] := Module[{k1, k2, k3, k4},
k1 = h*f[y];
k2 = h*f[y + 1/2 k1];
k3 = h*f[y + 1/2 k2];
k4 = h*f[y + k3];
y + k1/6 + k2/3 + k3/3 + k4/6]
solution = NestList[phi, {0, 1}, 101];
Table[{y[[1]], y[[2]], Abs[y[[2]] - 1/16 (y[[1]]^2 + 4)^2]},
{y, solution[[1 ;; 101 ;; 10]]}]

40
Task/Runge-Kutta-method/Maxima/runge-kutta-method.maxima Normal file
View file

@ -0,0 +1,40 @@
/* Here is how to solve a differential equation */
'diff(y, x) = x * sqrt(y);
ode2(%, y, x);
ic1(%, x = 0, y = 1);
factor(solve(%, y)); /* [y = (x^2 + 4)^2 / 16] */
/* The Runge-Kutta solver is builtin */
load(dynamics)$
sol: rk(t * sqrt(y), y, 1, [t, 0, 10, 1.0])$
plot2d([discrete, sol])$
/* An implementation of RK4 for one equation */
rk4(f, x0, y0, x1, n) := block([h, x, y, vx, vy, k1, k2, k3, k4],
h: bfloat((x1 - x0) / (n - 1)),
x: x0,
y: y0,
vx: makelist(0, n + 1),
vy: makelist(0, n + 1),
vx[1]: x0,
vy[1]: y0,
for i from 1 thru n do (
k1: bfloat(h * f(x, y)),
k2: bfloat(h * f(x + h / 2, y + k1 / 2)),
k3: bfloat(h * f(x + h / 2, y + k2 / 2)),
k4: bfloat(h * f(x + h, y + k3)),
vy[i + 1]: y: y + (k1 + 2 * k2 + 2 * k3 + k4) / 6,
vx[i + 1]: x: x + h
),
[vx, vy]
)$
[x, y]: rk4(lambda([x, y], x * sqrt(y)), 0, 1, 10, 101)$
plot2d([discrete, x, y])$
s: map(lambda([x], (x^2 + 4)^2 / 16), x)$
for i from 1 step 10 thru 101 do print(x[i], " ", y[i], " ", y[i] - s[i]);

16
Task/Runge-Kutta-method/OCaml/runge-kutta-method.ocaml Normal file
View file

@ -0,0 +1,16 @@
let y' t y = t *. sqrt y
let exact t = let u = 0.25*.t*.t +. 1.0 in u*.u
let rk4_step (y,t) h =
let k1 = h *. y' t y in
let k2 = h *. y' (t +. 0.5*.h) (y +. 0.5*.k1) in
let k3 = h *. y' (t +. 0.5*.h) (y +. 0.5*.k2) in
let k4 = h *. y' (t +. h) (y +. k3) in
(y +. (k1+.k4)/.6.0 +. (k2+.k3)/.3.0, t +. h)
let rec loop h n (y,t) =
if n mod 10 = 1 then
Printf.printf "t = %f,\ty = %f,\terr = %g\n" t y (abs_float (y -. exact t));
if n < 102 then loop h (n+1) (rk4_step (y,t) h)
let _ = loop 0.1 1 (1.0, 0.0)

8
Task/Runge-Kutta-method/Octave/runge-kutta-method.octave Normal file
View file

@ -0,0 +1,8 @@
function ydot = f(y, t)
ydot = t * sqrt( y );
endfunction
t = [0:10]';
y = lsode("f", 1, t);
[ t, y, y - 1/16 * (t.**2 + 4).**2 ]

16
Task/Runge-Kutta-method/PARI-GP/runge-kutta-method.pari Normal file
View file

@ -0,0 +1,16 @@
rk4(f,dx,x,y)={
my(k1=dx*f(x,y), k2=dx*f(x+dx/2,y+k1/2), k3=dx*f(x+dx/2,y+k2/2), k4=dx*f(x+dx,y+k3));
y + (k1 + 2*k2 + 2*k3 + k4) / 6
};
rate(x,y)=x*sqrt(y);
go()={
my(x0=0,x1=10,dx=.1,n=1+(x1-x0)\dx,y=vector(n));
y[1]=1;
for(i=2,n,y[i]=rk4(rate, dx, x0 + dx * (i - 1), y[i-1]));
print("x\ty\trel. err.\n------------");
forstep(i=1,n,10,
my(x=x0+dx*i,y2=(x^2/4+1)^2);
print(x "\t" y[i] "\t" y[i]/y2 - 1)
)
};
go()

25
Task/Runge-Kutta-method/PL-I/runge-kutta-method.pli Normal file
View file

@ -0,0 +1,25 @@
Runge_Kutta: procedure options (main); /* 10 March 2014 */
declare (y, dy1, dy2, dy3, dy4) float (18);
declare t fixed decimal (10,1);
declare dt float (18) static initial (0.1);
y = 1;
do t = 0 to 10 by 0.1;
dy1 = dt * ydash(t, y);
dy2 = dt * ydash(t + dt/2, y + dy1/2);
dy3 = dt * ydash(t + dt/2, y + dy2/2);
dy4 = dt * ydash(t + dt, y + dy3);
if mod(t, 1.0) = 0 then
put skip edit('y(', trim(t), ')=', y, ', error = ', abs(y - (t**2 + 4)**2 / 16 ))
(3 a, column(9), f(16,10), a, f(13,10));
y = y + (dy1 + 2*dy2 + 2*dy3 + dy4)/6;
end;
ydash: procedure (t, y) returns (float(18));
declare (t, y) float (18) nonassignable;
return ( t*sqrt(y) );
end ydash;
end Runge_kutta;

71
Task/Runge-Kutta-method/Pascal/runge-kutta-method.pascal Normal file
View file

@ -0,0 +1,71 @@
program RungeKuttaExample;
uses sysutils;
type
TDerivative = function (t, y : Real) : Real;
procedure RungeKutta(yDer : TDerivative;
var t, y : array of Real;
dt : Real);
var
dy1, dy2, dy3, dy4 : Real;
idx : Cardinal;
begin
for idx := Low(t) to High(t) - 1 do
begin
dy1 := dt * yDer(t[idx], y[idx]);
dy2 := dt * yDer(t[idx] + dt / 2.0, y[idx] + dy1 / 2.0);
dy3 := dt * yDer(t[idx] + dt / 2.0, y[idx] + dy2 / 2.0);
dy4 := dt * yDer(t[idx] + dt, y[idx] + dy3);
t[idx + 1] := t[idx] + dt;
y[idx + 1] := y[idx] + (dy1 + 2.0 * (dy2 + dy3) + dy4) / 6.0;
end;
end;
function CalcError(t, y : Real) : Real;
var
trueVal : Real;
begin
trueVal := sqr(sqr(t) + 4.0) / 16.0;
CalcError := abs(trueVal - y);
end;
procedure Print(t, y : array of Real;
modnum : Integer);
var
idx : Cardinal;
begin
for idx := Low(t) to High(t) do
begin
if idx mod modnum = 0 then
begin
WriteLn(Format('y(%4.1f) = %12.8f Error: %12.6e',
[t[idx], y[idx], CalcError(t[idx], y[idx])]));
end;
end;
end;
function YPrime(t, y : Real) : Real;
begin
YPrime := t * sqrt(y);
end;
const
dt = 0.10;
N = 100;
var
tArr, yArr : array [0..N] of Real;
begin
tArr[0] := 0.0;
yArr[0] := 1.0;
RungeKutta(@YPrime, tArr, yArr, dt);
Print(tArr, yArr, 10);
end.

21
Task/Runge-Kutta-method/Perl-6/runge-kutta-method.pl6 Normal file
View file

@ -0,0 +1,21 @@
sub runge-kutta(&yp) {
return -> \t, \y, \δt {
my $a = δt * yp( t, y );
my $b = δt * yp( t + δt/2, y + $a/2 );
my $c = δt * yp( t + δt/2, y + $b/2 );
my $d = δt * yp( t + δt, y + $c );
($a + 2*($b + $c) + $d) / 6;
}
}
constant δt = .1;
my &δy = runge-kutta { $^t * sqrt($^y) };
loop (
my ($t, $y) = (0, 1);
$t <= 10;
($t, $y) = ($t + δt, $y + δy($t, $y, δt))
) {
printf "y(%2d) = %12f ± %e\n", $t, $y, abs($y - ($t**2 + 4)**2 / 16)
if $t.narrow ~~ Int;
}

22
Task/Runge-Kutta-method/Perl/runge-kutta-method.pl Normal file
View file

@ -0,0 +1,22 @@
sub runge_kutta {
my ($yp, $dt) = @_;
sub {
my ($t, $y) = @_;
my @dy = $dt * $yp->( $t , $y );
push @dy, $dt * $yp->( $t + $dt/2, $y + $dy[0]/2 );
push @dy, $dt * $yp->( $t + $dt/2, $y + $dy[1]/2 );
push @dy, $dt * $yp->( $t + $dt , $y + $dy[2] );
return $t + $dt, $y + ($dy[0] + 2*$dy[1] + 2*$dy[2] + $dy[3]) / 6;
}
}
my $RK = runge_kutta sub { $_[0] * sqrt $_[1] }, .1;
for(
my ($t, $y) = (0, 1);
sprintf("%.0f", $t) <= 10;
($t, $y) = $RK->($t, $y)
) {
printf "y(%2.0f) = %12f ± %e\n", $t, $y, abs($y - ($t**2 + 4)**2 / 16)
if sprintf("%.4f", $t) =~ /0000$/;
}

21
Task/Runge-Kutta-method/Python/runge-kutta-method.py Normal file
View file

@ -0,0 +1,21 @@
def RK4(f):
return lambda t, y, dt: (
lambda dy1: (
lambda dy2: (
lambda dy3: (
lambda dy4: (dy1 + 2*dy2 + 2*dy3 + dy4)/6
)( dt * f( t + dt , y + dy3 ) )
)( dt * f( t + dt/2, y + dy2/2 ) )
)( dt * f( t + dt/2, y + dy1/2 ) )
)( dt * f( t , y ) )
def theory(t): return (t**2 + 4)**2 /16
from math import sqrt
dy = RK4(lambda t, y: t*sqrt(y))
t, y, dt = 0., 1., .1
while t <= 10:
if abs(round(t) - t) < 1e-5:
print("y(%2.1f)\t= %4.6f \t error: %4.6g" % ( t, y, abs(y - theory(t))))
t, y = t + dt, y + dy( t, y, dt )

1
Task/Runge-Kutta-method/README Normal file
View file

@ -0,0 +1 @@
Data source: http://rosettacode.org/wiki/Runge-Kutta_method

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

@ -0,0 +1,35 @@
/*REXX program uses the Runge-Kutta method to solve the differential */
/* ____ */
/*equation: y'(t)=t²√y(t) which has the exact solution: y(t)=(t²+4)²/16*/
numeric digits 40; d=digits()%2 /*use forty digits, show ½ that. */
x0=0; x1=10; dx=.1; n=1 + (x1-x0) / dx; y.=1
do m=1 for n-1; mm=m-1
y.m=Runge_Kutta(dx, x0+dx*mm, y.mm)
end /*m*/
say center(x,13,'─') center(y,d,'─') ' ' center('relative error',d,'─')
do i=0 to n-1 by 10; x=(x0+dx*i)/1; y2=(x*x/4+1)**2
relE=format(y.i/y2-1,,13)/1; if relE=0 then relE=' 0'
say center(x,13) right(format(y.i,,12),d) ' ' left(relE,d)
end /*i*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────RATE subroutine─────────────────────*/
rate: return arg(1)*sqrt(arg(2))
/*──────────────────────────────────Runge_Kutta subroutine──────────────*/
Runge_Kutta: 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 + 2*k2 + 2*k3 + k4) / 6
/*──────────────────────────────────SQRT subroutine─────────────────────*/
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits()
numeric digits 11; g=.sqrtG()
do j=0 while p>9; m.j=p; p=p%2+1; end; do k=j+5 to 0 by -1
if m.k>11 then numeric digits m.k
g=.5*(g+x/g); end; numeric digits d; return g/1
.sqrtG: numeric form; m.=11; p=d+d%4+2
parse value format(x,2,1,,0) 'E0' with g 'E' _ .; return g*.5'E'_%2

8
Task/Runge-Kutta-method/Racket/runge-kutta-method-1.rkt Normal file
View file

@ -0,0 +1,8 @@
(define (RK4 F δt)
(λ (t y)
(define δy1 (* δt (F t y)))
(define δy2 (* δt (F (+ t (* 1/2 δt)) (+ y (* 1/2 δy1)))))
(define δy3 (* δt (F (+ t (* 1/2 δt)) (+ y (* 1/2 δy2)))))
(define δy4 (* δt (F (+ t δt) (+ y δy1))))
(list (+ t δt)
(+ y (* 1/6 (+ δy1 (* 2 δy2) (* 2 δy3) δy4))))))

5
Task/Runge-Kutta-method/Racket/runge-kutta-method-2.rkt Normal file
View file

@ -0,0 +1,5 @@
(define ((step-subdivision n method) F h)
(λ (x . y) (last (ODE-solve F (cons x y)
#:x-max (+ x h)
#:step (/ h n)
#:method method))))

10
Task/Runge-Kutta-method/Racket/runge-kutta-method-3.rkt Normal file
View file

@ -0,0 +1,10 @@
(define (F t y) (* t (sqrt y)))
(define (exact-solution t) (* 1/16 (sqr (+ 4 (sqr t)))))
(define numeric-solution
(ODE-solve F '(0 1) #:x-max 10 #:step 1 #:method (step-subdivision 10 RK4)))
(for ([s numeric-solution])
(match-define (list t y) s)
(printf "t=~a\ty=~a\terror=~a\n" t y (- y (exact-solution t))))

4
Task/Runge-Kutta-method/Racket/runge-kutta-method-4.rkt Normal file
View file

@ -0,0 +1,4 @@
> (require plot)
> (plot (list (function exact-solution 0 10 #:label "Exact solution")
(points numeric-solution #:label "Runge-Kutta method"))
#:x-label "t" #:y-label "y(t)")

27
Task/Runge-Kutta-method/Ruby/runge-kutta-method.rb Normal file
View file

@ -0,0 +1,27 @@
def calc_rk4(f)
return ->(t,y,dt){
->(dy1 ){
->(dy2 ){
->(dy3 ){
->(dy4 ){ ( dy1 + 2*dy2 + 2*dy3 + dy4 ) / 6 }.call(
dt * f.call( t + dt , y + dy3 ))}.call(
dt * f.call( t + dt/2, y + dy2/2 ))}.call(
dt * f.call( t + dt/2, y + dy1/2 ))}.call(
dt * f.call( t , y ))}
end
TIME_MAXIMUM, WHOLE_TOLERANCE = 10.0, 1.0e-5
T_START, Y_START, DT = 0.0, 1.0, 0.10
def my_diff_eqn(t,y) ; t * Math.sqrt(y) ; end
def my_solution(t ) ; (t**2 + 4)**2 / 16 ; end
def find_error(t,y) ; (y - my_solution(t)).abs ; end
def is_whole?(t ) ; (t.round - t).abs < WHOLE_TOLERANCE ; end
dy = calc_rk4( ->(t,y){my_diff_eqn(t,y)} )
t, y = T_START, Y_START
while t <= TIME_MAXIMUM
printf("y(%4.1f)\t= %12.6f \t error: %12.6e\n",t,y,find_error(t,y)) if is_whole?(t)
t, y = t + DT, y + dy.call(t,y,DT)
end

12
Task/Runge-Kutta-method/Run-BASIC/runge-kutta-method.run Normal file
View file

@ -0,0 +1,12 @@
y = 1
while t <= 10
k1 = t * sqr(y)
k2 = (t + .05) * sqr(y + .05 * k1)
k3 = (t + .05) * sqr(y + .05 * k2)
k4 = (t + .1) * sqr(y + .1 * k3)
if right$(using("##.#",t),1) = "0" then print "y(";using("##",t);") ="; using("####.#######", y);chr$(9);"Error ="; (((t^2 + 4)^2) /16) -y
y = y + .1 *(k1 + 2 * (k2 + k3) + k4) / 6
t = t + .1
wend
end

41
Task/Runge-Kutta-method/Standard-ML/runge-kutta-method.ml Normal file
View file

@ -0,0 +1,41 @@
fun step y' (tn,yn) dt =
let
val dy1 = dt * y'(tn,yn)
val dy2 = dt * y'(tn + 0.5 * dt, yn + 0.5 * dy1)
val dy3 = dt * y'(tn + 0.5 * dt, yn + 0.5 * dy2)
val dy4 = dt * y'(tn + dt, yn + dy3)
in
(tn + dt, yn + (1.0 / 6.0) * (dy1 + 2.0*dy2 + 2.0*dy3 + dy4))
end
(* Suggested test case *)
fun testy' (t,y) =
t * Math.sqrt y
fun testy t =
(1.0 / 16.0) * Math.pow(Math.pow(t,2.0) + 4.0, 2.0)
(* Test-runner that iterates the step function and prints the results. *)
fun test t0 y0 dt steps print_freq y y' =
let
fun loop i (tn,yn) =
if i = steps then ()
else
let
val (t1,y1) = step y' (tn,yn) dt
val y1' = y tn
val () = if i mod print_freq = 0 then
(print ("Time: " ^ Real.toString tn ^ "\n");
print ("Exact: " ^ Real.toString y1' ^ "\n");
print ("Approx: " ^ Real.toString yn ^ "\n");
print ("Error: " ^ Real.toString (y1' - yn) ^ "\n\n"))
else ()
in
loop (i+1) (t1,y1)
end
in
loop 0 (t0,y0)
end
(* Run the suggested test case *)
val () = test 0.0 1.0 0.1 101 10 testy testy'

33
Task/Runge-Kutta-method/Tcl/runge-kutta-method.tcl Normal file
View file

@ -0,0 +1,33 @@
package require Tcl 8.5
# Hack to bring argument function into expression
proc tcl::mathfunc::dy {t y} {upvar 1 dyFn dyFn; $dyFn $t $y}
proc rk4step {dyFn y* t* dt} {
upvar 1 ${y*} y ${t*} t
set dy1 [expr {$dt * dy($t, $y)}]
set dy2 [expr {$dt * dy($t+$dt/2, $y+$dy1/2)}]
set dy3 [expr {$dt * dy($t+$dt/2, $y+$dy2/2)}]
set dy4 [expr {$dt * dy($t+$dt, $y+$dy3)}]
set y [expr {$y + ($dy1 + 2*$dy2 + 2*$dy3 + $dy4)/6.0}]
set t [expr {$t + $dt}]
}
proc y {t} {expr {($t**2 + 4)**2 / 16}}
proc δy {t y} {expr {$t * sqrt($y)}}
proc printvals {t y} {
set err [expr {abs($y - [y $t])}]
puts [format "y(%.1f) = %.8f\tError: %.8e" $t $y $err]
}
set t 0.0
set y 1.0
set dt 0.1
printvals $t $y
for {set i 1} {$i <= 101} {incr i} {
rk4step δy y t $dt
if {$i%10 == 0} {
printvals $t $y
}
}