Data commit

Task/Runge-Kutta-method/Haskell/runge-kutta-method-1.hs

@@ -0,0 +1,25 @@
+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 . (\(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)

Task/Runge-Kutta-method/Haskell/runge-kutta-method-2.hs

@@ -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)

Task/Runge-Kutta-method/Haskell/runge-kutta-method-3.hs

@@ -0,0 +1,45 @@
+rk4 :: Double -> Double -> Double -> Double
+rk4 y x dx =
+  let f x y = x * sqrt y
+      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)
+  in y + (k1 + 2.0 * k2 + 2.0 * k3 + k4) / 6.0
+
+actual :: Double -> Double
+actual x = (1 / 16) * (x * x + 4) * (x * x + 4)
+
+step :: Double
+step = 0.1
+
+ixs :: [Int]
+ixs = [0 .. 100]
+
+xys :: [(Double, Double)]
+xys =
+  scanl
+    (\(x, y) _ -> (((x * 10) + (step * 10)) / 10, rk4 y x step))
+    (0.0, 1.0)
+    ixs
+
+samples :: [(Double, Double, Double)]
+samples =
+  zip ixs xys >>=
+  (\(i, (x, y)) ->
+      [ (x, y, actual x - y)
+      | 0 == mod i 10 ])
+
+main :: IO ()
+main =
+  (putStrLn . unlines) $
+  (\(x, y, v) ->
+      unwords
+        [ "y" ++ justifyRight 3 ' ' ('(' : show (round x)) ++ ") = "
+        , justifyLeft 19 ' ' (show y)
+        , '±' : show v
+        ]) <$>
+  samples
+  where
+    justifyLeft n c s = take n (s ++ replicate n c)
+    justifyRight n c s = drop (length s) (replicate n c ++ s)