単振り子のシミュレーション

Main.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ViewPatterns #-}

module Main where

import Data.Maybe
import Graphics.Gloss
import Numeric.Hamilton
import Numeric.LinearAlgebra.Static hiding ((<>))
import qualified Data.Vector.Sized as V


pendulum :: System 2 1
pendulum = mkSystem' mass transform potential
  where
    mass = vec2 1 1
    transform (V.head -> t) =
      let (x, y) = (sin t, -cos t)
       in fromJust $ V.fromList [x, y]
    potential = V.last -- y座標の値

type Model = Phase 1

draw :: Model -> Picture
draw (Phs qs _) =
  let t      = realToFrac $ qs <.> 180 / pi              -- 度数法に変換
      stick  = translate 0 (-75)  $ rectangleSolid 1 150 -- 棒
      weight = translate 0 (-150) $ circleSolid 10       -- 重り
   in rotate (-t) $ stick <> weight

main :: IO ()
main = simulate inWindow white 24 initModel draw (const step)
  where
    inWindow  = InWindow "Haskell Day 2018" (640, 480) (100, 100)
    initModel = Phs 1 0
    step dt = stepHam (realToFrac dt) pendulum