Submission #1966163

---

Source Code Expand

(* persistent array *)
module PArray : sig
  type 'a t

  val init : int -> (int -> 'a) -> 'a t
  val make : int -> 'a -> 'a t
  val of_list : 'a list -> 'a t
  val get : 'a t -> int -> 'a
  val set : 'a t -> int -> 'a -> 'a t
  (** [set a n x] returns a persistent array replacing element number [n] of [a] with [x].
     [a] is *not* modified. *)
  val length : 'a t -> int
  val to_list : 'a t -> 'a list
  val iter : ('a -> unit) -> 'a t -> unit
  val iteri : (int -> 'a -> unit) -> 'a t -> unit
  val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
  val fold_right : ('b -> 'a -> 'a) -> 'b t -> 'a -> 'a
end = struct
  type 'a t = 'a data ref
  and 'a data = Arr of 'a array | Diff of int * 'a * 'a t

  let init n f = ref (Arr (Array.init n f))
  let make n v = ref (Arr (Array.make n v))
  let of_list l = ref (Arr (Array.of_list l))

  let rec reroot k = function
    | { contents = Arr a } -> k a
    | { contents = Diff (i, v, t') } as t ->
        reroot (fun a ->
          t' := Diff (i, a.(i), t);
          a.(i) <- v;
          k a) t'
  let reroot k = function
    | { contents = Arr a } -> k a
    | { contents = Diff (_, _, _) } as t ->
        reroot (fun a -> t := Arr a; k a) t

  let rec get t i = reroot (fun a -> a.(i)) t

  let set t i v =
    reroot (fun a ->
      if v = a.(i) then t
      else begin
        let result = ref (Arr a) in
        t := Diff (i, a.(i), result);
        a.(i) <- v;
        result
      end) t

  let length t = reroot Array.length t
  let to_list t = reroot Array.to_list t
  let iter f = reroot (Array.iter f)
  let iteri f = reroot (Array.iteri f)
  let fold_left f x = reroot (Array.fold_left f x)
  let fold_right f t x = reroot (fun a -> Array.fold_right f a x) t
end

(* persistent union-find data structure *)
module PUnionFind : sig
  type t
  type class_

  val make : int -> t
  val find : t -> int -> class_
  val union : t -> int -> int -> t
end = struct
  type t = { rank : int PArray.t; mutable parent : int PArray.t }
  type class_ = int

  let make n = { rank = PArray.make n 0; parent = PArray.init n (fun i -> i) }

  let rec find parent i k =
    let j = PArray.get parent i in
    if i = j then k parent i
    else find parent j (fun parent r -> k (PArray.set parent i r) r)
  let find ({ parent } as h) i = find parent i (fun parent r ->
    h.parent <- parent;
    r)

  let union uf x y =
    let cx = find uf x in
    let cy = find uf y in
    if cx = cy then uf
    else begin
      let rx = PArray.get uf.rank x in
      let ry = PArray.get uf.rank y in
      match compare rx ry with
      | -1 -> { uf with parent = PArray.set uf.parent cx cy }
      | 1 -> { uf with parent = PArray.set uf.parent cy cx }
      | 0 -> { rank = PArray.set uf.rank cx (cx + 1); parent = PArray.set uf.parent cy cx }
    end
end

module ClassSet = Set.Make (struct
  type t = PUnionFind.class_
  let compare = compare
end)


let () =
  let n, m = Scanf.scanf "%d %d\n" (fun n m -> n, m) in
  Array.init m (fun _ -> Scanf.scanf "%d %d\n" (fun a b -> a, b))
  |> Array.fold_left (fun u (a, b) -> PUnionFind.union u (a - 1) (b - 1)) (PUnionFind.make n)
  |> (fun u -> Array.init n (PUnionFind.find u))
  |> Array.fold_left (fun s x -> ClassSet.add x s) ClassSet.empty
  |> ClassSet.cardinal
  |> (fun n -> Printf.printf "%d\n" (n - 1))

Submission Info

Compile Error

File "./Main.ml", line 87, characters 6-248:
Warning 8: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
2

Judge Result