I had quick look, will spend more time with your code, at first blush its amazing…
Here is Day 12 in 25 LOC from your repo. Wow.
( in my defense most of my 40 LOC is DCG related 
)
Thank you for the tip @anon95304481 I don’t know what “mode directed tabling” is yet, but I’ll look into it to see if I can improve on day 12. What fattens it up is the dumb way I’ve written the expand and unfold predicates – all they do is make 5 copies of the input data, so I’m sure its probably a one liner I’m not seeing.
EDIT:
Lol, yeah looking at how @BarrensZeppelin did it:
append([L, [0'?], L, [0'?], L, [0'?], L, [0'?], L], NewL),
Literally a one liner when you’re thinking in terms of strings and not DCGs. @BarrensZeppelin , you can also write it like this I think:
append([L, `?`, L, `?`, L, `?`, L, `?`, L], NewL),
Back ticks indicate an array of codes in SWI Prolog.
The XSB people, notably David Warren and Theresa Swift, call it subsumptive tabling or more precisely answer subsumption. That doesn’t deal with “sum”. It implies that all answers are subsumed by some value. That works fine for e.g., “max”. The problem with “sum” is that it it changes if the same answer is produced twice. As tabling removes duplicate (variant) answers, it is easy to get unexpected results with “sum”.
Tabling can your code short, easy and fast. It is not easy to understand though 
2 Likes
Back ticks indicate an array of codes in SWI Prolog.
Ah, using backticks for lists of character codes is a nice tip, thanks! 
Using append([A, A, A, A, A], A5) to create five copies of A feels dirty, but I think it’s the shortest you can do.
For larger numbers of copies I guess you can do something like length(As, N), maplist(=(A), As), append(As, AN).
Tabling can your code short, easy and fast. It is not easy to understand though
I enjoy the challenge of writing succinct solutions to the AoC puzzles in Prolog, especially if I can use language features that are intrinsic to Prolog. But I agree with your point.
Your stuff is actually amazing @BarrensZeppelin … I’m going to end up spending many hours studying your code. Its literally half the LOC of my best attempts in many cases. You may find day 6 and 16 interesting in my repo, they are slightly shorter than yours, and you can probably make them shorter still.
1 Like
A nicely-written DCG is heaven - it feels like the code is just stating the obvious, while it is also solving the problem 
- and able to be both a parser and a generator.
Just as a tiny example, here’s my day 12 input-parsing DCG.
Chalenge accepted RE CLP @tatut Here is a restricted proof of concept. Items in day 19, part 2 have 4 variables ranging from 1-4000. I use 2 variables in this example without loss of generality. I’ll encode these rules and calculate the total number of accepting combinations:
in{a<1000:aa,b>2000:bb,R}
aa{b>2500:cc,R}
bb{a>3700:A,R}
cc{b>3500:A,R}
The code:
:- use_module(library(clpfd)).
:- table test(sum).
test(Answer) :-
[A,B] ins 1..4000,
% Apply rules.
(A #< 1000 #/\ B #> 2500 #/\ B #> 3500;
B #> 2000 #/\ A #> 3700),
fd_size(A,Na), fd_size(B,Nb),
Answer is Na * Nb.
Here is day 19 implemented as outlined above using CLPFD. Its 49 LOC for both parts. Part 2 is 18 LOC.
Summing does happen for all results of p/2, regardless of duplicates of the 1st argument. The problem is that if we also table q/2 we only get the unique results of q/2 and thus only sum over these unique results.
Tabled results are unique, but not sorted. The ordering indeed depends on hashes. At some point I proposed to add an option to tabling to get ordered results. That didn’t result in a lot of positive reactions back then.
Day 20 is quite hard Part 1 fiddly but straightforward – you just write some code to simulate the machine and run it for 1000 cycles. However, part two requires working out how many cycles it would take for a specific module to reach a specific state.
I think I have an angle on part 2… At least for simple examples, it looks like you can work backwards from the desired state to the first state to determine what the initial state must be. It also appears that flip-flops in the circuit are all individually cyclical. So if I can figure out what starting state results in the modules activation, I can then use the cycles of the individual flip-flops with the largest common multiplier (LCM) to work out how many cycles it will take for them all to be the required state. Watch this space …
Here is a useful diagram courtesy of Graphviz. rx – the target module – is there in the middle. Note how there are 4 disconnected sub-graphs. For example, the chains go:
rx ← qn ← cq ← kx
Up to there they are all conjunctions. After that, they are all flip-flops connected back and forth to kx and each other.
All of kx, zd, zq and mt must be “high” at the same time for rx to end up “low”, and all of them are disjoined blocks. So figure out how any of the blocks work and the problem should be solved One step closer…
1 Like
Ok, solved day 20 I used data analysis again rather than computer science but hey-ho …
I monitored the qn node – the one just before rx. It is a conjunction so it has a memory of the 4 sub-graphs fronted by cq, jx, tt and qz. I recorded how many button presses it took before each of cx, jx, tt and qz signalled “high”. It occurred on intervals for each of them:
% jx = 3907
% qz = 3911
% tt = 3931
% cq = 4021
Then I just calculated the largest common multiplier, and got a very big number:
gcd(0, X, X) :- X #> 0, !.
gcd(X, Y, Z) :- X #>= Y, X1 #= X-Y, !,gcd(X1,Y,Z).
gcd(X, Y, Z) :- X #< Y, X1 #= Y-X, !,gcd(X1,X,Z).
lcm_(X,Y,Z) :- gcd(X,Y,Z0), Z #= X*Y // Z0.
lcm([H|T],Z) :- foldl(lcm_,T,H,Z).
?- lcm([3907,3911,3931,4021], Out).
Out = 241528477694627.
Recap of the solution for part 2: (1) Speculate that problem must be decomposable somehow, (2) draw graph of how nodes are connected and notice topology implies sub-graphs fronted by individual conjunction nodes, (3) work out cycles on which those nodes emit “high” signals, and (4) use LCM to calculate largest common multiplier at which they all coincide.
Here is some horrible code that will get you there for both parts (I’ll make it better):
:- use_module(library(dcg/basics)).
:- use_module(library(clpfd)).
% Parser
% --------------------------------------------------------------------------
update(_, _, []) :- !.
update(M, A, [B|Bs]) :-
( ht_put_new(M, B, [A]) -> true; ht_update(M, B, As, [A|As]) ),
!, update( M, A, Bs).
sources([S|Ss]) --> string_without(`,\n`,S), ", ", !, sources(Ss).
sources([S]) --> string_without(`\n`, S).
broad(M, M2) --> "broadcaster -> ", sources(Bs),
{ ht_put(M, `0`, bc(Bs)), update(M2, `0`, Bs) }.
conj(M, M2) --> "&", string(A), " -> ", sources(Bs),
{ ht_put( M, A, con(Bs, []) ), update(M2, A, Bs) }.
flip(M, M2) --> "%", string(A), " -> ", sources(Bs),
{ ht_put( M, A, flp(Bs, off) ), update(M2, A, Bs) }.
lines(_,_) --> [].
lines(M,M2) --> (broad(M,M2); conj(M,M2); flip(M,M2)), "\n", !, lines(M,M2).
% Simulator
% --------------------------------------------------------------------------
simulate(_, _, [], N ,N) :- !.
simulate(Map, Inv, [`0`-low-`0`|T], N0, N) :-
ht_get( Map, `0`, bc(Bs) ),
findall(`0`-low-B, member(B, Bs), Cmds),
append(T, Cmds, Stack),
append(N0, Cmds, N1),
!, simulate(Map, Inv, Stack, N1, N).
simulate(Map, Inv, [_-high-A|T], N0, N) :-
ht_get( Map, A, flp(_,_) ),
!, simulate(Map, Inv, T, N0, N).
simulate(Map, Inv, [_-low-A|T], N0, N) :-
ht_get( Map, A, flp(Bs, S0) ),
(S0=off->S=on; S=off), (S=on->P=high; P=low),
findall(A-P-B, member(B, Bs), Cmds),
append(T, Cmds, Stack),
ht_put(Map, A, flp(Bs, S)),
append(N0, Cmds, N1),
!, simulate(Map, Inv, Stack, N1, N).
simulate(Map, Inv, [B0-P0-A|T], N0, N) :-
ht_get( Map, A, con(Bs, In0) ),
once((select(B0-_, In0, In1); In1=In0)),
In = [B0-P0|In1],
ht_get( Inv, A, Exp),
once( (\+ (member(E, Exp), \+ memberchk(E-_, In)),
\+ memberchk(_-low, In),
P=low; P=high)),
findall(A-P-B, member(B, Bs), Cmds),
append(T, Cmds, Stack),
ht_put(Map, A, con(Bs, In)),
append(N0, Cmds, N1),
!, simulate(Map, Inv, Stack, N1, N).
simulate(Map, Inv, [_|T], N0, N) :- simulate(Map, Inv, T, N0, N).
repeat(_, _, 0, N, N) :- !.
repeat(Map, Inv, M0, L0-H0, N) :-
simulate(Map, Inv, [`0`-low-`0`], [`0`-low-`0`], Ps),
% A trace to output button presses between "high" signals
% at qn (the conjunction before rx).
findall(_,
( member(Code-high-`qn`, Ps),
string_codes(S, Code),
writeln([M0, S]) ), _),
aggregate_all(count, member(_-low-_,Ps), L),
aggregate_all(count, member(_-high-_,Ps), H),
L1 is L0+L, H1 is H0+H, M is M0-1,
!, repeat(Map, Inv, M, L1-H1, N).
repeat(Map, Inv, M, N) :-
repeat(Map, Inv, M, 0-0, L-H), N is L*H.
gcd(0, X, X) :- X #> 0, !.
gcd(X, Y, Z) :- X #>= Y, X1 #= X-Y, !,gcd(X1,Y,Z).
gcd(X, Y, Z) :- X #< Y, X1 #= Y-X, !,gcd(X1,X,Z).
lcm_(X,Y,Z) :- gcd(X,Y,Z0), Z #= X*Y // Z0.
lcm([H|T],Z) :- foldl(lcm_,T,H,Z).
% Solution
% --------------------------------------------------------------------------
solve(File, Part1) :-
ht_new(Map), ht_new(Inv),
phrase_from_file(lines(Map, Inv), File),
repeat(Map, Inv, 1000, Part1). % change to 100000 to use the trace.
% jx = 3907
% qz = 3911
% tt = 3931
% cq = 4021
2 Likes
Note that gcd is a built-in function,
?- A is gcd(10,8).
A = 2.
1 Like
Day 21 part 1 is concisely stated and I’m fairly sure would admit to an elegant Prolog solution which I’m unlikely to maximally deliver on If you have time @anon95304481 I’d be interested to see how you’d conceive it. You can get the full input for part 1 here:
A little bit of conceptual progress on day 21, part 1. I’ll try it out later.
Starting at any given point, I can calculate all the finishing positions for 8 steps in about 445k inferences. So say points A, B, C are reachable from point X in 8 steps, I can then say connect(A,X), connect(B,X), connect(C,X). I can do that for every point in the grid in about 7.4 billion inferences (445k * 129^2) , which is tractable.
Using this new 8-at-a-time graph, I can calculate all points reachable in 64 steps in just 8 steps. So unless I’ve blundered somewhere in my thinking, that should solve Part 1.
EDIT:
The blunder is fairly obvious. Doing the above redistributes the work such that pre-processing up front is fairly quick but all it does is create a much more connected graph. So doing the 8 step walk at the end is just as costly as the 64 step walk at the beginning. You can easily conclude this by just asking “how is this redistribution of work different to what a 64 step walk would do anyway…”
A bit more conceptual progress on day 21 (or another blunder, let’s see ).
I note that N steps is always a subset of final states that N+2 steps can achieve, but not necessarily N+1 steps.
So, a solution could be just to walk to all the furthest states (those that either cannot be continued further or are of maximum length) and note all the states along the way where {Path Index} mod 2 =:= 0.
If the furthest walk problem is tractable somehow, then it solves part 1 (or I’ve blundered again).
EDIT: I think this is on the right path but the relationship between cells is more general than stated. At the moment it looks to me like it may be possible to state it as a recurrence relationship between adjacent cells to avoid recalculating overlapping paths. I.e. if it can be stated as a recurrence (like the typical fibonacci example), then each calculation can be memoised. Trying now
Ok that’s nailed Part 1! Here is a solution in just 18 LOC. The essential insight is that the number of paths of S steps from the origin to a cell is just going to be the number of ways of getting to any of its adjacent cells in S-1 steps. Since stuff at S is determined by stuff at S-1 we have a simple recurrence relationship which can be tabled. I found this quite hard to put together and could not have done it without a bit of reading on dynamic programming. Now onto part 2
Part 1 code:
:- use_module(library(dcg/basics)).
grid(_,_,[]) --> [].
grid(X0,_,Xs) --> "\n", {X is X0+1}, !, grid(X,1,Xs).
grid(X0,Y0,[p(X0-Y0,V)|Xs]) --> [V],{Y is Y0+1}, !, grid(X0,Y,Xs).
grid(X0,Y0,Xs) --> `.`, {Y is Y0+1}, !, grid(X0,Y,Xs).
connect(X0-Y0, X-Y) :-
member(I-J, [1-0, 0-1, -1-0, 0-(-1)]),
X is I+X0, Y is J+Y0, once(p(X-Y,_)).
:- table count(_,_,sum).
count(X-Y, 0, 1) :- p(X-Y, 0'S), !.
count(_, 0, 0) :- !.
count(X-Y, S0, Count) :-
S is S0-1, connect(X-Y, I-J), count(I-J, S, Count).
solve(File, Part1) :-
phrase_from_file(grid(1, 1, Ps0), File),
include([p(_,V)]>>(V\=0'#), Ps0, Ps),
retractall(p(_,_)), maplist(asserta, Ps),
aggregate_all(count, X-Y,(p(X-Y,_), count(X-Y, 64, N), N>0), Part1).
EDIT: Part 2 is interesting … the map is tiled infinitely in every direction and we need to find how many cells can be reached in 26501365 steps (versus just 64 previously …).
You keep on counting lines of code even though you habitually put multiple subgoals on the same line. Maybe we can have some fair measure that does not depend on how you like your line breaks or how you name your variables? For example, we can count the LOCs of the output of the built-in listing/1? And anyway, you can put arbitrarily complex goals in the second argument of aggregate_* and findall/bagof/setof. You can also use library(yall) to save lines without reducing complexity.
If you want to seriously compare solutions for “length” you’d have to address those issues somehow.
IMHO, it’s not so much important the actual metric… more relevant it’s the feelings the author communicate, after all, Wordpress’ motto is
code is poetry
I’m grateful to @emiruz for sharing his project with us.
3 Likes
Yes indeed. Obsessing over LOCs takes some of the magic away though