actual proper d8p2

08/part2.pl

@@ -0,0 +1,80 @@
+:- table direction_loop/1.
+
+:- op(700, xfx, l).
+:- op(700, xfx, r).
+From l To :- From to To-_.
+From r To :- From to _-To.
+
+answer(Answer) :-
+    starts(Starts),
+    routes(Starts, Routes),
+    collapse_routes(Routes, _-(Answer-_-_)).
+
+collapse_routes([X], X).
+collapse_routes(Routes, Collapsed) :-
+    sort(2, @=<, Routes, [Route1, Route2 | CdrRoutes]),
+    unify2(Route1, Route2, 0-0-0-0, [], NewRoute),
+    collapse_routes([NewRoute | CdrRoutes], Collapsed).
+
+unify2(Route1, Route2, N1-Term1-N2-Term2, Founds, NewRoute) :-
+    Route1 = A1-(Stride1-Offset1-Loop1),
+    Route2 = A2-(Stride2-Offset2-Loop2),
+    nth0(Term1, Loop1, C1-_),
+    nth0(Term2, Loop2, C2-_),
+    Z1 is Offset1 + Stride1*N1 + C1,
+    Z2 is Offset2 + Stride2*N2 + C2,
+    next(Route1, N1-Term1, NextN1-NextTerm1),
+    (   Z1 =:= Z2
+    ->  (   Founds = [OldZ]
+        ->  atom_concat(A1, A2, NewA),
+            NewStride is Z1 - OldZ,
+            NewRoute = NewA-(NewStride-OldZ-[0-NewA]),
+            !
+        ;   unify2(Route1, Route2, NextN1-NextTerm1-N2-Term2, [Z1], NewRoute)
+        )
+    ;   Z1 < Z2
+    ->  unify2(Route1, Route2, NextN1-NextTerm1-N2-Term2, Founds, NewRoute)
+    ;   next(Route2, N2-Term2, NextN2-NextTerm2),
+        unify2(Route1, Route2, N1-Term1-NextN2-NextTerm2, Founds, NewRoute)
+    ).
+
+next(_-(_-_-Loop), NLoops-Term, NextNLoops-NextTerm) :-
+    length(Loop, LoopLen),
+    (   Term < LoopLen - 1
+    ->  NextNLoops is NLoops, NextTerm is Term + 1
+    ;   NextNLoops is NLoops + 1, NextTerm is 0).
+
+routes(Starts, Routes) :-
+    maplist([S, S-Route]>>(zloop([], S, 0, [], Route)), Starts, Routes).
+
+zloop(_, _, _, Zs, Stride-Offset-Loop) :-
+    Zs = [FirstZIndex-Z | _], reverse(Zs, [LastZIndex-Z | ReversedZs]),
+    DeltaZ is LastZIndex - FirstZIndex, DeltaZ =\= 0,
+    direction_len(Len),
+    divmod(DeltaZ, Len, _, 0),
+    Offset = FirstZIndex, Stride = DeltaZ,
+    foldl([Idx-Z, NewIdx-Z, Off, Off]>>(NewIdx is Idx - Off),
+          ReversedZs, ReversedLoop, Offset, _),
+    reverse(ReversedLoop, Loop),
+    !.
+
+zloop(Directions, Node, Index, Zs, Route) :-
+    (   is_end(Node)
+    ->  append(Zs, [Index-Node], NewZs)
+    ;   NewZs = Zs
+    ),
+    next_step(Directions, Move, Remain),
+    G =.. [Move, Node, To], G,
+    NewIndex is Index + 1,
+    zloop(Remain, To, NewIndex, NewZs, Route).
+
+starts(Starts) :- findall(X, X to _, Nodes), include(is_start, Nodes, Starts).
+
+is_start(Node) :- atom_chars(Node, [_, _, a]).
+is_end(Node) :- atom_chars(Node, [_, _, z]).
+
+next_step([Move | Remain], Move, Remain).
+next_step([], Move, Remain) :- direction_list([Move | Remain]).
+
+direction_list(Dir) :- direction(Str), atom_chars(Str, Dir).
+direction_len(Len) :- direction_list(D), length(D, Len).