:- 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) :- writef('Collapsing: %t\n', [Routes]), 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).