ここでいうループとは、一般的に while や for などといった構文で行われる繰り返し処理のことである。当然 Haskell においても同等のことは可能だが、いわゆる手続き的な言語での書き方に慣れていると、再代入ができない Haskell でどう書けば良いのか迷うこともあるだろう。本記事ではそんな場合に Haskell でどのような書き方ができるのか、いくつかの例を紹介する。

例題: Bubble Babble

簡単な例では map や filter といった関数を使うことになるが、これらに関しては最近では他の言語でも名前は違えど同等の機能があることが殆どなので、構文の違いに戸惑うことはあっても考え方自体が分からないということはないだろう。

とはいえ、世の中全ての課題が map や filter で解決できるかといえばそんなことはない。ループの中で状態を書き換えながら状況に応じた処理を行わねばならないときもある。そんな処理の例題として、本記事では Bubble Babble のエンコーダを使うことにする。

具体的な仕様は次の URL にある。

本記事ではあくまで「少し複雑な繰り返し処理の例」として取り上げるだけなので、アルゴリズム自体の詳細には立ち入らない。概要としては、バイナリ列をアルファベットと - の列、いわゆる ASCII 文字列に変換するものだ。同様のエンコーディングである Base64 と比べると、結果は長くなるが、代わりに簡易的なチェックサムを持ち、ある程度人間にも読みやすいのが特徴となっている。

仕様書は数学的な表記が行われており、こと Haskell においてはこれをほぼそのまま書き下すこともできる。ただ本記事では他言語で可能な変数の再代入やループの途中脱出といった点をどのように Haskell で実現するのかを主眼とするため、数学的な書き下し方式については末尾に補足として紹介する。

本エンコーダは以下のような特徴を持ち、 map や filter などの抽象度の高い道具の組み合わせだけで実装するのは難しい。

入力に応じて途中脱出がある
入力長と出力長が異なる
C という状態を持つ¹

このエンコーダを、 Haskell で encode :: B.ByteString -> B.ByteString として記述したい。

参考のため C++ で簡単に実装した例を示す。

const char *const v = "aeiouy";
const char *const c = "bcdfghklmnprstvzx";

std::ostream &bubble_babble_encode(std::istream &in, std::ostream &out) {
    out << 'x';

    uint8_t C = 1;
    while (in.good()) {
        int i = in.get();
        if (!in.good()) {
            out << v[C%6];
            out << c[16];
            out << v[C/6];
            break;
        }
        const uint8_t c1 = static_cast<uint8_t>(i);
        out << v[(((c1 >> 6) &  3) + C  )%6]; // XX000000 + C%6
        out << c[(((c1 >> 2) & 15)      )  ]; // 00XXXX00
        out << v[(((c1     ) &  3) + C/6)%6]; // 000000XX + C/6

        i = in.get();
        if (!in.good()) {
            break;
        }
        const uint8_t c2 = static_cast<uint8_t>(i);
        out << c[(c2 >> 4) & 15]; // XXXX0000
        out << '-';
        out << c[ c2       & 15]; // 0000XXXX

        C = (C*5 + c1*7 + c2)%36;
    }

    out << 'x';
    return out;
}

準備

サンプルコードは共通して以下の import や共通関数を利用できるものとする。

import Data.Bits ((.|.), (.&.), shiftL, shiftR)
import Data.List
import Data.Monoid ((<>))
import Data.Word
import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy as BL

voels, consonants :: B.ByteString
voels      = C.pack "aeiouy"
consonants = C.pack "bcdfghklmnprstvzx"

toWord :: Char -> Word8
toWord = toEnum . fromEnum

再帰（ループカウンタ）

Haskell におけるループは原始的には再帰で行う。このとき、「変数の再代入」は「再帰呼び出し時の引数」で、「(途中)脱出」は「再帰呼び出しをしない」ことで行う。

例えば素直にループカウンタとチェックサム C を状態として実装してみるとこんな感じになるだろう。ループごとに変化していく値を、再帰関数の引数に置くのがコツだ。

encode :: B.ByteString -> B.ByteString
encode input = BL.toStrict . B.toLazyByteString $ loop 0 1 (B.char8 'x') <> B.char8 'x'
  where
    maxlen :: Int
    maxlen = B.length input

    loop :: Int -> Int -> B.Builder -> B.Builder
    loop i s res
      | i < maxlen =
        let c1 = fromIntegral $ B.index input i
            c2 = fromIntegral $ B.index input (i + 1)
            outputs1 =
              [ B.word8 (voels      `B.index` mod (((c1 `shiftR` 6) .&.  3) +     s  ) 6)
              , B.word8 (consonants `B.index`      ((c1 `shiftR` 2) .&. 15)             )
              , B.word8 (voels      `B.index` mod (( c1             .&.  3) + div s 6) 6)
              ]
            outputs2 =
              [ B.word8 (consonants `B.index` ((c2 `shiftR` 4) .&. 15))
              , B.char8 '-'
              , B.word8 (consonants `B.index` ( c2             .&. 15))
              ]
            ns = mod (s*5 + c1*7 + c2) 36
        in
          if i + 1 < maxlen
            then loop (i + 2) ns $ res <> mconcat outputs1 <> mconcat outputs2
            else res <> mconcat outputs1
      | otherwise = res
        <> B.word8 (voels      `B.index` mod s 6)
        <> B.word8 (consonants `B.index` 16)
        <> B.word8 (voels      `B.index` div s 6)

例題がビット演算の塊なのでどうしてもそのあたりに煩雑な印象を受けるが、そのあたりを取り除いてループ部分に集中してみるとこんな感じだろうか。

loop :: Int -> Int -> B.Builder -> B.Builder
loop i s res
  | i < maxlen =
      if i + 1 < maxlen
        then loop (i + 2) ns $ res <> outputs1 <> outputs2
        else res <> outputs1
  | otherwise = res <> finalOutputs

関数 loop は第一引数にループカウンタ、第二引数にチェックサム、第三引数に「これまでの出力」、そして戻り値が最終結果である。

ループに深くかかわっているのは下の三行だ。

then loop (i + 2) ns $ res <> outputs1 <> outputs2

これがループの繰り返し部分にあたる。2 文字ずつ読んでいるため、ループカウンタは 2 進める。チェックサムは既定の計算を行って新たな値を次のループに渡す。そして「これまでの出力」に「今回の出力」を繋げたものが、次回ループにとっての「これまでの出力」となるわけだ。

else res <> outputs1

次にここが入力長が奇数だった場合の終点である。 loop を呼び出さず、「これまでの出力」に「最後の 1 文字の出力」を繋げて完成だ。

ちなみに入力長に関わらず let 節では c2 も定義している。普通に考えると B.index input (i + 1) は存在しないのでエラーになりそうなものだが、 Haskell では遅延評価が行われるので、 else 節では outputs2 、即ち c2 も参照しないためエラーになることはない。

| otherwise = res <> finalOutputs

そしてこれが入力長が偶数だった場合の終点だ。このエンコーディング方式では、入力長が偶数だった場合には最後にチェックサムを付与することになっているためそれを付与して終わることになる。

再帰（パターンマッチ＆リスト結合）

ループカウンタを用いるというのも今風ではない感じがする。今回は入力を ByteString としているが、リストとすればパターンマッチで処理することも可能だ。今回の場合はわざわざリストに変換する必要が出ているが、元々リストが自然なデータならば考え方のひとつだ。

結果の作り方も「これまでの出力」を引数に受け取らず、再帰関数の結果自体を「残りの出力」とし、「今回の出力」＋「残りの出力」という結合の形で作っていく。ちなみに先に紹介したループカウンタを用いた形式でも同じように結果を作ることができるので、先の例を loop :: Int -> Int -> B.Builder として書き直してみるのも面白いだろう。引数がひとつ減ってコードの見た目も少しすっきりするはずだ。ただ、手続き的なやり方に慣れていると、この考え方にたどり着くには時間がかかるかもしれない。

encode :: B.ByteString -> B.ByteString
encode = B.pack . (toWord 'x' :) . encode' 1 . map fromIntegral . B.unpack

encode' :: Int -> [Int] -> [Word8]
encode' s (c1:c2:xs) = outputs1 . outputs2 . encode' ns $ xs
  where
    outputs1 = (++)
      [ voels      `B.index` mod (((c1 `shiftR` 6) .&.  3) +     s  ) 6
      , consonants `B.index`      ((c1 `shiftR` 2) .&. 15)
      , voels      `B.index` mod (( c1             .&.  3) + div s 6) 6
      ]
    outputs2 = (++)
      [ consonants `B.index` ((c2 `shiftR` 4) .&. 15)
      , toWord '-'
      , consonants `B.index` ( c2             .&. 15)
      ]
    ns = mod (s*5 + c1*7 + c2) 36
encode' s [c1] =
      [ voels      `B.index` mod (((c1 `shiftR` 6) .&.  3) +     s  ) 6
      , consonants `B.index`      ((c1 `shiftR` 2) .&. 15)
      , voels      `B.index` mod (( c1             .&.  3) + div s 6) 6
      , toWord 'x'
      ]
encode' s [] =
  [ voels      `B.index` mod s 6
  , consonants `B.index` 16
  , voels      `B.index` div s 6
  , toWord 'x'
  ]

ビット演算部分が煩雑なのでループ部分だけ抜き出してみよう。主要な部分は以下の三行だ。第一引数がチェックサム、第二引数が残りの入力となる。

encode' s (c1:c2:xs) = outputs1 . outputs2 . encode' ns $ xs
encode' s [c1]       = outputs1
encode' s []         = [...]

一番上の行がループの本体で、再帰呼び出しで 2 文字ずつ処理している。二行目と三行目はそれぞれ入力長が奇数だった場合、偶数だった場合の最終処理だ。

`foldl` を用いる

再帰で実装する方式を見てきたが、 ByteString にはもちろん foldl などが用意されており、せっかくなのでこれを使いたい。一般論としてはライブラリ側がこういった関数を用意してくれている場合は、使った方がパフォーマンス上も有利なことが多い。しかし、この foldl はループ本体が必ず 1 文字ずつ呼び出されるインターフェースとなっているため、これまでのように 2 文字ずつ処理するようなことはできない。仕方ないので、現在処理している文字が奇数番目なのか偶数番目なのかを管理しながら 1 文字ずつ処理することにしよう。

data Reading = First | Second Int

data State
  = State
  { sCheck :: Int
  , sReading :: Reading
  , sResult :: B.Builder
  }

encode :: B.ByteString -> B.ByteString
encode = BL.toStrict . B.toLazyByteString . finish . B.foldl f (State 1 First (B.char8 'x'))
  where
    f :: State -> Word8 -> State
    f (State s First r) wa =
      let a = fromIntegral wa
      in State s (Second a) $ r
        <> B.word8 (voels      `B.index` mod (((a `shiftR` 6) .&.  3) +     s  ) 6)
        <> B.word8 (consonants `B.index`      ((a `shiftR` 2) .&. 15)             )
        <> B.word8 (voels      `B.index` mod (( a             .&.  3) + div s 6) 6)
    f (State s (Second s1) r) wa =
      let a = fromIntegral wa
      in State (mod (s*5 + s1*7 + a) 36) First $ r
        <> B.word8 (consonants `B.index` ((a `shiftR` 4) .&. 15))
        <> B.char8 '-'
        <> B.word8 (consonants `B.index` ( a             .&. 15))

    finish :: State -> B.Builder
    finish (State s First r) = r
      <> B.word8 (voels      `B.index` mod s 6)
      <> B.word8 (consonants `B.index` 16)
      <> B.word8 (voels      `B.index` div s 6)
      <> B.char8 'x'
    finish (State _ (Second _) r) = r <> B.char8 'x'

ビット演算が煩雑過ぎて例題間違えたかなという気持ちが今更でてきた。それはともかくこれまでのように省略してみよう…と言いたいところだが、その前にデータ構造を確認しよう。

data Reading = First | Second Int

アルゴリズム全体が 2 文字ずつ処理していく形式となっているが、前述した通り foldl のインターフェース上 1 文字ずつしか処理できない。このため、そのペアの前半を処理しているのか、後半を処理しているのかを区別するための状態を定義した。 Second に Int を含めているのは、後半の計算を行うために前半の文字が何だったかを知る必要があるためだ。この Int に前半の文字を詰めて後半に渡すわけだ。

data State
  = State
  { sCheck :: Int
  , sReading :: Reading
  , sResult :: B.Builder
  }

こちらはタプルでも構わないが、分かりやすさのために定義した。 sCheck がチェックサム、 sReading が先ほど定義したペアのどちらを処理中か、 sResult が全体の結果である。

さて、直接ループに関わらないところを色々省略するとコードはこんな形になる。

f :: State -> Word8 -> State
f (State s First       r) a = State  s (Second a) $ r <> output1
f (State s (Second s1) r) a = State ns First      $ r <> output2

finish :: State -> B.Builder
finish (State s First      r) = r <> finalOutputs
finish (State _ (Second _) r) = r <> B.char8 'x'

f は Reading を交互に入れ替えながら一文字ずつ処理する部分、 finish は foldl 自体が完了した後、最終状態から実際の結果を取り出す部分だ。

補足: 仕様をそのまま書き下す

これまでは基本的に手続き的に考えていた挙動をどのように Haskell で実装するか、という観点で例を紹介してきた。しかし Haskell では本来の仕様の数学的な表記をほぼそのまま書き下すこともできる。一般的にはこの形式の記述方式は残念ながらまだパフォーマンスに劣ることが多く、高速に、あるいは狭い空間で処理をしたい場合はこれまでみてきたような方式を採用しつつ、細かなパフォーマンスチューニングを施すことになるだろう。とはいえ、十分に小さな例ではパフォーマンスが問題になることはなく、特に学術的な問題に対応するには便利である。 Haskell の強みとして良く紹介される点でもある。

仕様書の URL を再掲する。

順番に書き下していこう。

Below, _|X|_ denotes the largest integer not greater than X.

この表記は整数を整数で割る場合にしか使われていない。要は丸め方の定義だが、今回の範疇では div が仕様通りの挙動をする。

Let the data to be encoded be D[1] ... D[K] where K is the length of the data in bytes; every D[i] is an integer from 0 to 2^8 - 1.

K と D[i] が定義されている。 K が入力長で D[i] が入力文字そのものだ。1-origin なことに気を付けて素直に書き下す。

k :: Int
k = B.length input

d :: Int -> Int
d i = fromIntegral $ B.index input (i - 1)

First define the checksum series C[1] ... C[|K/2|] where
 C[1] = 1
 C[n] = (C[n - 1] * 5 + (D[n * 2 - 3] * 7 + D[n * 2 - 2])) mod 36

チェックサム C を定義している。再帰の形で書かれているがこれもそのまま書き下せる。

c :: Int -> Int
c 1 = 1
c n = (c (n - 1) * 5 + (d (n * 2 - 3) * 7 + d (n * 2 - 2))) `mod` 36

The data is then transformed into |K/2| `tuples'
T[1] ... T[|K/2|] and one `partial tuple' P so that

 T[i] = <a, b, c, d, e>

where

 a = (((D[i * 2 - 3] >> 6) & 3) + C[i]) mod 6
 b = (D[i * 2 - 3] >> 2) & 15
 c = (((D[i * 2 - 3]) & 3) + _|C[i] / 6|_) mod 6
 d = (D[i * 2 - 2] >> 4) & 15; and
 e = (D[i * 2 - 3]) & 15.

The partial tuple P is

 P = <a, b, c>

where if K is even then

 a = (C[i]) mod 6
 b = 16
 c = _|C[i] / 6|_

but if it is odd then

 a = (((D[K] >> 6) & 3) + C[i]) mod 6
 b = (D[K] >> 2) & 15
 c = (((D[K]) & 3) + _|C[i] / 6|_) mod 6

tuple と partial tuple が定義されている。ちょっと量が多いが頑張っていこう。

data Tuple
  = Tuple
  { _t_a :: Int
  , _t_b :: Int
  , _t_c :: Int
  , _t_d :: Int
  , _t_e :: Int
  }
  | Partial
  { _p_a :: Int
  , _p_b :: Int
  , _p_c :: Int
  }

t :: Int -> Tuple
t i
  | i <= div k 2 = Tuple
    { _t_a = (((d (i * 2 - 1) `shiftR` 6) .&. 3) + c i) `mod` 6
    , _t_b = (d (i * 2 - 1) `shiftR` 2) .&. 15
    , _t_c = (((d (i * 2 - 1)) .&. 3) + div (c i) 6) `mod` 6
    , _t_d = (d (i * 2) `shiftR` 4) .&. 15
    , _t_e = (d (i * 2)) .&. 15
    }
  | even k = Partial
    { _p_a = c i `mod` 6
    , _p_b = 16
    , _p_c = c i `div` 6
    }
  | otherwise = Partial
    { _p_a = (((d k `shiftR` 6) .&. 3) + c i) `mod` 6
    , _p_b = (d k `shiftR` 2) .&. 15
    , _p_c = ((d k .&. 3) + div (c i) 6) `mod` 6
    }

ちなみに D の添え字は明らかに間違っている ² のでコードの方では修正してある。これで実際に動かしてみるとサンプルと合致するので仕様書のミスだろう。

仕様書では T の添え字は _|K/2|_ まででその後に P が続く、となっているが、定義した t はガード節で場合分けをして _|K/2|_ + 1 のときに P を返すように実装した。 P の定義にも i が含まれておりそのまま参照したかったからである。

The `vowel table' V maps integers between 0 and 5 to vowels as
 0 - a
 1 - e
 2 - i
 3 - o
 4 - u
 5 - y
and the `consonant table' C maps integers between 0 and 16 to consonants as
 0 - b
 1 - c
 2 - d
 3 - f
 4 - g
 5 - h
 6 - k
 7 - l
 8 - m
 9 - n
10 - p
11 - r
12 - s
13 - t
14 - v
15 - z
16 - x

マッピングテーブル V C が定義されている。これは素直に書けばよい。なお c はチェックサムで利用済みなので別の名前を割り当てた。

voe, con :: Int -> Char
voe i = "aeiouy" !! i
con i = "bcdfghklmnprstvzx" !! i

The encoding E(T) of a tuple T = <a, b, c, d, e> is then the string
 V[a] C[b] V[c] C[d] `-' C[e]
where there are five characters, and `-' is the literal hyphen.

The encoding E(P) of a partial tuple P = <a, b, c> is thethree-character string
 V[a] C[b] V[c].

Tuple 列を具体的に文字列に変換する部分だ。これも素直に書ける。

e :: Tuple -> String
e (Tuple ta tb tc td te) = [voe ta, con tb, voe tc, con td, '-', con te]
e (Partial pa pb pc) = [voe pa, con pb, voe pc]

Finally, the encoding of the whole input data D is obtained as
`x' E(T[1]) E(T[2]) ... E(T[_|K/2|_]) E(P) `x'
where `x's are literal characters.

で、最初と最後に x をつけたら完成とのことだ。

encode :: B.ByteString -> B.ByteString
encode input = C.pack . ('x' :) $ concatMap (e . t) [1..div k 2 + 1] ++ "x"

完成した全体を掲載する。

data Tuple
  = Tuple
  { _t_a :: Int
  , _t_b :: Int
  , _t_c :: Int
  , _t_d :: Int
  , _t_e :: Int
  }
  | Partial
  { _p_a :: Int
  , _p_b :: Int
  , _p_c :: Int
  }

encode :: B.ByteString -> B.ByteString
encode input = C.pack . ('x' :) $ concatMap (e . t) [1..div k 2 + 1] ++ "x"
  where
    k :: Int
    k = B.length input

    d :: Int -> Int
    d i = fromIntegral $ B.index input (i - 1)

    c :: Int -> Int
    c 1 = 1
    c n = (c (n - 1) * 5 + (d (n * 2 - 3) * 7 + d (n * 2 - 2))) `mod` 36

    t :: Int -> Tuple
    t i
      | i <= div k 2 = Tuple
        { _t_a = (((d (i * 2 - 1) `shiftR` 6) .&. 3) + c i) `mod` 6
        , _t_b = (d (i * 2 - 1) `shiftR` 2) .&. 15
        , _t_c = (((d (i * 2 - 1)) .&. 3) + div (c i) 6) `mod` 6
        , _t_d = (d (i * 2) `shiftR` 4) .&. 15
        , _t_e = (d (i * 2)) .&. 15
        }
      | even k = Partial
        { _p_a = c i `mod` 6
        , _p_b = 16
        , _p_c = c i `div` 6
        }
      | otherwise = Partial
        { _p_a = (((d k `shiftR` 6) .&. 3) + c i) `mod` 6
        , _p_b = (d k `shiftR` 2) .&. 15
        , _p_c = ((d k .&. 3) + div (c i) 6) `mod` 6
        }

    voe, con :: Int -> Char
    voe i = "aeiouy" !! i
    con i = "bcdfghklmnprstvzx" !! i

    e :: Tuple -> String
    e (Tuple ta tb tc td te) = [voe ta, con tb, voe tc, con td, '-', con te]
    e (Partial pa pb pc) = [voe pa, con pb, voe pc]

続編

Haskell でループする (2)

これが簡易的なチェックサムとなる ↩
i = 1 のとき D[i * 2 - 3] をしたら負の添え字を参照してしまう。また、 e への入力も仕様書の通りだと 16bit 中 4bit が失われてしまう。 ↩