ピタゴラス3体問題

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


threeBody :: System 6 6
threeBody = mkSystem mass id potential
  where
    mass = vector [3, 3, 4, 4, 5, 5]
    dist x1 y1 x2 y2 = sqrt $ (x1 - x2)^2 + (y1 - y2)^2
    potential (V.toList -> [x1, y1, x2, y2, x3, y3]) =
      - (2 * 3 * 4 / dist x1 y1 x2 y2) - (2 * 3 * 5 / dist x1 y1 x3 y3) - (2 * 4 * 5 / dist x2 y2 x3 y3)


type Model = Phase 6

draw :: Model -> Picture
draw (Phs qs _) =
  let x1 = realToFrac $ qs <.> vector [1, 0, 0, 0, 0, 0]
      y1 = realToFrac $ qs <.> vector [0, 1, 0, 0, 0, 0]
      x2 = realToFrac $ qs <.> vector [0, 0, 1, 0, 0, 0]
      y2 = realToFrac $ qs <.> vector [0, 0, 0, 1, 0, 0]
      x3 = realToFrac $ qs <.> vector [0, 0, 0, 0, 1, 0]
      y3 = realToFrac $ qs <.> vector [0, 0, 0, 0, 0, 1]
      b1 = translate x1 y1 $ circleSolid 0.3
      b2 = translate x2 y2 $ circleSolid 0.4
      b3 = translate x3 y3 $ circleSolid 0.5
   in scale 30 30 $ b1 <> b2 <> b3


main :: IO ()
main = simulate inWindow white 24 initModel draw (const step)
  where
    inWindow  = InWindow "Pythagorean Three Body" (640, 480) (100, 100)
    initModel = Phs (vector [1.5, 2, -1.5, -2, 1.5, -2]) (vector [0, 0, 0, 0, 0, 0])
    step dt = stepHam (realToFrac dt) threeBody