旅のチェックリスト

筆者が旅に出る際に確認する項目をまとめた。

事前の準備

  • 渡航ビザ: 必要な場合もあるので事前に確かめよう。
  • ESTA(アメリカの場合): どんな理由であれUSに入国する場合申請する必要がある。大抵すぐ承認されるが、遅くとも出発の72時間前に済ませるべきである。
  • 宿: 好みに応じてホテルでもAirBnBなどで民泊を予約しても。後者はキッチンが用意されているところもある。
  • 交通手段: 電車は大抵の場合当日で大丈夫だが、もちろん船舶や航空機の場合は予約が必須である。
  • 冷蔵庫の整理: 日持ちしないものは消費してしまおう。

携帯するもの

  • 財布: 財布は現金やカードを収納する。リスク回避の観点から財布は省きセキュリティポーチで代用することもできる。
  • : 自宅を施錠、および帰りに解錠するのに必要である。こちらもリスク回避のため、自宅の鍵のみを持っていくという選択もある。
  • 交通系ICカード: 空港や港に向かったり、コンビニで買い物したりする際に便利である。
  • 保険証(国内の場合): 怪我や病気などになった場合、ないと損する。
  • クレジットカード: 紛失した場合無効化できる。
  • 腕時計 時間を気にするならあったほうがよいだろう。
  • 装飾品 首掛けバードコールやブレスレットなど。省略可

一般

汎用性が高いため、これらはまとめて一つの袋などに入れておくと有用である。

  • ビニール袋: ゴミや細々とした物をまとめるために、2枚程度は用意したい。
  • マイクロファイバークロス: レンズやメガネなどの光学機器を使う場合必須である。
  • 非常食 質量・体積あたりのカロリー密度が高いものを100kcal*日数くらい用意しておくと、いざという時の体力の回復に役立つ。
  • インスタント食品 カップ麺やスープなどは熱湯を要求するが、食味とカロリー密度において優れている。特に海外に行く際、一つは用意しておくと心も暖まる。宿泊場所にキッチンがあるがスーパーは遠いといった場合、袋麺なども選択肢になり、荷物の圧縮につながる。

国内で入手しやすいものの質量とカロリーを比較すると以下のようになる。

名前 質量(g) カロリー(kcal) 質量比
inゼリー スーパーエネルギー 120 200 1.67
大粒ラムネ 41 153 3.73
カップヌードル カレー 87 422 4.85
カロリーメイト 80 400 5.0

ゼリーは液体として扱われ、国際線には手荷物として持ち込めないので注意が必要である。

  • 酔い止め: 乗り物酔いする体質の場合
  • サプリメント: 旅先でバランスのいい食事ができるとは限らないのでマルチビタミンは確保したい。また、疲労対策としてアミノ酸サプリメントもあるとよい。小分けにする場合は怪しまれないよう気を付けたい。
  • ボディソープ、シャンプー、コンディショナー、洗顔料など 機内に持ち込めるよう、小さい容器に入れ密封可能な袋にまとめておく。もし宿泊先にあるという確証がある場合は省いても良い。
  • 固体石鹸: もし上記のいずれかを切らした場合のバックアップになる。液体枠を圧迫しないため持っておいて損はない。
  • 剃刀: 除去すべき体毛がある場合用意すべきである。
  • ネックライト: 街灯がなく真っ暗闇になるところもあり、安全を確保する上で重要だ。
  • 爪切り: 爪が伸びすぎると危険かつ不衛生である。1週間を超える滞在の場合は爪切りは必須である。
  • 日焼け止め: 低緯度地域に向かう場合、紫外線から体を守るために用意したい。
  • ポケットティッシュ
  • : 袋でもいいしハンカチでもいい。
  • 絆創膏: 大きめのものが3枚程度あると安心だ。
  • 櫛・ヘアブラシ
  • 新聞紙などの薄い紙: 靴が濡れた際に乾かすのに使える。

衣類

行き先の気候に合わせたものを用意する。

  • 下着
  • 靴下
  • シャツ
  • 手袋
  • 洗濯可能な衣類ケース

電子・電気製品

電気製品は一つの袋にまとめておくと、手荷物検査を迅速に進められる。

  • イヤホン・ヘッドホン: 移動中に音楽を楽しみたい場合。音漏れしにくく、遮音性が高いものを選びたい。国際線では機内エンターテイメントのためにイヤホンが配布される場合もあるが、音質は極めて劣悪だ。
  • 撮影機材: 旅の思い出を残す一つの手段だ。
    • カメラボディ: 割となんでもよい。レンズを交換する隙を晒したくない場合は複数持って行こう。
    • 広角レンズ: 風景、建築、料理や集合写真など、トリミングする前提で幅広く応用できる。大は小を兼ねるとはこのことだ。
    • 超望遠ズーム: 150-600mmなど。2kg程度で取り回しがよく、野鳥や動物の撮影に適する。
    • 高倍率ズームレンズ: 画質・明るさにこだわらないなら、18-300mmなどの高倍率ズームレンズの一本だけでもよい。多くはAPS-C向けで、風景から、野鳥などの撮影まで使える画角を持つ。
    • 三脚: 夜景、自撮り、動画のいずれかを撮る予定なら三脚は欲しい。いざという時は武器にもなる
    • カメラのバッテリーの充電器: 写真のみなら大抵数日は持つが、それ以上の場合は充電器を用意しておくと安心だ。
    • カメラの予備バッテリー
  • カメラとPCを接続するためのケーブルやハブ
  • ラップトップPC: 現地で撮った写真を取り込んで編集、投稿するという一連の流れを実現する上であると望ましい。
  • USB充電器: タップに5V出力が付いたようなものは変換プラグとのシナジーがある。
  • スマートフォンを充電するためのケーブル
  • モバイルバッテリー: 携帯端末のバッテリー切れは避けたい。航空機を使う場合、こちらは預けることができないので要注意。

国外の場合

  • ボールペン: 税関申告書や出入国カードの記入に必要となる。機内で取り出せるようにしておこう。
  • SIMカードを二枚挿しできるスマートフォン: SIMカードの入れ替えは紛失のリスクが伴う。二枚挿入できるスマートフォンを持って行こう。 
  • 旅券(パスポート): 言わずもがな。
  • 海外キャッシングのできるカード: 大量の現金を事前に用意するのはコストやリスクの観点からあまりよろしくなく、通貨によってはそもそも事前に用意できないケースもある。現地で現金を得る手段として確保しておきたい。
  • 変換プラグ: 行き先によっては必要となる。
  • 現金: 最低限、現地の通貨をあらかじめ用意しておきたい。それが難しい場合、現地で両替できるようなものを代わりに持って行こう(メキシコペソなら米ドルなど)。

娯楽

荷物に余裕があるなら、いずれかを持っていくのも一興だ。

  • 携帯用ゲーム機: 移動中の暇潰しになる。
  • トランプ、花札、サイコロなど: 筆者とは無縁だが、複数人での旅なら一つの楽しみとなりうる。
  • DJコントローラ: もし知人同士で自動車に乗り、運転しないということであれば車内が盛り上がること間違いなしだ。
  • MIDIキーボード: 旅先の雰囲気を音楽として残したいなら是非とも用意したい。25鍵など小さいものでもあるとないとでは大違いだ。

出発の直前に(国外の場合)

  • 日本食は食べたか? 長旅の前に日本の食べ物を体に蓄えておきたい。和食やラーメンなどはもちろんだが、見落としがちなのは洋食(オムライスなどの日本料理)だ。
  • 風呂に入ったか? 日本から北米までの距離を渡る際、ほぼ一日風呂に入らずに過ごすことになる。しかも浴室は日本よりも簡素な場合がほとんどなので、出発する直前に入念に体を洗おう。

余録

いかがだろうか?今回ダラスへと向かう機内で執筆していたが、ネックライトと新聞紙を忘れていたことに気づいた。次回はこのリストを見返して気をつけると同時に、読者にもチェックリストの作成をおすすめしたい。

ある期間内に更新されたデータを素早く検索できるモデル

特定の技術とは関係ない、誰でも思いつきそうな、でも便利なお話。

こんなケースを考えてみよう。

人気のトレーディングカードゲームAugur Unlimitedを扱うショップ「しらさぎ商店」では、1000種類にも及ぶカードの買い取り・販売をしている。記録のため、カードごとに日時、価格、在庫数などをまとめたレコードを毎日データベースに書き込んでいる。

新着・売り切れや、価格の変化などを、指定された期間について一覧で表示するようなWebページを作りたいとオーナーは考えた。しかし、ユーザーからの要求ごとに全データの差分を取るのは、あまり効率的な手段とはいえない。レアなカードでもない限り価格は一定であることが多いからだ。 どうすれば更新されたものだけを効率よく取り出せるだろうか?

答えはシンプルで、「日時」を「作成日時」と「終了日時」に分け、価格などが変わった時だけ新しくレコードを作成すると同時に、前のレコードの終了日時を更新すればよいのだ。新しいレコードの終了日時は未来永劫先とする。こうすると、任意の期間t0 ~ t1について、「更新される前のデータの集合」と「更新後のデータの集合」を取得することができる(データベースがこのようなクエリを許す限り)。

  • 更新前: t0 < 終了日時 < t1 かつ 作成日時 < t0
  • 更新後: t0 < 作成日時 < t1 かつ 終了日時 > t1

図にするとこんな感じだ。

f:id:fumiexcel:20190212190421p:plain

赤で示したレコードと緑で示したレコードを比較すると、サンカノゴイが削除され、イスカとカワセミが更新、コブハクチョウが新しく追加されたことがわかる。二番目の条件は、期間内に作成・終了されたレコード(カワセミ)を弾くためのものだ。

至極単純なアプローチだが、このような問題について記述している文章が見つからなかったので、今後のために残しておく。

追記 この形式はValid timeと呼ばれているらしい。

戊戌の追憶

この記事は、筆者が過ごした2018年を簡潔に振り返り、その経験を糧とすることを狙う。

1月

第二鰓弓由来側頸嚢胞という先天異常が原因で首が化膿し、激痛に苦しんでいた。対人関係のトラブルなどもあり軽い錯乱状態にあったのか、自分が知らない間に高い買い物をすることがあった。

drinkery: Boozy streaming library というストリーム処理ライブラリを作った。当初はすべて酒関係の用語を用いていたが、批判を受けてそこはやめた。今思えばそれで正解だった気がする。 パフォーマンスはモナディックなAPIを持つライブラリの中ではトップクラスで、双方向性や多入力多出力のような発展的な機能もあるが、ListTが正しく効率的に実装されているのがなによりの魅力である。ListTのために時々使っている。

危うい精神状態だったが被写体には恵まれた。この写真はけっこう気に入っている。

2月

警察のおかげで対人トラブルは解消された。アリピプラゾール(エビリファイ)の服薬を始めて、自分の脳の働きが変質しているような感じがした。薬のせいか忘れ物が増えた。

Discordのボイスチャンネルに入った際に通知メッセージを投稿する GitHub - fumieval/discord-vc-notification を作った。実用とHaskellチュートリアルを兼ねている。けっこうな数のサーバーに導入されたようで喜ばしい。

fumieval.hatenablog.com

生き甲斐の一つである野鳥撮影は続けた。

3月

花粉症とその薬のせいで生産性がかなり削られていた気がする。

PPL 2018: 第20回プログラミングおよびプログラミング言語ワークショップ

のために鳥取に行った。ヘラサギというレアな鳥に会えた。

4月

溜め込んでいた力を解放できた月だ。

Bigmoonが私の看板ライブラリであるextensibleを使っており、偵察のためにアルバイトを始めた。2週ごとに名古屋に出勤という形で楽しく仕事を続けている。

Haskell-jpの新しいロゴ案を作り、投票によって正式に採用された。薬でブーストされたセンスのおかげだと思う。

5月

アリピプラゾールの副作用の悪夢や物忘れが気になってくる。

Wikiシステムを作った。アルゴリズムからWebプログラミングまで様々な技術を応用するいい課題だった。現在もextensible攻略Wikiに使われている。

この時期はシギ・チドリ類が飛来し、干潟などでよく観察できる。毎年お疲れ様と言いたい。

6月

スキーマを導出してWell typedかつ短いエンコードができるだけでなく、後方互換でコンポーザブルなデシリアライザを構築できる直列化ライブラリ、wineryを創り出した。機能面もパフォーマンスもなかなか優秀なライブラリだと思う。

fumieval.hatenablog.com

サギの雛たちが育ってきてコロニーでは賑やかな光景が見られた。

7月

CAT S60という、サーモグラフィー搭載のごついスマートフォンを買った。他に使っている人を見たことはなく、自慢できる一本だ。

Overwatchでメインで使っていたキャラクターであるシンメトラがリワークを受け、使える技が一新された。研究がされてないこともあいまって環境にぶっ刺さり、シルバーからプラチナ帯までのし上がった。

とあるオフ会に参加して知り合いが増えた。

togetter.com

8月

Lisztというデータベースの実装を一新し、全データを一つのファイルにまとめる試みをしていた。非常に興味深い例題でけっこうな時間を費やした。

Minecraft (Bedrock Edition)でよく遊んだ。しばらくMinecraftから離れていたが、新しい生物やブロックなどが追加されていて通話などもしつつ楽しめた。新たな居場所を見出したような気がした。

9月

Compact regionsというGHC 8.2の新機能の効果的な使い方を発見した。更新頻度が低いデータを納め、それをIORefで保持するのがよい。私が執筆したものではないがこの記事でよく説明されている。

qiita.com

ガス欠気味であまり新しいものを生み出せなかった。なおOverwatchではシンメトラで暴れまくった。

10月

三宅島へと飛んだ。船で行く予定だったが台風で欠航になり、仕方なく新中央航空の19人乗りの双発機で行った。

f:id:fumiexcel:20181001093145j:plain

ほぼ徒歩で島を一周するという目論見で、穏やかながら新鮮な離島の雰囲気を味わうことができた。

予約していた民宿の女将は欠航が理由で私は来ないと思い込んでいたようで、無人の宿の前で待ちぼうけを食うというアクシデントがあった。幸い、数時間したら女将が戻ってきたため蚊に血を吸い尽くされるのは免れた。女将の作ってくれた料理はとても美味しかった。結局、宿泊費はただにしてもらったので結果オーライである。

f:id:fumiexcel:20181002124857j:plain

個人経営の古めかしいスーパーマーケットに東方や艦これのグッズが飾ってあり、離島は離島でも同じ世界にいることを感じた。

f:id:fumiexcel:20181003091512j:plain

三宅島で過ごした三日間は、間違いなく幸せなものだった。鳥の多い時期にまた行きたい。

行きつけのMinecraft BEのサーバーが過疎気味だったので、自分で新しいサーバーを立てた。Java版ゆえにサーバーMODなどが豊富で、以前とはまた違った楽しみ方ができた。

11月

Haskell Day 2018が開催された。Haskell関連の勉強会が開催されるのは久しぶりだ。来場者は150人と大盛況で、有意義なものだった。なお、私はLisztについての発表をしたが、しばらくこのような場に立つことがなかったため発表スキルの低下を痛感した。

仕事ではGHC 8.6への移行に従事していた。セグメンテーション違反で落ちる致命的なバグが見つかったのもいい思い出だ。#15892 (Segmentation fault with ByteString) – GHC

自分でも理由はよくわからないが、この月は写真をあまり撮らなかった。よくよく考えると精神的に不安定だった気がする。

12月

心の調子が急激によくなった。

簡潔データ構造に興味が湧き、厳密には簡潔データ構造ではないがElias-fano encodingという手法について調べていた。

fumieval.hatenablog.com

普段扱っている純粋関数型データ構造とはまた違ったトリッキーさがあり、刺激的な体験だった。

ローグライクなカードゲームのSlay the Spireに少しはまったりした。一押しはディフェクトで、「山札から任意の2枚を選ぶ」「山札の先頭数枚から好きなだけ選んで捨てる」「捨て札を手札に戻す」といった制御系のカードを揃えていき、運ゲー運ゲーでなくする過程が楽しい。

そして鳥の季節がやってきた。昨年は見られなかったアトリが来ていて喜ばしい。

総評

一年を通して、私の心と体、そして人間関係などの環境は徐々に改善された。ストレスの減少によって体づくりの効率も上がったのも間違いない。

そして、私は新しい能力、新しい道具、新しい仲間を得ることができた。来年からとは言わず今日から、それらを無駄にすることのないよう心がけていきたい。

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となる。これをヒストグラムのようにして23個のビンに分ける。

  • 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ビットの整数を105個格納する場合、消費ビット数は17*105ビットとなかなか優秀な圧縮率を誇る。

n番目の値を読み出すときは、上位は{ \displaystyle select_1(n) - n}を求め、下位はそのまま取り出してくっつければよい。{ \displaystyle 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に対して{ \displaystyle O(\log N)}個、selectの計算量は配列の長さNについて{ \displaystyle O(\log N)}なので、この演算の計算量は{ \displaystyle 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により、複雑でバグを仕込みやすい処理も簡単にテストできる
  • 利用例がまだ少なく、研究しがいがある

参考文献

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

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

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

束縛とバインディング

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

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

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

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

Haskellにおける誤解

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

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

  • 未評価の計算(1 + 1など)
  • 値(1Just (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)」という、ここまでの議論からすればもってのほかな表現が使われている。この節は削除されたが、同様の表現が最新版にも残っている。これに関して、所有権によって変数と値の一対一対応があるから可能であるという意見が有識者によって述べられた。

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

まとめ

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

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

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

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

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

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

コード生成タイプ

Protocol Bufferscap'n'protoなど

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

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

汎用フォーマットタイプ

CBORMessagePackJSONXMLなど

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

固定タイプ

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)

SFixSSelfはやや奇妙に映るかもしれない。これは、再帰的なデータ型のためのもので、SFix不動点を束縛し、SSelf nは直近n番目の不動点を参照する。このFooBarのような複雑に絡み合った再帰も、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

データを復元する際は、まずdeserialiseSchemaを取り出したのち、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に似た簡単なインターフェイスを持ちながら、シリアライズした情報の可用性を飛躍的に高める。まだまだ荒削りではあるが実用にも耐え、定番ライブラリであるbinaryaesonの代替として高いポテンシャルがあると信じている。もしバグや要望などがあれば、ぜひGitHubに投稿願いたい。

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を通じる。前者はwebsocketsTLSをサポートする為のwuss、後者はhttp-clienthttp-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アクションを別のモナドのアクションから返すコンボはなかなか有用だ。 なお、forkIOunliftioパッケージで定義され、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モノイドを使えばよい。AltAlternativeインスタンス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

watchListdiscord-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

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

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

それを実現してくれるのが埋め込みオブジェクトだ。それぞれ、timestampdescription、ユーザー名とアイコンは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を参照