Ruby でリストモナドを使ってみる

　本記事は Wantedly Advent Calendar 2024 の13日目として書かれました。

　Haskell の様な関数型言語で逐次計算を扱うための汎用的なフレームワークとして用いられているモナドですが、List モナドや Maybe モナドの様に個別例を見ていくと、関数型言語に限らず有用な概念が含まれている事に気付かされます。手続きそれ自体を値として捉え、それに対する操作すら許容するモナドの考え方は、逐次計算を記述する手続き型言語として生まれながら、メタプログラミングの形で動的なプログラムの書き換えを許容する Ruby とも重なるところがあるのではないでしょうか。

　本記事では、逐次計算を抽象化したモナドのうち、非決定計算の実装に相当する List モナドに Ruby を通じて触れてみます。業務で Ruby を書いている際は探索的な処理は ActiveRecord 任せになりがちですが、競技プログラミングの様にデータベースの使えない環境や、オンメモリで処理が完結する場合には List モナドが便利な道具となることでしょう。

List モナドとは

　逐次計算を抽象化した概念であるモナドの一種で、リストを用いた非決定計算の実装に相当します。本節では Haskell での List モナドの使用例を通じて、具体的にはどのようなものか見ていきましょう。

List モナドの使用例

　例えば、SEND+MORE=MONEY の覆面算を List モナドを用いて解くことを考えましょう。これは、同じアルファベットは同じ数字で、相異なるアルファベットは異なった数字で置き換えて先頭に余分な0が付かない自然数を作った際、SEND+MORE=MONEY が成り立つような数字の割り当てを求めるパズルです。

実際に SEND+MORE=MONEY を解くプログラムを Haskell で List モナドを用いて実装すると、次の様になります。

do
  s <- [1..9]
  e <- [0..9]
  n <- [0..9]
  d <- [0..9]
  m <- [1..9]
  o <- [0..9]
  r <- [0..9]
  y <- [0..9]
  guard (nub [s,e,n,d,m,o,r,y] == [s,e,n,d,m,o,r,y])
  let send = 1000 * s + 100 * e + 10 * n + d
  let more = 1000 * m + 100 * o + 10 * r + e
  let money = 10000 * m + 1000 * o + 100 * n + 10 * e + y
  guard (send + more == money)
  return (send, more, money)

最上位桁の s と m には 1 から 9 までの自然数が入り、それ以外のアルファベットには 0 から 9 まで、それぞれのアルファベットに入る数字は相異なり、それらを並べた自然数 send、more、money の間には send + more == money が成り立つ、とまるで覆面算のルールを宣言的に書き下した様なコードですが、これだけの実装でも実際に答えが得られてしまいます。

% ghci
GHCi, version 9.10.1: https://www.haskell.org/ghc/  :? for help
ghci> import Data.List (nub)
ghci> import Control.Monad (guard)
ghci> :{
ghci| do
ghci|   s <- [1..9]
ghci|   e <- [0..9]
ghci|   n <- [0..9]
ghci|   d <- [0..9]
ghci|   m <- [1..9]
ghci|   o <- [0..9]
ghci|   r <- [0..9]
ghci|   y <- [0..9]
ghci|   guard (nub [s,e,n,d,m,o,r,y] == [s,e,n,d,m,o,r,y])
ghci|   let send = 1000 * s + 100 * e + 10 * n + d
ghci|   let more = 1000 * m + 100 * o + 10 * r + e
ghci|   let money = 10000 * m + 1000 * o + 100 * n + 10 * e + y
ghci|   guard (send + more == money)
ghci|   return (send, more, money)
ghci| :}
[(9567,1085,10652)]

List モナドの実態

　コードの文面だけ見ると狐につままれたような印象になりますが、Haskell でモナドを使ったコードを見通し良く書くための do 構文を脱糖してやると、何が行われているのか見えてきます。先ほど挙げた覆面算を List モナドで解くコード

do
  s <- [1..9]
  e <- [0..9]
  n <- [0..9]
  d <- [0..9]
  m <- [1..9]
  o <- [0..9]
  r <- [0..9]
  y <- [0..9]
  guard (nub [s,e,n,d,m,o,r,y] == [s,e,n,d,m,o,r,y])
  let send = 1000 * s + 100 * e + 10 * n + d
  let more = 1000 * m + 100 * o + 10 * r + e
  let money = 10000 * m + 1000 * o + 100 * n + 10 * e + y
  guard (send + more == money)
  return (send, more, money)

で do 構文を脱糖してやると、次の様なコードと等価になります。

[1..9] >>= (\s ->
  [0..9] >>= (\e ->
    [0..9] >>= (\n ->
      [0..9] >>= (\d ->
        [1..9] >>= (\m ->
          [0..9] >>= (\o ->
            [0..9] >>= (\r ->
              [0..9] >>= (\y ->
                (guard (nub [s,e,n,d,m,o,r,y] == [s,e,n,d,m,o,r,y])) >>= (\_ ->
                  let send = 1000 * s + 100 * e + 10 * n + d in
                  let more = 1000 * m + 100 * o + 10 * r + e in
                  let money = 10000 * m + 1000 * o + 100 * n + 10 * e + y in
                  (guard (send + more == money)) >>= (\_ ->
                    return (send, more, money)
                  )
                )
              )
            )
          )
        )
      )
    )
  )
)

何やら見慣れない演算子 >>= が出てきましたが、これと return はモナドのインスタンスに対して定義されるメソッドで、List に対しては次の様な定義で与えられます。要は Ruby の flat_map 的な関数を使って、与えられたリストの中を全探索しているだけですね。

instance Monad [] where
  return x = [x]
  xs >>= f = concatMap f xs

また、条件に対して絞り込みを行うために用いたヘルパ関数 guard の定義も見ておくと、（簡単のために List モナドに特殊化すると）次のようになります。

guard :: Bool -> [()]
guard True  = [()]
guard False = []

concatMap f [] は f の実装に関わらず空リスト [] になる（※concatMap f xs は Ruby で言う xs.flat_map(&f) 相当）のに対し、concatMap f [()] は単に f () を返すので guard の引数が真になるものだけを絞り込める訳ですね。

　なお先程挙げた覆面算を解くプログラムを実行してみると大変遅かった訳ですが、List モナドの実態が Ruby で言う flat_map 的な関数を用いた全探索であった事を念頭に置くと納得できますね。今回は説明の都合上省略していましたが、実用的なコードでは途中で枝刈りを行ってやれば現実的な計算時間で動くかと思います。

Ruby での List モナドの実装

　条件を満たす値の探索を宣言的に記述できて嬉しい List モナドですが、我々の普段使う Ruby で同様のコードを書くにはどうすれば良いでしょうか？もちろん List モナドの定義をベタに書き下して

(1..9).flat_map do |s|
  (0..9).flat_map do |e|
    (0..9).flat_map do |n|
      (0..9).flat_map do |d|
        (1..9).flat_map do |m|
          (0..9).flat_map do |o|
            (0..9).flat_map do |r|
              (0..9).flat_map do |y|
                ([s,e,n,d,m,o,r,y].uniq == [s,e,n,d,m,o,r,y] ? [[]] : []).flat_map do
                  send = 1000 * s + 100 * e + 10 * n + d
                  more = 1000 * m + 100 * o + 10 * r + e
                  money = 10000 * m + 1000 * o + 100 * n + 10 * e + y
                  (send + more == money ? [[]] : []).flat_map do
                    [[send, more, money]]
                  end
                end
              end
            end
          end
        end
      end
    end
  end
end

みたいに書けなくもない訳ですが、こんな async/await 以前の JavaScript みたいなコードを書いては台無しです。Haskell の do 構文のように、ネストを深くせず List モナドを書けないものでしょうか？

　本節では、メタプログラミングによって構文木を組み立ててから List モナドの解釈を行う手法と、継続オペレータを使って Ruby のコードの制御を直接捻じ曲げる手法の二通りで DSL の定義を試みます。それぞれの手法に一長一短はありますが、少なくとも DSL を定義することでコールバック地獄が解消することは期待できます。

メタプログラミングを用いた DSL の定義

　Ruby による素朴な List モナドの実装では定義した変数を引き回すために、>>= 相当の操作の度にコールバック関数を重ねる必要があってネストが深くなっていましたが、変数の取り回しを DSL 側で面倒を見てやれば簡潔に記述できるようになります。

　例えば do 構文で記述した際の構文木を次のように return で終端された >>= 式の列と捉えると、

@binds = []
@binds << [:s, proc { (1..9) }]
@binds << [:e, proc { (0..9) }]
@binds << [:n, proc { (0..9) }]
@binds << [:d, proc { (0..9) }]
@binds << [:m, proc { (1..9) }]
@binds << [:o, proc { (0..9) }]
@binds << [:r, proc { (0..9) }]
@binds << [:y, proc { (0..9) }]
@binds << [nil, proc {|s:, e:, n:, d:, m:, o:, r:, y:, **| [s,e,n,d,m,o,r,y].uniq == [s,e,n,d,m,o,r,y] ? [[]] : [] }]
@binds << [:send, proc {|s:, e:, n:, d:, **| [1000 * s + 100 * e + 10 * n + d] }]
@binds << [:more, proc {|m:, o:, r:, e:, **| [1000 * m + 100 * o + 10 * r + e] }]
@binds << [:money, proc {|m:, o:, n:, e:, y:, **| [10000 * m + 1000 * o + 100 * n + 10 * e + y] }]
@binds << [nil, proc {|send:, more:, money:, **| send + more == money ? [[]] : [] }]
@return = proc {|send:, more:, money:, **| [send, more, money]}

構文木の解釈を行う際に定義済変数を取り回してやればブロックのネストは不要になります。

def perform(binds, **kwargs)
  return [@return.call(**kwargs)] if binds.empty?

  (x, f), *binds = binds
  f.call(**kwargs).flat_map {|v| perform(binds, **kwargs.merge({ x => v })) }
end

perform @binds

もっともコールバック地獄から逃れたとはいえ、この構文木をユーザーに直接記述させるのは大変なので、適当な DSL を定義してやりましょう。

class ArrayMonad
  private_class_method :new

  def initialize
    @binds = []
    @return = nil
  end

  def self.perform(&block)
    self.new.perform(&block)
  end

  def perform
    yield self
    interpret @binds
  end

  def submit(&block)
    @return = block
  end

  def bind(var = nil, &block)
    @binds << [var, block]
  end

  def guard(&block)
    bind {|**kwargs| block.call(**kwargs) ? [[]] : [] }
  end

  private

  def interpret(binds, **kwargs)
    return [@return.call(**kwargs)] if binds.empty?

    (x, f), *binds = binds
    f.call(**kwargs).flat_map {|v| interpret(binds, **kwargs.merge({ x => v })) }
  end
end

ArrayMonad.perform do |m|
  m.bind(:s) { (1..9) }
  m.bind(:e) { (0..9) }
  m.bind(:n) { (0..9) }
  m.bind(:d) { (0..9) }
  m.bind(:m) { (1..9) }
  m.bind(:o) { (0..9) }
  m.bind(:r) { (0..9) }
  m.bind(:y) { (0..9) }
  m.guard {|s:, e:, n:, d:, m:, o:, r:, y:, **| [s,e,n,d,m,o,r,y].uniq == [s,e,n,d,m,o,r,y] }
  m.bind(:send) {|s:, e:, n:, d:, **| [1000 * s + 100 * e + 10 * n + d] }
  m.bind(:more) {|m:, o:, r:, e:, **| [1000 * m + 100 * o + 10 * r + e] }
  m.bind(:money) {|m:, o:, n:, e:, y:, **| [10000 * m + 1000 * o + 100 * n + 10 * e + y] }
  m.guard {|send:, more:, money:, **| send + more == money }
  m.submit {|send:, more:, money:, **| [send, more, money]}
end

　メタプログラミングを使って DSL を定義したことで Ruby でも Haskell の do 構文の様に簡潔に List モナドを使ったプログラムが書けるようになった訳ですが、一旦構文木を組み立ててから解釈を行う都合上、do 構文内の記法を追加する度に DSL 側での対応が必要になってしまう欠点もあります。例えば今回は途中変数 send 等の宣言を >>= 相当の文で代用していますが、let による変数の宣言を真面目にサポートするのなら DSL 側の定義に手を入れる必要があるでしょう。

継続オペレータを用いた DSL の定義

　メタプログラミングによる DSL の定義では一旦構文木を組み立ててから解釈を行う都合上、do 構文内の記法を追加する度に DSL の実装を修正する必要がありましたが、一々ブロックを使ってコード片を切り出さず継続オペレータを用いて直接制御フローを歪めてやることでも見通しの良い DSL が定義できます。

　そもそもメタプログラミングを用いて DSL を定義する際に何故一旦構文木を組み立てる必要があったかと言うと、>>= 相当の操作で導入した変数を引き回す必要があったのも勿論なのですが、do 構文相当の DSL 内の制御フローと一般的な逐次実行の制御フローが食い違っていることが挙げられます。例えば先程の DSL では

ArrayMonad.perform do |m|
  m.bind(:s) { (1..9) }
  m.bind(:e) { (0..9) }
  m.bind(:n) { (0..9) }
  m.bind(:d) { (0..9) }
  m.bind(:m) { (1..9) }
  m.bind(:o) { (0..9) }
  m.bind(:r) { (0..9) }
  m.bind(:y) { (0..9) }
  m.guard {|s:, e:, n:, d:, m:, o:, r:, y:, **| [s,e,n,d,m,o,r,y].uniq == [s,e,n,d,m,o,r,y] }
  m.bind(:send) {|s:, e:, n:, d:, **| [1000 * s + 100 * e + 10 * n + d] }
  m.bind(:more) {|m:, o:, r:, e:, **| [1000 * m + 100 * o + 10 * r + e] }
  m.bind(:money) {|m:, o:, n:, e:, y:, **| [10000 * m + 1000 * o + 100 * n + 10 * e + y] }
  m.guard {|send:, more:, money:, **| send + more == money }
  m.submit {|send:, more:, money:, **| [send, more, money]}
end

と書いた訳ですが、これが何故

ArrayMonad.perform do |am|
  s = am.bind(1..9)
  e = am.bind(0..9)
  n = am.bind(0..9)
  d = am.bind(0..9)
  m = am.bind(1..9)
  o = am.bind(0..9)
  r = am.bind(0..9)
  y = am.bind(0..9)
  am.guard([s,e,n,d,m,o,r,y].uniq == [s,e,n,d,m,o,r,y])
  send = 1000 * s + 100 * e + 10 * n + d
  more = 1000 * m + 100 * o + 10 * r + e
  money = 10000 * m + 1000 * o + 100 * n + 10 * e + y
  am.guard(send + more == money)
  am.submit [send, more, money]
end

と書けなかったかと言うと、Ruby の文では s = am.bind(1..9) で変数 s を定義した後直ちに e = am.bind(0..9) 以降の文の評価に移ってしまい、仮に s = 1 として解が見つからなかった場合にも flat_map による探索を続行できないためです。一方継続オペレータと呼ばれる言語機能を用いれば、明示的に制御構文を使わなくても e = am.bind(0..9) 以降の文を繰り返し実行できるので探索を続けられるようになります。

　ここで、継続オペレータとはその後の計算（継続）を切り出して用いる機能の事で、Ruby にはその一種の call/cc が実装されています。

Kernel.#callcc (Ruby 3.3 リファレンスマニュアル)

継続を作成します。 [[c:Continuation]] を参照してください。

https://docs.ruby-lang.org/ja/latest/method/Kernel/m/callcc.html

この call/cc はざっくり言うと C 言語で言う setjmp のようなもので、call/cc で得られた継続（call/cc 以降の処理を切り出したもの）を呼び出せば longjmp 相当の大域脱出が行えます。この機能を使って無理やりジャンプすれば、一々ブロックを使ってコード片を切り出さなくても s = am.bind(1..9) 以降の文を s = 1, 2, ... , 9 について繰り返し実行できそうですね。

　実際に call/cc を使って Haskell の do 構文相当の DSL を定義してみましょう。call/cc は setjmp/longjmp 相当の機能を提供するものであり、ジャンプした後勝手に戻ってきてはくれないので、return が呼び出された際にバックトラックを行うために call/cc を複数回用いています。

require "continuation"

class ArrayMonad
  def self.perform(&block)
    self.new.perform(&block)
  end
  
  def perform(&block)
    callcc do |k|
      @submits = []
      @backtrack = k
      @submits << yield(self)
      @backtrack.call
    end
    @submits
  end
  
  def bind(xs)
    backtrack = @backtrack
    callcc do |ret|
      xs.each do |x|
        callcc do |k|
          @backtrack = proc {
            @backtrack = backtrack
            k.call
          }
          ret.call(x)
        end
      end
      @backtrack.call
    end
  end

  def guard(b)
    b ? [[]] : []
  end
end

ArrayMonad.perform do |am|
  s = am.bind(1..9)
  e = am.bind(0..9)
  n = am.bind(0..9)
  d = am.bind(0..9)
  m = am.bind(1..9)
  o = am.bind(0..9)
  r = am.bind(0..9)
  y = am.bind(0..9)
  am.guard([s,e,n,d,m,o,r,y].uniq == [s,e,n,d,m,o,r,y])
  send = 1000 * s + 100 * e + 10 * n + d
  more = 1000 * m + 100 * o + 10 * r + e
  money = 10000 * m + 1000 * o + 100 * n + 10 * e + y
  am.guard(send + more == money)
  [send, more, money]
end

この DSL を使って書いた覆面算を解くプログラムを見ると一見探索を行わない逐次的な処理に見えますが、実際には call/cc を使って無理やりジャンプしているので e = am.bind(0..9) 以下の処理は s = 1, 2, 3, ... , 9 の全ての場合に対して実行されます。従ってローカル変数定義 send = 1000 * s + 100 * e + 10 * n + d も全ての s, e, n, d の場合について繰り返されるので、DSL 側で特別な対応をしなくても do 構文の途中で変数の宣言が行えてしまいます。

　継続オペレータを使って DSL を定義すれば Ruby 側の言語機能を流用でき、認知負荷の低いコードが書けて良い事づくめの様にも見えますが、実行パフォーマンスと処理系のバージョン毎の互換性に課題を抱えている事にも言及しなければなりません。メタプログラミングを使った DSL の実装では覆面算を解くのに M3 Max の MacBook Pro 上で 0.32 秒しかかかりませんでした（説明のために枝刈りを省いて8重ループを回していましたが、非効率なので枝刈りを追加しています）が、call/cc を使った実装では10分待っても計算が終わらない始末でした。これは恐らく Ruby の call/cc 実装が覆面算の計算に必要な情報に限らず現在の実行コンテキスト全てを継続として退避する分オーバーヘッドが大きいのが原因で、そんな Ruby 処理系の実行コンテキストに依存した実装になっているせいでバージョンが上がると call/cc が良く壊れるなんて話もあります。（call/cc を使うと処理系に warning: callcc is obsolete; use Fiber instead と怒られたりしますが、今回の DSL では継続を複数回呼び出しているので Fiber では代替できないんですよね。）

まとめ

　本記事では、Haskell の様な関数型言語で逐次計算を扱うための汎用的なフレームワークとして用いられているモナドのうち、非決定計算の実装に相当する List モナドに Ruby を通じて触れました。業務で Ruby を書いている際は探索的な処理は ActiveRecord 任せになりがちですが、探索処理を宣言的に記述できる List モナドは競技プログラミングの様にデータベースの使えない環境や、オンメモリで処理が完結する場合に便利な道具となることでしょう。