gistfile1.txt

(* Disjoint Set implementation in Ocaml.
 * The implementation here is written by Jesper Louis Andersen, but is
 * loosely based on an equivalent in MLton:
 *
 * Copyright (C) 2009 Matthew Fluet.
 * Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
 *    Jagannathan, and Stephen Weeks.
 *
 * MLton is released under a BSD-style license.
 * See the file MLton-LICENSE for details.
 *)

exception DSError of string

type 'a root = {value : 'a;
		rank: int }

type 'a t = T of 'a parent ref
and  'a parent =
    Parent of 'a t
  | Root of 'a root

let singleton v = T (ref (Root {value = v; rank = 0}))

let rank (T t) =
  match !t with
    |  Root {rank = r; value = v} -> r
    |  _ -> raise (DSError "rank")

let set_rank (T t, r) =
    match !t with
	| Root {value = v; rank = r1} -> t := Root {value = v; rank = r}
	| _ -> raise (DSError "set_rank")


let inc_rank r = set_rank (r, rank r + 1)

let parent (T t) =
  match !t with
    | Parent p -> p
    | _ -> raise (DSError "parent")


let set_parent (T t, p) = t := Parent p

let root_value (T t) =
  match !t with
    | Root {value = v; rank = r} -> v
    | _ -> raise (DSError "root_value")

let set_root_value (T t, v) =
  match !t with
    | Root {rank = r; value = v1} -> t := Root {rank = r; value = v}
    | _ -> raise (DSError "set_root_value")

let equal (T r, T r') = r = r'

let is_root (T t) = match !t with
  | Root _ -> true
  | Parent _ -> false

let is_representative = is_root

let rec root s =
  if is_root s then s
  else
    let r = root (parent s) in
	set_parent (s, r);
	r

let representative = root

let deref s = root_value (root s)

let set s v = set_root_value (root s, v)

let equals (s1, s2) = equal (root s1, root s2)

let union (s1, s2) =
  let r1 = root s1 in
  let r2 = root s2 in
    if equal (r1, r2) then ()
    else
	let n1 = rank r1 in
	let n2 = rank r2 in
	  if n1 < n2
	  then set_parent (r1, r2)
	  else set_parent (r2, r1);

	  if n1 == n2 then inc_rank r1 else ()

let can_union (s1, s2, f) =
  equals (s1, s2) || (match f (deref s1, deref s2) with
			    None -> false
			  | Some v -> (union (s1, s2);
				       set s1 v;
				       true))

gistfile2.txt