aoc23/14/part2.pl

:- use_module(library(pio)).
:- use_module(library(clpfd)).
:- initialization(main, main).

main([FileName|_]) :-
    input(FileName, Input),
    rolls(Input, 0, [], First-Cycle-Hist),
    reverse(Hist, [_|TrueHist]),
    BillionOffset is ((999999999 - First) mod Cycle) + First,
    nth0(BillionOffset, TrueHist, BillionMap),
    % maplist({TrueHist}/[M]>>(
    %     nth0(Nth, TrueHist, M),
    %     map_weight(M, W),
    %     writef('Weight(%t) = %t\n', [Nth, W]),
    %     print(M)), TrueHist),
    write('======================\n'),
    print(BillionMap),
    map_weight(BillionMap, FinalWeight),
    writef('First = %t, Cycle = %t, FinalOffset = %t, Answer = %t\n',
           [First, Cycle, BillionOffset, FinalWeight]).

map_weight(Map, W) :- rotate(Map, Rotated), map_weight(Rotated, _, W).

map_weight([_], 0, 0).
map_weight([Row|Map], RowI, W) :-
    map_weight(Map, PrevRowI, PrevW),
    RowI is PrevRowI + 1,
    include(['O']>>(true), Row, Rocks),
    length(Rocks, NRocks),
    W is PrevW + RowI*NRocks.

rolls(Map, N, Hist, First-Cycle-Hist) :-
    match(Map, Hist, Cycle),
    First is N - Cycle - 1,
    !.
rolls(Map, N, Hist, X) :-
    roll(Map, NewMap),
    NextN is N + 1,
    NewHist = [Map|Hist],
    rolls(NewMap, NextN, NewHist, X).

match(Map, [Map|_], 1) :- !.
match(Map, [_|Entries], N) :-
    match(Map, Entries, NextN),
    N is NextN + 1.

% North is to the left
roll(Map, NewMap) :-
    concurrent_maplist(collapse, Map, NorthCollapsed),
    rotate(NorthCollapsed, West),
    concurrent_maplist(collapse, West, WestCollapsed),
    rotate(WestCollapsed, South),
    concurrent_maplist(collapse, South, SouthCollapsed),
    rotate(SouthCollapsed, East),
    concurrent_maplist(collapse, East, EastCollapsed),
    rotate(EastCollapsed, NewMap).

rotate(Map, NewMap) :-
    transpose(Map, X),
    concurrent_maplist(reverse, X, NewMap).

print(Map) :-
    rotate(Map, RotMap),
    append([[_|RealMap], [_]], RotMap),
    maplist([X]>>(
        append([_|Y], [_], X),
        atomics_to_string(Y, S),
        writef('%t\n', [S])), RealMap),
    write('\n').

collapse(Row, NewRow) :-
    phrase(rock_counts(Counts), Row),
    phrase(condense(Zs), Counts),
    phrase(reexpand(Zs), NewRow),
    true.

reexpand([]) --> eos.
reexpand([N-Next|Rocks]) --> ['#'], stack(N, Next), reexpand(Rocks).

stack(0, 0) --> [], !.
stack(0, Z) --> {NextZ is Z - 1}, ['.'], stack(0, NextZ), !.
stack(N, Z) --> {NextZ is Z - 1, NextN is N - 1}, ['O'], stack(NextN, NextZ).

condense([]) --> [0-0-0].
condense([N-Next|Rocks]) --> [0-I-I, N-z-Next], condense(Rocks), !.
condense(Rocks) --> [_-_-_], condense(Rocks).

rock_counts([0-0-0]) --> [].
rock_counts([LastN-I-LastZ, LastN-LastI-LastZ|Rocks]) -->
    ['.'], rock_counts([LastN-LastI-LastZ|Rocks]),
    {I is LastI + 1}.
rock_counts([N-I-LastZ, LastN-LastI-LastZ|Rocks]) -->
    ['O'], rock_counts([LastN-LastI-LastZ|Rocks]),
    {I is LastI + 1, N is LastN + 1}.
rock_counts([0-I-I, LastN-z-Len, LastN-LastI-LastZ|Rocks]) -->
    ['#'], rock_counts([LastN-LastI-LastZ|Rocks]),
    {I is LastI + 1, Len is I - LastZ - 1}.

% North is to the left
input(FileName, Input) :-
    phrase_from_file(lines(Raw), FileName),
    concurrent_maplist(pad, Raw, PaddedInput),
    concurrent_maplist(reverse, PaddedInput, Reversed),
    transpose(Reversed, Rotated),
    concurrent_maplist(pad, Rotated, Input).

pad(Row, Rowx) :- append(['#'|Row], ['#'], Rowx).

lines([]) --> eos, !.
lines([Line|Lines]) --> line(Line), lines(Lines).

line([]) --> "\n"; eos.
line(['O'|Chars]) --> "O", line(Chars).
line(['.'|Chars]) --> ".", line(Chars).
line(['#'|Chars]) --> "#", line(Chars).

eos([], []).