(* persistent union-find = Tarjan's algorithm with persistent arrays *)
(* manually defunctorized version *)

type t = { 
  c: Pa4.t;
  mutable father: Pa4.t;
}
      
let create n = 
  { c = Pa4.create n 0;
    father = Pa4.init n (fun i -> i) }
    
let rec find_aux f i = 
  let fi = Pa4.get f i in
  if fi == i then 
    f, i
  else 
    let f, r = find_aux f fi in 
    let f = Pa4.set f i r in
    f, r
      
let find h x = 
  let f,rx = find_aux h.father x in h.father <- f; rx
  
let union h x y = 
  let rx = find h x in
  let ry = find h y in
  if rx != ry then begin
    let rxc = Pa4.get h.c rx in
    let ryc = Pa4.get h.c ry in
    if rxc > ryc then
      { h with father = Pa4.set h.father ry rx }
    else if rxc < ryc then
      { h with father = Pa4.set h.father rx ry }
    else
      { c = Pa4.set h.c rx (rxc + 1);
	father = Pa4.set h.father ry rx }
  end else
    h