aoc23/08/part2.pl

:- 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) :-
    writef('Collapsing: %t\n', [Routes]),
    sort(2, @=<, Routes, [Route1, Route2 | CdrRoutes]),
    unify2(Route1, Route2, NewRoute),
    collapse_routes([NewRoute | CdrRoutes], Collapsed).

% unify2 combines 2 routes into one with its own stride-offsets-dests
unify2(Route1, Route2, Route12) :- unify2(Route1, Route2, 0-0-0-0, [], Route12).
unify2(Route1, Route2, N1-Dest1-N2-Dest2, Founds, NewRoute) :-
    Route1 = A1-(Stride1-Offset1-Dests1),
    Route2 = A2-(Stride2-Offset2-Dests2),
    nth0(Dest1, Dests1, C1-Z1),
    nth0(Dest2, Dests2, C2-Z2),
    Len1 is Offset1 + Stride1*N1 + C1,
    Len2 is Offset2 + Stride2*N2 + C2,
    next(Dests1, N1-Dest1, NextN1-NextDest1),
    (   Len1 =:= Len2
    ->  (   Founds = [OldLen]
        ->  atom_concat(A1, A2, NewA), atom_concat(Z1, Z2, NewZ),
            NewStride is Len1 - OldLen,
            NewRoute = NewA-(NewStride-OldLen-[0-NewZ]),
            !
        ;   unify2(Route1, Route2, NextN1-NextDest1-N2-Dest2, [Len1], NewRoute)
        )
    ;   Len1 < Len2
    ->  unify2(Route1, Route2, NextN1-NextDest1-N2-Dest2, Founds, NewRoute)
    ;   next(Dests2, N2-Dest2, NextN2-NextDest2),
        unify2(Route1, Route2, N1-Dest1-NextN2-NextDest2, Founds, NewRoute)
    ).

% next(Dests, NumberOfLoops-WhichInternalZ, NextNumberOfLoops-NextInternalZ)
next(Dests, NLoops-Dest, NextNLoops-NextDest) :-
    length(Dests, DestsLen),
    (   Dest < DestsLen - 1
    ->  NextNLoops is NLoops, NextDest is Dest + 1
    ;   NextNLoops is NLoops + 1, NextDest is 0).

routes(Starts, Routes) :-
    maplist([S, S-Route]>>(zloop(S, Route)), Starts, Routes).

% zloop builds a route (Stride-Offset-Internals for a particular starting node.
zloop(Node, Route) :- zloop([], Node, 0, [], Route).
zloop(_Direction, _Node, _Index, Zs, Stride-Offset-Dests) :-
    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, ReversedDests, Offset, _),
    reverse(ReversedDests, Dests),
    !.
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).