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

_3ix 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

XML*1JSON*2もLensで操作できるぜ!

Lensにはたくさんあんまり出番がない兄弟があるのでそこんとこよろしく!

じゃあな!

Haskell Advent Calendar 13日目: シンセサイザーで理解するArrowプログラミング

Haskell Advent Calendar 13日目の記事です。


ごきげんよう。

今年も音楽の冬がやってまいりました。Haskellより音楽のほうに力を注いでいる気がするこの頃ですが、ふとこう思いました――「Haskellでシンセサイザーを作たらとても楽しいのではないか?」

シンセサイザーの仕組みは、たとえばFM・減算式ならこうなります:

f:id:fumiexcel:20131214173624p:plain

しかし、これが実装出来てもあまり嬉しくない、というのはわかっていただけるのではないでしょうか――そう、ただのシンセサイザーではなくどんなシンセサイザーでも作れるフレームワークが欲しいのです。

部品を作る部品 -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#26Haskellに移植しただけです。信号、カットオフ、レゾナンスをそれぞれ入力として取ります。

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されるべき。

Operationalモナドをゲームに応用した話

データを処理することは、プログラミングのもっとも本質的な部分である。数値、文字列、あるいはデータの集まりなどを扱うために、数々の構造が考えられてきた。Haskellにおいては、「手順」もデータとして扱うことができる。これは、DSLを作るうえで非常に有用であり、ゲーム開発やデータベース操作……手続きがかかわるあらゆるものに応用できるだろう。

手順をデータとして扱う方法として、FreeモナドとOperationalモナドがある。ここでは、Operationalモナドをゲームのキャラクターの制御に用いた例を紹介する。Freeモナドの導入については、Andres Löh氏のHaskell eXchange 2013の講演がわかりやすく、おすすめである。

データを作る

アクションゲームの敵の動きとして、この二つを考えよう:

  • 待機
  • 接近(攻撃)
  • 索敵(プレイヤーの位置を調べる)

EnemyMというモナドがあれば、Haskellの値としてそれらを定義することができる。

wait :: EnemyM ()
move :: Position -> EnemyM ()
scout :: EnemyM Position

では、EnemyMはどうやって作るのだろうか?その答えの一つはOperationalモナドだ。

{-# LANGUAGE TemplateHaskell #-}
import Control.Monad.Operational.Mini

data EnemyI a where
    Wait :: EnemyI ()
    Move :: Position -> EnemyI ()
    Scout :: EnemyM Position

makeSingletons ''EnemyI

type EnemyM = Program EnemyI

「位置pに向かって動く」という動作は、そのままMove p :: EnemyI ()という値として表現される。EnemyIは挙動の最小単位になっている。この型にProgramをかぶせることによって、それらを合成できるようになる――Programは好きなものをモナドにしてしまう力があるのだ。具体的な構成方法については、私の過去の記事*1を参照されたい。

実装

以下は、この考えに基づき実装したコードだ。もっとも基本的な関数singletonは、命令の最小単位をProgramレベルに持ち上げる。minioperationalのmakeSingletonsを使えば、singletonを適用した命令を自動生成することも可能だが、今回は使っていない。

data Tactic x where
    Approach :: Tactic ()
    Wait :: Tactic ()
    RelativePlayer :: Tactic (Maybe (V2 Float))
    Put :: Enemy -> Tactic ()
    Get :: Tactic Enemy
    Randomly :: Random r => (r, r) -> Tactic r


type Strategy = ReifiedProgram Tactic

defaultStrategy :: Strategy ()
defaultStrategy = do
    r <- singleton RelativePlayer
    a <- use enemyAttacked
    case r of
        Just d
            | a -> attacking defaultStrategy
            | quadrance d < 160 ^ 2 -> attacking defaultStrategy
            | quadrance d > 320 ^ 2 -> enemyAttacked .= False
        _ -> singleton Wait

attacking :: Strategy a -> Strategy a
attacking cont = do
    replicateM_ 29 $ singleton Approach
    replicateM_ 33 $ singleton Wait
    cont

ここで、ReifiedProgramはProgramの変種である。CPS変換されているかどうかの違いがあるが、説明は省略する。Enemyは敵の状態を直接的に表す型である。敵の種類ごとにコンストラクタを作れば、Affine traversal*2で内部状態を読み書きできるため、とても便利だ。

独自のモナドを定義するメリットは、「同じプログラム(Strategy)でも、キャラクターごとの個性を表現できる」ということと、データであるため、合成、分解、検証が容易であるという点にある。

以下はプログラムを分解し、より具体的な動きに変換している関数の例である。敵の状態を扱うStateモナドの上で動いている。

exec cha (Approach :>>= cont) = do
    target <- lift $ use $ thePlayer . position
    pos <- use position

    case cha of
        Squirt -> do
            velocity . _x .= signum (view _x target - view _x pos)
            modify updateAnimation
        Fly -> velocity .= normalize (target - pos) * V2 3 6
    return (cont ())

exec cha (Wait :>>= cont) = do
    velocity . _x .= 0
    return (cont ())
exec _ (RelativePlayer :>>= cont) = do
    target <- lift $ use $ thePlayer . position
    pos <- use position
    return (cont (Just $ target - pos))
exec _ (Get :>>= cont) = cont <$> get
exec _ (Put s :>>= cont) = cont <$> put s
exec _ (Randomly r :>>= cont) = cont <$> liftIO (randomRIO r)

雑魚敵と飛ぶ敵で、移動の方法を変えている。また、RelativePlayerの部分の処理を変えれば、「視野」を設けるといった高度なことも可能になるだろう。

ProgramやReifiedProgramは、変換先のモナドを制限しない。そのため、ありとあらゆる環境*3にプログラムを持ち運ぶことができる。ちょうどLuaのような埋め込み言語の、さらに上位版と見てもよい*4

この実装の全体はGitHubで公開している

f:id:fumiexcel:20131111153604p:plain

その他

  • 拙作のfree-gameゲームエンジンとして使ったが、スクロールを含むマップの描画は予想していたよりも簡単に記述することができた。その理由もまた、モナドをデータとして扱っているからである。
  • 全体で約500行と、内容の貧相さの割には行数がかさんでしまった。無理してStateモナドを利用せずに、リアクティブプログラミングを取り入れたほうがよかったかもしれない。karakuriというパッケージでも、アクターの記述のよりよい方法を模索している。
  • 音声関連のライブラリはまだ十分に整備されていないのが現状である。DirectSoundも公開されたが、クロスプラットフォームかつインストールしやすくかつメンテナのいるパッケージはまだない。Haskellでゲーム開発をしていくうえで、今もっとも大きな問題だと考えている。

課題

今回は非常に単純な挙動だったが、たとえば動的計画法などを用いてマップの格子と行動にスコアを割り当て、スコアが高いところに向かって行動するなど、より高度なAIも記述できるはずだ。戦略性とアクション性を両立しやすくするアプローチとして、モナドはとても革新的なツールだと確信している。

プログラムの検証については、本研究では確実な手法を見出すことはできなかった。今後も、何か面白いアプローチができないか考えていきたい。

参考

*1: モナドとはモナドである - モナドとわたしとコモナド

*2:対象が存在しない場合があるLensの変種。Lensについてはhttp://hackage.haskell.org/package/lens-3.10/docs/Control-Lens.htmlを参照のこと

*3:型クラスによるアプローチと違い、同じモナドに対し複数の変換方法があってもよい

*4:実行時に動作を差し替えられないのが難点だが…

ミックスの仕上がりを綺麗にする(かもしれない)簡単な工夫

ミキシングはコンピュータによる楽曲制作には欠かせない。きちんとミキシングしなければ、まるで重油の浮いた泥のようなサウンドになってしまうのはご存じだろう。

ミックスにおける重要な課題の一つは、低域をすっきりさせることだ。低域をクリーンにすることは、聴きやすさと音圧の向上につながる。

そこでおすすめなのが、「全トラックにハイパスフィルタをかける」という方法だ。まず40~50Hzをカットオフ周波数とするハイパスフィルタを挿入し、全体で聴いて不自然にならない程度にカットオフと帯域幅を調整すれば、それだけでとてもすっきりするだろう。

f:id:fumiexcel:20131106154028p:plain

余裕が出来たら、ベースとキックの音をガンガン上げていこう。下手にマキシマイザーをいじるよりも、ずっと音圧が稼げるはずだ。

高専プロコン競技部門に参加した

どうも、Haskellの宣伝をしまくっていた@fumievalです。

全国高等専門学校 第24回プログラミングコンテスト競技部門に、@NKMR_YA@39moguraさんと一緒に茨城工業高等専門学校の代表チームとして出場しました。

f:id:fumiexcel:20131016123648p:plain

去年もそれを使った、ような…

競技の流れは以下の通りです。

  • 送信側m人と受信側n人(m + n = 3)に分かれる。
  • 送信側に文字列Sが配布される。
    • 木製の長方形の容器(パケット)と、 それぞれの面に1から6までの点が刻まれた立方体状の樹脂(サ イ コ ロが与えられるので、必要に応じてそれを使う。
    • 設置されたカメラにより、20秒間隔でパケットが撮影される。ただし、手などが写っていると魂を抜かれ失格。
  • 受信側は、何らかの文字列S'をサーバーに送信する。必要に応じて、送信側で撮影されたパケットの画像を利用することができる。
  • 制限時間が過ぎると終了。
    • SとS'を先頭から比較し、もっとも一致している文字数が多いチームが勝利。
    • 文字数が等しい場合、その文字列を提出するまでの秒数が少ないほうが勝利。
    • 秒数が等しい場合、いくつかのサイコロを振り、その合計が大きいほうが勝利。

それはとっても簡単だなって

去年の問題は、乱雑に置かれたサイコロの個数を数えるという高難易度…むしろ人間がやったほうが楽なものでしたが、今年の問題はある程度プログラミングを生かせると感じました。もう何も怖くない。

GUIも、CUIもあるんだよ

私がエンコーダ、デコーダを開発し、残りの二人が画像認識プログラムを作るという割り当てでした。配置を表示するプログラムも作ってしまったので、それを使うことになりました。

f:id:fumiexcel:20131016123335p:plain

写真のようにサイコロの1、2、5の目だけを使い、中央の色を調べることで画像認識を簡単にするという方針でした。

f:id:fumiexcel:20130926170951j:plain

工夫なんて、あるわけない

後述する事情により、1から6までの目を使うことになりました。エンコード方法は、サイコロ5つを2文字に割り当てるという至極単純なもの。暗号化も圧縮もありません。目の列は1行ごとに左から右に並べられます。

本番で与えられた文字列がこんな感じだったので、エントロピー符号くらいは使うべきでした…あたしって、ほんとバカ

こんなの絶対おかしいよ

本番はマウスも含め周辺機器が利用できません。これはちょっと厳しいです…本当のルールと向き合えますか?

もう誰にも頼らない

真上から撮影できるとは限らないことが判明したため、急遽私も画像認識のプログラムを開発することになりました。

10/9頃、ある程度サイコロの目を判別できるようになりました。幾度ものパラメータの調整を経て、百発百中の精度を得ました。

f:id:fumiexcel:20131016124840p:plain

アルゴリズムは、画像の中の黒い点をカウントするだけです。

この時点でシステムのすべてがHaskell製になりましたが、そこは…まあ。データ構造、線型代数、画像処理、並列化などの多少の勉強になりました。

わたしの、サイコロの友達

他の二方のおかげで、準優勝というよい結果を残すことができました。とても感謝しています。来年はその一つ上を目指すだけなので、気が楽です。来年はサイコロじゃないといいなあ。

最後に、ともに闘ってくれたチームのメンバー、本コンテストを開催した運営の方々、会場を用意していただいた旭川市民文化会館の方々、および財布を拾っていただいたホテルの方に、心より感謝を申し上げます。

リンク