Advent of Code 2024

Hello all, AoC is upon us again :slight_smile: I’ve chosen Prolog again this year, and now that I have a bit of experience with it, it is a delight to be tinkering again.

I’m keeping my solutions here, with a special effort this year to write code using declarative idioms unique to the Prolog approach.

Please share your thoughts and solutions!

Here are the first couple days:

Day 1

This uses re_foldl/6 and a nth0/3 index matching trick I saw @jan do once to solve both parts concisely.

acc(_{0:_, l1:X, l2:Y}, Xs-Ys, [X|Xs]-[Y|Ys]).

solve(In, Part1, Part2) :-
    read_file_to_string(In, S, []),
    re_foldl(acc, "(?<l1_I>\\d+) +(?<l2_I>\\d+)", S, []-[], Xs_-Ys_, []),
    maplist(msort, [Xs_,Ys_], [Xs,Ys]),
    aggregate_all(sum(abs(X-Y)), (nth0(Idx,Xs,X), nth0(Idx,Ys,Y)), Part1),
    aggregate_all(sum(A*C), (member(A,Xs), aggregate_all(count, member(A,Ys), C)), Part2).

Day 2

This uses the magical append/3 and select/3 predicates to concisely and declaratively implement the safety tests.

safe(Xs) :-
    Xs \= [],
    \+ (append(_, [A,B|_], Xs), A>=B, append(_, [C,D|_], Xs), D>=C),
    \+ (append(_, [A,B|_], Xs), (abs(A-B) =:= 0; abs(A-B) > 3)).

mod_then_safe(Xs) :- member(X, Xs), select(X, Xs, Ys), safe(Ys), !.

acc(_{0:_,n:X}, Xs, [X|Xs]).

nums(S,Xs) :- re_foldl(acc, "(?<n_I>\\d+)", S, [], Xs, []).

solve(In, Part1, Part2) :-
    read_file_to_string(In, S, []),
    split_string(S, "\n", "", Ss),
    maplist(nums, Ss, Xs),
    aggregate_all(count, (member(X, Xs), safe(X)), Part1),
    aggregate_all(count, (member(X, Xs), mod_then_safe(X)), Part2).
3 Likes

Awesome, compact code ! Thanks so much !
I keep learning from your work, just didn’t know the existence of re_foldl/6.

Day3 is pretty easy, here is my solution, based on standard DCG. Use of regex seems problematic due to the recursive formulation.

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

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

part1(Kind,Sum) :-
    phrase_from_file(multiplications(Ms),Kind),
    sumlist(Ms,Sum).

part2(Kind,Sum) :-
    phrase_from_file(multiplications(Ms,1),Kind),
    sumlist(Ms,Sum).

multiplications([]) --> [].
multiplications([M|Ms]) -->
    multiplication(M),
    multiplications(Ms).
multiplications(Ms) --> [_], multiplications(Ms).

multiplication(M) -->
    "mul(", operand(A), ",", operand(B), ")",
    {M is A*B}.

operand(V) --> integer(V).
operand(V) --> multiplication(V).

on_off(1) --> "do()".
on_off(0) --> "don't()".

multiplications([],_On) --> [].
multiplications([M|Ms],On) -->
    multiplication(M,On),
    multiplications(Ms,On).
multiplications(Ms,_On) -->
    on_off(OnNext),
    multiplications(Ms,OnNext).
multiplications(Ms,On) -->
    [_],
    multiplications(Ms,On).

multiplication(M,On) --> multiplication(M1), {M is On * M1}.

2 Likes

Here is one way to make use of re_foldl/6 for Day 03:

mul_do_acc(_{0:_,2:_,op:"mul",x:X,y:Y}, A-V0-V1, A-V2-V3) :-
    V2 is V0+(X*Y), V3 is V1+A*(X*Y).
mul_do_acc(_{0:_, op:"do"}, _-V0-V1, 1-V0-V1).
mul_do_acc(_{0:_, op:"don't"}, _-V0-V1, 0-V0-V1).

solve(In, Part1, Part2) :-
    Regex = "(?<op>mul|do|don't)\\(((?<x_I>\\d+),(?<y_I>\\d+))?\\)",    
    read_file_to_string(In, S, []),
    re_foldl(mul_do_acc, Regex, S, 1-0-0, _-Part1-Part2, []).
1 Like

Maybe I unnecessarily complicated my DCG, accounting for recursion in mul(A,B). Now will test your code with an hand made input…

I used DCGs extensively for 2023, but to be honest I found regex much easier for these simple inputs. Pattern matching against groups is a very nice capability. You see above, I was able to capture many things with the regex, and then treat them separately in the mul_do_acc/3 predicate. Its so convenient.

Just tried this input: xmul(2,mul(3,4)).
Your code yields 12, mine yields 24.
Seems my reading of specs was useless complicated…

Pretty impressive that you can handle recursion in such short code! In this case, I think the input is supposed to just be corrupted code, so there is no recursive evaluation implied.

Day 04

Here it is. I think the tricky part is representing the grid conveniently. It is 15 LoC, but I’d be excited if you can see a way to make this solution more concise:

o2c(Xs, N, A-B, Os0, Cs) :-
    include({N,A,B}/[X-Y]>>(A+X>=0,A+X<N,Y+B>=0,Y+B<N), Os0, Os),
    maplist({Xs,N,A,B}/[X-Y,C]>>(I is (A+X)+(Y+B)*N, nth0(I,Xs,C)), Os, Cs).

xmas(Cs, N, X) :-
    member(Os, [[1-0,2-0,3-0], [-1-0,-2-0,-3-0], [1-(-1),2-(-2),3-(-3)], [0-(-1),0-(-2),0-(-3)],
		[1-1,2-2,3-3], [-1-(-1),-2-(-2),-3-(-3)], [-1-1,-2-2,-3-3], [0-1,0-2,0-3]]),
    o2c(Cs, N, X, Os, ['M','A','S']).

x_mas(Cs, N, X) :-
    o2c(Cs, N, X, [-1-(-1),1-(-1),-1-1,1-1], Out),
    memberchk(Out, [['M','S','M','S'], ['S','M','S','M'], ['M','M','S','S'], ['S','S','M','M']]).

solve(In, Part1, Part2) :-
    read_file_to_string(In, S, []), string_chars(S,Cs0),
    nth0(N, Cs0, '\n'), !, exclude(=('\n'), Cs0, Cs),
    aggregate_all(count, (nth0(I,Cs,'X'), X is mod(I,N), Y is I//N, xmas(Cs,N,X-Y)), Part1),
    aggregate_all(count, (nth0(I,Cs,'A'), X is mod(I,N), Y is I//N, x_mas(Cs,N,X-Y)), Part2).

There is a neat imaginary number trick I’ve seen in Python here:

The author solves Day 04 in 9 LoC of Python, but I guess something similar would not be practical in Prolog?

Day 05

Here it is. I think a neat use case for CLPFD. It feels longer than it has to be, so if you can see a way of shortening this, let me know!

:- use_module(library(clpfd)).

list_to_nums(X,Y) :- split_string(X,",","",Y0), maplist(atom_number,Y0,Y).

partial_sort(Cs0, Xs, Ys) :-
    length(Ref,100), Ref ins 1..100,
    findall(A-B, (member(A-B, Cs0), (memberchk(A,Xs), memberchk(B,Xs))), Cs),
    maplist({Ref}/[I1-I2]>>(nth1(I1,Ref,A), nth1(I2,Ref,B), A #< B), Cs),
    label(Ref), !,

    maplist({Ref}/[I,X]>>nth1(I,Ref,X), Xs, Vs),
    pairs_keys_values(Pairs, Vs, Xs),
    keysort(Pairs, Sorted),
    pairs_values(Sorted, Ys).

mid_point(X, Y) :- length(X, N0), N is 1 + N0 // 2, nth1(N, X, Y).

solve(In, Part1, Part2) :-
    read_file_to_string(In, S, []),
    string_concat(Rest, Data, S), string_concat(Cons, "\n\n", Rest),
    re_foldl([_{0:_,a:A, b:B},V0,[A-B|V0]]>>true,"(?<a_I>\\d+)\\|(?<b_I>\\d+)",Cons,[],Cs,[]),

    split_string(Data, '\n', [], Data1), exclude(=(""), Data1, Data2),
    maplist(list_to_nums, Data2, Data3),

    aggregate_all(sum(N), (member(X,Data3), partial_sort(Cs, X, X), mid_point(X, N)), Part1),
    aggregate_all(sum(N), (member(X,Data3), partial_sort(Cs, X, Y), X \= Y, mid_point(Y,N)), Part2), !.

General point: should be bettter to use element/3 instead of nth1/3 with clpfd, to take advantage of delayed label/1.

1 Like

In the specific case above it just loops forever (or takes orders of magnitude longer) if I swap nth1/3 for element/3.

Day 06

Here it is. I couldn’t think of how to do this in fewer lines, or with better performance. Disappointingly, it takes just under 4 minutes to finish. Do you see a non-hacky, non-imperative way to improve performance?

:- table coo/5, ref/3.

coo(Cols, Rows, Idx0, X-Y, Idx) :-
    X0 is X + mod(Idx0, Cols), Y0 is Y + Idx0 // Cols,
    X0 >= 0, Rows > X0, Y0 >= 0, Cols > Y0,
    Idx is X0 + Y0 * Cols, Cols * Rows > Idx.

ref(Dir, Off, Turn) :-
    member(Dir-Turn-Off, ['<'-'^'-(-1-0),'>'-'v'-(1-0),'^'-'>'-(0-(-1)),'v'-'<'-(0-1)]).

walk(Pos-Dir, Cols, Rows, Os, Ps, Final) :-
    ref(Dir, Off, Next),
    (   coo(Cols, Rows, Pos, Off, NewPos),
        get_assoc(NewPos, Os, 0), !
    ->  walk(Pos-Next, Cols, Rows, Os, Ps, Final)
    ;   coo(Cols, Rows, Pos, Off, NewPos), !,
        \+ get_assoc(NewPos-Dir, Ps, 0),
        put_assoc(NewPos-Dir, Ps, 0, Ps1),
        walk(NewPos-Dir, Cols, Rows, Os, Ps1, Final)
    ;   assoc_to_keys(Ps, Vs0), pairs_keys(Vs0, Vs), sort(Vs, Final)).

solve(In, Part1, Part2) :-
    read_file_to_string(In, S, []), string_chars(S, Cs0),
    nth0(N, Cs0, '\n'), exclude(=('\n'), Cs0, Cs),
    nth0(Start, Cs, C), memberchk(C, ['<','>','^','v']), !,
    length(Cs, Last), M is Last // N,
    findall(I-0, (nth0(I,Cs,O), O='#'), Os), list_to_assoc(Os, OsAssoc),
    list_to_assoc([(Start-C)-0], AssocP),
    walk(Start-C, N, M, OsAssoc, AssocP, U1), length(U1, Part1),
    aggregate_all(
	count,
	(member(P, U1), P\=Start, put_assoc(P, OsAssoc, 0, OsAssoc2),
	 \+ walk(Start-C, N, M, OsAssoc2, AssocP, _)), Part2).

memberchk/2 would be faster, because it’s written in C, optimized for performance.

Maybe faster still as individual predicates, i.e. facts, therefore indexed.

There’s also some tips at Reddit.

Day7

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

equation(Res-Ns) --> integer(Res), `: `, sequence(integer, ` `, Ns), eol.
equations(Eqs) --> sequence(equation, Eqs).
input(Eqs) :- phrase_from_file(equations(Eqs), 'day7.txt').

op1(L,R,Ans) :- Ans is L * R.
op1(L,R,Ans) :- Ans is L + R.

calc(_, Res-[Res]).
calc(Op, Res-[L,R|Rest]) :- call(Op,L,R,Ans), calc(Op, Res-[Ans|Rest]).

sum_success(Op, Res-Ns, Acc, Acc) :- \+ calc(Op, Res-Ns), !.
sum_success(_, Res-_, Acc0, Acc1) :- Acc1 is Acc0 + Res.

part(Op, Ans) :-
    input(I),
    foldl(sum_success(Op), I, 0, Ans).

part1(Ans) :- part(op1, Ans).

op2(L,R,Ans) :- op1(L,R,Ans).
op2(L,R,Ans) :- atom_concat(L,R,A), atom_number(A, Ans).

part2(Ans) :- part(op2, Ans).

Pretty straightforward sum or the succeeding equations.
Using simple foldl over the equations was faster than aggregate_all.

Very concise, well done! You may benefit from some early stopping checks though. If the formula evaluates to more than the target value, it can be terminated.

Here is my take:

test([X|Xs], Total0, Extra, Target) :-
    Target >= Total0,
    (  Total is Total0+X
    ;  Total is Total0*X
    ;  Extra = true, Total is X + Total0*10**(floor(log10(X))+1)),
    test(Xs, Total, Extra, Target), !.
test([], Target, _, Target).

check(S, Total1-Total2) :-
    re_foldl([_{0:_,n:N},V0,[N|V0]]>>true, "(?<n_I>\\d+)", S, [], Ns0, []),
    reverse(Ns0, [Total,Head|Rest]),
    (  test(Rest, Head, false, Total) -> Total1 = Total, Total2 = Total
    ;  test(Rest, Head, true, Total),    Total1 = 0,     Total2 = Total), !.
check(_,0-0).

solve(In, Part1, Part2) :-
    read_file_to_string(In, S, []),
    split_string(S, "\n", "", Ss),
    maplist(check, Ss, Totals),
    aggregate_all(sum(A), member(A-B, Totals), Part1),
    aggregate_all(sum(max(A,B)), member(A-B, Totals), Part2).

That exclamation mark can be before the recursive call to test, to save on a bit of choicepoint remembering.

I don’t think so because the choices are directly above it, so the predicate would not be able to re-enter.

This line is the only choicepoint in test that the cut removes.

Here is a CLPFD version of Day 07, Part 1. It is about 20x slower than the version above. Does anyone see how it could be sped up?

:- use_module(library(clpfd)).

check(S, Total) :-
    re_foldl([_{0:_,n:N},V0,[N|V0]]>>true, "(?<n_I>\\d+)", S, [], Ns0, []),
    reverse(Ns0, [Total,Head|Rest]),
    length(Rest, N), length(Cons, N), Cons ins 0..1,
    foldl([X,C,V0,V]>>(V#>=V0, V#=C*(V0+X)+(1-C)*(V0*X)), Rest, Cons, Head, Total),
    label(Cons), !.
check(_, 0).

solve(In, Part1) :-
    read_file_to_string(In, S, []),
    split_string(S, "\n", "", Ss),
    maplist(check, Ss, Totals),
    sumlist(Totals, Part1).