(* Autor: Jan Kociniak
   Reviewer: Piotr Wojtczak
   WPF 2017Z - Przelewanka  *)


exception Solution of int

(* funkcja generujaca liste osiagalnych stanów, ktore nie sa jeszcze rozwiazaniem  *)
(* arr - poczatkowy stan, d - liczba krokow, comp - to co chcemy osiagnac          *)

let states (arr, d) comp =
  let n = Array.length arr and d1 = d+1 and l = ref [] in
    for i = 0 to n-1 do
      let (xi, yi) = arr.(i) in
      (* dolanie do pełna i-tej szklanki *)
      if yi <> xi then begin
        arr.(i) <- (xi, xi);
        if arr = comp then raise (Solution (d1))
        else
          l := (Array.copy arr, d1)::!l;
      end;
      (* oproznienie i-tej szklanki *)
      if yi <> 0 then begin
        arr.(i) <- (xi, 0);
        if arr = comp then raise (Solution (d1))
        else
          l := (Array.copy arr, d1)::!l;
      end;
        (* reset *)
        arr.(i) <- (xi, yi);
      for j = i+1 to n-1 do
        let (xj, yj) = arr.(j) in
        (* przelanie z i do j *)
        if yj <> xj  && yi <> 0 then begin
        arr.(j) <- (xj, min (yj + yi) xj);
        arr.(i) <- (xi, max 0 (yi - xj + yj));
        if arr = comp then raise (Solution (d1))
        else
          l := (Array.copy arr, d1)::!l;
      end;
        (* przelanie z j do i *)
        if yi <> xi && yj <> 0 then begin
        arr.(i) <- (xi, min (yi + yj) xi);
        arr.(j) <- (xj, max 0 (yj - xi + yi));
        if arr = comp then raise (Solution (d1))
        else
          l := (Array.copy arr, d1)::!l;
      end;
        (* reset *)
        arr.(i) <- (xi, yi);
        arr.(j) <- (xj, yj);
      done;
    done;
    !l

let gcd arr =
  let rec euclid a b =
    let (m, n) = (max a b, min a b) in
    if n = 0 then m else euclid (m mod n) n
  in
  let gcd_x = Array.fold_left (fun a (x, _) -> euclid a x) 0 arr in
  Array.fold_left (fun a (_, y) -> a && y mod gcd_x = 0) true arr


let bfs arr =
  if arr = Array.map (fun (x, _) -> (x, 0)) arr then 0 else
  if not (gcd arr) then -1 else
    let q = Queue.create()
    and been = Hashtbl.create 1000000
    and start = Array.map (fun (x, _) -> (x, 0)) arr in
    let filter (x, d) =
      if Hashtbl.mem been x = false then begin
           Queue.add (x, d) q;
           Hashtbl.add been x true; end
      in
         Hashtbl.add been start true;
         Queue.add (start, 0) q;
         while not (Queue.is_empty q) do
           let act = Queue.take q in
           List.iter filter (states act arr);
         done;
         -1

let przelewanka arr =
  try bfs arr with
  | Solution(x) -> x