Help us understand the problem. What is going on with this article?

gloss: 動かして遊んで学ぶHaskell

More than 1 year has passed since last update.

gloss: 動かして遊んで学ぶHaskell

by lotz
1 / 53

自己紹介

趣味はHaskellと人工知能
普段は半蔵門で働くエンジニア

Twitter: @lotz84_(質問があればこちらまで)
GitHub: @lotz84
Qiita: @lotz


Haskell入門のあとにありがちなパターン


image.png

by Twitterを巡回していてわかったHaskell初心者が躓きやすいポイント8つ

(lotz調べ)


もっと想像力を刺激するような
実装例が必要なのでは?


gloss: Painless 2D vector graphics, animations and simulations.

出展: glossではじめるグラフィック描画 :: Haskell入門の次に読む記事


gloss

2Dグラフィックを簡単に描画できるライブラリ

  • アニメーション
  • シミュレーション
  • マウスやキーボードのイベント処理

にも対応

目に見えるものがすぐに作れるので楽しい!✌('ω'✌ )三✌('ω')✌三( ✌'ω')✌


今回の目標
Twitterで「glossで作ってみた」報告が
たくさん投稿される


Hello World


gloss: Hello World

import Graphics.Gloss

main :: IO ()
main = display inWindow white message
  where
    inWindow = InWindow "Haskell Day 2018" (640, 480) (100, 100)
    message = text "Hello World"


display

与えられた図形を単純に描画する関数

display :: Display -- 描画モード
        -> Color   -- 背景色
        -> Picture -- 描画する図形
        -> IO ()

-- ウィンドウの表示モードを表す型
data Display = InWindow String (Int, Int) (Int, Int)
             | FullScreen

-- 色を表す型
data Color = ...

-- 図形を表す型
data Picture = ...

glossにおける重要な4つの関数

-- 与えられた図形を単純に描画する関数
display :: Display -- 描画モード
        -> Color   -- 背景色
        -> Picture -- 描画する図形
        -> IO ()


-- 時間変化を伴う図形(アニメーション)を描画する関数
animate :: Display            -- 描画モード
        -> Color              -- 背景色
        -> (Float -> Picture) -- 経過時間を受け取って図形を返す関数
        -> IO ()


-- モデルの時間発展をシミュレーションして描画する関数
simulate :: Display            -- 描画モード
         -> Color              -- 背景色
         -> Int                -- 1秒あたりのステップ数
         -> model              -- モデルの初期値
         -> (model -> Picture) -- モデルから図形に変換する関数
         -- ビューポートと前ステップからの経過時間を受け取ってモデルを発展させる関数
         -> (ViewPort -> Float -> model -> model)
         -> IO ()


-- キーボードやマウスなどの入力イベントを処理してゲームを描画する関数
play :: Display -- 描画モード
     -> Color   -- 背景色
     -> Int     -- 1秒あたりのステップ数
     -> world   -- ワールドの初期値
     -> (world -> Picture)        -- ワールドから図形に変換する関数
     -> (Event -> world -> world) -- イベントを元にワールドを更新する関数
     -> (Float -> world -> world) -- 1ステップの経過時間を受け取ってワールドを発展させる関数
     -> IO ()

Picture


Line

線分

line :: [(Float, Float)] -> Picture


Circle

circle :: Float -> Picture

circleSolid :: Float -> Picture


Rectangle

長方形

rectangleWire :: Float -> Float -> Picture

rectangleSolid :: Float -> Float -> Picture


Text

文字列

text :: String -> Picture

ただし、フォントの指定や日本語の表示ができない


Pictureを変形する


Translate

図形を移動する

translate :: Float   -- x座標の移動量
          -> Float   -- y座標の移動量
          -> Picture -- 移動させたい図形
          -> Picture

glossの座標系


Scale

拡大縮小させる

scale :: Float -> Float -> Picture -> Picture


Hello World 2

「Hello World」の文字列全体を表示する

import Graphics.Gloss

main :: IO ()
main = display inWindow white message
  where
    inWindow = InWindow "Haskell Day 2018" (640, 480) (100, 100)
    message = translate (-160) 0 . scale 0.5 0.5 $ text "Hello World"


Rotate

図形を時計回りに回転させる。角度は度数法で指定する

rotate :: Float -> Picture -> Picture


Color

図形の色を変える

color :: Color -> Picture -> Picture

black, white, red, green, blue  :: Color

makeColor :: Float -- Red
          -> Float -- Green
          -> Float -- Blue
          -> Float -- Alpha
          -> Color


Monoid

PictureはMonoidのインスタンスとなっている
図形を合成するときはモノイドの演算を用いる

circle 50 <> rectangleWire 50 50


物理シミュレーション


二重振り子のシミュレーション

tweet


simulateの考え方

-- モデルの時間発展をシミュレーションして描画する関数
simulate :: Display            -- 描画モード
         -> Color              -- 背景色
         -> Int                -- 1秒あたりのステップ数
         -> model              -- モデルの初期値
         -> (model -> Picture) -- モデルから図形に変換する関数
         -- ビューポートと前ステップからの経過時間を受け取ってモデルを発展させる関数
         -> (ViewPort -> Float -> model -> model)
         -> IO ()


以下の3つの設計が重要

  • 状態を表す抽象的なモデル
  • モデルの時間発展を記述する関数
  • モデルを視覚的な情報に変換する関数

モデルと時間発展

二重振り子における状態

運動方程式

(m_1 + m_2)l_1\frac{d^2\theta_1}{dt^2} + m_2l_2\frac{d^2\theta_2}{dt^2}\cos(\theta_1 - \theta_2) + m_2l_2\left(\frac{d\theta_2}{dt}\right)^2\sin(\theta_1 - \theta_2) + (m_1 + m_2)g\sin\theta_1 = 0
l_1l_2\frac{d^2\theta_1}{dt^2}\cos(\theta_1 - \theta_2) + l^2_2\frac{d^2\theta_2}{dt^2} - l_1l_2\left(\frac{d\theta_1}{dt}\right)^2\sin(\theta_1 - \theta_2) + gl_2\sin\theta_2 = 0

この連立方程式を二つの加速度について解けば良い…

参考: 二重振り子 - Wikipedia


hamilton

image.png

ハミルトン力学と自動微分を利用して一般化座標系における物理をシミュレーションしてくれるライブラリ

-- m次元のデカルト座標、n次元の一般化座標を持つ系
data System m n = ...

-- 系を作成する関数
mkSystem' :: (KnownNat m, KnownNat n)    
          => R m                        -- 各デカルト座標系における慣性(質量)
          -> (Vector n a -> Vector m a) -- 一般化座標系からデカルト座標系への変換
          -> (Vector m a -> a)          -- デカルト座標系における位置エネルギー
          -> System m n

-- 相空間の状態を系に従って発展させる関数
stepHam :: (KnownNat m, KnownNat n)
        => Double     -- 微小時間
        -> System m n -- 物理系
        -> Phase n    -- 相空間の状態
        -> Phase n

data Phase n = Phs
  { phsPositions :: R n -- 一般化座標
  , phsMomenta   :: R n -- 一般化運動量
  }

二重振り子におけるSystem

pendulum :: System 4 2
pendulum = mkSystem' mass transform potential
  where
    mass = vec4 1 1 1 1                                     -- 慣性
    transform (V.toList -> [t1, t2]) =                      -- 角度から重りのデカルト座標への変換
      let (x1, y1) = (sin t1, -cos t1)
          (x2, y2) = (sin t1 + sin t2, -(cos t1 + cos t2))
       in fromJust $ V.fromList [x1, y1, x2, y2]
    potential (V.toList -> [_, y1, _, y2]) = y1 + y2        -- 位置エネルギー(y座標の値の合計)

二重振り子の描画

type Model = Phase 2

draw :: Model -> Picture
draw (Phs qs _) =
  let radian   = 180 / pi
      t1       = realToFrac $ qs <.> vec2 1 0
      t2       = realToFrac $ qs <.> vec2 0 1
      l        = 100                                    -- 振り子の見た目の長さ
      stick  = translate 0 (-l/2)  $ rectangleSolid 1 l -- 棒
      weight = translate 0 (-l)    $ circleSolid 10     -- 重り
      (x1, y1) = (l * sin t1, l * (-cos t1))            -- 1つ目の振り子の先端位置
      pendulum1 =                   rotate (-t1 * radian) $ stick <> weight
      pendulum2 = translate x1 y1 . rotate (-t2 * radian) $ stick <> weight
   in pendulum1 <> pendulum2


二重振り子のシミュレーション

main :: IO ()
main = simulate inWindow white 24 initModel draw (\_ -> step)
  where
    inWindow  = InWindow "Haskell Day 2018" (640, 480) (100, 100)
    initModel = Phs (vec2 2 2) (vec2 0 0)
    step dt = stepHam (realToFrac dt) pendulum

https://gist.github.com/lotz84/7c784e2fc3c4016960dbe323ae53b4d2

  • 初期値をずらした振り子を50本用意すれば冒頭の動画が作れる
  • 同じ方法でn重振り子も簡単に作れる

コモナドで作るライフゲーム


コモナド

自己関手の圏におけるコモノイド対象
Haskellでは単なる型クラス

class Functor w     => Comonad w where
  extract   :: w a -> a
  duplicate :: w a -> w (w a)

  extend    :: (w b -> a) -> w b -> w a
  extend f = fmap f . duplicate
  • 包まれた値から中身を取り出す extract
  • 包まれた値をさらに包む duplicate

モナド

自己関手の圏におけるモノイド対象
Haskellでは単なる型クラス

class Applicative m => Monad m   where
  pure      :: a -> m a
  join      :: m (m a) -> m a

  (>>=)     :: (a -> m b) -> m a -> m b
  k >>= m = join $ fmap k m
  • 値を包む return
  • 二重に包まれた値を一重にする join

コモナドにまつわる話

今日はコモナドの詳しい話は割愛します


ライフゲーム

ライフゲームは1970年にイギリスの数学者コンウェイによって考案された
生命の誕生・進化・淘汰のプロセスを再現した簡易的なモデル

平面上に生存セル■と死亡セル□が升目上に並べられており、決められたルールにより時間発展していく


ライフゲームの4つのルール

  • 誕生
    • 死亡セルに隣接する生存セルがちょうど3つあれば、生存セルとなる
  • 生存
    • 生存セルに隣接する生存セルが2つか3つならば、生存セルとなる

  • 過疎
    • 生存セルに隣接する生存セルが1つ以下ならば、死亡セルとなる
  • 過密
    • 生存セルに隣接する生存セルが4つ以上ならば、死亡セルとなる

例: ブロック・ブリンカー・グライダー


ライフゲームのデータ構造

-- | 1点に注目した無限リスト
data Z a = Z [a] a [a]

left, right :: Z a -> Z a
left  (Z (l:ls) c rs    ) = Z ls     l (c:rs)
right (Z ls     c (r:rs)) = Z (c:ls) r rs


ライフゲームのデータ構造

iterate1 :: (a -> a) -> a -> [a]
iterate1 f = tail . iterate f

instance Functor Z where
  fmap f (Z ls c rs) = Z (fmap f ls) (f c) (fmap f rs)

instance Comonad Z where
  -- extract   :: Z a -> a
  extract (Z _ a _) = a

  -- duplicate :: Z a -> Z (Z a)
  duplicate z = Z (iterate1 left z) z (iterate1 right z)


ライフゲームのデータ構造

-- | 1点に注目した無限平面(2重リスト)
newtype Z2 a = Z2 (Z (Z a))

instance Functor Z2 where
  fmap f (Z2 zz) = Z2 (fmap (fmap f) zz)

instance Comonad Z2 where
  -- extract   :: Z2 a -> a
  extract (Z2 zz) = extract (extract zz)

  -- duplicate :: Z2 a -> Z2 (Z2 a)
  duplicate (Z2 zz) = fmap Z2 . Z2 . roll $ roll zz
    where
      roll :: Z (Z a) -> Z (Z (Z a))
      roll zz = Z (iterate1 (fmap left) zz) zz (iterate1 (fmap right) zz)


ライフゲームのデータ構造

True: 生存セル
False: 死亡セル

-- | 注目している点の周りのTrueの数を数える
neighbours :: Z2 Bool -> Int
neighbours (Z2 (Z
  (Z (n0:_) n1 (n2: _):_)
  (Z (n3:_) _  (n4:_))
  (Z (n5:_) n6 (n7: _):_))) =
    length $ filter id [n0, n1, n2, n3, n4, n5, n6, n7]

-- | 注目している点が次のステップで生存するかを判定する
life :: Z2 Bool -> Bool
life z = (a && (n == 2 || n == 3)) || (not a && n == 3)
  where
    a = extract z
    n = neighbours z

-- ライフゲームを時間発展させる
extend life :: Z2 Bool -> Z2 Bool


ライフゲームの描画

wWidth, wHeight :: Num a => a
wWidth  = 640
wHeight = 480

type Model = Z2 Bool

draw :: Model -> Picture
draw (Z2 (Z _ _ rows)) =
  let cSize   = 20 -- セルの大きさ
      -- 基本となるセルの四角形。右下に原点がくる
      cell    = translate (-cSize / 2) (cSize / 2) $ rectangleSolid cSize cSize
      b2c b   = if b then black else white -- Boolから色への変換
      nWidth  = ceiling $ wWidth  / cSize  -- 横方向のセルの個数
      nHeight = ceiling $ wHeight / cSize  -- 縦方向のセルの個数
      cells   = do
        ((Z _ _ row), h) <- zip rows [1..nHeight] -- 縦方向に盤面を走査する
        (b,           w) <- zip row  [1..nWidth]  -- 横方向に行を走査する
        let x = fromIntegral w * cSize - wWidth / 2   -- セルのx座標
            y = wHeight / 2 - fromIntegral h * cSize  -- セルのy座標
            transform = color (b2c b) . translate x y -- セルに施す変形
        pure $ transform cell
   in mconcat cells -- 計算した全てのセルを結合して1つのPictureにする


ライフゲームの実装

toZ :: a -> [a] -> Z a
toZ a xs = Z (repeat a) a (xs ++ repeat a)

toZ2 :: a -> [[a]] -> Z2 a
toZ2 a xss = Z2 $ toZ (toZ a []) (map (toZ a) xss)


main :: IO ()
main = simulate inWindow white 3 initModel draw (\_ _ -> extend life)
  where
    inWindow  = InWindow "Haskell Day 2018" (wWidth, wHeight) (100, 100)
    field = [ " # "
            , "  #"
            , "###"
            ]
    initModel = toZ2 False $ map (map (== '#')) field

https://gist.github.com/lotz84/435630be7ee21cc9b4dfbd004a7cb7fd

  • 遅延評価により描画に必要なデータだけ評価されるのでちゃんと動く
  • しかし時間がたつにつれ計算量が増えていくのが難点
  • Z2を平面ではなくトーラス上に実装することはできる?

Graphics.Gloss.Interface.IO


glossの中でIOを使いたい

  • 乱数
  • ネットワーク通信
  • セーブデータのファイル出力
  • FRPライブラリと組み合わせて使いたい
  • (などなど)

glossのモジュールを眺めてみると…


Graphics.Gloss.Interface.IO

-- モデルの時間発展をシミュレーションして描画する関数
simulateIO :: Display            -- 描画モード
           -> Color              -- 背景色
           -> Int                -- 1秒あたりのステップ数
           -> model              -- モデルの初期値
           -> (model -> IO Picture) -- モデルから図形に変換する関数
           -- ビューポートと前ステップからの経過時間を受け取ってモデルを発展させる関数
           -> (ViewPort -> Float -> model -> IO model)
           -> IO ()

-- キーボードやマウスなどの入力イベントを処理してゲームを描画する関数
playIO :: Display -- 描画モード
       -> Color   -- 背景色
       -> Int     -- 1秒あたりのステップ数
       -> world   -- ワールドの初期値
       -> (world -> IO Picture)        -- ワールドから図形に変換する関数
       -> (Event -> world -> IO world) -- イベントを元にワールドを更新する関数
       -> (Float -> world -> IO world) -- 1ステップの経過時間を受け取ってワールドを発展させる関数
       -> IO ()

Graphics.Gloss.Interface.Pure(比較用)

-- モデルの時間発展をシミュレーションして描画する関数
simulate   :: Display            -- 描画モード
           -> Color              -- 背景色
           -> Int                -- 1秒あたりのステップ数
           -> model              -- モデルの初期値
           -> (model ->    Picture) -- モデルから図形に変換する関数
           -- ビューポートと前ステップからの経過時間を受け取ってモデルを発展させる関数
           -> (ViewPort -> Float -> model ->    model)
           -> IO ()

-- キーボードやマウスなどの入力イベントを処理してゲームを描画する関数
play   :: Display -- 描画モード
       -> Color   -- 背景色
       -> Int     -- 1秒あたりのステップ数
       -> world   -- ワールドの初期値
       -> (world ->    Picture)        -- ワールドから図形に変換する関数
       -> (Event -> world ->    world) -- イベントを元にワールドを更新する関数
       -> (Float -> world ->    world) -- 1ステップの経過時間を受け取ってワールドを発展させる関数
       -> IO ()

例: カオスゲーム

適当な点から始めて多角形の頂点をランダムに選び内分点を取っていくとフラクタル図形ができる(反復関数系

例えば三角形と中点で内分点を取る操作を繰り返すと シェルピンスキーのギャスケット になる

vertexes :: [Point]
vertexes = [(0, 120), (-160, -120), (160, -120)]

次の点を計算する関数

type Model = [Point]

step :: Model -> IO Model
step [] = pure []                          -- まだ点が無ければ何もしない
step ps@((x, y):_) = do
  gen <- createSystemRandom                -- 乱数のジェネレータを生成
  i   <- uniformR (0, 2) gen               -- ランダムなインデックスを生成
  let (vx, vy) = vertexes !! i             -- ランダムな頂点の座標
  pure $ ((x + vx) / 2, (y + vy) / 2) : ps -- 内分点を計算して追加する

イベントハンドラ

handler :: Event -> Model -> IO Model
-- 最初に左クリックされた点を開始点とする
handler (EventKey (MouseButton LeftButton) Down _ (x, y)) [] = pure $ [(x, y)] 
handler _ model = pure model -- それ以外の時は何もしない

描画処理

draw :: Model -> IO Picture
draw ps =
  let vCircles = map (\(x, y) -> translate x y $ circleSolid 5) $ vertexes
      pCircles = map (\(x, y) -> translate x y $ circleSolid 2) $ ps
   in pure $ mconcat vCircles <> mconcat pCircles

main関数

main :: IO ()
main = playIO inWindow white 24 [] draw handler (\_ -> step)
  where
    inWindow  = InWindow "Haskell Day 2018" (640, 480) (100, 100)

https://gist.github.com/lotz84/492f260bf75588f0eab88b99ee9276d4


まとめ

  • glossを使えば簡単に2Dグラフィックを扱える
  • hamiltonを使えば運動方程式も簡単に扱える
  • コモナドを使えばライフゲームが簡単に作れる
  • glossにはIOを伴うインターフェースも用意されている

さぁglossで遊びましょう!


ご清聴ありがとうございました

Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away
Comments
Sign up for free and join this conversation.
If you already have a Qiita account
Why do not you register as a user and use Qiita more conveniently?
You need to log in to use this function. Qiita can be used more conveniently after logging in.
You seem to be reading articles frequently this month. Qiita can be used more conveniently after logging in.
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away