:- 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, [Route1 | RestOfRoutes]), foldl(unify2, RestOfRoutes, Route1, _-(_-Answer-_)). % unify2 combines 2 routes into one with its own stride-offsets-dests unify2(Route1, Route2, NewRoute) :- once(findnsols(2, S, converge(Route1, Route2, S), SolutionPair)), SolutionPair = [NewA-LenA-NewZ, _-LenB-_], NewStride is LenB - LenA, NewRoute = NewA-(NewStride-LenA-[0-NewZ]). % Len = Stride1*X1 + Offset1 + Dest1 = Stride2*X2 + Offset2 + Dest2 % For performance, Route1's Stride should =< Route2's Stride converge(Route1, Route2, NewA-Len-NewZ) :- writef('Combining %t - %t\n', [Route1, Route2]), Route1 = A1-(Stride1-Offset1-Dests1), Route2 = A2-(Stride2-Offset2-Dests2), natnum(X2), pick([Dests1, Dests2], [Dest1-Z1, Dest2-Z2]), 0 is (Stride2*X2 + Offset2 + Dest2 - Offset1 - Dest1) mod Stride1, Len is Stride2*X2 + Offset2 + Dest2, atom_concat(A1, A2, NewA), atom_concat(Z1, Z2, NewZ). 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). % pick([[1,2,3], [4], [5,6]], X). X = [1,4,5]; X = [1,4,6]; X = [2,4,5]; ... pick(ListOfLists, Items) :- maplist([SubList, X]>>(member(X, SubList)), ListOfLists, Items). natnum(0). natnum(N) :- natnum(N0), N is N0 + 1.