自己紹介
趣味はHaskellと人工知能
普段は半蔵門で働くエンジニア
Twitter: @lotz84_（質問があればこちらまで）
GitHub: @lotz84
Qiita: @lotz
Haskell入門のあとにありがちなパターン
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における重要な４つの関数
-- 与えられた図形を単純に描画する関数
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
物理シミュレーション
二重振り子のシミュレーション
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
この連立方程式を二つの加速度について解けば良い…
hamilton
ハミルトン力学と自動微分を利用して一般化座標系における物理をシミュレーションしてくれるライブラリ
-- 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)) -- １つ目の振り子の先端位置
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
- 初期値をずらした振り子を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
コモナドにまつわる話
-
コモナドはモナドの圏論的双対
- 有名なモナドの双対
- Reader ↔ Env
- Writer ↔ Traced
- State ↔ Store
- 有名なモナドの双対
- Zipperもコモナド
-
Lensは余状態余モナドの余代数
- つまりStoreコモナドの余代数
-
画像のフィルタ処理をコモナドで実装できる
- ガウシアンフィルタとか微分フィルタとか
今日はコモナドの詳しい話は割愛します
ライフゲーム
ライフゲームは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
- 遅延評価により描画に必要なデータだけ評価されるのでちゃんと動く
- しかし時間がたつにつれ計算量が増えていくのが難点
- 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)
まとめ
- glossを使えば簡単に2Dグラフィックを扱える
- hamiltonを使えば運動方程式も簡単に扱える
- コモナドを使えばライフゲームが簡単に作れる
- glossにはIOを伴うインターフェースも用意されている