Advent of code 2023

Day 6 is up! Difficult decreased drastically, its all over the place this year. 19 LOC, but it feels like it could be much less.

The constraint is that X(X-T) > D, where X is the time spent charging, T is the total available time and D is the record distance. Therefore, the distance travelled and time charged correspond via a quadratic equation: X^2 - XT + D = 0. The solutions to the equation mark the bounds of the minimum and maximum possible charge time to be within record distance.

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

line([]) --> ("";"\n").
line([X|Xs]) --> blanks,number(X),line(Xs).
file(Time,Dist) --> "Time:",line(Time),"Distance:",line(Dist).

sols(T-D,N) :-
    Q is sqrt(T^2-4*D),
    Min is (T-Q)/2, Max is (T+Q)/2,
    (floor(Min)=:=Min->Xmn is Min+1; Xmn is ceiling(Min)),
    (floor(Max)=:=Max->Xmx is Max-1; Xmx is floor(Max)),
    N is floor(Xmx-Xmn+1).

concat(Ns,R) :-
    maplist(number_chars,Ns,Cs),
    flatten(Cs,S),number_chars(R,S).

solve(File,Part1,Part2) :-
    phrase_from_file(file(Time,Dist),File),
    pairs_keys_values(Pairs,Time,Dist),
    foldl([A,B,C]>>(sols(A,N),C is N*B),Pairs,1,Part1),
    concat(Time,T), concat(Dist,D),
    sols(T-D,Part2).

@emiruz

While I have not been giving likes to individual replies, I am following along and am grateful to see your updates and the additional information others are adding.

Look forward daily to see what you post. :slightly_smiling_face:

2 Likes

(From reddit):

Today lends itself well to CLPZ:

solve([Time, Record], N) :-
		Charge in 0..Time,
		Dist #= Charge * (Time - Charge),
		Dist #> Record,
		fd_size(Charge, N).
1 Like

I think the rub here is that fd_size/2 predicate. If you replace it instead with something like aggregate_all(count,label([Charge]),N) because you didn’t know fd_size/2 existed (like me :slight_smile: ), it becomes totally unscalable for large numbers. E.g. from the actual problem:

solve([55826490,246144110121111],N).

So as a result of exposure to this and @meditans solution from day 5, I now understand what “reasoning over domains” means, what it is for and how it is distinct from brute forcing or more general optimisation.

2 Likes

This is my solution for today aoc2023/06/main.pl at f4a0fdd6fb2c9f88f06f32ee86e7f55d98c6bd74 · meditans/aoc2023 · GitHub

You may notice that the clpFD is equal to what @Garklein just wrote, and that’s because I stole it :smile:. I had done almost the same with constraints (see commit before), but using chain/2 and then fd_dom and then manually doing the computation instead of fd_size, and just using more variables than necessary. Kudos @Garklein, 5 beautiful lines!

1 Like

Hey @meditans / @CapelliC I’d be very grateful for your help. I’m trying to implement a clpfd version of day 5. I have a simple take but I can’t get the main predicate to be bidirectional. Here is the sample data I’m using:

seeds: 79 14 55 13

seed-to-soil map:
50 98 2
52 50 48

soil-to-fertilizer map:
0 15 37
37 52 2
39 0 15

fertilizer-to-location map:
49 53 8
0 11 42
42 0 7
57 7 4

I’ve written a short predicate called findit/5 and I’m trying to work out why it isn’t working bidirectionally. For example, if you run solve("sample.txt",59,Loc). it will return Loc=61, but if you run solve("sample.txt",Seed,61) it will fail. It works in the Seed >> Loc direction every time, but only sometimes in the Loc >> Seed direction, and I can’t work out why.

Here is the code. You don’t have to worry about the parsing stuff. The Cs variable ends up with a list of all of the lines in the format c(Dest-Src-Loc,From,To). The seeds themselves are also there in the format c(Src-Src-Loc,none,'seed'), so its all in one list.

I’d be very grateful if you can help me figure it out!

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

% Parse input file.
seeds([]) --> [].
seeds([c(X-X-L,none,`seed`)|Xs]) --> blanks,number(X),blanks,number(L),seeds(Xs).
rngs(_,_,[]) --> [].
rngs(Fr,To,[c(A-B-C,Fr,To)|Xs]) --> number(A),blanks,number(B),blanks,number(C),
				    "\n",rngs(Fr,To,Xs).
rngs(Fr,To,[c(A-B-C,Fr,To)]) --> number(A),blanks,number(B),blanks,number(C).
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(Seeds,Cats) --> "seeds:",seeds(Seeds),"\n\n",cats(Cats).

% Connect seed to location.
findit(_,`location`,Src,Src,_) :- !.
findit(Cs,Fr,Src,Loc,Seed) :-
    ((member(c(D-S-L,Fr,To),Cs),Src#>=S,S+L-1#>=Src)->
	 SrcNew #= Src+D-S; SrcNew #= Src),
    memberchk(c(_,Fr,To),Cs),
    findit(Cs,To,SrcNew,Loc,Seed).
findit(Cs,Seed,Loc) :-
    member(c(_-S-L,none,To),Cs),
    Seed #>= S, S+L-1 #>= Seed,
    findit(Cs,To,Seed,Loc,Seed).

solve(File,Seed,Loc) :-
    phrase_from_file(file(Ss,Cs0),File),
    flatten([Ss,Cs0],Cs),
    findit(Cs,Seed,Loc).

do you have a sample.txt so that I can run the script? Or is it the test data for day 05?
It would be useful if you offered a particular call of the findit predicate, but my hunch would be that the ! is losing solutions in one sense. Or memberchk, or the use of -> ; (every non-logical predicate could introduce this behavior)

Sure here is the data, just copy paste it into a file called sample.txt:

seeds: 79 14 55 13

seed-to-soil map:
50 98 2
52 50 48

soil-to-fertilizer map:
0 15 37
37 52 2
39 0 15

fertilizer-to-location map:
49 53 8
0 11 42
42 0 7
57 7 4

I’ve managed to make the findit/5 predicate bidirectional by adding a clause. The problem was the soft cut. I figured it out by printing the domains of the variables during recursion and I noticed they became incompatible in the soft-cut but its not possible to back track from one side to the other.

findit(_,`location`,Src,Src,_) :- !.
findit(Cs,Fr,Src,Loc,Seed) :-
    ((member(c(D-S-L,Fr,To),Cs),Src#>=S,S+L-1#>=Src)->
	 SrcNew #= Src+D-S; SrcNew #= Src),
    memberchk(c(_,Fr,To),Cs),
    findit(Cs,To,SrcNew,Loc,Seed),!.
findit(Cs,Fr,Src,Loc,Seed) :-
    memberchk(c(_,Fr,To),Cs),
    findit(Cs,To,Src,Loc,Seed).
findit(Cs,Seed,Loc) :-
    member(c(_-S-L,none,To),Cs),
    Seed #>= S, S+L-1 #>= Seed,
    findit(Cs,To,Seed,Loc,Seed).

Now, even though its bidirectional (i.e. for every seed it will find the location and vice versa), I can’t get labeling to enumerate all the seed-to-location mappings. The seeds range from 79-92 and 55-67, but for some reason it does 79-92 and then stops short at 58 in the 2nd range:

?- solve("sample.txt",Seed,Loc),label([Seed,Loc]).
Seed = 79,
Loc = 81 ;
Seed = 80,
Loc = 82 ;
Seed = 81,
Loc = 83 ;
Seed = 82,
Loc = 84 ;
Seed = 83,
Loc = 85 ;
Seed = 84,
Loc = 86 ;
Seed = 85,
Loc = 87 ;
Seed = 86,
Loc = 88 ;
Seed = 87,
Loc = 89 ;
Seed = 88,
Loc = 90 ;
Seed = 89,
Loc = 91 ;
Seed = 90,
Loc = 92 ;
Seed = 91,
Loc = 93 ;
Seed = 92,
Loc = 94 ;
Seed = 55,
Loc = 53 ;
Seed = 56,
Loc = 54 ;
Seed = 57,
Loc = 55 ;
Seed = 58,
Loc = 56 ;
false.

Meanwhile, running solve("sample.txt",59,Loc) gives Loc=61, and running solve("sample.txt",Seed,61) gives Seed=59.

This might be a clue you can interpret. Look at the domains for Seed which I’ve set. In the first case, where the enumeration stops, the Loc domain is wrong (i.e. Seed=59 should map to Loc=61, which is clearly impossible in those domains):

?- Seed in 55..67, solve("sample.txt",Seed,Loc).
Seed in 55..58,   <---- PROBLEM IT TRUNCATES TO THIS BOUNDARY.
2+Seed#=_A,
_A in 57..60,
-4+_A#=Loc,
Loc in 53..56 .

?- Seed in 59..67, solve("sample.txt",Seed,Loc).
Seed in 59..67,
2+Seed#=Loc,
Loc in 61..69.

Hello,
Since nobody has done day 7 yet, here is my quite verbose solution for part 2:

Day 7, part 2 solution
:- use_module(library(dcg/basics)).
:- use_module(library(dcg/high_order)).
:- use_module(library(clpfd)).

card(2) --> "2".
card(3) --> "3".
card(4) --> "4".
card(5) --> "5".
card(6) --> "6".
card(7) --> "7".
card(8) --> "8".
card(9) --> "9".
card(10) --> "T".
card(1) --> "J".
card(12) --> "Q".
card(13) --> "K".
card(14) --> "A".

row(Hand-Bid) -->
   {length(Hand, 5)},
   sequence(card, Hand), white, integer(Bid), eol.
rows(Rows) -->
   sequence(row, Rows).

% Five of a kind
type(7, [X, X, X, X, X]).
% Four of a kind
type(6, Hand) :-
   dif(X, Y),
   select(X, Hand, [Y, Y, Y, Y]).
% Full house
type(5, Hand) :-
   dif(X, Y),
   select(X, Hand, Four),
   select(X, Four, [Y, Y, Y]).
% Three of a kind
type(4, Hand) :-
   dif(X, Y),
   dif(X, Z),
   dif(Y, Z),
   select(X, Hand, Four),
   select(Y, Four, [Z, Z, Z]).
% Two pair
type(3, Hand) :-
   dif(P1, P2),
   dif(P1, X),
   dif(P2, X),
   select(P1, Hand, Four),
   select(P1, Four, Three),
   select(P2, Three, Two),
   select(P2, Two, [X]).
% One pair
type(2, Hand) :-
   maplist(dif(P1), [A, B, C]),
   all_distinct([A, B, C]),
   select(P1, Hand, Four),
   select(P1, Four, [A, B, C]).
% High card
type(1, Hand) :-
   all_distinct(Hand).

replace([], []).
replace([X | L1], [Y | L2]) :-
   (  X = 1
   -> Y in 2..14
   ;  Y = X
   ),
   replace(L1, L2).

main(Sum) :-
   phrase_from_file(rows(Rows), "7"),
   pairs_keys(Rows, Hands),
   maplist(replace, Hands, HandsWithVar),
   maplist(type, Types, HandsWithVar),
   pairs_keys_values(TypeRows, Types, Rows),
   sort(TypeRows, SortedTypeRows),
   pairs_values(SortedTypeRows, HandsBids),
   pairs_values(HandsBids, Bids),
   length(SortedTypeRows, N),
   numlist(1, N, Ranks),
   maplist([Rank, Bid, Prod]>>(Prod is Rank*Bid), Ranks, Bids, Prods),
   sum_list(Prods, Sum).

One thing I really enjoyed was specifying the type of hands using only pure prolog constructs like unification, select/3, dif/2 or the practical all_distinct/1 predicate from clpfd.

% Five of a kind
type(7, [X, X, X, X, X]).
% Four of a kind
type(6, Hand) :-
   dif(X, Y),
   select(X, Hand, [Y, Y, Y, Y]).
% Full house
type(5, Hand) :-
   dif(X, Y),
   select(X, Hand, Four),
   select(X, Four, [Y, Y, Y]).
% Three of a kind
type(4, Hand) :-
   dif(X, Y),
   dif(X, Z),
   dif(Y, Z),
   select(X, Hand, Four),
   select(Y, Four, [Z, Z, Z]).
% Two pair
type(3, Hand) :-
   dif(P1, P2),
   dif(P1, X),
   dif(P2, X),
   select(P1, Hand, Four),
   select(P1, Four, Three),
   select(P2, Three, Two),
   select(P2, Two, [X]).
% One pair
type(2, Hand) :-
   maplist(dif(P1), [A, B, C]),
   all_distinct([A, B, C]),
   select(P1, Hand, Four),
   select(P1, Four, [A, B, C]).
% High card
type(1, Hand) :-
   all_distinct(Hand).

Amazingly, this part of the code didn’t change when going from part 1 to part 2 !

2 Likes

Oh yes, I much prefer your hand classification to mine :slight_smile: I didn’t know about dif, select and so on. Here my 40 LOC:

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

% Convert picture cards to numbers.
to_num(V,R) :- maplist(to_num_, V, R).
to_num_(C, V) :- nth1(V, `123456789TJQKA`, C), !.

% Classify hand.
class_([X,X,X,X,X],6) :- !.
class_(V,5) :- append([_,[X,X,X,X],_],V),!.
class_(V,4) :- append([_,[X,X,X],_,[Y,Y],_],V), X\=Y,!.
class_(V,4) :- append([_,[X,X],_,[Y,Y,Y],_],V), X\=Y,!.
class_(V,3) :- append([_,[X,X,X],_],V),!.
class_(V,2) :- append([_,[X,X],_,[Y,Y],_],V), X\=Y,!.
class_(V,1) :- append([_,[X,X],_],V),!.
class_(_,0).
class(V,C)  :- \+ memberchk(0,V), msort(V,V0), class_(V0,C),!.
class(X,C0) :-
    aggregate_all(max(C),(between(2,14,N),replace(X,0,N,Y),class(Y,C)),C0).

% Replace a value in a list.
replace(F,T,In,Out) :- maplist(replace_(F,T), In, Out).
replace_(F,T,I,O) :- (F==I -> O=T ; O=I).

% Parse input.
line(C-V) --> string_without(" ",C),blank,number(V).
file([]) --> ("";"\n").
file([C-V|Xs]) --> line(C0-V),{to_num(C0,C)},"\n",file(Xs).

solve(File,Part1,Part2) :-
    phrase_from_file(file(Cs0),File),
    findall(C0-V,(member(C-V,Cs0),class(C,K),append([K],C,C0)),Cs1),
    msort(Cs1,Cs1_),
    aggregate_all(sum(X),(nth1(I,Cs1_,_-V),X is I*V),Part1),
    findall(C0-V,(member(C-V,Cs0),
		  replace(C,11,0,C1),
		  class(C1,K),
		  append([K],C1,C0)),Cs2),
    msort(Cs2,Cs2_),
    aggregate_all(sum(X),(nth1(I,Cs2_,_-V),X is I*V),Part2).

EDIT: 30 LOC after integrating some of @jan tips :slight_smile:

It felt fairly verbose today, but surprisingly most solutions in any language are > 40 lines: significantly more.

And you can make it a lot shorter :slight_smile: I think your to_num/2 can be

to_num(V,R) :- maplist(to_num_, V, R).
to_num_(C, V) :- nth1(V, `123456789TJQKA`, C), !.

To compute the class, you probably better use clumped/2. As you cut all clauses before, the all_distinct/1 call does nothing, so no need for clpfd.

Your replace/4 is select/4 (with different argument order).

2 Likes

Ohh nice tips, thank you! Is there a simple way to make select/4 replace all occurrences in cases where there are more than one?

Sorry, missed that. This saves two lines

replace(F,T,In,Out) :- maplist(replace_(F,T), In, Out).
replace_(F,T, I,O) :- ( F == I -> O = T ; O = I ).

I’d probably write it as a normal Prolog predicate for production purposes (without DCG), which would be three lines.

2 Likes

Beautiful :slight_smile: So concise now.

Here is mine aoc2023/07/main.pl at e9780ceddbbfd4608fc53c16c5dfb7677030b8c7 · meditans/aoc2023 · GitHub
I wonder what could be improved!

Here’s a question: I would like to use tabling on the predicate use_joker, but tabling complains that I’m using attributed variables. Is there something I should do?

1 Like

I find it interesting that pretty much everyone that volunteers a Prolog solution ends up doing it a different way – there are a few Prolog solvers on Reddit too.

I believe swi-prolog tabling does not support attributed variables: Dif/2 and tabling - doesn't mix? - #3 by jan

1 Like