前回,Seq型の要素はviewl関数またはviewr関数を使って参照することを説明しました。viewlやviewrを利用すると,リストに対して用意されている様々な関数と同様の機能を持つ関数をSeq型に対して定義できます。

 しかし,viewlやviewrを使って実装した関数は,Seqを左端または右端から順に処理するため,処理に線形時間がかかってしまいます。これでは,Seq型がFingerTreeという木によって実装されている利点を生せません。今回は,Data.Sequenceモジュールが提供するいくつかの関数を取り上げ,それらがいかに効率的な処理を行っているかを説明します。

Seq型にランダム・アクセスする関数

 前回紹介したviewlやviewrは,Seq型の要素に逐次的にアクセスします。これとは別に,Seq型がFingerTreeという木によって実装されていることを生かし,Seqの特定の個所を高速に参照・更新するランダム・アクセス関数が用意されています。Data.Sequecenモジュールは,Seqの左から特定の個所にアクセスする様々な関数を提供しています(参考リンク)。

 特定の位置にある要素を参照する関数「index」は以下のように定義されています。

-- | /O(log(min(i,n-i)))/. The element at the specified position,
-- which should be a positive integer less than the size of the sequence.
-- If the position is out of range, 'index' fails with an error.
index           :: Seq a -> Int -> a
index (Seq xs) i
  | 0 <= i && i < size xs = case lookupTree i xs of
                                 Place _ (Elem x) -> x
  | otherwise   = error "index out of bounds"

data Place a = Place {-# UNPACK #-} !Int a

 index関数は指定した位置までの探索を行います。この関数の内部では,指定した位置の要素をlookupTree関数で参照しています。index関数に渡す位置の値がFingerTreeの大きさを超える場合には「index out of bounds」というメッセージとともに例外が発生します(これ以降に示すソースコードでは,今回の説明に関係ない部分は省略しています)。

lookupTree :: Sized a => Int -> FingerTree a -> Place a
lookupTree _ Empty = error "lookupTree of empty tree"
lookupTree i (Single x) = Place i x
lookupTree i (Deep _ pr m sf)
  | i < spr     =  lookupDigit i pr
  | i < spm     =  case lookupTree (i - spr) m of
                        Place i' xs -> lookupNode i' xs
  | otherwise   =  lookupDigit (i - spm) sf
  where spr     = size pr
        spm     = spr + size m

data FingerTree a
   = Empty
   | Single a
   | Deep {-# UNPACK #-} !Int !(Digit a) (FingerTree (Node a)) !(Digit a)

 lookupTreeは,FingerTreeが空(Empty)であれば「lookupTree of empty tree」というメッセージとともに例外を発生するよう定義されています。ただし,実際には呼び出し元のindex関数によって事前に例外が発生するため,この処理が行われることはありません。空のFingerTreeの大きさは0であるため,「0 <= i && i < size xs」の評価結果は常に偽となり,Seqの範囲外を示す例外が発生するからです。

 なぜ,このような無駄な処理を記述しているのでしょうか?

 Haskellでは,発生し得るすべての値をパターンが網羅していない場合,条件にない値が与えられたときにはパターン照合が失敗し,PatternMatchFail型の例外が発生します(参考リンク)。

module Test where
import Control.Exception
import Prelude hiding (catch)

failableMatch [] = "success."

catchException val
  = catch (evaluate val)
          (\(PatternMatchFail str) -> return "success.")

*Failable> failableMatch  "fail."
*** Exception: Test.hs:6:0-19: Non-exhaustive patterns in function failableMatch
*Failable> catchException $ failableMatch "fail."
"success."

 GHCには,発生し得るすべての値をパターンが網羅していない場合に警告を表示する「-fwarn-incomplete-patterns」というオプションが用意されています(参考リンク)。警告を表示することで,ユーザーが実行時例外の発生を未然に防げるようになります。ところがこのオプションを使うと,lookupTreeのEmptyのように「決して使用されない値」がパターン内に存在しない場合にも警告が表示されます。そこで,このオプションを使った場合に警告が表示されるのを防ぐため,使用しないEmptyに対する評価結果を記述しているのです。

 いずれにせよ,使用しない値を含めたすべてのパターンを書いておくのは良い習慣です。すべてのパターンを書いておけば,関数を書き換えたことでそれまで使用していなかった値に対するパターン照合が行われるようになっても,関数を期待通りに動作させられます。

 話を戻しましょう。FingerTreeが1個の要素だけを持つ,すなわちSingleである場合には,そのまま要素を取り出します。指定した位置が指であれば,lookupDigit関数を使って指にある要素を取り出します。

lookupDigit :: Sized a => Int -> Digit a -> Place a
lookupDigit i (One a) = Place i a
lookupDigit i (Two a b)
  | i < sa      = Place i a
  | otherwise   = Place (i - sa) b
  where sa      = size a
lookupDigit i (Three a b c)
  | i < sa      = Place i a
  | i < sab     = Place (i - sa) b
  | otherwise   = Place (i - sab) c
  where sa      = size a
        sab     = sa + size b
lookupDigit i (Four a b c d)
  | i < sa      = Place i a
  | i < sab     = Place (i - sa) b
  | i < sabc    = Place (i - sab) c
  | otherwise   = Place (i - sabc) d
  where sa      = size a
        sab     = sa + size b
        sabc    = sab + size c

 そうでなければlookupTreeとlookupNodeを再帰的に呼び出し,中央の節に対する探索を続けます。lookupNodeの定義は以下の通りです。

lookupNode :: Sized a => Int -> Node a -> Place a
lookupNode i (Node2 _ a b)
  | i < sa      = Place i a
  | otherwise   = Place (i - sa) b
  where sa      = size a
lookupNode i (Node3 _ a b c)
  | i < sa      = Place i a
  | i < sab     = Place (i - sa) b
  | otherwise   = Place (i - sab) c
  where sa      = size a
        sab     = sa + size b

 最終的に,lookupTree,lookupDigit,lookupNodeのそれぞれが返すPlace型から要素を取り出し,結果として返しています。

 では,使ってみましょう。

Prelude Data.Sequence> index empty 0
*** Exception: index out of bounds
Prelude Data.Sequence> index (singleton 1) 0
1
Prelude Data.Sequence> index (singleton 1) 1
*** Exception: index out of bounds
Prelude Data.Sequence> index (3 <| (singleton 1 |> 2)) 0
3
Prelude Data.Sequence> index (3 <| (singleton 1 |> 2)) 1
1
Prelude Data.Sequence> index (3 <| (singleton 1 |> 2)) 2
2
Prelude Data.Sequence> index (fromList ['a'..'z']) 0
'a'
Prelude Data.Sequence> index (fromList ['a'..'z']) 11
'l'
Prelude Data.Sequence> index (fromList ['a'..'z']) 25
'z'
Prelude Data.Sequence> index (fromList ['a'..'z']) 50
*** Exception: index out of bounds

 指定した位置がSeqの範囲内であれば要素を取り出せることを確認できました。

 次にindex関数のコストを見ていきましょう。FingerTreeのように「二つあるいは三つの節を持つ木」の要素にアクセスする処理は,基本的には木の大きさに対して対数時間(「O(log(n))」と表現します)がかかります(参考リンク)。index関数の場合には「FingerTreeの大きさn」と「参照したい個所i」という2種類の情報を使って要素にアクセスできるので,実際のコストは,iとn-iのうち小さいほうの対数時間,つまり「O(log(min(i,n-i)))」になります。

 要素を取り出す関数をviewrやviewlを使って実装した場合には,指定した位置まで再帰的に関数を呼び出す線形時間の処理になります。したがって,index関数のほうがコストは低くなります。

 index関数と同様に,Seq型の要素を更新する関数「adjust」と「update」も定義されています。

 adjust関数の定義は以下の通りです。

-- | /O(log(min(i,n-i)))/. Update the element at the specified position.
-- If the position is out of range, the original sequence is returned.
adjust          :: (a -> a) -> Int -> Seq a -> Seq a
adjust f i (Seq xs)
  | 0 <= i && i < size xs = Seq (adjustTree (const (fmap f)) i xs)
  | otherwise   = Seq xs

adjustTree      :: Sized a => (Int -> a -> a) ->
                        Int -> FingerTree a -> FingerTree a
adjustTree _ _ Empty = error "adjustTree of empty tree"
adjustTree f i (Single x) = Single (f i x)
adjustTree f i (Deep s pr m sf)
  | i < spr     = Deep s (adjustDigit f i pr) m sf
  | i < spm     = Deep s pr (adjustTree (adjustNode f) (i - spr) m) sf
  | otherwise   = Deep s pr m (adjustDigit f (i - spm) sf)
  where spr     = size pr
        spm     = spr + size m

 adjust関数には,指定した位置の要素を操作する関数を渡します。指定した位置がFingerTreeの大きさを超える場合には何もしません。FingerTreeが空である場合には,adjustの「0 <= i && i < size xs」により,空のFingerTreeがそのままSeqとして返されます。index関数と同様に,adjustTreeの中にある「FingerTreeが空の場合の処理」は実際には行われません。adjust関数の定義は,index関数の「Place型を返す処理」が「関数fを使って指定個所を操作する処理」に置き換えられているだけなので,特に難しくはないでしょう。

 adjustよりも手軽に使るのがupdate関数です。指定した要素の値を直接書き換えます。実際のupdateの定義では「const x」をadjustに渡しています。

-- | /O(log(min(i,n-i)))/. Replace the element at the specified position.
-- If the position is out of range, the original sequence is returned.
update          :: Int -> a -> Seq a -> Seq a
update i x      = adjust (const x) i

 これらの関数を使ってみましょう。

Prelude Data.Sequence> adjust (+1) 0 empty
fromList []
Prelude Data.Sequence> adjust (+1) 0 $ singleton 1
fromList [2]
Prelude Data.Sequence> adjust (+1) 1 $ singleton 1
fromList [1]
Prelude Data.Sequence> adjust (+1) 1 $ 2 <| (singleton 1 |> 3)
fromList [2,2,3]
Prelude Data.Sequence> update 2 1024 $ 2 <| (singleton 1 |> 3)
fromList [2,1,1024]
Prelude Data.Sequence> update 11 '-' $ fromList ['a'..'z']
fromList "abcdefghijk-mnopqrstuvwxyz"

 評価結果として「fromList」が表示されました。前回,fromListはリストからSeq型に変換する関数だと説明しました。なぜ,この関数が表示されているのでしょうか?

 その理由を探るために,処理系で出力を行っているShowクラスのインスタンスの定義を見てみましょう。

instance Show a => Show (Seq a) where
        showsPrec p xs = showParen (p > 10) $
                 showString "fromList " . shows (toList xs)

 実は,Seq型のShowクラスに対するインスタンスは,Seq型をtoList関数を使ってリストに変換してから「fromList」という文字列とともに表示するように定義されています。「fromList」というメッセージは「リストにfromListを適用して構成したSeq」と「出力の対象であるもともとのSeq」が等価な構造を持つ,ということを意図しています。

 「fromList」の意味がわかれば,期待したように指定した場所の要素が変更されていることを理解できると思います。

 ちなみに,adjust関数とupdate関数のコストは,index関数と同じく対数時間「O(log(min(i,n-i)))」です。