2018-12-21

Elias-Fano encoding: 単調増加する数列をほぼ簡潔に表現する

Haskell Advent Calendar 2018 20日目

単調増加する自然数の列を、最低限のビット数で表現するための興味深いテクニックと、Haskellによる実装を紹介する。

Elias-Fano encoding

この手法は、簡潔データ構造に分類されるもの一つであるが、厳密には条件を満たさないため疑似簡潔データ構造と呼ばれる。1970年代、Peter EliasとRobert Mario Fanoによって独立して発見された。

例題として1, 1, 4, 10, 17, 22, 23, 30という列をエンコードしてみよう。まず、それぞれの数を上位3ビットと下位2ビットに分割する。列の長さをNとしたとき、上位のビット数は ${ \displaystyle \lceil \lg N \rceil }$ とする。

上位ビットの列は000 000 001 010 100 101 101 111となる。これをヒストグラムのようにして2³個のビンに分ける。

000: 2個
001: 1個
010: 1個
011: 0個
100: 1個
101: 2個
110: 0個
111: 1個

これにアルファ符号(個数分だけ1を並べ、0で区切る)を適用すれば上位の表現は完成だ。要素数分の1と、バケット数 ${ \displaystyle 2^{\lceil \lg N \rceil} }$ 分の0を合わせるのでおよそ ${ \displaystyle 2N }$ ビット使う。

1101010010110010

下位ビットの列は、そのまま結合する。こちらは、元のビット数をWとしたとき、 ${ \displaystyle N(W-lg(N)) }$ ビット消費する。

0101001001101110

32ビットの整数を10⁵個格納する場合、消費ビット数は17*10⁵ビットとなかなか優秀な圧縮率を誇る。

n番目の値を読み出すときは、上位は $select_1(n) - n$ を求め、下位はそのまま取り出してくっつければよい。 $select_1(n)$ は簡潔データ構造の文脈でよく使われる演算の一つで、ビット列のn番目に出現する1の位置を求める。nを引くのは、ちょうどn個だけ0が混ざっているからだ。

実装

早速実装してみよう。上位ビットのエンコーダは非自明そうに見えるが、要素の位置、上位ビット、カウンタの三つ組(i, u, n)を持つステートマシンで簡単に表現できる。

(i, u, n) = (0, 0, 0)から開始する
uが最大値を超えたとき、nを出力し停止
i番目の上位ビットとuを比較する
- 等しい場合、(i + 1, u, n + 1)に更新する
- 異なる場合、nを出力し、(i, u + 1, 0)に更新する

あまり知られていないが、vectorパッケージにはData.Vector.Fusion.Stream.Monadicという簡単なオートマトンを表現するためのモジュールがある。状態と、それを更新する関数の対という単純な作りで、最適化が効く限りこの構造は消滅してただのループとなる。表現力は限られているが、他の追従を許さないパフォーマンスを誇る。

data Stream m a = forall s. Stream (s -> m (Step s a)) s

data Step s a where
  Yield :: a -> s -> Step s a
  Skip  :: s -> Step s a
  Done  :: Step s a

ビット列をVector Boolのように愚直に扱っていては空間効率が悪いので、まずはビット列をWord64の配列に変換する仕組みを作りたい。ここでは受けとったWord64から任意のビット数だけ切り取り、それらを連結して出力する変換器を定義する。Bの最初のフィールドが切り取るビット数となる。溢れたビットの処理はやや煩雑だが、やるだけなので読み飛ばしても構わない。ただしINLINEは必須で、これがないと最適化が止まってしまいポテンシャルを発揮できない。

import Data.Bits
import Data.Word (Word64)
import qualified Data.Vector.Fusion.Stream.Monadic as S

data B = B !Int !Word64

data Chunker s = Chunker s !Word64 !Int
  | ChunkerDone

chunk64 :: Applicative m => S.Stream m B -> S.Stream m Word64
chunk64 (S.Stream upd s0) = S.Stream go $ Chunker s0 zeroBits 0 where
  go ChunkerDone = pure S.Done
  go (Chunker s acc len) = flip fmap (upd s) $ \case
    S.Done -> S.Yield acc ChunkerDone
    S.Skip s' -> S.Skip $ Chunker s' acc len
    S.Yield (B width w) s' -> case mask width .&. w of
      w' | width + len >= 64 -> S.Yield (acc .|. unsafeShiftL w' len)
            $ Chunker s' (unsafeShiftR w' (64 - len)) (len + width - 64)
         | otherwise -> S.Skip $ Chunker s' (acc .|. unsafeShiftL w' len) (len + width)
{-# INLINE chunk64 #-}

次に、アルファ符号のエンコーダを定義する。chunk64は64より長いビット列を受け取れないので、複数に分けるという処理をする。

data Unary s = Unary s | UnaryCont !Int s

unary :: Applicative m => S.Stream m Int -> S.Stream m B
unary (S.Stream upd s0) = S.Stream go $ Unary s0 where
  go (Unary s) = flip fmap (upd s) $ \case
    S.Done -> S.Done
    S.Skip s' -> S.Skip (Unary s')
    S.Yield n s' -> step n s'
  go (UnaryCont n s') = pure $ step n s'
  step n s'
    | n < 64 = S.Yield ((n + 1) `B` mask n) (Unary s')
    | otherwise = S.Yield (B 64 (complement zeroBits)) (UnaryCont (n - 64) s')
{-# INLINE unary #-}

これらを組み合わせてエンコーダを定義する。エンコードの結果として出力するのは以下の5つ組だ。

data EliasFano = EliasFano
    { efLength :: !Int
    , efWidth :: !Int
    , efUpper :: !(UV.Vector Word64)
    , efRanks :: !(UV.Vector Int)
    , efLower :: !(UV.Vector Word64)
    }
    deriving Show

efLength: 要素数
efWidth: 下位ビットの幅
efUpper: 上位ビットの列
efRanks: 上位ビットの列をpopcountして累積加算させた列(あとで有利に働く)
efLower: 下位ビットの列

以下がエンコーダの実装だ。Streamを効率よくVectorに変換する関数が提供されており、fromStream'でそれらを利用している。upd関数は先に述べたアルゴリズムを実装している。unsafeが散らばっていて可読性はよくないが、ロジックは比較的わかりやすいだろう。

import Control.Monad.ST
import Data.Bits
import qualified Data.Vector.Generic as V
import qualified Data.Vector.Generic.Mutable as GM
import qualified Data.Vector.Unboxed as UV
import qualified Data.Vector.Fusion.Bundle.Monadic as B
import qualified Data.Vector.Fusion.Bundle.Size as B
import qualified Data.Vector.Fusion.Stream.Monadic as S
import Data.Word

data EncoderState s = ESCont !Int !Word64 !Int | ESDone

unsafeFromVector :: V.Vector v Word64 => v Word64 -> EliasFano
unsafeFromVector vec = runST $ do
  efLower <- fromStream' ((efWidth * efLength + 63) `div` 64)
    $ chunk64 $ S.map (B efWidth . fromIntegral) $ B.elements $ B.fromVector vec
  efUpper <- fromStream' ((efLength + 3) `div` 4)
    $ chunk64 $ unary $ S.Stream upd $ ESCont 0 0 0
  return EliasFano
    { efRanks = UV.prescanl (+) 0 $ UV.map popCount efUpper
    , ..
    }
  where
    upd ESDone = pure S.Done
    upd (ESCont i current n)
      | current > maxValue `unsafeShiftR` efWidth = pure $ S.Yield n ESDone
      | otherwise = pure $ case fromIntegral $ V.unsafeIndex vec i `unsafeShiftR` efWidth of
        u | u == current -> S.Skip $ ESCont (i + 1) current (n + 1)
          | otherwise -> S.Yield n (ESCont i (current + 1) 0)

    efLength = V.length vec

    fromStream' len s = GM.munstream (B.fromStream s (B.Exact len))
      >>= UV.unsafeFreeze
    {-# INLINE fromStream' #-}

    maxValue
      | V.null vec = 1
      | otherwise = V.last vec + 1
    efWidth = max 1 $ ceiling $ logBase 2 (fromIntegral maxValue / fromIntegral efLength :: Double)
{-# SPECIALISE unsafeFromVector :: UV.Vector Word64 -> EliasFano #-}

鬼門となるのは要素のアクセスだ。まずはWord64に対するselect関数を実装しなければならない。これに関しては優れたアルゴリズムが研究されており*1、ekmett先生によってすでに実装されていた*2のでそれを拝借した。この手法を直感的に理解するのは、私の頭では不可能だった。

ここさえクリアすれば、Word64の配列に対してselectを実装するのはさほど難しくない。どの要素に対してselectWord64を呼べばいいかは、先に用意しておいたpopcountの配列に対する二分探索によって判断できる。

select :: (V.Vector v Int, V.Vector v Word64) => v Int -> v Word64 -> Int -> Int
select ranks vec q = go 0 (V.length ranks - 1) where
  go l r
    | l >= r = selectWord64 v (q - V.unsafeIndex ranks l) + 64 * l
    | q < V.unsafeIndex ranks (i + 1) = go l i
    | otherwise = go (i + 1) r
    where
      i = div (l + r) 2
      v = V.unsafeIndex vec i
{-# SPECIALISE select :: UV.Vector Int -> UV.Vector Word64 -> Int -> Int #-}

下位ビットを読み出す処理は、ビットを跨ぐ場合さえ気をつければ大丈夫だ。

readBits :: V.Vector v Word64 => v Word64 -> Int -> Int -> Word64
readBits vec width pos
  | b + width > 64 = unsafeShiftL extra (64 - b) .|. base
  | otherwise = base
  where
    i = unsafeShiftR pos 6
    b = pos .&. 63
    base = (V.unsafeIndex vec i `unsafeShiftR` b) .&. mask width
    extra = V.unsafeIndex vec (i + 1) .&. mask (width + b - 64)
{-# SPECIALISE readBits :: UV.Vector Word64 -> Int -> Int -> Word64 #-}

これらを合わせればインデックスの処理が出来上がる。上位ビットの配列は、元の列の長さNに対して $O(\log N)$ 個、selectの計算量は配列の長さNについて $O(\log N)$ なので、この演算の計算量は $O(\log \log N)$ となる。

(!) :: EliasFano -> Int -> Word64
(!) (EliasFano _ width upper ranks lower) i
  = fromIntegral (unsafeShiftL (select ranks upper i - i) width)
  .|. readBits lower width (i * width)

ここで紹介したコードはGitHubに保存している。

github.com

テスト

ビット演算という性質上、同じ型の中でたくさんの値を扱うためバグが湧きやすい。QuickCheckは大いに役立った。最終チェックとして以下のテストを残した。

import qualified Test.QuickCheck as QC

prop_access :: [QC.NonNegative Int] -> QC.NonNegative Int -> QC.Property
prop_access xs i_ = QC.counterexample (show (base, ef, i))
  $ ef ! i == base !! i
  where
    i = QC.getNonNegative i_ `mod` length base
    base = scanl (+) 0 $ map (fromIntegral . QC.getNonNegative) xs
    ef = unsafeFromVector $ UV.fromList base

ベンチマーク

やはり気になるのはパフォーマンスだ。適当に単調増加する数列をこしらえ、反転やインデックスなどの基本的な演算と比較した。

td :: V.Vector Word64
td = V.scanl (+) 0 $ V.fromList $ map (toEnum . fromEnum) $ "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."

main = do
  let ef = unsafeFromVector td
  defaultMain
    [ bench "encode/elias-fano" $ whnf unsafeFromVector td
    , bench "encode/vector" $ whnf V.reverse td
    , bench "access/elias-fano" $ nf (map (ef!)) [0..V.length td - 1]
    , bench "access/vector" $ nf (map (td V.!)) [0..V.length td - 1]
    ]

結果はこの通りだ。インデックスはUnboxed Vectorの2倍強遅いが、内部で3つの配列を使っていることを考えると期待以上であると言える。

encode/elias-fano                        mean 3.891 μs  ( +- 78.82 ns  )
reverse/vector                            mean 705.7 ns  ( +- 12.20 ns  )
access/elias-fano                        mean 16.69 μs  ( +- 423.2 ns  )
access/vector                            mean 7.499 μs  ( +- 2.076 μs  )

応用

Elias-Fano encodingはマイナーな手法ではあるが、よく知られている応用として検索のためのインデックス化が挙げられる。単語ごとに、マッチする文書の番号の一覧をメモリ上に保持するといった風に利用できる。ここでは紹介しなかったが、ある値より等しいかそれ以上の要素を探すという演算も効率よく実装でき、積集合を求める操作において並外れたパフォーマンスを発揮する。

また、個人的な研究として、LOUDSなどの木構造の簡潔な表現と組み合わせ、シリアライズに応用できないか模索している。直列化に簡潔データ構造を用いる例は少ないので開拓しがいがあると感じている。

まとめ

Elias-Fano encodingは、単調増加する自然数の列を圧縮しつつ、効率の良いアクセスも提供する
Data.Vector.Fusion.Stream.Monadicを使って、パフォーマンスを犠牲にすることなく抽象度を高められる
QuickCheckにより、複雑でバグを仕込みやすい処理も簡単にテストできる
利用例がまだ少なく、研究しがいがある

参考文献

Sorted integers compression with Elias-Fano encoding | Antonio Mallia

*1:Sebastiano Vigna, Broadword implementation of Rank/Select Queries, 2014

*2:https://github.com/ekmett/succinct/blob/master/src/Succinct/Internal/Broadword.hs#L82

2018-10-31

「名前の束縛」という名の束縛

実用的なプログラミングにおいて、名前と概念を結びつける「束縛」はほぼ必須の概念である。しかし、その言葉には大きな誤解と混乱が根付いていた。

事の発端となったのは「Haskellにおいては、変数は値を代入するものではなく、値に束縛するものである」という議論である*1 *2。しかし、これは大きな誤解を孕んでいる。言葉の定義に立ち返ってその誤解を解いていこう。

束縛とバインディング

実は「束縛」には二つの意味がある。一つは、数学的な意味での変数の束縛*3、もう一つは、識別子と実体の結合という意味での束縛*4だ。

前者は変数の導入と言い換えることもできる。ラムダ計算におけるラムダ抽象と変数の関係もこれである。重要なのは、これはあくまで変数とそれを導入する抽象の関係であり、変数と実体の関係ではないことだ。

「AをBに束縛する」と言った場合後者で、プログラミングの文脈ではこちらを耳にすることが多いだろう。混乱を避けるため、後者を「バインディング」、あるいは「バインド」と本稿で呼ぶことにする。バインディングは以下のような関係性として説明できる。

主語バインディングが
目的語 識別子を
間接目的語 実体(式、値、計算など)に
述語束縛する

Haskellにおける誤解

Haskellは、x = 42のような定義を与えることによって、変数で値を参照できる。だからといって「Haskellでは変数を値にバインドする」と言い切ってしまうことには大きな問題がある。理由は簡単で、変数に対して値以外もバインドできるからだ。例えばy = x + 1という宣言を考えてみよう。この宣言はyをバインドするが、その対象はx + 1という計算であり、式を評価した結果の値ではない。

定義がインライン化(その名前が使われている場所に展開)されず、メモリ上に領域を確保すべきものと処理系が判断した場合、初めて値に関する議論が始まる――これが「代入」である。代入は、オブジェクトをヒープ(実行時に確保されるメモリ領域)上の場所にセットする。ここで言うオブジェクトは大きく分けて2種類ある*5。

未評価の計算(1 + 1など)
値(1、Just (6 * 7)、\x -> x * x)など

代入に構文上の概念である変数が介在する必要はなく、しかも値以外のオブジェクトも代入できる。したがって、Haskellの文脈で「変数に値を代入する」と言うのは便宜的に通用こそするものの、実は二重、三重に混乱した表現であることがわかる。

この混乱は言語仕様ですらやらかしてしまっている。Haskell 2010 Language Reportの3.17.2 Informal Semantics of Pattern Matchingを見ると、"Binding does not imply evaluation"と注記しているにもかかわらず、本来オブジェクトに対するものであるパターンマッチを値に対するものと宣言してしまい、変数を値に束縛するという旨の表現を二箇所で使ってしまっている。学習者は言語仕様を読むだけでなく、case undefined + undefined of _ -> 42のような式を手元で評価し、実際の意味論を把握することを推奨する。

さらなる誤解？

Rustの公式ドキュメント *6 では、「値を変数に束縛する(bind some value to a name)」という、ここまでの議論からすればもってのほかな表現が使われている。この節は削除されたが、同様の表現が最新版にも残っている。これに関して、所有権によって変数と値の一対一対応があるから可能であるという意見が有識者によって述べられた。

Rust、所有権があって型によっては値と変数が一対一になるのでそういう意図かなーと好意的に解釈してます
— κeen (@blackenedgold) October 30, 2018

加えてHaskellと違いRustにはサンクなどは存在しないため、確かにそう言うこともできるのかもしれない。

まとめ

以下のような主張はすべて誤りである。

Haskellに変数は存在しない: 変数は本来不定のものという意味で、一度代入した値を変えられる構造ではない。それだけでなく、HaskellにはIORefのような参照型も存在する。そもそも本来「ミュータブルな参照」と呼ぶべき概念を変数と呼称すべきではない。
Haskellでは全てが定数である: 定数は場合にかかわらず決まった値を持つもの、例えば0や円周率などで、実行時に変化させることのできないものがすべて定数というわけではない。
Haskellには代入は存在しない: 代入そのものはほとんどの実用的な言語に存在する概念で、もちろんHaskellも例外ではない。変数が直接指し示す場所に再代入をすることは許されていない点が、Cなどの典型的な手続き型言語と異なる。繰り返しになるが、IORefやミュータブルな配列などを使えば、同じ構造を参照しながら、中身の値を実行時に変化させることができる。
純粋な関数型言語では変数は値に直接束縛される: この文言を信じていると、遅延評価を原則とする言語で痛い目を見ることになるだろう。バインディングは式の評価とは無関係であることを忘れてはいけない。

また、英語などで書かれた文書を翻訳するときも、bindがどちらの意味で使われているかに注意を払うべきである。

*1:Haskellの変数には値を代入しません、束縛します。

*2:手続き型との違い

*3: 自由変数と束縛変数

*4: 束縛 (情報工学) - Wikipedia

*5:GHCにおけるオブジェクトの正確な分類は、Commentary/Rts/Storage/HeapObjects – GHCで詳しく述べられている

*6: Variable Bindings - The Rust Programming Language

2018-06-03

日持ちする直列化のためのライブラリ「winery」

人類は、酒と共に発展してきたと言っても過言ではない。穀物や果実などを酒に変換することにより、糖を除く栄養を保ったまま、高い保存性を持たせることができる。酒は人々の喉を潤し、時に薬として使われた。

プログラミングにおいても、終了したら消えてしまうデータを、保存性の高いバイト列に変えたい場面がよくある。そのような操作を直列化(シリアライズ)と呼び、いくつかのアプローチが存在する。

コード生成タイプ

Protocol Buffers、cap'n'protoなど

データの構造を記述する言語(スキーマ)から、データ構造およびシリアライザ・デシリアライザをコードごと生成する。幅広い言語で使える一方、作れる構造が限られており、定義済みの構造にも使えないので、Haskellのような言語とは相性があまりよくない。

互換性を保つ機能が充実していることが多い。

汎用フォーマットタイプ

CBOR、MessagePack、JSON、XMLなど

数値や文字列などを自由に組み合わせられる表現を用いる。腐りにくく、表現の自由度も高いが、レコードの配列などをエンコードするとフィールド名の分だけ冗長になってしまう。また、既存のデータ型との相互変換において互換性を保つには自分で処理を書く必要がある。

固定タイプ

Marshal (OCaml)、binary (Haskell)など

何のメタデータも持たせず、値の集まりを直接エンコードする。バイト数を短縮でき、型さえ合っていれば正しくデコードできるが、型が変わってしまうと元のデータは使い物にならなくなってしまう。そのため、複雑な構造の長期保存には向かない。

winery

これらのアプローチの欠点を克服するため、wineryという新しいライブラリを開発した。

基本のインターフェイスはbinaryと同様、至ってシンプルである。Serialiseクラスのインスタンスなら、 serialiseで値をByteStringにエンコードし、deserialiseでデコードできる。

instance Serialise a where
  schemaVia :: Proxy a -> [TypeRep] -> Schema
  toEncoding :: a -> Encoding
  deserialiser :: Deserialiser a

serialise :: Serialise a => a -> ByteString
deserialise :: Serialise a => ByteString -> Either StrategyError a

ジェネリクスを用いて、レコードや和型にインスタンスを与えることもできる。以下のように書けばレコードのためのインスタンスを生成できる。gdeserialiserRecordにJustを与えれば、デフォルト値を指定することもできる。

instance Serialise Foo where
  schemaVia = gschemaViaRecord
  toEncoding = gtoEncodingRecord
  deserialiser = gdeserialiserRecord Nothing

このように宣言を省略した場合、任意の和型に対応したものが作られる。

instance Serialise Foo

wineryがbinaryと違うのは、データだけでなく、そのスキーマも直列化するという点だ。serialiseはスキーマを付属させることにより、生成元のプログラムが変わったり失われたりしても、データがどのような構造を持っているか知ることができる。フィールド名などのメタデータを一箇所に集約することによって、CBORやJSONなどの持つ冗長性を解決している。

|スキーマのバージョン|スキーマ|データ|

以下はwineryのスキーマ型の定義である。Serialiseのインスタンスはジェネリクスによって導出されている。

data Schema = SSchema !Word8
  | SUnit | SBool | SChar
  | SWord8 | SWord16 | SWord32 | SWord64
  | SInt8 | SInt16 | SInt32 | SInt64 | SInteger
  | SFloat | SDouble
  | SBytes | SText
  | SList !Schema | SArray !(VarInt Int) !Schema
  | SProduct [Schema] | SProductFixed [(VarInt Int, Schema)]
  | SRecord [(Text, Schema)]
  | SVariant [(Text, [Schema])]
  | SFix Schema
  | SSelf !Word8
  deriving (Show, Read, Eq, Generic)

SFixとSSelfはやや奇妙に映るかもしれない。これは、再帰的なデータ型のためのもので、SFixは不動点を束縛し、SSelf nは直近n番目の不動点を参照する。このFooとBarのような複雑に絡み合った再帰も、wineryならば難なく直列化できる。

data Foo = Foo | FooBar Foo Bar
data Bar = BarFoo Foo | BarBar Bar

スキーマとデータを分別して使うことももちろん可能だ。serialiseOnlyは、データのみを直列化する。

serialiseOnly :: Serialise a => a -> ByteString

スキーマはschema関数で取得できるので、そのままserialiseすれば良い。

schema :: Serialise a => proxy a -> Schema

データを復元する際は、まずdeserialiseでSchemaを取り出したのち、getDecoderでデシリアライザを生成する。対応していないスキーマの場合はエラーになり、成功した場合はByteStringから値を復元する関数が得られる。スキーマを解釈する関数と、デコードする関数が分離されているため、一度スキーマを与えれば、多数のデータを高速に処理することができる。

getDecoder :: Serialise a => Schema -> Either StrategyError (ByteString -> a)

互換性

レコードからのフィールドの削除と、バリアントへのコンストラクタの追加は自明に互換性を保てる。それ以外の場合、自分でデシリアライザを組み立てることも可能である。

Deserialiserが基本となる構造である。Alternativeのインスタンスなので、複数の値を取り出したり、スキーマに対応できなかった場合に代わりを用意するといった合成可能性を持つ。

deserialiser :: Serialise a => Deserialiser a

レコードから値を取り出すにはextractFieldを使う。

extractField :: Serialise a => Text -> Deserialiser a

コンストラクタを抽出したい場合、extractConstructorを使う。 gdeserialiserVariant <|> (\() -> Unknown) <$> extractConstructor "Obsolete"のように、ジェネリックな実装と組み合わせることによって今は無きコンストラクタにも対応することができる。

extractConstructor :: Serialise a => Text -> Deserialiser a

検査性

wineryのコマンドラインツールを使えば、元のプログラムなしにデータをいい感じに成形して閲覧できる。どんなデータもデシリアライズできるTerm型を内部で利用している。

$ winery --print-schema < test.winery
μ { foo :: ( Nothing | Just Integer ), bar :: [ByteString], nodes :: [Self 0] }
{ foo = Nothing
, bar = ["hello"]
, nodes = [{ foo = Just 42, bar = ["world"], nodes = [] }] }

将来的には、jqのような豪華なDSLを用意する予定だ。雑に(しかしながらコンパクトかつ高速に)ダンプした情報をwineryコマンドで整形し、UNIXのコマンドや表計算ソフトで解析するといった斬新な戦法も可能になるだろう。

隠し能力

binaryと違い、wineryのデシリアライザはステートレスである。その心は、値を取り出すために、バイト列を全て走査する必要がない。正格でない構造なら、巨大なデータの一部を必要に応じて取り出すという使い方もできる。

まとめ

wineryはbinaryに似た簡単なインターフェイスを持ちながら、シリアライズした情報の可用性を飛躍的に高める。まだまだ荒削りではあるが実用にも耐え、定番ライブラリであるbinaryやaesonの代替として高いポテンシャルがあると信じている。もしバグや要望などがあれば、ぜひGitHubに投稿願いたい。

2018-02-11

HaskellでDiscordのBotを作る

Discordはゲーミング向けのテキストチャットと音声通話を兼ねるプラットフォームであり、「テキストチャンネル」と「ボイスチャンネル」の二種を好きなだけ作ることができる。もちろん音声を全チャンネルに常時垂れ流すわけには行かないので、通話するにはボイスチャンネルに参加するという手順を踏む必要がある。しかし、例えば誰かがやっているゲームに混ざろうとしてボイスチャンネルに参加しても、チャンネル外のユーザーにはいかなる通知も発生しないため、気づかれないままのことがよくある。

そこで、ボイスチャンネルに参加したとき、テキストチャンネルにその旨を投稿するボットを用意すれば、気軽に通話の合図を送れる。全員に通話の意思を表明でき、Skypeの着信のように邪魔にもならないので、少人数のグループにとって極めて有用である。

Discordは柔軟なAPIを用意しているため、比較的容易にそのようなボットを開発できる。もちろん、Haskellを使って実装する。この記事で使用するソースコードはGitHub - fumieval/discord-vc-notificationにある。

使ってみる (2018/02/28追記)

アプリは公開してある。このURLから認証し、テキストチャンネルのトピックにdiscord-vc-notification: Generalという行を追加すれば、お使いのサーバーのGeneralボイスチャンネルに誰か参加したときに通知される。

https://discordapp.com/oauth2/authorize?client_id=418329413860458496&scope=bot&permissions=53484608

APIの利用

まず、からNew Appをクリックし、アプリおよびボットの情報を登録する。フォームを適当に埋めるだけで良い。完了したらClient IDとBot tokenをメモしておく。そして、以下のURLを開き、どのサーバーに追加するか決めて認証する。なお、53484608はパーミッションをエンコードした整数で、公式のツールで計算することができる。

https://discordapp.com/oauth2/authorize?client_id=クライアントID&scope=bot&permissions=53484608

デッキ構築

Discordは、WebSocketでリアルタイムに通信するGatewayとRESTful APIの二種類を提供し、どちらもTLSを通じる。前者はwebsocketsとTLSをサポートする為のwuss、後者はhttp-clientとhttp-client-tlsを必要とする。stackでパッケージを作成し、package.yamlに以下の依存ライブラリを指定する。

dependencies:
- base >= 4.7 && < 5
- aeson
- bytestring
- http-client
- http-client-tls
- http-types
- text
- time
- unordered-containers
- websockets
- wuss
- rio
- unliftio

Preludeのゾロ新*1には懐疑的だが、あえてMichael Snoymanがつい最近リリースしたrioをデッキに加えた。

github.com

処理の流れ

公式ドキュメント*2でも認めるほど、Gateway APIはやや複雑だ。まずはこのインチキダイアグラムで処理の流れを確認しよう。 f:id:fumiexcel:20180208223954p:plain

矢印が示す順に、メッセージの送受信を行う。

Hello

まずはGatewayに接続してみよう(dvn-connect.hs)。

import Control.Monad
import qualified Data.ByteString.Char8 as B
import qualified Network.WebSockets as WS
import qualified Wuss as WS

main = WS.runSecureClient "gateway.discord.gg" 443 "/?v=6&encoding=json"
  $ \wsConn -> forever $ WS.receiveData wsConn >>= B.putStrLn

実行すると、図に示したように、まずコード10のHelloメッセージが送られてくるのが確認できる。opがコード、dが内容を表す。heartbeat_intervalは、こちらがHeartbeatメッセージを送信すべき周期をミリ秒単位で指定している。

{"t":null,"s":null,"op":10,"d":{"heartbeat_interval":41250,"_trace":["gateway-prd-main-qrq5"]}}

Heartbeat

次にHeartbeatを送信する(dvn-heartbeat.hs)。これを怠ると一定時間後に切断されてしまう。

WebSocketの接続はプログラム全体で共有したいが、そんな時にrioが役に立つ。最大の売りであるRIO型は、ReaderT r IOと等価なモナドなのだ。 rioはロガーも提供しており、Env型に放り込むことでRIO内なら好きな時にログを出力できる。

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
import RIO
import UnliftIO.Concurrent
import Data.Aeson
import Data.Aeson.Types
import qualified Network.WebSockets as WS
import qualified Wuss as WS

data Env = Env
  { wsConn :: WS.Connection
  , logFunc :: LogFunc
  }

instance HasLogFunc Env where
  logFuncL = to logFunc

send :: Value -> RIO Env ()
send v = ask >>= \Env{..} -> liftIO $ WS.sendTextData wsConn $ encode v

JSONの解釈にはaesonのParserモナドを使う。固有アクションの一つである(.:) :: FromJSON a => Object -> Text -> Parser aは、オブジェクトから指定された名前のフィールドを取り出す。

そして、実行すべきアクションを結果として返す。IOアクションを別のモナドのアクションから返すコンボはなかなか有用だ。なお、forkIOはunliftioパッケージで定義され、import UnliftIO.Concurrentからインポートしたものを参照している。RIOに対応しているため、自分でReaderTを剥がす必要がなく、ボンタンアメのごとくそのまま使える。rioを使った甲斐があったと言えるだろう。

sendHeartbeat :: Int -> RIO Env ()
sendHeartbeat period = forever $ do
  send $ object ["op" .= (1 :: Int), "d" .= (251 :: Int)]
  liftIO $ threadDelay $ 1000 * period

hello :: Object -> Parser (RIO Env ())
hello obj = do
  op <- obj .: "op"
  guard $ op == (10 :: Int)
  dat <- obj .: "d"
  interval <- dat .: "heartbeat_interval"
  return $ void $ forkIO $ sendHeartbeat interval

mainは以下のようになる。

main :: IO ()
main = WS.runSecureClient "gateway.discord.gg" 443 "/?v=6&encoding=json"
  $ \wsConn -> do
    logOpts <- mkLogOptions stderr True -- verbose
    withStickyLogger logOpts $ \logFunc -> forever $ do
      bs <- WS.receiveData wsConn
      obj <- case decode bs of
        Nothing -> fail "Failed to parse a JSON object"
        Just a -> pure a
      runRIO Env{..} $ case parse hello obj of
        Success m -> m
        Error _ -> logWarn $ "Unhandled: " <> displayBytesUtf8 (toStrictBytes bs)

実行するといい感じにフォーマットされたログが出てくる。なお"op":11は、 Heartbeatに対する肯定応答だ。

f:id:fumiexcel:20180211161028p:plain

Identify

次は認証のためのデータを送信する( dvn-identify.hs) 。ここでトークンが必要になるので、環境変数から取得してEnvにセットする。

+import System.Environment

 data Env = Env
   { wsConn :: WS.Connection
+  , botToken :: Text
   , logFunc :: LogFunc

 main = WS.runSecureClient "gateway.discord.gg" 443 "/?v=6&encoding=json"
   $ \wsConn -> do
+    botToken <- fromString <$> getEnv "DISCORD_BOT_TOKEN"
     logOpts <- mkLogOptions stderr True

あとは固定されたデータを送るだけでかまわない。

identify :: RIO Env ()
identify = do
  Env{..} <- ask
  send $ object
    [ "op" .= (2 :: Int)
    , "d" .= object
      [ "token" .= botToken
      , "properties" .= object
        [ "$os" .= T.pack "linux"
        , "$browser" .= T.pack "discord-vc-notification"
        , "$device" .= T.pack "discord-vc-notification"
        ]
      , "compress" .= False
      , "large_threshold" .= (250 :: Int)
      , "shard" .= [0 :: Int, 1]
      , "presence" .= object
        [ "game" .= Null
        , "status" .= T.pack "online"
        , "since" .= Null
        , "afk" .= False
        ]
      ]
    ]

helloを受け取った直後に送信するようにすれば完成だ。

   interval <- dat .: "heartbeat_interval"
-  return $ void $ forkIO $ sendHeartbeat interval
+  return $ do
+    _ <- forkIO $ sendHeartbeat interval
+    identify

実行すると以下のような出力が得られるはずだ。READYは認証に成功したことを意味し、このボットを承認しているサーバーの数だけGUILD_CREATEが送られてくる。

2018-02-11 16:22:46.592659: [warn] Unhandled: {"t":null,"s":null,"op":11,"d":null}
@(tutorial/dvn-identify.hs:75:20)
2018-02-11 16:22:46.593743: [warn] Unhandled: {"t":"READY","s":1,"op":0,"d":{"v":6,"user_settings":{},"user":{"verified":true,"username":"Wight","mfa_enabled":false,"id":"410395043501965312","email":null,"discriminator":"4943","bot":true,"avatar":"d4b67c58bf382981f5fb8ce73930cf4c"},"shard":[0,1],"session_id":"82c05e747cd8480db30909572a9a493e","relationships":[],"private_channels":[],"presences":[],"guilds":[{"unavailable":true,"id":"349143256711561216"},{"unavailable":true,"id":"410796870978502657"}],"_trace":["gateway-prd-main-1476","discord-sessions-prd-1-19"]}}
@(tutorial/dvn-identify.hs:75:20)
2018-02-11 16:22:46.594370: [warn] Unhandled: {"t":"GUILD_CREATE", ...

Guild Create

いよいよ本質的な機能の実装に迫る。どのボイスチャンネルを監視し、どのテキストチャンネルに投稿するのかを、チャンネルに設定されたトピックを読み込んで決める(dvn-watchlist.hs)。

現在は受信処理をするのはhelloしかないが、Object -> Parser (RIO Env ())を合成可能にすれば新しいハンドラを定義できる。答えは簡単で、Altモノイドを使えばよい。AltはAlternativeのインスタンスをMonoidに変換するラッパーで、Parserが失敗した時に次のハンドラを呼び出すことができる。これからよく使うので、型シノニムを定義しておこう。

+import Data.Monoid

-hello :: Object -> Parser (RIO Env ())
-hello obj = do
+type MessageHandler = Object -> Alt Parser (RIO Env ())
+
+combined :: MessageHandler
+combined = mconcat [hello] 
+
+hello :: MessageHandler
+hello obj = Alt $ do

-      runRIO Env{..} $ case parse hello obj of
+      runRIO Env{..} $ case parse (getAlt . combined) obj of

サーバー内のチャンネル一覧を含む巨大なオブジェクト(guildオブジェクト)がGUILD CREATEメッセージとして飛んでくる。これを処理する関数guildCreateと、チャンネルのトピックを読み込み、監視すべきボイスチャンネルの一覧を取得するwatchListを定義する。取得した情報はHashMapのIORefとして管理する。

+import qualified Data.HashMap.Strict as HM
+import qualified Data.Text as T

   , logFunc :: LogFunc
+  , watchMap :: IORef (HM.HashMap Text Text)
   }

     logOpts <- mkLogOptions stderr True
+    watchMap <- newIORef HM.empty
     withStickyLogger logOpts $ \logFunc -> forever $ do

watchListはdiscord-vc-notification:で始まる行をトピックから探し、IDの一覧を取り出す。ボイスチャンネルについてはそもそもtopicフィールドが存在しないので、空のリストを返す。

watchList :: Object -> Parser [(Text, Text)]
watchList obj = do
  topic <- obj .: "topic"
  tcid <- obj .: "id"
  return $ do
    str <- T.lines topic
    vcids <- maybeToList $ T.stripPrefix "discord-vc-notification:" str
    vcid <- T.splitOn " " vcids
    guard $ not $ T.null vcid
    return (vcid, tcid)
  <|> pure []

各チャンネルについてwatchListを呼び出し、HashMapに変換したのちIORefに書き込む。

guildCreate :: MessageHandler
guildCreate obj = Alt $ do
  t <- obj .: "t"
  guard $ t == ("GUILD_CREATE" :: Text)
  dat <- obj .: "d"
  chs <- dat .: "channels"
  wm <- HM.fromList . concat <$> traverse watchList (chs :: [Object])
  return $ do
    Env{..} <- ask
    writeIORef watchMap wm
    logDebug $ "watchlist: " <> displayShow wm

忘れずに定義した関数をcombinedに追加しよう。

 combined :: MessageHandler
 combined = mconcat
   [ hello
+  , guildCreate
   ]

Discordのチャンネルのトピックに、discord-vc-notification: 41xxxxxxxxxxxxxx(チャンネルID)という行を追加してみよう。チャンネルIDはDiscordのクライアントからUser Settings -> Appearance -> Developer Modeを有効にし、チャンネル名を右クリックすることで取得できる。成功すれば、起動時に以下のようなログが出るはずだ。

2018-02-11 17:06:35.557899: [debug] watchlist: fromList [("349143256711561218","410323579796717579")]
@(tutorial/dvn-watchlist.hs:79:5)

Voice State Update

ユーザーが参加、退出、ミュートなどの操作をしたとき、VOICE_STATE_UPDATEメッセージが送られてくる。内容はVoice Stateオブジェクトで、ここからユーザーIDとチャンネルIDを取り出す。

ユーザーが参加した時だけその旨を投稿したいので、退出やミュートに関するイベントは無視する必要がある。そのため、各ユーザーはどのボイスチャンネルに入っているかをHashMapで管理する。

   , watchMap :: IORef (HM.HashMap Text Text)
+  , memberState :: IORef (HM.HashMap Text Text)
   }

     watchMap <- newIORef HM.empty
+    memberState <- newIORef HM.empty
     withStickyLogger logOpts $ \logFunc -> forever $ do

この場合アトミック性は要求されないが、atomicModifyIORefの結果としてアクションを返す小技を紹介しておこう。

voiceChannelJoin :: MessageHandler
voiceChannelJoin obj = Alt $ do
  t <- obj .: "t"
  guard $ t == ("VOICE_STATE_UPDATE" :: Text)
  dat <- obj .: "d"
  cid <- dat .:? "channel_id"
  uid <- dat .: "user_id"
  return $ do
    Env{..} <- ask
    wm <- readIORef watchMap
    joined <- atomicModifyIORef memberState
      $ \ms -> (HM.alter (const cid) uid ms, do
        vc <- cid
        tc <- HM.lookup vc wm
        return $ postJoined uid vc tc)
    sequence_ joined

postJoined :: Text -> Text -> Text -> RIO Env ()
postJoined uid vc tc = logInfo
  $ mconcat [display tc, ": ", display uid, " joined ", display vc]

 combined :: MessageHandler
 combined = mconcat
   [ hello
   , guildCreate
+  , voiceChannelJoin
   ]

combinedに新しいハンドラを追加して出来上がり( dvn-update.hs )。実際にDiscord側のボイスチャンネルに参加してみると、以下のようなログが残る。体裁を整えてメッセージとして投稿すればいよいよ完成だ。

2018-02-11 17:23:44.765171: [info] 410796870978502659: 345439212583256064 joined 410796870978502661

POST /channels/:channel_id/messages

dvn-post.hs からはいよいよRESTful APIの出番が出てくる。異なるプロトコルなのでやや面倒ではあるが、特別難しいことはない。

+import qualified Data.Text.Encoding as T
+import Data.Time
+import qualified Network.HTTP.Client as HC
+import Network.HTTP.Client.TLS
+import Network.HTTP.Types

HTTPクライアントのマネージャーを用意しておく。プログラム全体で扱う値をEnv型にまとめておいたおかげで、このような変更がしやすい。

   { wsConn :: WS.Connection
+  , hcManager :: HC.Manager
   , botToken :: Text

     memberState <- newIORef HM.empty
+    hcManager <- HC.newManager tlsManagerSettings
     withStickyLogger logOpts $ \logFunc -> forever $ do

APIを呼び出す関数は以下のように定義できる。

discordApi :: Method -> [Text] -> Maybe Value -> RIO Env Object
discordApi m ps obj = ask >>= \Env{..} -> do
  initialRequest <- liftIO $ HC.parseRequest "https://discordapp.com/"
  resp <- liftIO $ HC.httpLbs initialRequest
    { HC.method = m
    , HC.path = T.encodeUtf8 $ T.intercalate "/" $ "/api" : ps
    , HC.requestBody = maybe mempty (HC.RequestBodyLBS . encode) obj
    , HC.requestHeaders =
      [ ("Authorization", "Bot " <> T.encodeUtf8 botToken)
      , ("User-Agent", "discord-vc-notification")
      , ("Content-Type", "application/json")
      ]
    }
    hcManager
  case decode $ HC.responseBody resp of
    Nothing -> fail $ "Malformed response: " ++ show (HC.responseBody resp)
    Just a -> return a

ボイスチャンネルに参加した時、以下の内容を投稿したい。

時刻
チャンネル名
ユーザー名
できればアイコンも

それを実現してくれるのが埋め込みオブジェクトだ。それぞれ、timestamp、description、ユーザー名とアイコンはauthorに含めることでいい感じに投稿できる。GET /users/:user_idを呼び出すとユーザーの名前とアイコンのURLのための識別番号を取得できる。実際に投稿できるようにpostJoinedを書き換える。

postJoined :: Text -- user id
  -> Text -- voice channel id
  -> Text -- text channel id
  -> RIO Env ()
postJoined uid vc tc = do
  now <- liftIO getCurrentTime
  uInfo <- discordApi "GET" ["users", uid] Nothing
  author <- either fail pure $ flip parseEither uInfo $ const $ do
    name <- uInfo .: "username"
    avatar <- uInfo .: "avatar"
    return $ object
      [ "name" .= (name :: Text)
      , "icon_url" .= T.intercalate "/"
        ["https://cdn.discordapp.com", "avatars", uid, avatar <> ".png?size=256"]
      ]
  void $ discordApi "POST" ["channels", tc, "messages"]
    $ Just $ object
      [ "content" .= T.empty
      , "embed" .= object
        [ "description" .= T.concat ["Joined <#", vc, ">"]
        , "timestamp" .= formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S" now
        , "author" .= author
        ]
      ]

そして、ボイスチャンネルに参加すると、このようなメッセージが投稿される。あたかもテキストチャンネルに参加したかのように表示されている(おそらくDiscordクライアントのバグ)が、なかなかこぎれいにまとまっている。

f:id:fumiexcel:20180211182202p:plain

無関係なメッセージを無視する処理などを加えて仕上げたのがMain.hsだ。

まとめ

特に非自明なことをやったつもりはなかったが、いくつかの発見があった。

monad-controlのより安全*3な代替物としてのunliftioの存在。
IOアクションを別のモナドのアクションとして返す技「モナド重ね」の有用性。
欲しいものを自分で実現できるDiscordのAPIの網羅性。

DiscordのBot開発は、下手なゲームよりも遊び甲斐がありそうだ。

*1:ジェネリック医薬品を指す俗語

*2:"The API for interacting with Gateways is complex and fairly unforgiving"

*3:monad-control is trickyを参照

2017-12-24

ガバガバAltJSを作った(言語実装 Advent Calendar 2017)

qiita.com

JavaScriptを書いていると、頻出する継続渡しのリフレインにうんざりさせられる。

foo.bar(function(result){
  qux.baz(function(data){
    hoge(function(r){
　　...
    });
  });
});

そこで、腕試しに継続モナドをベースにしたAltJS、jatkoを作った。フィンランド語で「継続」という意味だ(継続戦争から知った人も多いだろう)。しかし、なんの考えもなしに653行Haskellを書いた結果ガバガバな言語になってしまった。

Hello, world

Haskellにだいぶ近いのでなんとなく読めるはず。

infixr 1 ->
infixr 0 $

($) = \x -> x

constructor String : Type
constructor (->) : Type -> Type -> Type
constructor JSAction : Type -> Type
constructor JSCont : forall b r. ((b -> r) -> r) -> JSAction b

register return JSAction = \a -> JSCont $ \cont -> cont a
register bind JSAction = \m k -> JSCont $ \cont -> case m of
  JSCont f -> f $ \a -> case k a of
    JSCont c -> c cont

console'log = [|function(str){ return function(cont){console.log(str); cont(null);}|]
  : String -> JSAction Unit

main = (do
  console'log "hello,";
  console'log "world") JSAction

console'log = [|function(str){ return function(cont){console.log(str); cont(null);}|]
  : String -> JSAction Unit

この部分が重要で、継続渡しスタイルな生JSをBSDブラケットで囲むことでアクションを定義でき、do記法でフラットに組み合わせることができる。

ガバガバポイントその1: 型と値を区別しない

型も値も同じ構造で扱うという、JavaScriptもびっくりなガバガバ仕様を採用した。すべてはこのExpr型の値として表される。

data Literal = LInt !Int | LDbl !Double | LStr !String
  | LJavaScript !String
  deriving (Show, Eq)

data Expr a = Var a -- ^ 変数
  | Expr a :$ Expr a -- ^ 適用
  | Con !Name [Expr a] -- ^ コンストラクタ
  | Lit !Literal
  | Lam !Name (Expr a)-- ^ ラムダ
  | Case [(Name, [Name], Expr a)] -- ^ パターンマッチ
  | Expr a ::: Expr a -- ^ 型シグネチャ
  | Forall !Name (Expr a) -- ^ 全称量化
  | Coerce (Expr a)
  deriving (Show, Eq, Functor, Foldable, Traversable)

ガバガバポイントその2: 後付けできるパターンマッチ

register return JSAction = \a -> JSCont $ \cont -> cont a

とすると、returnが種Type -> Typeの型tを受け取り、a -> t aを返す関数として定義され、JSActionに対する実装が追加される。実装を後から増やすことが可能で、型クラス相当の役割を担うが、クラスに相当する宣言が今の所存在しない。

ガバガバポイントその3: 怪しい型推論

型推論器は何も参考にせず勝手気ままに実装した。それっぽく振舞うが、高い確率で欠陥がある。

気づきなど

構文解析にはparsers、実装としてtrifectaを使った。これがなかなか使いやすく、二項演算子からリテラルまでだいたい欲しいものが揃っている。特に面白いのは、「改行をスキップしない」のようなパーサーの変化をモナド変換子によって実現しているところだ。これは「モナド変換子の代替」とされるExtensible effectsでは素直にはいかないだろう。

オフサイドルールの実装はなかったので、同じようにモナド変換子として実装を試みたが、do記法がうまく扱えなかった。しっくりくる実装ができたらプルリクエストを送りたい。

演算子の優先順位などの情報を共有したり、型推論器で状態を扱うのにもReaderT、StateTなどが役に立つ。まとめると、パーサーコンビネータとモナド変換子があれば言語処理系が作れるというわけだ。

2017-12-19

HaskellのABC(Haskell Advent Calendar 6th)

Haskellといえば一文字変数名、一文字変数名といえばHaskellという{{要出典}}ほどにHaskellでは一文字の変数名がよく使われている。これは名前を考えるのをサボっているとは限らない。多相性によって変数が具体的な性質を持たないがゆえに、具体的な名前がつけられないというのが主な理由だ。あるいは、適切な名前があっても、既存の名前と被っているという場合もある。かといって完全なランダムというわけでもないので、一文字変数名はどのように選べばいいか考察していこう。

a

よくある種: *

アルファベットの最初であるaは汎用性が高い。型変数に使うのが王道だ。値レベルの変数として単体で使うことは意外と少ない。

reverse :: [a] -> [a]

b

よくある種: *

aに続いて、bも型変数によく使われる。

map :: (a -> b) -> [a] -> [b]

c

三つの値が与えられたとき、それぞれa, b, cとつけることが多い。また、継続(continuation)に名前を付けたいがkとcontが使用済みな場合にも使う。

d

よくある型 Float, Double

差分(difference)もしくは行列式(determinant)として。dx,dyのように他のアルファベットと組み合わせる場合も多い。

e

何かの要素(element)であるという性質を強調したいとき、型、値ともに使うことがある。

f

よくある種 * -> *

関数(function)を表すのに非常に重要だ。Alternative以下な関手のための型変数にもよく使われる。

g

よくある種 * -> *

fとほぼ同じ用途である。

h

fと同じ使い方もするが、高さ(height)としての出番が多い。

area :: Num a => Rectangle a -> a
area (Rectangle w h _ _) = w * h

i

よくある型 Int

添字(index)を表す定番の文字で、言語を問わずよく使われている。入力(input)を表すのにも使う。

j

よくある型 Int

iに続いて添字を表す。筆者はヤコビアンに使ったこともあるが、あまりいい例とは言えない。

forM_ [0..9] $ \i -> forM_ [0..9] $ \j -> putStrLn $ show i ++ " * " ++ show j ++ " = " ++ show (i * j :: Int)

k

第三の添字あるいはマップのキーのほか、Haskellにおいては継続の名前としてもよく使われる。種変数も忘れてはいけない。

answer :: ContT r IO Int
answer :: ContT $ \k -> do
   putStr "Calculating the answer..."
   k 42
   putStrLn "Done."

l

長さ(length)として。まれに、内容に興味のないリストの名前として使うこともある。

m

よくある種 * -> *

よくある型 Map k v, Int

モナドの型変数や、モナディックなアクションの名前として頻繁に使う、ある意味Haskellらしい変数名だ。nと共に、整数の変数としてもしばしば出番が来る他、マップの名前としても使う。

when :: Monad m => Bool -> m () -> m ()

n

よくある型 Int

自然数ないし整数を表すことが多い。モナドが二つあるときに使うことも稀にある(mmorphなど)

o

oは忌避される傾向があるが、原点、オプション、出力など、いくらか使い道はある。

p

よくある型 Double, a -> Bool

パラメータ、位置(position)、点(point)、述語(predicate)、ピボットなどに引っ張りだこだ。

q

pに続いてパラメータとして使われる。クエリにも。

r

よくある型 a -> r

結果または継続を表す。これを奪われると個人的にきつい。

newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r }

s

よくある種 *

状態(state)、ストリーム、構造(structure)などに使う。個人的なお気に入りだ。

type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t

t

よくある型 Float, Double

時間(time)、接点、接線(tangent)など。

u

よくある型 Float, Double

UV座標系を扱う際、vとの対で用いる。

v

よくある型 Float, Double

「値(value)」として漠然と使うこともあれば、ベクトル(vector)を表すこともある。言語処理系を実装する際は変数(variable)という意味でも用いる。

w

よくある型 Float, Double

幅(width)、重み(weight)、あるいはクオータニオンの成分など。モナドの双対であるコモナドの型変数としても使われる。その心は上下反転させたm。

x

よくある種 *

値の変数の定番中の定番だ。振る舞いに一切関与しない型変数にも用いられる。

y

xと同様、変数に使う。

z

x,yと同様、汎用的な変数名。座標を扱う際は頻繁に用いる。rが使えないときに代用することもできる。

総評

抽象度の高いコードにおいて、名前をつけるというのはなかなか難しい問題の一つだ。幸い、型変数含め局所的な変数なら一文字でも行儀は悪くないので、既存のライブラリなども参考にしつつガンガン短い名前を使っていこう。

2017-10-17

ステートマシン猛レース

ストリーム処理ライブラリはHaskellにおいて競争の激しい分野の一つだ。ストリーム処理ライブラリとは大雑把に言うと、IOなどの作用を絡めながら値の列(ストリーム)を生成したり、処理したりする構造を提供するライブラリである。多くのライブラリは、以下の3種の構造を定義している。

生産者(プロデューサー): IOなどのアクションを伴いつつ値を生成する。
消費者(コンシューマー): 多くの場合モナド変換子になっており、await :: Consumer s m sのようなアクションを組み合わせ、値の列を処理するプログラムを書ける。
変換者(トランスデューサー): 入力を受け取りながら、出力もできる。

生産者と消費者が変換者の特殊な場合であるものも多い。

今回は、基本中の基本とも言える操作であるスキャンの速さを調べる。scan (+) 0は入力ストリーム[0,1,2,3, ...]を出力[0,1,3,6, ...]のように変換する。

iteratee, tubes, streaming, machinecell, io-streams, pipes, machines, conduit, boomboxと試作品のfeeders、predatorsパッケージをベンチマークした。ソースコードはhttps://github.com/fumieval/feeders/blob/all-bench/benchmarks/benchmark.hsにある。ライブラリ数という点では、2017年現在最も網羅的なベンチマークだろう。

pipes

使用実績: ghc-mod, purescript
利点速い、ドキュメントが豊富
欠点終端、残余を扱えない

まずは人気のpipes。yieldとawaitをモナドで組み合わせる素直なインターフェイスが魅力で、scanの実装もわかりやすい。ただし、runEffect以外の方法での分解はあまり想定していないのか、自分でPipeを分解するにはPipes.Internalモジュールをインポートしないといけない。その際はpipesの設計の理解が必須となる。

scan :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Pipe a b m r
scan step begin done = go begin
  where
    go x = do
        yield (done x)
        a <- await
        let x' = step x a
        go $! x'

変換に相当する値と、それを走らせる関数に分けてCriterionでベンチマークする。

sourceP :: Monad m => P.Producer Int m ()
sourceP = each [1..10000]

drainP :: Pipe Int a Identity () -> ()
drainP p = runIdentity $ runEffect $ for (sourceP >-> p) discard

main = defaultMain
  [ bench "pipes" $ whnf drainP (scan (+) 0 id) ]

10000要素を処理するのに179μsという結果が出た。一件あたり18ナノ秒はなかなか悪くないと言えるだろう。なおGHCは8.0.2で、CPUはIntel(R) Core(TM) i7-6700K CPU @ 4.00GHzである。

time                 179.3 μs   (177.9 μs .. 180.8 μs)
                     1.000 R²   (0.999 R² .. 1.000 R²)
mean                 179.1 μs   (178.4 μs .. 179.9 μs)
std dev              2.457 μs   (2.043 μs .. 3.124 μs)

tubes

利点インターフェイスが親しみやすい
欠点極端に遅い

time                 22.99 s    (22.21 s .. 24.75 s)
                     0.999 R²   (0.999 R² .. 1.000 R²)
mean                 22.86 s    (22.61 s .. 23.04 s)
std dev              269.8 ms   (0.0 s .. 308.6 ms)

23「秒」という圧倒的な時間が目を引いたのはtubesだ。Freeモナドをベースにした基本を押さえたAPI、リストモナド相当のSourceに加えContravariantなSinkと第一印象は良いが、さすがに10万倍も遅いと実用的とは言いがたい。

scanT :: Monad m => (b -> a -> b) -> b -> Tube a b m x
scanT f = go where
  go b = await >>= \x -> let !b' = f b x in yield b' >> go b'

sourceT :: Monad m => Tube () Int m ()
sourceT = each [1..value]

drainT :: Tube Int a Identity () -> ()
drainT h = runIdentity $ runTube $ sourceT >< h >< stop

streaming

使用実績: 不明

利点速い
欠点消費者がない

benchmarking scan/streaming
time                 77.40 μs   (77.07 μs .. 77.74 μs)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 77.17 μs   (77.01 μs .. 77.41 μs)
std dev              668.9 ns   (552.8 ns .. 820.2 ns)

streamingはpipesの倍以上の速度が印象的だ。streamingには変換者や消費者に相当する構造はないため、やや不公平な比較かもしれない。

Stream (Of a)がaを生産するモナド変換子であり、これをリストのように扱う数々の関数が提供されている。

drainS :: (Stream (Of Int) Identity () -> Stream (Of a) Identity ()) -> ()
drainS h = runIdentity $ effects $ h sourceS

sourceS :: Monad m => Stream (Of Int) m ()
sourceS = each [1..value]

...
, bench "streaming" $ whnf drainS (S.scan (+) 0 id)

ストリーム処理ライブラリを使う動機はモナディックな消費であることが多いが、そうでない場合は選択肢となりうるだろう。

io-streams

使用実績: snap

利点速い
欠点何を書くにもIOを使わないといけない

time                 87.93 μs   (86.58 μs .. 89.68 μs)
                     0.996 R²   (0.989 R² .. 1.000 R²)
mean                 88.13 μs   (87.08 μs .. 91.47 μs)
std dev              5.351 μs   (1.913 μs .. 10.55 μs)
variance introduced by outliers: 63% (severely inflated)

io-streamsは使うモナドをIOに限定するという開き直った設計のパッケージだ。たかをくくっていたが、streamingに迫る速度が出ており侮れない。

import qualified System.IO.Streams as Is

drainIs :: (Is.InputStream Int -> IO (Is.InputStream b)) -> IO ()
drainIs h = do
  i <- Is.fromList [1..value]
  i' <- h i
  o <- Is.nullOutput
  Is.connect i' o

scanIs :: (b -> a -> b) -> b -> Is.InputStream a -> IO (Is.InputStream b)
scanIs f b0 i = do
  r <- newIORef b0
  Is.makeInputStream $ Is.read i >>= \case
    Nothing -> return Nothing
    Just x -> do
      b <- readIORef r
      let !b' = f b x
      writeIORef r b'
      return $ Just b'

machines

使用実績: 不明

利点各種構造が透明で、拡張性に富む
欠点 Tee、Stackなどの発展形はAPIが乏しく、うまく合成できない

ekmett発のmachinesはまずまずの性能だ。

time                 190.8 μs   (190.1 μs .. 191.5 μs)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 190.7 μs   (190.2 μs .. 191.1 μs)
std dev              1.542 μs   (1.366 μs .. 1.771 μs)

PlanTというCPSのモナドから変換器のMachineTを鋳造するというアプローチを用いている。複数の入力をサポートしているのも面白い。比較的習得は容易だが奥が深い。また、pipesと違い終端に対応できる。

sourceM = enumerateFromTo 1 value

drainM :: ProcessT Identity Int o -> ()
drainM m = runIdentity $ runT_ (sourceM ~> m)

, bench "machines" $ whnf drainM (scan (+) 0)

conduit

使用実績: Yesod

利点ストリームの終端や残りをきちんと扱える
欠点 APIが複雑。オーバーヘッドがある

time                 302.4 μs   (301.5 μs .. 303.3 μs)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 302.1 μs   (301.6 μs .. 302.8 μs)
std dev              2.029 μs   (1.547 μs .. 2.515 μs)

かつて黄金時代を築いたconduitはmachinesよりも遅かった。しかし、ストリームの終端及び残余、リソースの解放などをサポートしていることを考えればかなり優秀だと言える。

import qualified Data.Conduit.List as C
import qualified Data.Conduit.Combinators as CC

drainC :: C.Conduit Int Identity a -> ()
drainC c = runIdentity $ (sourceC C.$= c) C.$$ C.sinkNull

sourceC = C.enumFromTo 1 value

, bench "conduit" $ whnf drainC (CC.scanl (+) 0)

この手のライブラリに依存しないような環境の変化が起こったものの、まだまだ現役だ。コンビネータの種類が非常に多く、ハードルが高いという難点もある。

iteratee

利点ストリームの終端、残余はもちろんシークなども表現可能
欠点遅い。設計が汚く、扱いが非常に難しい

使用実績: Tsuru Capital

最古参のiterateeはpipesの約20倍遅いという残念な結果となった。

time                 3.392 ms   (3.299 ms .. 3.502 ms)
                     0.995 R²   (0.993 R² .. 0.998 R²)
mean                 3.361 ms   (3.325 ms .. 3.399 ms)
std dev              121.1 us   (105.5 us .. 142.4 us)
variance introduced by outliers: 20% (moderately inflated)

実装もわかりやすいとは言いがたい。今あえてこのライブラリを選択する必要はないだろう。iterateeを使ったコードを保守するのは苦行そのものだ。

import qualified Data.Iteratee.Iteratee as I
import qualified Data.Iteratee.ListLike as I

scanI :: Monad m => (b -> a -> b) -> b -> I.Enumeratee [a] [b] m x
scanI f = I.unfoldConvStream (\a0 -> I.liftI $ \case
  I.Chunk xs -> return $ mapAccumL (\a x -> let !r = f a x in (r, r)) a0 xs
  I.EOF _ -> return (a0, [a0]))

sourceI :: I.Enumerator [Int] Identity a
sourceI = I.enumList $ map pure [1..value]

drainI :: I.Enumeratee [Int] [a] Identity () -> ()
drainI h = runIdentity $ I.run $ runIdentity $ I.run $ runIdentity $ sourceI $ h $ I.mapM_ $ const $ return ()

feeders

利点 iterateeの問題点を克服し、親しみやすいインターフェイスを持つ
欠点まだまだ遅い

time                 414.3 μs   (409.7 μs .. 421.8 μs)
                     0.998 R²   (0.996 R² .. 1.000 R²)
mean                 413.9 μs   (412.1 μs .. 421.0 μs)
std dev              9.814 μs   (3.347 μs .. 22.63 μs)
variance introduced by outliers: 15% (moderately inflated)

Feederは、「消費者に供給する構造」として生産者を表現するiterateeの考え方を継承しつつ、よりまともなデザインを目指した試作品だ。

Eaterモナドが消費者、FeederがEaterを変換するモナドとして実装されている。

newtype Feeder s n m a = Feeder { unFeeder :: forall x r. Eater s n x -> (a -> Eater s n x -> m r) -> m r }

killEater :: Monad m => Eater s m a -> m a
sinkNull :: Monad m => Eater s m ()
feed :: Monad m => Feeder s n m a -> Eater s n x -> m (a, Eater s n x)

type Rancher a b m = Feeder b m (Eater a m)
(>-$) :: Monad m => Rancher a b m x -> Eater b m r -> Eater a m r

scan :: Monad m => (b -> a -> b) -> b -> Rancher a b m ()
scan f b = lift await >>= \case
  Nothing -> return ()
  Just a -> do
    let !b' = f b a
    yieldOn liftP b'
    scan f b'

drainF :: Rancher Int a Identity () -> ()
drainF h = runIdentity $ killEater $ snd $ runIdentity $ feed sourceF $ h >-$ sinkNull

sourceF :: Feeder Int Identity Identity ()
sourceF = yieldMany [1..value]

こちらもストリームの終端と残余を扱えるが、conduitにスピードに負けていては仕方がない。

predators

利点 iterateeやconduitと同等の実用的な表現力を、一風変わったシンプルな実装で実現
欠点生産者を使いきって消費者を残すインクリメンタルな使い方はできない

PredatorはFeederとは逆に、生産者を捕食する構造として消費者を実装した。

prey :: Monad m => Predator s n m a -> Prey s n x -> m (Maybe (a, Prey s n x))

type Heterotroph a b m = Predator a m (Prey b m)
(@->) :: Monad m => Prey a m x -> Heterotroph a b m r -> Prey b m (Maybe r)

scan :: Monad m => (b -> a -> b) -> b -> Heterotroph a b m ()
scan f b = do
  a <- awaitOn lift
  let !b' = f b a
  lift $ yield b'
  scan f b'

drainPd :: Heterotroph Int a Identity () -> ()
drainPd h = maybe () fst $ runIdentity $ prey Pd.sinkNull $ sourcePd @-> h

sourcePd :: Prey Int Identity ()
sourcePd = yieldMany [1..value]

conduitと全く異なるアプローチでありながら、残余と終端を処理でき、同等の速度も出ているのでポテンシャルを秘めている。私のやる気が続けばさらなる進展があるかもしれない。ネーミングも気に入っている。

time                 300.7 μs   (299.2 μs .. 302.1 μs)
                     0.999 R²   (0.998 R² .. 0.999 R²)
mean                 314.9 μs   (310.0 μs .. 321.2 μs)
std dev              19.03 μs   (13.81 μs .. 23.15 μs)
variance introduced by outliers: 56% (severely inflated)

boombox

利点高い柔軟性と高パフォーマンスを両立している
欠点 APIが非常に乏しい

ストリーム処理の大統一を目指して作ったライブラリboomboxはpipesよりも速い。

time                 160.7 μs   (160.1 μs .. 161.5 μs)
                     1.000 R²   (0.999 R² .. 1.000 R²)
mean                 163.1 μs   (162.1 μs .. 164.1 μs)
std dev              3.382 μs   (2.810 μs .. 4.125 μs)
variance introduced by outliers: 14% (moderately inflated)

生産と消費にTapeとPlayerTという専用の構造を用意し、変換器は両者を組み合わせて表現する。ストリームの残余処理、シークなどなんでも表現できるが、可能性を残しすぎたことが仇となりAPIが乏しい。Recorder Identity IdentityがPipeに相当する変換器で、IdentityをStoreに差し替えればシーク可能になり、当然通常のストリームからシーク可能なストリームへの変換器も定義できる。NonEmptyコモナドを使えば複数の世界線に分岐するようなストリームも表現できる。machinesと違い、どうカスタマイズしても必ず合成ができるのがポイントだ。

scanB :: (b -> a -> b) -> b -> Recorder Identity Identity m a b
scanB f = go where
  go b = Tape $ await >>= \x -> let !b' = f b x in return (b', pure $ go b')

sourceB :: Tape Identity Maybe Int
sourceB = tap [1..value]

drainB :: Recorder Identity Identity Maybe Int a -> ()
drainB h = maybe () (\(_,_,r) -> r) $ sourceB @.$ h >-$ forever await

パフォーマンスは良好なので、全ライブラリの統一を目指して研究を続けていきたい。

machinecell

利点今のところ唯一のArrowベースのライブラリ
欠点遅い

time                 185.5 ms   (184.1 ms .. 188.5 ms)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 184.2 ms   (183.4 ms .. 185.3 ms)
std dev              1.176 ms   (562.9 μs .. 1.702 ms)
variance introduced by outliers: 14% (moderately inflated)

machinecellはアロー変換子としてストリーム変換器を実装した異色のパッケージだ。これもなかなか速い、と思いきや単位がマイクロではなくミリで、pipesの1000分の1の速さだった。今後の改良に期待したい。

drainMc :: Mc.ProcessA (->) (Mc.Event Int) a -> ()
drainMc h = Mc.run_ (h >>> arr (const Mc.noEvent)) [1..value]

, bench "machinecell" $ whnf drainMc (Mc.evMap (+) >>> Mc.accum 0)

まとめ

あまり凝ったことをしないならば、今のところpipesが無難だと考えている。しかし、終端処理、シークなどが絡むと、どのライブラリも困難に直面する。決着は未だついていない。