読者です 読者をやめる 読者になる 読者になる

きくらげ観察日記

好きなことを、適当に。

PFDSを読む: Leftist Heapの実装

inkar-us-i.hatenablog.com

この記事ではLeftist Heapについて語るだけで終わっていたので、今回はバリバリ実装していきます。
その前に、Leftist Heapの定義のついてのおさらいをしておきましょう。
Leftist Heapとは、以下の性質をもつ二分木です。

  1. 根の部分が常に最小値となる
  2. 全てのノードについて、そのノードの左側の子のrankは、右側の子のrank以上である。

ここで、rankとは、ツリーの最も右をたどっていったときに、葉に到達するまでに現れたノードの個数を指します。

それでは実装していきましょう。まずはヒープの定義から。

exception Empty

module type HEAP =
  sig
    type t
    type elt

    val empty : unit -> t
    val is_empty : t -> bool

    val insert : elt -> t -> t
    val merge : t -> t -> t

    val find_min : t -> elt (* raises Empty if heap is empty *)
    val delete_min : t -> t (* raises Empty if heap is empty *)

    val from_list : elt list -> t
    val size : t -> int
  end

次に比較可能なデータ型を定義します。二分木のときに使ったのと同様のものです。

module type ORDERED =
  sig
    type t

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

以下がLeftist Heapの定義になります。

module LeftistHeap (Elt : ORDERED)
       : HEAP with type elt = Elt.t =
  struct
    type elt = Elt.t
    type t =
      | E
      | T of int * elt * t * t

    let rank = function
      | E -> 0
      | T (r, _, _, _) -> r

    (* leftist な性質を保ったまま T(r, x, a, b) に相当するものを作ってくれるやつ *)
    let make_t x a b =
      if rank a >= rank b then T (rank b + 1, x, a, b)
      else T (rank a + 1, x, b, a)

    let empty () = E
    let is_empty = function
      | E -> true
      | _ -> false

    let rec merge h1 h2 = match h1, h2 with
      | _, E -> h1
      | E, _ -> h2
      | T (_, x1, a1, b1), T (_, x2, a2, b2) ->
         if Elt.leq x1 x2 then make_t x1 a1 (merge b1 h2)
         else make_t x2 a2 (merge h1 b2)

    let insert x h = merge (T (1, x, E, E)) h
    let find_min = function
      | T (_, x, _, _) -> x
      | E -> raise Empty
    let delete_min = function
      | T (_, _, a, b) -> merge a b
      | E -> raise Empty

    (* 畳み込むより、ツリーの数が1ステップで半分になるようにマージしていったほうが効率的 *)
    let rec from_list xs =
      let rec iter res xs = match xs with
        | a :: b :: xs -> iter (merge a b :: res) xs
        | a :: [] -> a :: res
        | [] -> res in
      let rec from_list' xs = match iter [] xs with
        | [] -> raise Empty
        | h :: [] -> h
        | xs' -> from_list' xs'
      in from_list' (List.rev_map (fun x -> T (1, x, E, E)) xs)

    let size t =
      let rec size' n = function
        | E -> n
        | T (_, x, a, b) -> size' (size' (n + 1) a) b
      in size' 0 t
  end

rankを一々求めるとO(logn)のコストがかかってしまうので、Tの第一引数としてメモっておきます。

詳細はコード読んでください。

Purely Functional Data Structures

Purely Functional Data Structures

純粋関数型データ構造

純粋関数型データ構造