Haskellでオブジェクト指向を再発明する
状態管理のモデル案: spawn/killモデルの実装を作ってみた。
worldsパッケージがそれだ(露骨な名前だが赦してほしい)。前の記事と違う点は、Worldがモナド変換子として実装されている点だけである。
worlds-exampleは画面内のキャラクターを方向キーで操作する例。メインのプログラムは以下のようになっている:
import Include import Types import qualified Entity.Player as Player import Assets main = runGameDefault $ runWorldT $ do player <- spawn $ Player.new (V2 240 240) forever $ do whenM (lift $ keyPress KeyLeft) $ player .! Player.Move L whenM (lift $ keyPress KeyRight) $ player .! Player.Move R whenM (lift $ keyPress KeyDown) $ player .! Player.Move D whenM (lift $ keyPress KeyUp) $ player .! Player.Move U player .! update lift tick
見ての通り、Player内部の状態には直接関与しない。一方、Playerの実装では、mainから受け取ったメッセージを解釈し、実際の動作と状態遷移に変換する。
{-# LANGUAGE GADTs #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-} module Entity.Player where import Include import Types import Assets data States = States { _hp :: Float , _position :: Vec2 , _direction :: Direction , _animation :: Int } makeLenses ''States data Actions x where GetCoord :: Actions Vec2 Update :: Actions () Move :: Direction -> Actions () instance Updatable Actions where update = Update type Player s = Life (WorldT s Game) Actions () -- 命令を受け取る部分 handle :: (MonadState States m, FreeGame m) => Actions a -> m a handle GetCoord = use position handle Update = do d <- use direction n <- use animation p <- use position translate p $ bitmap $ playerBitmap (n `div` 5) d handle (Move d) = do case d of L -> position -= V2 2 0 R -> position += V2 2 0 U -> position -= V2 0 2 D -> position += V2 0 2 direction .= d animation += 1 life :: States -> Player s life s = Alive $ \e -> do (a, s') <- lift $ runStateT (handle e) s return (a, life s') new :: Vec2 -> Player s new p = life $ States { _hp = 8 , _position = p , _direction = R , _animation = 0 }
これはまさにカプセル化とメッセージパッシングであり、オブジェクト指向の実装であると言える。従来のオブジェクト指向と違う点は、インスタンス、メソッドなどの仕組み全てがファーストクラスであり、カスタマイズすることができることである。たとえば、メソッドをモナドにするのは、Operationalモナドを使えば高々2行の変更で可能だろう。
ゲーム開発などにおいてこのアプローチがどう使えるか、これからも調べていきたい。
追記
ドッペルゲンガーを作ってみた。インスタンスは霊本体と操作するクローンに分かれている。
haunt :: (Monad m, FreeGame m) => Name s Player.Actions r -> Life (WorldT s m) Identity () haunt she = go R where go d = Alive $ \(Identity pass) -> do r <- lift $ randomness (0 :: Int, 59) she .! Player.Move d if r == 0 then do i <- lift $ randomness (0, 3) return (pass, go (directions !! i)) else return (pass, go d) main = runGameDefault $ runWorldT $ do player <- spawn $ Player.new (V2 240 240) playerClone <- spawn $ Player.new (V2 320 240) doppelganger <- spawn $ haunt playerClone forever $ do whenM (lift $ keyPress KeyLeft) $ player .! Player.Move L whenM (lift $ keyPress KeyRight) $ player .! Player.Move R whenM (lift $ keyPress KeyDown) $ player .! Player.Move D whenM (lift $ keyPress KeyUp) $ player .! Player.Move U player .! update playerClone .! update doppelganger .! return () lift tick
状態管理のモデル案: spawn/killモデル
生と死のあるアクターを表現するためのモデルについて考えた(あくまで個人用メモ)。
以下の型変数sは世界の一意性、閉鎖性を表す。生命や名前を勝手に外に持ち出すことを防ぐために必要。
Life m a: 生命を表す型。aは生命の最終結果。Name s a: 生命に与えられた一意な名前。World s: 生命が住む世界を表すモナドで、以下の操作が可能。
spawn :: Life (World s) a -> World s (Name s a) -- 同じ世界に新しい生命を出現させる kill :: Name s a -> a -> World s () -- 同じ世界の生命を殺害する
world :: (forall s. World s a) -> Life Identity a
worldは中で起きた生と死を管理し、その過程をある種の命として表す。
これだけでは文字通り何もできないので、生命の間でコミュニケーションする何かが必要。
時間の概念をどのようにして表現するかも考えなければいけない。
(追記)アプローチ
生命自身の動作を表す新たな型変数eを追加する。
spawn :: Life (World s) e r -> World s (Name s e r) kill :: Name s e r -> r -> World s () contact :: Name s e r -> e a -> World s a
eはOperationalモナドやextensible effectsなどを使うことが想定される。
本日の料理: ヤングコーン、ピーマン、豚肉の炒め物
食材と処理
- にんにく1かけをみじん切りにする。
- ピーマンの実を適度な大きさに分割する。
- ヤングコーン(水煮)を小穂に対し斜めに切断する。
- 豚の細切れ肉を用意する。
調理
- フライパンを中火で熱する。
- フライパンにごま油を適量入れる。
- にんにくを入れて香りを引き出す。
- ピーマン、ヤングコーン、豚の細切れ肉の順に、間隔をおいて投入する。
- 食材に多少焦げ目がつくのを待つ。
- 中華スープの素を少量加える。
- 醤油を回しかける。
- 十数秒後、加熱を止めて完成。
Karakuriの導入(0) -状態をぶった切る！-
あるとき、私は思った――
「Getter、Setterと、状態を次に進める関数を持つ何かがほしい！そうすればゲームやユーザーインターフェイスなどがとても書きやすくなるのに……！」
私はそれをカラクリと名付けた。存在するかどうかわからない理想の構造を求めて…
オブジェクトの型をKとしよう。型A, Bに対するGetterが存在するならば、以下の関数が存在することになる。
getA :: K -> A getB :: K -> B
ここで積の性質を思い出そう。K -> (A, B)があればgetA、getBは自明だ。つまり、Getterは一つで十分ということになる。次に、X, YのSetterを考えよう。
setX :: X -> K -> K setY :: Y -> K -> K
和の性質により、Either X Y -> K -> Kが存在すれば、setX, setYの定義は自明になるので、Setterも一つで十分だ。そして、状態を更新する関数はK -> m Kとなる。それらを一つの型に詰め込むことでKarakuriが完成する。
data Karakuri m a b = Karakuri { look :: b , feed :: a -> Karakuri m a b , step :: m (Karakuri m a b) }
Karakuriはムーアマシンに相当し、lookは出力を取り出す関数、feedとstepは状態遷移にあたる。
KarakuriはApplicativeになるが、その仕組みはとても簡単だ。pure aはaを出すKarakuriになり、fを出力するKarakuriと、aを出力するKarakuriを(<*>)で合成するとf aを出力するKarakuriになる。
このKarakuriを使えば、状態が隠蔽されているが、一部分だけ制御できるオブジェクトが作れるのだ。次回はこれをもっと簡単に扱うためのモナドを導入してみよう。
継続渡しなHaskellライフ
CPS(Continuation passing style, 継続渡しスタイル)は、関数型プログラミングにおけるプログラムの書き方の一つである。CPSを導入する簡単な例をいくつか紹介しよう。
まず、入力された数値が3の倍数かどうかを判定するプログラムを作ってみよう。
foo :: IO Bool foo = do n <- readLn :: IO Int return (n `mod` 3 == 0)
ここで「CPS変換」なる儀式を行うと…こうなる！
foo' :: (Bool -> IO r) -> IO r foo' cont = do n <- readLn :: IO Int cont (n `mod` 3 == 0)
「なにこれ、returnを置き換えただけじゃねえか！意味わかんねー！」という声が聞こえてきそうだが、もう少し考えてみよう。
3の倍数が入力されたらFizz、5の倍数が入力されたらBuzz、15の倍数はFizzBuzz、それ以外は元の数を返すようなプログラムは、普通に考えればこのようになる。
bar :: IO (Either Int String) bar = do n <- readLn :: IO Int case (n `mod` 3, n `mod` 5) of (0, 0) -> return $ Right "FizzBuzz" (0, _) -> return $ Right "Fizz" (_, 0) -> return $ Right "Buzz" _ -> return $ Left n
barの結果はパターンマッチによって分岐することができるが、あることに気づくかもしれない。そう、条件分岐の結果を一旦代数的データ型に押し込み、それに対してさらに条件分岐を行おうとしているのだ……
さて、barをCPS変換するとこうなる。
bar' :: (Int -> IO r) -> (String -> IO r) -> IO r bar' left right = do n <- readLn :: IO Int case (n `mod` 3, n `mod` 5) of (0, 0) -> right "FizzBuzz" (0, _) -> right "Fizz" (_, 0) -> right "Buzz" _ -> left n
bar'の結果について分岐するには、Intが返ってきた場合の処理、Stringが返ってきた場合の処理をそれぞれ直接渡せばいいので、パターンマッチは不要だ。
打って変わって、今度はfooを4で割った商も一緒に返すように変更してみよう。
baz :: IO (Bool, Int) baz = do n <- readLn :: IO Int return (n `mod` 3 == 0, n `div` 4)
bazの結果であるタプルをBoolとIntに分解するには、やはりパターンマッチしなければいけない。そこでbazをCPS変換するとこのようになる。
baz' :: (Bool -> Int -> IO r) -> IO r baz' cont = do n <- readLn :: IO Int cont (n `mod` 3 == 0) (n `div` 4)
こちらは関数にBoolの値とIntの値が別々に渡されるので、タプルもパターンマッチも使う必要はない。
つまり、継続渡しスタイルを使うと計算の結果を代数的データ型を介さずに受け渡しできるのだ！そのメリットは明らかである。
CPSはattoparsecなどの様々なライブラリで利用されている。Haskellのプログラムを高速化したいならば、ぜひCPS変換することを検討してみてほしい。
Lensを使うぜ！
パッケージをインストールするぜ！そしてさっそくghciを起動するぜ！
$ cabal install lens
$ ghci
GHCi, version 7.6.3: http://www.haskell.org/ghc/ :? for help
Loading package ghc-prim ... linking ... done.
Loading package integer-gmp ... linking ... done.
Loading package base ... linking ... done.
Prelude> import Control.Lens
Prelude Control.Lens>
タプルから値を取り出すぜ！
> (1,1,4,5,1,4) ^. _3
4
リストの要素も取り出せるぜ！勿論範囲外の値は取れないけどな！
> [1,1,4,5,1,4] ^? ix 2 Just 4 > [1,1,4,5,1,4] ^? ix 6 Nothing
_3やix 2の部分がLens(正確に表現すれば、後者はLensの特殊な場合)だぜ！
リストやタプルの要素を書き換えることもできるぜ！
> (1,1,4,5,1,4) & _1 .~ 5 (5,1,4,5,1,4) > (1,1,4,5,1,4) & each %~ (*2) -- eachで全要素を参照するぜ！ (2,2,8,10,2,8) > [1,1,4,5,1,4] & ix 0 .~ 5 [5,1,4,5,1,4]
Stateモナドでも動くぜ！
> import Control.Monad.State > flip runStateT (1,1,4,5,1,4) $ use _1 (1,(1,1,4,5,1,4)) > flip runStateT (1,1,4,5,1,4) $ _1 .= 5 ((),(5,1,4,5,1,4)) > flip runStateT [1,1,4,5,1,4] $ each %= (*2) ((),[2,2,8,10,2,8])
データ型の各レコードに対応するLensを自動生成する機能もあるぜ！
{-# LANGUAGE TemplateHaskell #-} import Data.Map (Map) import Control.Lens data DB = DB { _foo :: Map String Int , _bar :: String , _baz :: Int } makeLenses ''DB -- makeLenses ''DB generates: -- foo :: Lens DB (Map String Int) -- bar :: Lens DB String -- baz :: Lens DB Int
Lensにはたくさんあんまり出番がない兄弟があるのでそこんとこよろしく！
じゃあな！
Haskell Advent Calendar 13日目: シンセサイザーで理解するArrowプログラミング
Haskell Advent Calendar 13日目の記事です。
ごきげんよう。
今年も音楽の冬がやってまいりました。Haskellより音楽のほうに力を注いでいる気がするこの頃ですが、ふとこう思いました――「Haskellでシンセサイザーを作たらとても楽しいのではないか？」
シンセサイザーの仕組みは、たとえばFM・減算式ならこうなります:
しかし、これが実装出来てもあまり嬉しくない、というのはわかっていただけるのではないでしょうか――そう、ただのシンセサイザーではなくどんなシンセサイザーでも作れるフレームワークが欲しいのです。
部品を作る部品 -Artery-
まず、私は、部品同士を「配線」できるようにするため、arteryというパッケージを作りました。
ArteryはArrowとしてのインターフェイスを持っています。Arrowはごく簡単に表現すると、以下のようなクラスで表現されます(実際とは少し異なります)。
class Arrow a where
arr :: (b -> c) -> a b c
(>>>) :: a b c -> a c d -> a b d
(***) :: a b c -> a b' c' -> a (b,b') (c,c')
このクラスが意味するのは、「普通の関数を任意のアローに埋め込むことができる」「アロー同士は合成できる」「二つのアローを同時に動かすことができる」ということで、「Arrow」=「配線のできる型」といった理解でも問題ないでしょう。
Arrow記法を使うことで、非常に直感的にアローの組み合わせを記述することができます。
{-# LANGUAGE Arrows #-} hoge :: Artery m (Float, Float) Float hoge = proc (freq, phase) -> do x <- f -< (freq, phase) y <- g -< (freq * 2, phase) returnA -< x * y
出力が代入される変数、アロー、入力を<-と-<でつなげて書きます。do記法と同じ構文糖衣で、コンパイル時にarr、(>>>)、(***)の組み合わせに還元されます。
部品
Arteryで実装した部品を紹介します。電子回路と違って中身を見てもあまり面白くないので、実装は基本的に飛ばします。
発振器
dsp-arteryパッケージ(https://github.com/fumieval/dsp-artery)で、鋸波と正弦波を発生させるArteryが定義されています。周波数と位相の対を入力として取ります。
sineWave :: (Floating a, Ord a, Given SampleRate) => Artery m (a, a) a sawWave :: (Given SampleRate, Fractional a) => Artery m (Float, Float) a
フィルタ
http://musicdsp.org/archive.php?classid=3#26をHaskellに移植しただけです。信号、カットオフ、レゾナンスをそれぞれ入力として取ります。
lowpass :: Fractional a => Artery m (a, (a, a)) a
エンベロープジェネレータ
お馴染みの、アタック、ディケイ、サスティン、リリースをパラメータとするエンベロープジェネレータです。
genADSR :: (Given SampleRate, Floating a, Ord a) => a -> a -> a -> a -> Artery m Bool a
ベースを作る
先に紹介した部品を組み合わせ、昔ながらのシンセベースを作ってみましょう。シグモイド関数を適用するのが音の太さの秘訣(?!)。
type Synth a = Given SampleRate => Artery m (Float, Bool) a bass :: Synth Float bass = proc (freq, gate) -> do w <- sawWave -< (freq, 0) env <- genADSR 0.001 2 0 1 -< gate saturator 8 <<< lowpass -< (w, (env * 0.8, 4)) saturator :: (Floating a) => a -> Artery m a a saturator gain = arr $ \x -> 2 / (1 + exp (gain * x)) - 1
ベルを作る
周波数変調や位相変調も、Arrow記法ならこんなに簡単。シンプルだけれど、私のお気に入りの音です。
bell :: Synth Float bell = proc (freq, gate) -> do m <- sineWave -< (64 * freq, 0) env <- genADSR 0.01 0.4 0.2 0.4 -< gate sineWave -< (freq * 2, m * env * 0.5)
リードを作る
減算、FMと来たら次は加算！ビブラートがかかっているのもポイント。
bundle :: Num b => [Artery m a b] -> Artery m a b bundle xs = … harmony :: Given SampleRate => [(Float, Float)] -> Artery m (Float, Float) Float harmony hs = bundle [arr (first (k*)) >>> sineWave >>> arr (*g) | (k, g) <- hs] lead :: Synth Float lead = proc (freq, gate) -> do vib <- sineWave -< (3, 0) s <- harmony [(1, 1), (2, 0.9), (3, 0.05), (4, 0.25), (5, 0.35) , (6, 0.4) , (7, 0.1) , (8, 0.08) , (9, 0.008) , (10, 0.001) , (11, 0.02), (14, 0.009), (16, 0.05), (18, 0.004), (20, 0.003) , (22, 0.002), (24, 0.001), (26, 0.001)] -< (freq * (1 + vib * 0.005), 0) env <- genADSR 0.1 2 1 1 -< gate Moog.lowpass -< (s, (env * 0.9, 1))
鳴らすために
これでFinish…ではありません。シンセにメロディを与え、その出力を具体化しなければならないのです！結構めんどくさい処理があるので、詳細はソースコードを見てください。
bpm = 140 samplePerBeat :: Given SampleRate => Int samplePerBeat = floor $ 60 / bpm * theSampleRate rhythm :: Given SampleRate => String -> Artery m () Bool rhythm = … melody :: Given SampleRate => Int -> Float -> [Int] -> Artery m () Float melody d t = … intro :: Given SampleRate => Artery m () (V2 Float) intro = melody 4 12 [4, 5, 7, 7, 12, 12, 4, 5, 7, 12, 14, 16, 14, 11, 12, 12, 7, 7, 4, 5, 7, 7, 12, 12, 14, 11, 12, 14, 17, 16, 17, 14] &&& rhythm "***-*-*********-*-**-*-*-********" >>> bell >>> arr pure -- モノラル→ステレオ
まず、メロディとリズムを組み合わせ、シンセの入力を生成します。二年前を思い出す……。そして、Arteryを再生したり止めたりするためにFreeモナドが登場します。
type Playlist r = Free (PlaylistF r) start :: Artery IO () r -> Playlist r ClipId stop :: ClipId -> Playlist r () wait :: Float -> Playlist r () runPlaylist :: Given SampleRate => Playlist r Void -> Artery IO () [r]
mainの実装。dsp-artery-ioのwithStreamで実際に音を鳴らします。
main = withStream def (withSampleRate gen) $ threadDelay (40 * 1000 * 1000) where gen :: Given SampleRate => Artery IO () (V2 Float) gen = runPlaylist song >>> arr sum >>> stereo' (saturator 1) song :: Given SampleRate => Playlist (V2 Float) a song = do i <- start intro wait (4 * 2) stop i forever $ do i <- start bassline j <- start mainMelody wait (4 * 8) stop i stop j
結果
ドラムはちょっと勘弁…
まとめ
Haskellでもそこそこの音は出せますが、やっぱりC++などで実装されたものに比べて処理が重いのが難点です。高速化が今後の課題となりそうです。
Arrowは、Haskellらしいプログラミングをする上での素晴らしい知恵の一つです。よりよいHaskellライフのために、Arrowが効く場面を見つけていきたいですね―― というか、Arrowはもっとevalされるべき。
