Compare commits

...

2 Commits

Author SHA1 Message Date
10e184a0bf d8p2 final optimized general solution 2023-12-09 16:41:07 -08:00
a997d00c89 improve d8p2 readability 2023-12-09 11:41:52 -08:00
2 changed files with 40 additions and 42 deletions

View File

@ -1,5 +1,3 @@
:- table direction_loop/1.
:- op(700, xfx, l). :- op(700, xfx, l).
:- op(700, xfx, r). :- op(700, xfx, r).
From l To :- From to To-_. From l To :- From to To-_.
@ -7,58 +5,43 @@ From r To :- From to _-To.
answer(Answer) :- answer(Answer) :-
starts(Starts), starts(Starts),
routes(Starts, Routes), routes(Starts, [Route1 | RestOfRoutes]),
collapse_routes(Routes, _-(_-Answer-_)). foldl(unify2, RestOfRoutes, Route1, Answer).
collapse_routes([X], X). % unify2 combines 2 routes into one with its own stride-offsets-dests
collapse_routes(Routes, Collapsed) :- unify2(Route1, Route2, NewRoute) :-
writef('Collapsing: %t\n', [Routes]), once(findnsols(2, S, converge(Route1, Route2, S), SolutionPair)),
sort(2, @=<, Routes, [Route1, Route2 | CdrRoutes]), SolutionPair = [NewA-LenA-NewZ, _-LenB-_],
unify2(Route1, Route2, 0-0-0-0, [], NewRoute), NewStride is LenB - LenA,
collapse_routes([NewRoute | CdrRoutes], Collapsed). NewRoute = NewA-(NewStride-LenA-[0-NewZ]).
unify2(Route1, Route2, N1-Term1-N2-Term2, Founds, NewRoute) :- % Len = Stride1*X1 + Offset1 + Dest1 = Stride2*X2 + Offset2 + Dest2
Route1 = A1-(Stride1-Offset1-Loop1), % For performance, Route1's Stride should =< Route2's Stride
Route2 = A2-(Stride2-Offset2-Loop2), converge(Route1, Route2, NewA-Len-NewZ) :-
nth0(Term1, Loop1, C1-_), writef('Combining %t - %t\n', [Route1, Route2]),
nth0(Term2, Loop2, C2-_), Route1 = A1-(Stride1-Offset1-Dests1),
Z1 is Offset1 + Stride1*N1 + C1, Route2 = A2-(Stride2-Offset2-Dests2),
Z2 is Offset2 + Stride2*N2 + C2, natnum(X2),
next(Route1, N1-Term1, NextN1-NextTerm1), pick([Dests1, Dests2], [Dest1-Z1, Dest2-Z2]),
( Z1 =:= Z2 0 is (Stride2*X2 + Offset2 + Dest2 - Offset1 - Dest1) mod Stride1,
-> ( Founds = [OldZ] Len is Stride2*X2 + Offset2 + Dest2,
-> atom_concat(A1, A2, NewA), atom_concat(A1, A2, NewA), atom_concat(Z1, Z2, NewZ).
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) :- routes(Starts, Routes) :-
maplist([S, S-Route]>>(zloop([], S, 0, [], Route)), Starts, Routes). maplist([S, S-Route]>>(zloop(S, Route)), Starts, Routes).
zloop(_, _, _, Zs, Stride-Offset-Loop) :- % 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]), Zs = [FirstZIndex-Z | _], reverse(Zs, [LastZIndex-Z | ReversedZs]),
DeltaZ is LastZIndex - FirstZIndex, DeltaZ =\= 0, DeltaZ is LastZIndex - FirstZIndex, DeltaZ =\= 0,
direction_len(Len), direction_len(Len),
divmod(DeltaZ, Len, _, 0), divmod(DeltaZ, Len, _, 0),
Offset = FirstZIndex, Stride = DeltaZ, Offset = FirstZIndex, Stride = DeltaZ,
foldl([Idx-Z, NewIdx-Z, Off, Off]>>(NewIdx is Idx - Off), foldl([Idx-Z, NewIdx-Z, Off, Off]>>(NewIdx is Idx - Off),
ReversedZs, ReversedLoop, Offset, _), ReversedZs, ReversedDests, Offset, _),
reverse(ReversedLoop, Loop), reverse(ReversedDests, Dests),
!. !.
zloop(Directions, Node, Index, Zs, Route) :- zloop(Directions, Node, Index, Zs, Route) :-
( is_end(Node) ( is_end(Node)
-> append(Zs, [Index-Node], NewZs) -> append(Zs, [Index-Node], NewZs)
@ -79,3 +62,10 @@ next_step([], Move, Remain) :- direction_list([Move | Remain]).
direction_list(Dir) :- direction(Str), atom_chars(Str, Dir). direction_list(Dir) :- direction(Str), atom_chars(Str, Dir).
direction_len(Len) :- direction_list(D), length(D, Len). 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.

View File

@ -8,4 +8,12 @@ nna to nnb-xxx.
nnb to nnc-nnc. nnb to nnc-nnc.
nnc to nnz-nnz. nnc to nnz-nnz.
nnz to nnb-nnb. nnz to nnb-nnb.
ooa to ooz-oob.
oob to ood-ooc.
ooc to ooa-oox.
ood to ooz-ood.
ooz to oob-ooz.
xxx to xxx-xxx. xxx to xxx-xxx.
% Routes = [mma-(2-2-[0-mmz]), nna-(6-3-[0-nnz, 3-nnz]), ooa-(8-1-[0-ooz, 1-ooz])].
% X = mmannaooa-(24-18-[0-mmznnzooz]).