Przelewanka

(* Przelewanka
Recenzent: Piotr Prabucki
Autor: Marcin Mazur *)

(* Exception, ktore konczy program, jesli znajdzie odpowiedz *)
exception Koniec of int

let przelewanka int_array =

(* Array bez kubków zer, poniewaz nie wplywaja one na rozwiazanie *)
    let good_input_array =
        Array.of_list (List.filter (fun (x, _) -> if x = 0 then false else true) (Array.to_list int_array)) in

(* Dlugosc naszej tablicy *)
    let dlugosc = Array.length good_input_array in

(* Pojemnosci szklanek *)
    let pojemnosci = Array.map (fun (y, _) -> y) good_input_array in

(* Licze NWD pojemnosci kubkow *)
    let nwd =
        let rec nwd_licz x y =
            if x = 0 then y
            else nwd_licz (y mod x) x in
        Array.fold_left nwd_licz 0 pojemnosci in

(* Czy to nie jest juz odpowiedz*)
    if Array.for_all (fun (_, y) -> y = 0) good_input_array || dlugosc = 0 then 0

(* Sprawdzam czy istnieje kubek, ktoy trzeba napelnic do pelna lub
    kubek, ktorego nie trzeba napelniac *)
    else if Array.for_all (fun (x, y) -> x <> y && y <> 0) good_input_array then -1

(* Sprawdzam czy wszystkie stany koncowe sa podzielne przez NWD *)
    else if not (Array.for_all (fun (_, x) -> (x mod nwd) = 0) good_input_array) then  -1

(* Tutaj zaczyna sie implementacja i wyliczanie stanow*)
    else

(* Wynik / stan koncowy *)
    let dream_state = Array.map (fun (_, y) -> y) good_input_array in

(* Hashtable, ktory przechowuje stany *)
    let mapa_stanow = Hashtbl.create 420420 in

(* Kolejka trzymajaca stany do rozpatrzenia *)
    let do_rozpatrzenia = Queue.create () in
    Queue.add ((Array.make dlugosc 0), 0) do_rozpatrzenia;

(* Funkcja nalania wody ze szklanki *)
    let nalej (tablica, kroki) numer_szklanki =
        let kopia = Array.copy tablica in
        Array.set kopia numer_szklanki (Array.get pojemnosci numer_szklanki);
        (kopia, kroki + 1) in

(* Funkcja wylania wody ze szklanki *)
    let wylej (tablica, kroki) numer_szklanki =
        let kopia = Array.copy tablica in
        Array.set kopia numer_szklanki 0;
        (kopia, kroki + 1) in

(* Funkcja przelania z jednej szklanki do drugiej *)
    let przelej (tablica, kroki) z_tej do_tej =
        let kopia = Array.copy tablica in
        let z_tej_ile_ma = (Array.get kopia z_tej) in
        let do_tej_ile_ma = (Array.get kopia do_tej) in
        let do_tej_ile_moze_miec = (Array.get pojemnosci do_tej) in
        if do_tej_ile_moze_miec - do_tej_ile_ma >= z_tej_ile_ma then
        begin
            Array.set kopia z_tej 0;
            Array.set kopia do_tej (do_tej_ile_ma + z_tej_ile_ma);
            (kopia, kroki + 1)
        end
        else
        begin
            Array.set kopia z_tej (z_tej_ile_ma - (do_tej_ile_moze_miec - do_tej_ile_ma));
            Array.set kopia do_tej do_tej_ile_moze_miec;
            (kopia, kroki + 1)
        end in

(* Funkcja hashujaca *)
    let hash tablica =
        Array.fold_left (fun sum x -> abs (sum * 10 + x)) 0 tablica in

(* Dream state hash *)
    let dream_hash = hash dream_state in

(* Pelna *)
    let pelna stan i_numer =
        (Array.get pojemnosci i_numer) = (Array.get (fst stan) i_numer) in

(* Pusta *)
    let pusta stan i_numer =
        0 = (Array.get (fst stan) i_numer) in

(* Obslugiwanie nowego stanu *)
    let obsluz zmieniony_stan =
        let changed_hash = hash (fst zmieniony_stan) in
        if changed_hash = dream_hash && (fst zmieniony_stan) = dream_state then
        begin
            raise (Koniec (snd zmieniony_stan));
        end
        else if not (Hashtbl.mem mapa_stanow changed_hash) then
        begin
            Hashtbl.add mapa_stanow changed_hash [zmieniony_stan];
            Queue.add zmieniony_stan do_rozpatrzenia;
        end
        else
        let wyjeta_lista = Hashtbl.find mapa_stanow changed_hash in
        let rec nie_ma zmieniony_stan lista =
            match lista with
            | hd :: tl -> if (fst hd) = (fst zmieniony_stan) then false else nie_ma zmieniony_stan tl
            | [] -> true in
        if nie_ma zmieniony_stan wyjeta_lista then
        begin
            Hashtbl.replace mapa_stanow changed_hash (zmieniony_stan :: wyjeta_lista);
            Queue.add zmieniony_stan do_rozpatrzenia;
        end
        else () in

(* Looper *)
    try
        while not (Queue.is_empty do_rozpatrzenia) do
            let aktualny_stan = Queue.take do_rozpatrzenia in
            (* nalewanie *)
            for i = 0 to dlugosc - 1 do
                if not (pelna aktualny_stan i) then
                let changed = nalej aktualny_stan i in
                obsluz changed
            done;
            (* wylewanie *)
            for i = 0 to dlugosc - 1 do
                if not (pusta aktualny_stan i) then
                let changed = wylej aktualny_stan i in
                obsluz changed
            done;
            (* przelewanie *)
            for i = 0 to dlugosc - 1 do
                if not (pusta aktualny_stan i) then
                begin
                for j = 0 to dlugosc - 1 do
                    if j <> i && not (pelna aktualny_stan j) then
                    begin
                    let changed = przelej aktualny_stan i j in
                    obsluz changed
                    end
                done
                end
            done
        done;
    -1
    with Koniec wynik -> wynik ;;

(* Testy:
assert(przelewanka [|(1, 0); (3, 0); (1, 0) |] = 0);;
assert(przelewanka [|(1, 5); (3, 3); (1, 1) |] = 3);;
assert(przelewanka [|(1, 0); (3, 0); (1, 0) |] = 0);;
assert(przelewanka [|(3, 5); (3, 3); (1, 1) |] = 3);;
assert(przelewanka [|(3, 3); (3, 3); (1, 0) |] = 3);;
assert(przelewanka [|(3, 2); (3, 2); (1, 0) |] = 4);;
assert(przelewanka [|(3, 1); (3, 1); (7, 1) |] = -1);;
assert(przelewanka [|(3, 1); (3, 1); (7, 0) |] = 7);;
assert(przelewanka [|(2,1); (1, 1); (7, 7) |] = 7);;
assert(przelewanka [|(2,0); (1, 1); (7, 1) |] = 6);;
assert(przelewanka [|(5,1); (1, 0); (7, 1) |] = 7);;
assert(przelewanka [|(5,5); (1, 1); (7, 1) |] = 5);;
assert(przelewanka [|(5,1); (1, 0); (7, 1) |] = 7);;
assert(przelewanka [|(5,3); (3, 3); (7, 1) |] = 4);;
assert(przelewanka [|(5,3); (3, 0); (7, 4) |] = 3);;
assert(przelewanka [|(5,0); (3, 3); (7, 4) |] = 2);;
assert(przelewanka [|(5,0); (3, 0); (7, 7) |] = 1);; *)