08-word-chains/day8.pl

   1 #!/usr/bin/env swipl
   2
   3 :- initialization(main).
   4 :- dynamic neighbours/2.
   5
   6 build_rooms:-
   7     get_rooms(Rooms),
   8     build_neighbours(Rooms).
   9
  10 get_rooms(Rooms):-
  11     setup_call_cleanup(
  12         open('08-rooms.txt', read, In),
  13         read_data(In, Rooms),
  14         close(In)
  15     ).
  16
  17
  18 read_data(In, L):-
  19     read_line_to_codes(In, H),
  20     (   H == end_of_file
  21     ->  L = []
  22     ;   L = [H|T],
  23         read_data(In,T)
  24     ).
  25
  26
  27 alphabet_codes(A):-
  28     string_codes('abcdefghijklmnopqrstuvwxyz', A).
  29
  30 adjacent(Word, Adjacents):-
  31     length(Word, N),
  32     adjacent(N, Word, Adjacents).
  33
  34 adjacent(N, Word, SAdjacents):-
  35     (N = 0 -> Adjacents = []
  36     ;
  37     swap_char(N, Word, NWords),
  38     N1 is N - 1,
  39     adjacent(N1, Word, RAdjacents),
  40     append(NWords, RAdjacents, Adjacents)),
  41     list_to_ord_set(Adjacents, SAdjacents).
  42
  43 swap_char(N, Word, Swapped):-
  44     alphabet_codes(As),
  45     setof(W,
  46         A^(member(A, As),
  47             nth1(N, Word, L, Rest),
  48             L \= A,
  49             nth1(N, W, A, Rest)),
  50         Swapped).
  51
  52 build_neighbours(Words):-
  53     build_neighbours(Words, Words).
  54
  55 build_neighbours([], _).
  56 build_neighbours([Word|Words], Dictionary):-
  57     adjacent(Word, Adjacents),
  58     intersection(Adjacents, Dictionary, Neighbours),
  59     string_codes(SWord, Word),
  60     maplist(string_codes, SNeighbours, Neighbours),
  61     assertz((neighbours(SWord, SNeighbours):-!)), % Need the cut to keep lookup deterministic in this dynamic predicate
  62     build_neighbours(Words, Dictionary).
  63
  64
  65
  66
  67 extend([W|Chain], Closed, Extended):-
  68     neighbours(W, Ns),
  69     ord_subtract(Ns, Closed, Successors),
  70     extend_chain(Successors, [W|Chain], Extended).
  71
  72 extend_chain([], _, []).
  73 extend_chain([N|Ns], Chain, [[N|Chain]|Extended]):-
  74     extend_chain(Ns, Chain, Extended).
  75
  76
  77 distance([], _, 0).
  78 distance([C|Cs], [O|Os], N):-
  79     (   C == O
  80     ->  distance(Cs, Os, N)
  81     ;   distance(Cs, Os, N1),
  82         N is N1 + 1).
  83
  84 estimated_costed([W|C], Goal, N-[W|C]):-
  85     length([W|C], N1),
  86     string_codes(W, Cs),
  87     distance(Cs, Goal, N2),
  88     N is N1 + N2.
  89
  90 estimated_costed_all([], _, []).
  91 estimated_costed_all([C|Cs], Goal, [A|As]):-
  92     estimated_costed(C, Goal, A),
  93     estimated_costed_all(Cs, Goal, As).
  94
  95
  96 astar(Start, SGoal, Path):-
  97     string_codes(SGoal, Goal),
  98     estimated_costed([Start], Goal, Costed),
  99     astar([Costed], SGoal, Goal, [], Path).
 100
 101 astar([], _, _, []).
 102 astar([_-Current|Agenda0], SGoal, Goal, Closed0, FoundPath):-
 103     %% write_ln([N-Current, SGoal, Goal]),
 104     (   Current = [W|_],
 105         W == SGoal
 106     ->  FoundPath = Current
 107     ;   [Word|_] = Current,
 108         ord_add_element(Closed0, Word, Closed),
 109         extend(Current, Closed, Extended),
 110         estimated_costed_all(Extended, Goal, ExtraAgenda),
 111         append(ExtraAgenda, Agenda0, Agenda1),
 112         keysort(Agenda1, Agenda),
 113         astar(Agenda, SGoal, Goal, Closed, FoundPath)
 114     ).
 115
 116
 117 reachable(Word, Steps, N):-
 118     reachable(Steps, [Word], [Word], Reachable),
 119     length(Reachable, ReachableN),
 120     N is ReachableN - 1.
 121
 122
 123 reachable(N, Found0, Boundary0, Reachable):-
 124     (   N == 0
 125     ->  Reachable = Found0
 126     ;   maplist(neighbours, Boundary0, FoundL),
 127         flatten(FoundL, Found1),
 128         list_to_ord_set(Found1, Boundary1),
 129         ord_subtract(Boundary1, Found0, Boundary),
 130         ord_union(Found0, Boundary, Found),
 131         N1 is N - 1,
 132         reachable(N1, Found, Boundary, Reachable)
 133     ).
 134
 135 main(_Argv):-
 136     time(build_rooms),
 137     time(astar("coax", "stay", P)),
 138     length(P, Part1),
 139     time(reachable("coax", 10, Part2)),
 140
 141     writef('Part 1: %w steps from coax to stay\n', [Part1]),
 142     writef('Part 2: %w rooms reacable in 10 steps from coax\n', [Part2]).