きくらげ観察日記

好きなことを、適当に。

PFDSを読む: 二分木の改良

長年積んでたPFDSを読み始めることにしました。
積んでる間に邦訳が出たらしいのですが、とりあえず気にしない方針で。

まずは単純な二分木

module type SET =
  sig
    type elt
    type set

    val empty : unit -> set
    val insert : elt -> set -> set
    val member : elt -> set -> bool
  end
module type ORDERED =
  sig
    type t

    val eq : t -> t -> bool
    val lt : t -> t -> bool
    val leq : t -> t -> bool
  end

module UnbalancedSet (Elt : ORDERED)
       : SET with type elt = Elt.t =
  struct
    type elt = Elt.t
    type tree =
      | E
      | T of tree * elt * tree
    type set = tree

    let empty () = E

    let rec member x tree = match tree with
      | E -> false
      | T (a, y, b) ->
         if Elt.lt x y then member x a
         else if Elt.lt y x then member x b
         else true

    let rec insert x tree = match tree with
      | E -> T (E, x, E)
      | T (a, y, b) ->
         if Elt.lt x y then T (insert x a, y, b)
         else if Elt.lt y x then T (a, y, insert x b)
         else tree
  end

最も簡単な二分木の実装です。
これを少しずつ改良していきます。

まずは、無駄な比較を減らしましょう。上のコードでは木の深さをdとすると、最大で2d回の比較をおこなうことになってしまいます。
x < y とならないような(= xと等しいかもしれない)yをおぼえていくことによって、この比較の回数をd + 1回に減らすことができます。

module UnbalancedSet_Ex2_2 (Elt : ORDERED)
       : SET with type elt = Elt.t =
  struct
    ...
    let insert x tree =
      let rec insert' parent x tree = match tree with
        | E ->
           begin match parent with
                 | Some x' when Elt.eq x x' -> E
                 | _ -> T (E, x, E)
           end
        | T (a, y, b) ->
           if Elt.lt x y then T (insert' parent x a, y, b)
           else T (a, y, insert' (Some y) x b)
      in insert' None x tree
  end

これで少しだけ高速化できました。

次に、無駄な要素のコピーを減らしましょう。
現在のところ、以下のようなツリーxsに対して要素4を追加したツリーysを新たに作った場合、xsとysは次のように要素を共有します。

f:id:cloudear8:20170429120145p:plain

しかし、例えばここで追加する要素が0であった場合、xsとysは同じツリーであるにも関わらず、以下のような要素のコピーが行われてしまいます。

f:id:cloudear8:20170429120151p:plain

これを解消するため、追加しようとしている要素を既に持っていた場合、引数のツリーをそのまま返すようにします。

module UnbalancedSet_Ex2_4 (Elt : ORDERED) : SET =
  struct
    ...
    exception Element_Exists
    let insert x tree =
      let rec insert' parent x tree = match tree with
        | E ->
           begin match parent with
                 | Some x' when Elt.eq x x' -> raise Element_Exists
                 | _ -> T (E, x, E)
           end
        | T (a, y, b) ->
           if Elt.lt x y then T (insert' parent x a, y, b)
           else T (a, y, insert' (Some y) x b)
      in try insert' None x tree
         with Element_Exists -> tree
  end

Purely Functional Data Structures

Purely Functional Data Structures

純粋関数型データ構造

純粋関数型データ構造