:- module day12.
:- interface.
:- import_module basics.

:- pred run(part::in, lines::in, answer::out) is cc_multi.

:- implementation.
:- import_module int.
:- import_module char.
:- import_module string.
:- import_module list.
:- import_module array2d.
:- import_module map.
:- import_module psqueue.
:- import_module solutions.

:- type point == {int, int}.

:- type grid ---> g(array :: array2d(char), start :: point, end :: point).

:- pred grid(lines::in, grid::out) is nondet.
grid(Lines, g(Arr, {SX, SY}, {EX, EY})) :-
  Arr = from_lists(map(to_char_list, Lines)),
  find(Arr, 'S', SX, SY),
  find(Arr, 'E', EX, EY).

:- pred find(array2d(T)::in, T::in, int::out, int::out) is nondet.
find(Arr, X, I, J) :- index_arr(Arr, I, J), Arr^elem(I, J) = X.

:- func grid^elem(point) = char.
G^elem({X, Y}) = G^array^elem(X, Y).

:- func height(char) = int.
height(C) = I :-
  if C = 'S' then I = 0
  else if C = 'E' then I = 25
  else I = to_int(C) - to_int('a').

:- func height(grid, point) = int.
height(G, P) = height(G^elem(P)).

:- pred adj_point(point::in, point::out) is multi.
adj_point({X, Y}, {X+1, Y}).
adj_point({X, Y}, {X-1, Y}).
adj_point({X, Y}, {X,   Y+1}).
adj_point({X, Y}, {X,   Y-1}).

:- pred adj(grid::in, point::in, point::out) is nondet.
adj(G, P, Q) :-
  adj_point(P, Q), in_bounds(G, Q),
  height(G, Q) =< height(G, P) + 1.

:- pred in_bounds(grid::in, point::in) is semidet.
in_bounds(G, {X, Y}) :- in_bounds(G^array, X, Y).


:- pred bounds(grid::in, int::out, int::out) is det.
bounds(G, W, H) :- bounds(G^array, W, H).

:- pred index(grid::in, point::out) is nondet.
index(Grid, {I, J}) :- index_arr(Grid^array, I, J).

:- pred index_arr(array2d(T)::in, int::out, int::out) is nondet.
index_arr(Arr, I, J) :-
  bounds(Arr, W, H),
  nondet_int_in_range(0, W-1, I),
  nondet_int_in_range(0, H-1, J).


:- type path == list(point).
:- type distance ---> i(int); inf.
:- type pm == map(point, point).
:- type nq == psqueue(distance, point).

:- pred (distance::in) < (distance::in) is semidet.
i(_) < inf.
i(M) < i(N) :- M < N.

:- pred min(distance::in, distance::in, distance::out) is det.
min(A, B, ite(A < B, A, B)).

:- func init_dist(point, point) = distance.
init_dist(Start, P) = ite(unify(P, Start), i(0), inf).

:- pred init_queue(grid::in, point::in, nq::out) is det.
init_queue(G, Start, Q) :-
  Points = solutions(index(G)),
  foldl(pred(P::in, !.Q::in, !:Q::out) is det :-
          det_insert(init_dist(Start, P), P, !Q),
        Points, psqueue.init, Q).

:- pred init_queue(grid::in, nq::out) is det.
init_queue(G, Q) :- init_queue(G, G^start, Q).

:- pred incr(distance::in, distance::out) is det.
incr(inf,  inf).
incr(i(N), i(N+1)).

:- pred neighbour(grid::in, nq::in, point::in, {point,distance}::out) is nondet.
neighbour(G, Q, P, {N, D}) :- adj(G, P, N), search(Q, N, D).

:- pred update_distance(point::in, distance::in, {point,distance}::in,
                        pm::in, pm::out, nq::in, nq::out) is det.
update_distance(Prev, DNew, {P, DOld}, !M, !Q) :-
  if DNew < DOld then
    (if adjust(func(_) = DNew, P, !Q) then true else die("point disappeared")),
    set(P, Prev, !M)
  else true.

:- pred path0(grid::in, point::in, pm::in, pm::out, nq::in, nq::out) is det.
path0(G, End, !M, !Q) :-
  det_remove_least(Distance, Point, !Q),
  (if Point = End then true else
    solutions(neighbour(G, !.Q, Point), Neighbours),
    incr(Distance, NeighDistance), % 🐴↔🐴
    foldl2(update_distance(Point, NeighDistance), Neighbours, !M, !Q),
    path0(G, End, !M, !Q)).

:- func get_path_len(grid, pm, point, point) = distance.
get_path_len(G, M, Start, Point) = Out :-
  if Point = Start then
    Out = i(0)
  else if search(M, Point, Prev) then
    incr(get_path_len(G, M, Start, Prev), Out)
  else
    Out = inf.


:- pred path_len(grid::in, point::in, point::in, distance::out) is det.
path_len(Grid, Start, End, Len) :-
  init_queue(Grid, Start, Queue),
  path0(Grid, End, init, Prevs, Queue, _),
  Len = get_path_len(Grid, Prevs, Start, End).

:- pred path_len(grid::in, distance::out) is det.
path_len(Grid, Len) :- path_len(Grid, Grid^start, Grid^end, Len).


:- pred start(grid::in, point::out) is nondet.
start(Grid, P) :- index(Grid, P), height(Grid, P) = 0.

:- pred shortest(grid::in, list(point)::in, point::in, distance::out) is det.
shortest(Grid, Starts, End, Distance) :-
  floyd_warshall(Grid, AllDistances),
  map(pred(P::in, D::out) is det :- fw_distance(Grid, AllDistances, P, End) = D,
      Starts, Distances),
  foldl(min, Distances, inf, Distance).

:- func distance(distance) = answer.
distance(inf)  = string("∞").
distance(i(N)) = int(N).


:- type dm == map({point, point}, int).

:- func fw_distance(grid, fw, point, point) = distance.
fw_distance(Grid, Array, From, To) = Out :-
  Val = Array^elem(point_to_int(Grid, From), point_to_int(Grid, To)),
  (if Val < 0 then Out = inf else Out = i(Val)).

:- pred edge(grid::in, {point,point}::out) is nondet.
edge(Grid, {From, To}) :- index(Grid, From), adj(Grid, From, To).


:- func point_to_int(grid, point) = int.
point_to_int(Grid, {X, Y}) = Y*W + X :-
  bounds(Grid, W, _).

:- func int_to_point(grid, int) = point.
int_to_point(Grid, I) = {I `mod` W, I `div` W} :-
  bounds(Grid, W, _).

:- func max_int_bound(grid) = int.
max_int_bound(Grid) = W * H :-
  bounds(Grid, W, H).

:- func edge_to_ints(grid, {point, point}) = {int, int}.
edge_to_ints(Grid, {From, To}) =
  {point_to_int(Grid, From), point_to_int(Grid, To)}.


:- pred loop(pred(int, T, T), int, T, T).
:- mode loop(pred(in, in, out) is det, in, in, out) is det.
:- mode loop(pred(in, di, uo)  is det, in, di, uo)  is det.
:- mode loop(pred(in, array2d_di, array2d_uo) is det,
            in, array2d_di, array2d_uo) is det.
loop(P, I, !Acc) :- loop(P, 0, I, !Acc).

:- pred loop(pred(int, T, T), int, int, T, T).
:- mode loop(pred(in, in, out) is det, in, in, in, out) is det.
:- mode loop(pred(in, di, uo)  is det, in, in, di, uo)  is det.
:- mode loop(pred(in, array2d_di, array2d_uo) is det,
            in, in, array2d_di, array2d_uo) is det.
loop(P, Lo, Hi, !Acc) :-
  if Lo >= Hi then true else
    P(Lo, !Acc),
    loop(P, Lo + 1, Hi, !Acc).

:- type fw == array2d(int).

:- pred add_edges(list({int,int})::in, fw::array2d_di, fw::array2d_uo) is det.
add_edges([], !Fw).
add_edges([{From, To} | Es], !Fw) :-
  !Fw^elem(From, To) := 1,
  add_edges(Es, !Fw).

:- pred floyd_warshall(grid::in, fw::array2d_uo) is det.
floyd_warshall(Grid, !:Fw) :-
  VCount = max_int_bound(Grid),
  Edges = map(edge_to_ints(Grid), solutions(edge(Grid))),

  !:Fw = array2d.init(VCount, VCount, -1),

  add_edges(Edges, !Fw),

  loop(pred(V::in, !.Fw::array2d_di, !:Fw::array2d_uo) is det :-
         !Fw^elem(V, V) := 0,
      VCount, !Fw),

  loop(pred(K::in, !.Fw::array2d_di, !:Fw::array2d_uo) is det :-
    loop(pred(I::in, !.Fw::array2d_di, !:Fw::array2d_uo) is det :-
      loop(pred(J::in, !.Fw::array2d_di, !:Fw::array2d_uo) is det :-
        (if
          IK = unsafe_lookup(!.Fw, I, K), IK > 0,
          KJ = unsafe_lookup(!.Fw, K, J), KJ > 0,
          IJ = unsafe_lookup(!.Fw, I, J), not (IJ > 0, IJ =< IK + KJ)
        then
          unsafe_set(I, J, IK + KJ, !Fw)
        else true),
        VCount, !Fw),
      VCount, !Fw),
    VCount, !Fw).

run(one, Lines, Out) :-
  if
    grid(Lines, Grid),
    path_len(Grid, Len)
  then
    Out = distance(Len)
  else
    die("bad input").
run(two, Lines, Out) :-
  % IOU one floyd warshall
  if grid(Lines, Grid) then
    solutions(start(Grid), Starts),
    shortest(Grid, Starts, Grid^end, Distance),
    Out = distance(Distance)
  else
    die("bad input").



/* omg could u imagine if this had worked tho

:- pragma memo(path/5, [fast_loose]).
:- pred path(grid::in, point::in, point::in, path::in, int::out)
    is nondet.
path(G, P, P, _,    0).
path(G, P, Q, Seen, Len + 1) :-
  adj(G, P, P1),
  not member(P1, Seen),
  path(G, P1, Q, [P|Seen], Len).

:- pred path(grid::in, point::in, point::in, int::out) is nondet.
path(G, P, Q, Len) :- path(G, P, Q, [], Len).

:- import_module solutions.

run(one, Lines, Out) :-
  if grid(Lines, G) then
    solutions(path(G, G^start, G^end), Paths),
    Out = int(det_head(Paths))
  else
    die("bad input").
*/