From ce7568e5fc16de0920fe4e68179c84c16bf6fcac Mon Sep 17 00:00:00 2001
From: Dory <dory@dory.moe>
Date: Sun, 17 Dec 2023 11:30:10 -0800
Subject: [PATCH] d17p2

---
 17/part2.pl | 91 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 91 insertions(+)
 create mode 100644 17/part2.pl

diff --git a/17/part2.pl b/17/part2.pl
new file mode 100644
index 0000000..fa6768c
--- /dev/null
+++ b/17/part2.pl
@@ -0,0 +1,91 @@
+:- use_module(library(pio)).
+:- use_module(library(dcg/basics)).
+:- initialization(main, main).
+% :- table cost/3.
+% :- table to_key/3.
+
+main([FileName|_]) :-
+    input(FileName, Map),
+    length(Map, EndXx), EndX is EndXx - 1,
+    Start1 = 0-0-horz, Start2 = 0-0-vert,
+    to_key(Start1, K1), to_key(Start2, K2), Costs = cost{}.put(K1, 0).put(K2, 0),
+    Map = [Row0|_], length(Row0, EndYx), EndY is EndYx - 1,
+    heur(0-0, EndX-EndY, Heur0),
+    list_to_heap([Heur0-Start1, Heur0-Start2], Queue),
+    astar(Map, Costs, Queue, EndX-EndY, N),
+    write(N), nl.
+
+astar(_Map, Costs, PQueue, DestX-DestY, N) :-
+    get_from_heap(PQueue, _, X-Y-From, _), X = DestX, Y = DestY,
+    to_key(DestX-DestY-From, FromKey), N = Costs.FromKey, !.
+
+astar(Map, Gs, PQueue, DestX-DestY, N) :-
+    get_from_heap(PQueue, _, X-Y-From, PQueueAfterPop),
+    to_key(X-Y-From, CurrentKey), CurrentG = Gs.CurrentKey,
+
+    findall(To-Cost, next(Map, X-Y-From, To, Cost), Neighbors),
+    foldl(add_neighbor(CurrentG, DestX, DestY),
+          Neighbors, PQueueAfterPop-Gs, NewPQueue-NewGs),
+    astar(Map, NewGs, NewPQueue, DestX-DestY, N).
+
+add_neighbor(CurrentG, DestX, DestY, (X-Y-Dir)-Cost, HeapIn-GsIn, HeapOut-GsOut) :-
+    NewGCandidate is CurrentG + Cost,
+    to_key(X-Y-Dir, Key), ExistingG = GsIn.get(Key, 9999999),
+    (   NewGCandidate < ExistingG
+    ->  NewG = NewGCandidate, GsOut = GsIn.put(Key, NewG),
+        heur(X-Y, DestX-DestY, Heur), Weight is NewG + Heur,
+        (   get_from_heap(HeapIn, _, X-Y-Dir, _), HeapOut = HeapIn
+        ;   add_to_heap(HeapIn, Weight, X-Y-Dir, HeapOut)
+        )
+    ;   GsOut = GsIn, HeapOut = HeapIn
+    ).
+
+to_key(X-Y-horz, Key) :- Key is 0 + Y*10 + X* 10000.
+to_key(X-Y-vert, Key) :- Key is 1 + Y*10 + X* 10000.
+
+next(Map, X-Y-horz, NextX-Y-vert, Cost) :-
+    LowX1 is X - 10, HighX1 is X - 4,
+    LowX2 is X + 4, HighX2 is X + 10,
+    (between(LowX1, HighX1, NextX); between(LowX2, HighX2, NextX)),
+    vert(Map, X-Y, NextX, Cost).
+next(Map, X-Y-vert, X-NextY-horz, Cost) :-
+    LowY1 is Y - 10, HighY1 is Y - 4,
+    LowY2 is Y + 4, HighY2 is Y + 10,
+    (between(LowY1, HighY1, NextY); between(LowY2, HighY2, NextY)),
+    horz(Map, X-Y, NextY, Cost).
+
+vert(Map, X-Y, NextX, Cost) :-
+    cost(Map, NextX-Y, _),
+    findall(
+        Ci,
+        (   (X < NextX -> between(X, NextX, Xi);  between(NextX, X, Xi)),
+            Xi =\= X,
+            cost(Map, Xi-Y, Ci)),
+        Costs),
+    sum_list(Costs, Cost).
+    % Cost = Costs.
+
+horz(Map, X-Y, NextY, Cost) :-
+    cost(Map, X-NextY, _),
+    findall(
+        Ci,
+        (   (Y < NextY -> between(Y, NextY, Yi);  between(NextY, Y, Yi)),
+            Yi =\= Y,
+            cost(Map, X-Yi, Ci)),
+        Costs),
+    sum_list(Costs, Cost).
+    % Cost = Costs.
+
+
+heur(X1-Y1, X2-Y2, Dist) :- Dist is sqrt((X1 - X2)**2 + (Y1 - Y2)**2).
+
+cost(Map, X-Y, Cost) :- nth0(X, Map, Row), nth0(Y, Row, Cost).
+
+print(Map) :- maplist([X]>>(atomic_list_concat(X, N), write(N), nl), Map).
+
+input(Name, Map) :- phrase_from_file(lines(Map), Name).
+lines([]) --> eos, !.
+lines([Nums|Lines]) -->
+    line(Line), lines(Lines),
+    {maplist([C, N]>>(N is C - 48), Line, Nums)}.
+line(Nums) --> digits(Nums), "\n".