the fun of programming chap1

ねじれヒープ.fs

type Tree<'T when 'T : comparison> = Null | Fork of 'T * Tree<'T> * Tree<'T>

let isEmpty = function
  | Null -> true
  | _ -> false

let minElem (Fork(x,_,_)) = x

let rec merge a b =

  let join (Fork(x,a,b)) c = Fork(x,b,merge a c)

  match (a, b) with
  | (Null, b) -> b
  | (a, Null) -> a
  | (a, b) when minElem a <= minElem b -> join a b
  | (a, b) -> join b a

let deleteMin (Fork(_,a,b)) = merge a b

let insert x a = merge (Fork(x,Null,Null)) a

ラウンドロビンヒープ.fs

type Colour = Red | Blue
type Tree<'T when 'T : comparison> = Null | Fork of Colour * 'T * Tree<'T> * Tree<'T>

let isEmpty = function
  | Null -> true
  | _ -> false

let minElem (Fork(_,x,_,_)) = x

let rec merge a b =

  let join t c =
    match t with
    | Fork(Red, x, a, b) -> Fork(Blue, x, merge a c, b)
    | Fork(Blue, x, a, b) -> Fork(Red, x, a, merge b c)

  match (a, b) with
  | (Null, b) -> b
  | (a, Null) -> a
  | (a, b) when minElem a <= minElem b -> join a b
  | (a, b) -> join b a

let deleteMin (Fork(_,_,a,b)) = merge a b

let insert x a = merge (Fork(Blue,x,Null,Null)) a

最大回避ヒープ.fs

type Tree<'T when 'T : comparison> = Null | Fork of int * 'T * Tree<'T> * Tree<'T>

let isEmpty = function
  | Null -> true
  | _ -> false

let minElem (Fork(_,x,_,_)) = x

let rec merge a b =

  let size = function
    | Null -> 0
    | Fork(n,_,_,_) -> n

  let orderBySize a b c =
    let biggest = Seq.max [size a; size b; size c]
    match () with
    | () when size a = biggest -> (a, b, c)
    | () when size b = biggest -> (b, a, c)
    | () when size c = biggest -> (c, a, b)

  let join (Fork(n,x,a,b)) c =
    let (aa, bb, cc) = orderBySize a b c
    Fork(n + size c, x, aa, merge bb cc)

  match (a, b) with
  | (Null, b) -> b
  | (a, Null) -> a
  | (a, b) when minElem a <= minElem b -> join a b
  | (a, b) -> join b a

let deleteMin (Fork(_,_,a,b)) = merge a b

let insert x a = merge (Fork(1,x,Null,Null)) a

遅延版ねじれヒープ.fs

type Tree<'T when 'T : comparison> = Null | Fork of 'T * Lazy<Tree<'T>> * Lazy<Tree<'T>>

let isEmpty = function
  | Null -> true
  | _ -> false

let minElem (Fork(x,_,_)) = x

let rec merge a b =

  let join (Fork(x,a,b)) c = Fork(x,b,lazy(merge (a.Force()) c))

  match (a, b) with
  | (Null, b) -> b
  | (a, Null) -> a
  | (a, b) when minElem a <= minElem b -> join a b
  | (a, b) -> join b a

let deleteMin (Fork(_,a,b)) = merge (a.Force()) (b.Force())

let insert x a = merge (Fork(x,lazy Null,lazy Null)) a

遅延最大回避ヒープと遅延ねじれヒープは実用になる。ラウンドロビンヒープは説明用らしい。