Skip to content

Instantly share code, notes, and snippets.

@lotz84
Created December 19, 2018 17:24
Show Gist options
  • Save lotz84/57eb6edbbf80de19f3de3702d3e0086f to your computer and use it in GitHub Desktop.
Save lotz84/57eb6edbbf80de19f3de3702d3e0086f to your computer and use it in GitHub Desktop.
ピタゴラス3体問題
{-# 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
@lotz84
Copy link
Author

lotz84 commented Dec 19, 2018

2018-12-20 02_22_45

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment