Advent of code 2023

Hey guys, is anyone doing advent of code this year? I’m going to try and do it all in Prolog (solutions are on Github). I thought this thread could be a nice place to discuss parsimonious solutions as the problems get more difficult. The first two problems have been trivial, but I hadn’t used DCGs before so they served to gently introduce me to them. I look forward to learning more Prolog this month :slight_smile:

3 Likes

The parsing part is ridiculously easy in Prolog, using DCGs.

I use library(plunit) to encode the advent-of-code examples.
e.g.: https://github.com/kamahen/advent-of-code-2023/blob/381b7d67c8b66c63df08a75331d3127edbd09433/day01_trebuchet.pl#L156

I did day 7 last year: https://twitter.com/hakankj/status/1600442193491021824 after I saw Hakat’s Picat solution. https://twitter.com/hakankj/status/1600442193491021824

2 Likes

I like the rigour in your day 1 solutions with the tests and all. I read through other peoples solutions once I have my own and its interesting to see the variety of solutions. Here is mine for day 1 part 2 as a comparison:

:- set_prolog_flag(double_quotes, chars).

eos_([], []).

% Compound to simple words.
comp2simp,[] --> call(eos_).
comp2simp,"twoone" --> "twone",!,comp2simp.
comp2simp,"eighttwo" --> "eightwo",!,comp2simp.
comp2simp,"eightthree" --> "eighthree",!,comp2simp.
comp2simp,"oneeight" --> "oneight",!,comp2simp.
comp2simp,"threeeight" --> "threeight",!,comp2simp.
comp2simp,"fiveeight" --> "fiveight",!,comp2simp.
comp2simp,"nineeight" --> "nineight",!,comp2simp.
comp2simp,"sevennine" --> "sevenine",!,comp2simp.
comp2simp,[X] --> [X],!,comp2simp.

% Words to numbers.
word2num,[] --> call(eos_).
word2num,"1" --> "one",!,word2num.
word2num,"2" --> "two",!,word2num.
word2num,"3" --> "three",!,word2num.
word2num,"4" --> "four",!,word2num.
word2num,"5" --> "five",!,word2num.
word2num,"6" --> "six",!,word2num.
word2num,"7" --> "seven",!,word2num.
word2num,"8" --> "eight",!,word2num.
word2num,"9" --> "nine",!,word2num.
word2num,[X] --> [X],word2num.

% Any sequence.
seq([]) --> [].
seq([X|Xs]) --> [X],seq(Xs).

% Non-digit sequence.
non_digit --> [].
non_digit --> [X],{\+ char_type(X,digit)},non_digit.

% A digit.
digit(X)  --> [X],{char_type(X,digit)}.

% First and last digit.
code(A,A) --> non_digit,digit(A),non_digit.
code(A,B) --> non_digit,digit(A),seq(_),digit(B),non_digit.

% Split a string into lines.
lines([]) --> [].
lines([A-B|Ls]) --> code(A,B),"\n",!,lines(Ls).
lines([A-B]) --> code(A,B).

solve(File,Answer) :-
    open(File,read,Stream),
    read_string(Stream,_,String),
    string_chars(String,Chars),
    phrase((comp2simp,word2num),Chars,Norm),
    close(Stream),
    phrase(lines(Ls),Norm),
    findall(X,(member(A-B,Ls),number_string(X,[A,B])),Xs),
    sumlist(Xs,Answer).

Day 3 is up. My solution is here. I feel that it could be more concise. There is probably a better way to state to_group/4.

If you manage to solve part 1 in < 57 lines or can see a way of making my solution shorter, I’d love to know! Here it is:

:- set_prolog_flag(double_quotes, chars).

to_coord([],_,_,Coords,Coords) :- !.
to_coord(['\n'|T],Row0,_,Acc,Coords) :-
    Row is Row0+1,!,
    to_coord(T,Row,1,Acc,Coords).
to_coord(['.'|T],Row,Col0,Acc,Coords) :-
    Col is Col0+1,!,
    to_coord(T,Row,Col,Acc,Coords).
to_coord([H|T],Row,Col0,Acc,Coords) :-
    Col is Col0+1,!,
    to_coord(T,Row,Col,[Row-Col0-H|Acc],Coords).
to_coord(Chars,Coords) :-
    to_coord(Chars,1,1,[],Coords0),
    reverse(Coords0,Coords).

summarise(Group0,X-Y-Y0-N) :-
    reverse(Group0,Group),
    Group=[X-Y-_|_],
    last(Group,_-Y0-_),
    findall(V,member(_-_-V,Group),Vs),
    number_string(N,Vs).

to_group([],Curr,Acc,Groups) :-
    Curr\=[],
    summarise(Curr,Summary),
    Groups=[Summary|Acc],!.
to_group([],_,Groups,Groups) :- !.
to_group([X-Y-V|T],[],Acc,Groups) :-
    char_type(V,digit),!,
    to_group(T,[X-Y-V],Acc,Groups).
to_group([_|T],[],Acc,Groups) :-
    to_group(T,[],Acc,Groups),!.
to_group([X-Y-V|T],Curr,Acc,Groups) :-
    char_type(V,digit),
    Curr=[X0-Y0-V0|_],
    char_type(V0,digit),
    X0=:=X,Y0+1=:=Y,!,
    to_group(T,[X-Y-V|Curr],Acc,Groups).
to_group(Coords,Curr,Acc,Groups) :-
    summarise(Curr,Summary),
    to_group(Coords,[],[Summary|Acc],Groups).
to_group(Coords,Groups) :-
    to_group(Coords,[],[],Groups).

solve(File,Answer) :-
    open(File,read,Stream),
    read_string(Stream,_,String),
    string_chars(String,Chars),
    close(Stream),
    to_coord(Chars,Coords),
    to_group(Coords,Groups),
    findall(
	V,
	\+ \+ (member(X-Y0-Y-V,Groups),
	 (member(X_-Y_-V_,Coords),
	  \+ char_type(V_,digit),
	  Y_ >= Y0-1,Y+1 >= Y_,
	  X_ >= X-1,X+1 >= X_)),
	Filtered),
    sumlist(Filtered,Answer).

4HbQ on reddit did both parts in 12 lines of Python:

import collections as c, math as m, re

parts = c.defaultdict(list)
board = list(open('data.txt'))
chars = {(r, c) for r in range(140) for c in range(140)
                if board[r][c] not in '01234566789.'}

for r, row in enumerate(board):
    for n in re.finditer(r'\d+', row):
        edge = {(r, c) for r in (r-1, r, r+1)
                       for c in range(n.start()-1, n.end()+1)}

        for o in edge & chars:
            parts[o].append(int(n.group(0)))

print(sum(sum(p)    for p in parts.values()),
      sum(m.prod(p) for p in parts.values() if len(p)==2))

Can anyone get anywhere close to this for Day 03 in Prolog at least for Part 1?

Hey @emiruz, I’m doing AoC2023 in prolog too! Caveat: I’m using prolog to explore the ways in which computations could be written, so my solutions are a bit idiosyncratic. That said, here’s my solution for day 3 (without imports unfortunately, as I’m using local packs for utilities):

% Parsing
dgt(dgt(N)) --> digit(N).
sym(sym(S)) --> symbol_chr(S), {S \= '.'}.
dot(dot)    --> `.`.
row(Xs)     --> list((dgt | sym | dot), Xs), nl.
input(Xs)   --> list(row, Xs).

position(M, I-J, X) :- nth0(I, M, Row), nth0(J, Row, X).

:- chr_constraint n/3.
n(I-J1, L1, N1), n(I-J2, L2, N2) <=> J1 + L1 #= J2 |
                                     n(I-J1, ξ(L1 + L2), ξ(N1*10^L2 + N2)).

parse(File, Mat-Ns) :-
    once(phrase_from_file(input(Mat), File)),
    findall(n(I-J, 1, N), position(Mat, I-J, dgt(N)), Constraints),
    local_chr(Constraints, n(_, _, _), Ns).

% Part 1
adjacent(I-J, n(A-B, L, _)) :-
    I in ξ(A-1)..ξ(A+1),
    J in ξ(B-1)..ξ(B+L).

partNumber(Mat-Ns, A-B, Value) :-
    position(Mat, I-J, sym(_)),
    member(n(A-B, L, Value), Ns),
    adjacent(I-J, n(A-B, L, Value)).

part1(Sol) :-
    parse('input1.data', Mat-Ns),
    aggregate(sum(N), I-J, partNumber(Mat-Ns, I-J, N), Sol).

% Part 2
gear(Mat-Ns, I-J, Ratio) :-
    position(Mat, I-J, sym('*')),
    include(adjacent(I-J), Ns, [n(_,_,N1), n(_,_,N2)]),
    Ratio #= N1*N2.

part2(Sol) :-
    parse('input1.data', Mat-Ns),
    aggregate(sum(Ratio), I-J, gear(Mat-Ns, I-J, Ratio), Sol).

I’ll publish this on github as soon as I publish the packs, but it’s interesting to compare.

Regarding the python solution, I don’t see where * symbols are checked for part 2 though. Do you have a link?

1 Like

Wow … you sir, are a magician. I’ll spend some time trying to understand how your solution works, but its certainly much more parsimonious than mine. I’ve never used CHR constraints. If you wouldn’t mind providing a few sentences of blurb to help me grok what you’ve done, I’d be grateful.

RE the Python code and checking for stars, it just so happens that there are no non-digit symbols in the problem that join to exactly 2 numbers… It also just so happens that there are no numbers which join up to more than one symbol, else it wouldn’t work.

I can’t seem to run the code. list/4 is unrecognised, and the chr constraints barf as well.

Is it my ancient version of SWI?

SWI-Prolog version 8.2.4 for x86_64-linux

Not really rigour …
I put in the tests mainly to confirm that I understood the problem - the author of Advent Of Code is nice enough to provide the test cases, so I just converted them to plunit style. And when I try things out at the command line, I copy&paste into a test case, to record this result for regression tests.

Haha, I’m hardly a magician, but here’s an explanation:

The core of this problem is a tension between the grid-like structure in which the adjacency relation is defined, and the fact that numbers capture information that is not completely factored out in the grid structure (the total value of the integer is not something you can immediately fathom by just looking at the grid structure).

Given the tension, we probably want to retain both representations and use them opportunistically, so, we first use DCGs in the first lines to parse the grid structure, and then we use some CHR to compute some info about the numbers.

Numbers are represented like n(I-J, Len, Value), where I-J is the coordinate of the initial digit of the number, Len is how many digits the number has, and Value is the number itself.

Here’s why this is a good representation:
The coordinate of the first digit uniquely identifies the number, working as a discriminator for the aggregate/4 clauses. Having the number of digits makes for easier adjacency calculations, and the value is needed to calculate part numbers and powers.

Now, how is the information about numbers computed? We start collecting all the individual digits, so for example n(0-0, 1, 3) and n(0-1, 1, 5) would mean that the first line starts with a 3 and a 5. This is desumed easily by the matrix representation.

The CHR rule merges together these individual representations. In our case the two constraints:

n(0-0, 1, 3) and n(0-1, 1, 5)

are substituted with the constraint

n(0-0, 2, 35).

and this continues till when the CHR process reaches a fixpoint. At that point we collect the remaining n constraints (they represent complete numbers), and pass both the matrix (to see where the symbols are) and the n terms (to see where the numbers are) to the predicates that do the actual computation in part1 and part2, which should be straightforward.

If you have more questions feel free to ask, and let me know what you think!

Yes, as I mentioned in my first answer, I’m importing some libraries of personal utilities, so the imports are missing. When I get to publish them as packs, I’ll post the complete solution to github, but I wanted to jump in the discussion :smile:

1 Like

Ah very nice :slight_smile: So the CHR is used to merge things as it goes along. It inspired me to tidy up my code a bit. Here is a new cut! Both parts in 46 lines of code.

summary(Grp0,X-Y-Y0-N) :-
    reverse(Grp0,Grp),
    Grp=[X-Y-_|_],
    last(Grp,_-Y0-_),
    findall(V,member(_-_-V,Grp),Vs),
    number_string(N,Vs).

to_coord([],_,_,[],Acc,Acc) :- !.
to_coord([],_,_,Cur,Acc,[Grp|Acc]) :- summary(Cur,Grp),!.
to_coord([H|T],X0,Y0,Cur,Acc0,Coords) :-
    memberchk(H,['\n','.']),
    (H='.' ->Y1 is Y0+1;Y1=Y0),
    (H='\n'->X is X0+1,Y=1;X=X0,Y=Y1),
    (Cur=[]->Acc=Acc0;summary(Cur,Grp),Acc=[Grp|Acc0]),!,
    to_coord(T,X,Y,[],Acc,Coords).
to_coord([H|T],X,Y0,Cur,Acc0,Coords) :-
    \+ char_type(H,digit),
    Y is Y0+1,
    (Cur\=[]->summary(Cur,Grp),Acc=[Grp|Acc0];Acc=Acc0),!,
    to_coord(T,X,Y,[],[X-Y0-Y0-H|Acc],Coords).
to_coord([H|T],X,Y0,Cur,Acc,Coords) :-
    Y is Y0+1,
    to_coord(T,X,Y,[X-Y0-H|Cur],Acc,Coords).

file_to_coords(File,Coords) :-
    open(File,read,Stream),
    read_string(Stream,_,String),
    string_chars(String,Chars),
    to_coord(Chars,1,1,[],[],Coords).    

star_group(Coords,X_,Y_,Grp) :-
    findall(V,(member(X-Y0-Y-V,Coords),
	       number(V),
	       Y_>=Y0-1,Y+1>=Y_,X_>=X-1,X+1>=X_),Grp).

prod(A,B,X) :- X is A*B.

solve(File,part1,Answer) :-
    file_to_coords(File,Coords),
    findall(V,(member(X-Y0-Y-V,Coords),number(V),
	       \+ \+ (member(X_-Y_-_-V_,Coords),
		      \+ number(V_),
		      Y_>=Y0-1,Y+1>=Y_,X_>=X-1,X+1>=X_)),Parts),
    sumlist(Parts,Answer).

solve(File,part2,Answer) :-
    file_to_coords(File,Coords),
    findall(Prod,(member(X-Y-_-'*',Coords),
		  star_group(Coords,X,Y,Grp),
		  length(Grp,2),
		  foldl(prod,Grp,1,Prod)),Prods),
    sumlist(Prods,Answer).
1 Like

@emiruz the repo with my solutions is now posted at GitHub - meditans/aoc2023: Solutions for advent of code 2023. I also take the opportunity to have a code review from more experienced prolog programmers!

1 Like

I have solved with the following code, somewhat more efficient than your one

:- module(capellic,
          [part1/2
          ,part2/2
          ]).

part1(Input, SumOfPartNumbers) :-
    read_items(Input, MaybePartNumbers, Symbols),
    convlist(is_part_number(Symbols), MaybePartNumbers, PartNumbers),
    sumlist(PartNumbers, SumOfPartNumbers).

part2(Input, SumOfGears) :-
    read_items(Input, MaybePartNumbers, Symbols),
    convlist(is_gear(MaybePartNumbers), Symbols, GearValues),
    sumlist(GearValues, SumOfGears).

% parsing

read_items(Input, MaybePartNumbers, Symbols) :-
    read_file_to_codes(Input, Codes, []),
    parse_positioned_items(Codes, 0,0, MaybePartNumbers, Symbols).
/* this is for comparing the parsed data against the dcg code
    length(MaybePartNumbers,NMaybePartNumbers),
    length(Symbols,NSymbols),
    tell(capellic_symbols),
    writeln([NMaybePartNumbers,NSymbols]),
    maplist(writeln,Symbols),
    told.
*/

parse_positioned_items([], _Row,_Col, [],[]).
parse_positioned_items([0'\n|Cs], Row,_, MaybePartNumbers, Symbols) :-
    Row1 is Row+1,
    parse_positioned_items(Cs, Row1,0, MaybePartNumbers, Symbols).
parse_positioned_items([0'.|Cs], Row,Col, MaybePartNumbers, Symbols) :-
    Col1 is Col+1,
    parse_positioned_items(Cs, Row,Col1, MaybePartNumbers, Symbols).
parse_positioned_items(Codes, Row,Col, [maybe_part_number(Row,Number,DigitsCols)|MaybePartNumbers],Symbols) :-
    digits(Codes, Col,ColStop, Codes1, Digits, DigitsCols),
    Col < ColStop,
    number_codes(Number, Digits),
    parse_positioned_items(Codes1, Row,ColStop, MaybePartNumbers,Symbols).
parse_positioned_items([Symbol|Codes], Row,Col, MaybePartNumbers,[symbol(Row,Col,Symbol)|Symbols]) :-
    Col1 is Col+1,
    parse_positioned_items(Codes, Row,Col1, MaybePartNumbers,Symbols).

digits([C|Codes], Col,ColStop, CodesRest, [C|Cs],[Col|DigitsCols]) :-
    between(0'0, 0'9, C),
    Col1 is Col+1,
    digits(Codes, Col1,ColStop, CodesRest, Cs,DigitsCols).
digits(Codes, Col,Col, Codes, [],[]).

adjacent(maybe_part_number(Row, Number, DigitsCols), R,C, Number) :-
    abs(Row-R) =< 1,
    member(DigitCol, DigitsCols),
    abs(DigitCol-C) =< 1,
    !.

% part1

is_part_number(Symbols, Item, Number) :-
    member(symbol(R,C,_), Symbols),
    adjacent(Item, R,C, Number).

% part2

is_gear(MaybePartNumbers, symbol(R,C,0'*), GearRatio) :-
    findall(Number, (member(Item, MaybePartNumbers), adjacent(Item, R,C, Number)), [G1,G2]),
    GearRatio is G1*G2.

but the parsing part is rather verbose, and when I switched to phrase_from_file, I got a bad surprise… I’m not sure I will find the problem, seems not a logic one, indeed it works flawless on the smaller input.

:- module(capellic_dcg,
          [part1_dcg/2
          ,part2_dcg/2
          ]).

:- use_module(library(dcg/basics)).

part1_dcg(Input, SumOfPartNumbers) :-
    read_items(Input, MaybePartNumbers, Symbols),
    convlist(is_part_number(Symbols), MaybePartNumbers, PartNumbers),
    sumlist(PartNumbers, SumOfPartNumbers).

part2_dcg(Input, SumOfGears) :-
    read_items(Input, MaybePartNumbers, Symbols),
    convlist(is_gear(MaybePartNumbers), Symbols, GearValues),
    sumlist(GearValues, SumOfGears).

% parsing

read_items(Input, MaybePartNumbers, Symbols) :-
    phrase_from_file(positioned_items(MaybePartNumbers, Symbols), Input), !,
    length(MaybePartNumbers,NMaybePartNumbers),
    length(Symbols,NSymbols),
    tell(capellic_dcg_symbols),
    writeln([NMaybePartNumbers,NSymbols]),
    maplist(writeln,Symbols),
    told.

row_col(Row,Col) -->
    lazy_list_location(file(_Name, Row, Col, _CharNo)).

positioned_items([],[]) --> [].
positioned_items(MaybePartNumbers, Symbols) -->
    ( "\n" ; "." ),
    positioned_items(MaybePartNumbers, Symbols).
positioned_items([maybe_part_number(Row, Number, DigitsCols)|MaybePartNumbers], Symbols) -->
    row_col(Row, ColStart),
    integer(Number),
    row_col(Row, ColStop),
    {ColStop1 is ColStop-1, numlist(ColStart, ColStop1, DigitsCols)},
    positioned_items(MaybePartNumbers, Symbols).
positioned_items(MaybePartNumbers, [symbol(Row, Col, Symbol)|Symbols]) -->
    row_col(Row, Col),
    [Symbol],
    positioned_items(MaybePartNumbers, Symbols).

adjacent(maybe_part_number(Row, Number, DigitsCols), R,C, Number) :-
    abs(Row-R) =< 1,
    member(DigitCol, DigitsCols),
    abs(DigitCol-C) =< 1,
    !.

% part1

is_part_number(Symbols, Item, Number) :-
    member(symbol(R,C,_), Symbols),
    adjacent(Item, R,C, Number).

% part2

is_gear(MaybePartNumbers, symbol(R,C,0'*), GearRatio) :-
    findall(Number, (member(Item, MaybePartNumbers), adjacent(Item, R,C, Number)), [G1,G2]),
    GearRatio is G1*G2.

2 Likes

its useful to know about convlist – i had not come across it.

Day 4 is up. My solution for both parts is below (41 LOC). It is still trivial in Prolog but I think for coders using imperative languages, the recursive element of the problem may seem harder and I suspect it will be reflected in the ratio between those who solve part1 and part2 in the completion stats.

If you have any pointers for how I can make my DCG more succinct, I’d be grateful. I’m a DCG newbie.

:- set_prolog_flag(double_quotes, chars).

% Spaces.
space([]) --> [' '].
space([_|Xs]) --> [' '],!,space(Xs).

% Sequence of digits.
digits([]) --> [].
digits([X|Xs])  --> [X],{char_type(X,digit)},digits(Xs).

% Parse card number entries.
record([]) --> [].
record([N|Rs]) --> space(_),digits(Ds),{number_string(N,Ds)},record(Rs).

% A card record.
card(Id,Ns,Ps) --> "Card",space(_),digits(Ds),{number_string(Id,Ds)},":",
		   record(Ns)," |",record(Ps).

% Split a string into games.
lines([]) --> [].
lines([Id-Ns-Ps|Ls]) --> card(Id,Ns,Ps),"\n",lines(Ls).
lines([Id-Ns-Ps]) --> card(Id,Ns,Ps).

intersect(As,Bs,N) :-
    findall(X,(member(X,As),member(X,Bs)),Xs),
    Xs\=[],length(Xs,N).

:- table copied/3.

copied(Id0-Ns0-Ps0,Cards,Total0) :-
    intersect(Ns0,Ps0,Len),
    findall(Total,(member(Id-Ns-Ps,Cards),
		   Id0+Len>=Id,Id>Id0,
		   copied(Id-Ns-Ps,Cards,Total)),Ts),
    sumlist(Ts,Sum),Total0 is Sum+1,!.
copied(_,_,1).

file_to_cards(File,Cards) :-
    open(File,read,Stream),
    read_string(Stream,_,String),
    string_chars(String,Chars),
    phrase(lines(Cards),Chars).

solve(File,part1,Answer) :-
    file_to_cards(File,Cards),
    findall(2^(N-1),(member(_-Ns-Ps,Cards),intersect(Ns,Ps,N)),Points),
    sumlist(Points,Answer).
solve(File,part2,Answer) :-
    file_to_cards(File,Cards),
    findall(N,(member(C,Cards),copied(C,Cards,N)),Points),
    sumlist(Points,Answer).
1 Like

Just sampling other peoples solutions from here, my solution above is above average for LOC. I suspect it is mostly due to the parsing. Folks have typically used regular expressions to reduce the parsing task to a couple lines of code whilst my parser is significantly more explicit.

I’m cleaning up my solution, and then I’ll show more compact parsing.

I think you could replace this with phrase_from_file.

The logic of your solution seems very compact, can you briefly explain what’s going on in the copied predicate?

Use this. That, together with the improvement further down removes the need for set_prolog_flag(double_quotes, chars). Note that the last clause of a predicate doesn’t need a cut after the guard to be deterministic as there is no alternative clause anyway.

space([]) --> " ".
space([_|Xs]) --> " ",space(Xs).

What about this? Does process character as codes. It is not only short, but also processes the file content as a stream, allowing to process arbitrary large files in bounded memory.

file_to_cards(File,Cards) :-
    phrase_from_file(lines(Cards),File).

The codes vs chars is more like a religious debate that was settled during the ISO standardization to accommodate Prolog systems that allow for either. Allowing for both is a bit hard as all parts of a larger system (libraries) that are involved in reading, writing or parsing need to agree. SWI-Prolog is due to its history part of the codes family. Yes, you can use it with chars for small examples but in larger applications and when using the relevant libraries, it quickly leads to problems. Debugging is somewhat more clumsy, but portray_text/1 simplifies it in most cases enough.

Seems so. Using library(dcg/basics) and library(dcg/high_order) you could cut a lot. And, you can also use library(pcre) to do the job using regular expressions. IMO they are great for simple things. As rules can more complicated, DCGs are easier to read, debug and maintain.

1 Like

Very nice :slight_smile: Its now 26 LOC, which feels satisfying. I got rid of the global flags, used
phrase_from_file instead, and used blanks and number from dcg/basics. Also, it turns out the Github LOC counter includes comments for Prolog code, so its a bit shorter than reported previously anyway:

:- use_module(library(dcg/basics)).

% Parse card number entries.
rcrd([]) --> [].
rcrd([N|Rs]) --> blanks,number(N),rcrd(Rs).

% A card record.
card(Id,Ns,Ps) --> "Card",blanks,number(Id),":",rcrd(Ns)," |",rcrd(Ps).

% Split a string into games.
lines([]) --> [].
lines([Id-Ns-Ps|Ls]) --> card(Id,Ns,Ps),"\n",lines(Ls).
lines([Id-Ns-Ps]) --> card(Id,Ns,Ps).

% Calculate number of common items.
intersect(As,Bs,N) :-
    findall(X,(member(X,As),member(X,Bs)),Xs),
    Xs\=[],length(Xs,N).

:- table copied/3.

% Calculate cumulative number of cards received.
copied(Id0-Ns0-Ps0,Cards,Total0) :-
    intersect(Ns0,Ps0,Len),
    findall(Total,(member(Id-Ns-Ps,Cards),
		   Id0+Len>=Id,Id>Id0,
		   copied(Id-Ns-Ps,Cards,Total)),Ts),
    sumlist(Ts,Sum),Total0 is Sum+1,!.
copied(_,_,1).

% Solutions to parts 1 & 2.
solve(File,part1,Answer) :-
    phrase_from_file(lines(Cards),File),
    findall(2^(N-1),(member(_-Ns-Ps,Cards),intersect(Ns,Ps,N)),Points),
    sumlist(Points,Answer).
solve(File,part2,Answer) :-
    phrase_from_file(lines(Cards),File),
    findall(N,(member(C,Cards),copied(C,Cards,N)),Points),
    sumlist(Points,Answer).

Yes please! If possible in vanilla Prolog (i.e. just standard libraries)? Helps me understand your wizardry :slight_smile:

It is just a depth first search, where the number of tickets at an ID is a sum of the totals from the tickets that the ID entails (and so on recursively). E.g. Say ID=1 wins two tickets, those would have IDs 2 and 3. copied/3 gets called on those (repeating the process for each) and the sum of their total is the total for ID=1. The base case is a ticket which entails no copies – just itself – which has a Total=1. The tabling is necessary because it results in a huge amount of recalculation. E.g. if ID=1 implies 2,3,4,5 and ID=2 implies 3,4 and ID=3 implies 4,5,6, all those common IDs get recalculated again and again.

There is a numeric way to calculate the number of copies which part 2 sign posts, but I liked this solution because it describes the process by which cards are copied.

1 Like