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


exception Solution of int

(* funkcja dorzucajaca do kolejki q wszystkie stany osiagalne ze stanu arr
   z zaktualizowaną liczbą ruchów (jesli nie sa rozwiazaniem) *)

let states (arr, d) q comp =
  let n = Array.length arr and d1 = d+1 in
    for i = 0 to n-1 do
      let (xi, yi) = arr.(i) in
      (* dolanie do pełna i-tej szklanki *)
      arr.(i) <- (xi, xi);
      if arr = comp then raise (Solution (d1)) else
        Queue.add (Array.copy arr, d1) q;
      (* oproznienie i-tej szklanki *)
      arr.(i) <- (xi, 0);
      if arr = comp then raise (Solution (d1)) else
        Queue.add (Array.copy arr, d1) q;
        (* reset *)
        arr.(i) <- (xi, yi);
      for j = i+1 to n-1 do
        let (xj, yj) = arr.(j) in
      (* przelanie z i do j *)
        arr.(j) <- (xj, min (yj + yi) xj);
        arr.(i) <- (xi, max 0 (yi - xj + yj));
        if arr = comp then raise (Solution (d1)) else
        Queue.add (Array.copy arr, d1) q;
      (* przelanie z j do i *)
        arr.(i) <- (xi, min (yi + yj) xi);
        arr.(j) <- (xj, max 0 (yj - xi + yi));
        Queue.add (Array.copy arr, d1) q;
        if arr = comp then raise (Solution (d1)) else
        (* reset *)
        arr.(i) <- (xi, yi);
        arr.(j) <- (xj, yj);
      done;
  done

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 in
       Queue.add ((Array.map (fun (x, _) -> (x, 0)) arr), 0) q;
       while not (Queue.is_empty q) do
         let (st, d) = Queue.take q in
         if not (Hashtbl.mem been st) then begin
               Hashtbl.add been st true;
               states (st, d) q arr; end
       done;
       -1

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