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