When I was a student assistant for Prolog exercises I already noted that 
For someone interested in programming languages, this is a nice feature Overall, I’m afraid it is not really good as it makes it harder to understand code written by others. Hopefully the declarative and concise nature of Prolog implementations compensate for this diversity …
Here’s day 5 again this time implemented using fdset operations in clpfd. I think the set theoretic bit (not the parsing) is probably an optimal treatment of this problem (52 LOC).
I map all seeds and categories to sets defined by ranges which the clpfd fdset abstraction makes simple. At every step, all IDs can be expressed as a single set. All that remains is to recursively map the set through the categories to the end, where the infimum of the final set is the answer.
map/3 is the gist of it, the rest is just juggling.
:- use_module(library(dcg/basics)).
:- use_module(library(clpfd)).
% Parse input file.
seeds([]) --> [].
seeds([c(S,0,none,seed)|Xs]) -->
blanks,number(X),{range_to_fdset(X..X,S)},seeds(Xs).
seedz([]) --> [].
seedz([c(S,0,none,seed)|Xs]) -->
blanks,number(X),blanks,number(L),
{E is X+L-1, range_to_fdset(X..E,S)},seedz(Xs).
rngs(_,_,[]) --> [].
rngs(Fr,To,[c(S,O,Fr,To)|Xs]) -->
number(D),blanks,number(X),blanks,number(L),
{E is X+L-1,range_to_fdset(X..E,S), O is D-X},
"\n",rngs(Fr,To,Xs).
rngs(Fr,To,[c(S,O,Fr,To)]) -->
number(D),blanks,number(X),blanks,number(L),
{E is X+L-1,range_to_fdset(X..E,S), O is D-X}.
cat([]) --> [].
cat(Rs) --> string(Fr),"-to-",string(To)," map:\n",rngs(Fr,To,Rs).
cats([Rs|Xs]) --> cat(Rs),"\n\n",!,cats(Xs).
cats([Rs]) --> cat(Rs).
file(F,Seeds,Cats) --> "seeds:",call(F,Seeds),"\n\n",cats(Cats).
% Map seed sets to seed location sets.
offset(S0,O,S) :- X in_set S0, Y #= X+O, fd_set(Y,S).
map_(_,[],AccS,AccD,AccS,AccD) :- !.
map_(Src,[S-O|T],AccS0,AccD0,SrcU,DstU) :-
fdset_union(S,AccS0,AccS),
fdset_intersection(Src,S,Int),
(empty_fdset(Int) ->
AccD=AccD0;offset(Int,O,Off),fdset_union(AccD0,Off,AccD)),
!,map_(Src,T,AccS,AccD,SrcU,DstU).
map_(Src,Dests,NewSrc) :-
empty_fdset(E),
map_(Src,Dests,E,E,SrcU,DstU),
fdset_subtract(Src,SrcU,Diff),
fdset_union(Diff,DstU,NewSrc).
map(`location`,Src,Src) :- !.
map(Fr,Src,End) :-
once(c(_,_,Fr,To)),
findall(S-O,c(S,O,Fr,To),Dests),
map_(Src,Dests,NewSrc),!,
map(To,NewSrc,End).
solve_(File,F,Answer) :-
phrase_from_file(file(F,Ss,Cs0),File),
flatten([Ss,Cs0],Cs),
retractall(c(_,_,_,_)),maplist(assertz,Cs),
findall(S,c(S,_,none,seed),[H|T]),
foldl([A,B,C]>>fdset_union(A,B,C),T,H,Seeds),
map(`seed`,Seeds,Final),
fdset_min(Final,Answer).
solve(File,Part1,Part2) :-
solve_(File,seeds,Part1),
solve_(File,seedz,Part2).
Oh no, the alternative solution you found was quite neat! And could eventually be implemented, as some of the predicates I was using are probably deprecated.
Day 08 solution: aoc2023/08/main.pl at 105ad91381bd96cbfe83ba442d446392b26d7659 · meditans/aoc2023 · GitHub
Day 8 solution:
I didn’t really know how to solve this treated purely as a computational question, but considering it as data, I noticed that for all seeds, the cycle length repeated. So the shortest cycle that matches all the cycle lengths would be the least common multiple of them all. This is the assumption I coded into the solution.
:- use_module(library(dcg/basics)).
:- use_module(library(clpfd)).
dir([]) --> [].
dir([l|Xs]) --> "L",!,dir(Xs).
dir([r|Xs]) --> "R",dir(Xs).
nodes([]) --> [].
nodes([i(S,l,F),i(S,r,T)|Xs]) -->
string(S)," = (",string(F),", ",string(T),")",blanks,!,nodes(Xs).
file(Dir,Nodes) --> dir(Dir),"\n\n",nodes(Nodes).
walk(_,Cur,Acc,Acc) :- t(Cur),!.
walk([H|T],Cur,Acc0,N) :-
i(Cur,H,Nxt),
Acc is Acc0+1,
append(T,[H],Dir),!,
walk(Dir,Nxt,Acc,N).
solve(File,part1,Answer) :-
phrase_from_file(file(Dir,Nodes),File),
retractall(i(_,_,_)),maplist(assertz,Nodes),
retractall(t(_)), assertz(t(`ZZZ`)),
walk(Dir,`AAA`,0,Answer).
solve(File,part2,Answer) :-
phrase_from_file(file(Dir,Nodes),File),
retractall(i(_,_,_)),maplist(assertz,Nodes),
findall([X,Y,0'A],i([X,Y,0'A],_,_),Starts0),
sort(Starts0,Starts),
findall(t([X,Y,0'Z]),i([X,Y,0'Z],_,_),Terms0),
sort(Terms0,Terms),
retractall(t(_)), maplist(assertz,Terms),
findall(N,(member(C,Starts),walk(Dir,C,0,N)),Results),
lcm(Results,Answer).
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).
Hey would you mind explaining how your solution works @meditans? How long does part 2 take to run?
I think many people did not enjoy day 8. The drop of rate is very high again, and completion rate of part 2 is comparable to day 1. I also found it deeply unsatisfying. I spent ages trying to find a general computational solution and in the end I had to resort to data analysis solution out of desperation – a bit like day 5 – but at least day 5 has a general computational solution which I could eventually work out (2 days later): I’m not sure sure day 8 does at all if you allow for the worse case scenarios.
You are right Jan, I feel the tension with line count, but you’re totally right, I should start documenting my solution better, they would be more useful!
I agree – to be honest, just doing these challenges in Prolog felt like enough of an achievement for me. I’ve only been using the language for about 6 months or so, so to be characterised as a “McLaren F1 pilot” is an honour I feel extremely unworthy of
Since these puzzles come out every day and I otherwise have a family and a day job, its tricky to invest significant time into making the solutions pedagological, however once the advent is over, I intend to do it. Even between day 1 and day 8 I feel like I’ve learned so much. For example, I had never used DCGs, CHR or CLP(FD). Today I used assertz/1 for the first time. I try to find time to work through alternative solutions to the same problems. I keep all the solutions on Github. At the end I want to go through all days with the hindsight of what I’ve learned by day 25 and refactor all of the solutions to be the best I can make them, at which point I will comment them more thoroughly.
I definitely do see the value of AoC2023 having a set of solid vanilla Prolog solutions. It’d be a great way to learn Prolog for newbies. Once they’ve completed each challenge – or if they get stuck on it – they can consult the repo. Hopefully this is something that the better Prolog programmers can pitch into as well.
You are doing a million times better than me, since I am too lazy to participate.
Seeing these Prolog solutions, gives me a warm, fuzzy feeling.
Producing working code for free is fantastic in itself - people can step through it at their own leisure, to examine how it works.
Explanatory comments are of course nice, but nowhere near as important as working code.
2 Likes
I also felt let down today, that my solution only works on AoC input.
Also, I loved the rare use of nth1 in Day 7 : )
Day 9 – it was annoyingly easy (17 LOC). I feel that they should have switched day 05 and day 09 when they were planning AoC Is there a more concise way to express this simple DCG?
:- use_module(library(dcg/basics)).
line([X|Xs]) --> whites,number(X),line(Xs).
line([X]) --> whites,number(X).
lines([]) --> [].
lines([L|Ls]) --> line(L),"\n",lines(Ls).
lines([L]) --> line(L).
diffs([],[]).
diffs([_],[]).
diffs([X,Y|T],[D|Ds]) :- D is Y-X, diffs([Y|T],Ds).
back([H],[H]) :- !.
back([X|T],[P,X|T]) :-
diffs([X|T],Ds), back(Ds,[P0|_]),
P is X-P0.
solve(File,Part1,Part2) :-
phrase_from_file(lines(Ls),File),
aggregate_all(sum(P),(member(L,Ls),reverse(L,Lr),back(Lr,[P|_])),Part1),
aggregate_all(sum(P),(member(L,Ls),back(L,[P|_])),Part2).
EDIT: lol sorry, just realised you can just reverse the list and do the same as in part 1 to save a few lines of code.
I was the guy in the middle on day 8:
I would suggest to try sequence/3, but right now I’m not sure it’s a good idea… Indeed when the declarative semantic doesn’t work out-of-the-box it becomes rather difficult to debug - specially with phrase from file…(I switch to read_file_to_codes/3 when I need to do).
Anyway, here is a snippet from day4, as you can see I’m still unsure about the proper solution (the commented nonterminal doesn’t work, but the expansion does).
parse_card(card(Id, WinNums, CmpNums)) -->
"Card", whites, integer(Id), whites, ":", whites,
integers(WinNums), whites, "|", whites, integers(CmpNums).
integers([I|Is]) -->
integer(I),
whites,
integers(Is).
integers([]) --> [].
% integers(Is) --> sequence(integer, whites, Is).
Why is that? library(portray_text) handles the lazy list fairly well AFAIK. I just pushed two enhancements. One is to the GUI tracer to add portray_text_length to the settings dialog such that you can control the amount of context and one to portray_text itself to allow (currently) for 10% non-ASCII but printing Unicode characters.
I wonder whether it is possible to have a fairly simply heuristic? The GUI debugger can probably be more aggressive in recognizing the DCG lists as text. Any other low-hanging fruit?
@Boris here is a more concise version of my Day 1 solution. I re-wrote it since it was literally the first time I had written a DCG and it was double the length Its 22 LOC now.
Another route would have just been to search each line forward and backwards to get the first / last numbers, but the backward search would have to be in reverse order because of cases like twone, nineight and so on. I suspect that would have been the easier route too.
:- use_module(library(dcg/basics)).
s(A,B,C) :- string_without(A,_,B,C).
d(A,B,C) :- digit(A,B,C).
line(A-A) --> s(`123456789`),d(A),s(`123456789\n`).
line(A-B) --> s(`123456789`),d(A),string(_),d(B),s(`123456789\n`).
lines([]) --> eol.
lines([L|Ls]) --> line(L),`\n`,!,lines(Ls).
lines([L]) --> line(L).
ns(X,C) :-
Ns=[`twoone`,`eighttwo`,`eightthree`,`oneeight`,`threeeight`,`fiveeight`,
`nineeight`,`sevennine`,`1`,`2`,`3`,`4`,`5`,`6`,`7`,`8`,`9`],
Cs=[`twone`,`eightwo`,`eighthree`,`oneight`,`threeight`,`fiveight`,`nineight`,
`sevenine`,`one`,`two`,`three`,`four`,`five`,`six`,`seven`,`eight`,`nine`],
nth1(I,Cs,X), nth1(I,Ns,C).
tr,[] --> call(eos),!.
tr,N --> {ns(X,N)},X,!,tr.
tr,[X] --> [X],tr.
solve(File,Part1,Part2) :-
phrase_from_file(lines(Ls),File),
aggregate_all(sum(X),(member(A-B,Ls),number_codes(X,[A,B])),Part1),
phrase_from_file((tr,tr,lines(Ls2)),File),
aggregate_all(sum(X),(member(A-B,Ls2),number_codes(X,[A,B])),Part2).
Very clever
We have seen there are safe alternatives to this that are probably better in most respects such as the throw/1 or the findall/3. I think especially the latter is quite need.
SWI-Prolog’s browser version at https://dev.swi-prolog.org/wasm/shell does 
It has no threads though 
Day 10 part1 in 23 LOC. Part 2 is going to take a bit more thinking
:- use_module(library(dcg/basics)).
ns(N,V) :- number_string(N,V).
t(_,_,[]) --> [].
t(X0,_,Xs) --> "\n",{X is X0+1},!,t(X,1,Xs).
t(X0,Y0,[p(X0,Y0,V)|Xs]) --> [V],{Y is Y0+1},!,t(X0,Y,Xs).
m(A,B) :- memberchk(A,B).
above(p(X0,Y,V0),p(X,Y,V)) :- X0-X=:=1,m(V0,`S|LJ`),m(V,`S|7F`).
below(p(X0,Y,V0),p(X,Y,V)) :- X-X0=:=1,m(V0,`S|7F`),m(V,`S|LJ`).
left(p(X,Y0,V0),p(X,Y,V)) :- Y0-Y=:=1,m(V0,`S-J7`),m(V,`S-FL`).
right(p(X,Y0,V0),p(X,Y,V)) :- Y-Y0=:=1,m(V0,`S-LF`),m(V,`S-7J`).
link(P1,P2) :-
member(X,[above,below,left,right]), call(X,P1,P2).
cycle([H|T],[H|T]) :-
\+ length(T,1), p(A,B,83), link(H,p(A,B,83)),!.
cycle([Prev|T],End) :-
p(A,B,C), link(Prev,p(A,B,C)),
\+ member(p(A,B,C),[Prev|T]),!,
cycle([p(A,B,C),Prev|T],End).
solve(File,Part1) :-
phrase_from_file(t(1,1,Xs),File),
retractall(p(_,_,_)),maplist(assertz,Xs),
p(X,Y,83), cycle([p(X,Y,83)],Cycle),
length(Cycle,N), Part1 is N/2.
Finally I got it! LOC means “line of code”…was wondering what it meant the previous days 