d25p1

25/part1.pl

@@ -0,0 +1,91 @@
+% This needs more stack. Try --stack_limit=4G
+:- use_module(library(pio)).
+:- use_module(library(dcg/basics)).
+:- initialization(main, main).
+
+main([FileName|_]) :-
+    input(FileName, Conns),
+    dict_pairs(Conns, _, ConnsList),
+    length(ConnsList, NNodes),
+    findnsols(
+        1, PartitionSize, (
+            _ = Conns.StartNode,
+            iterate(StartNode, EndNode, Conns, _),
+            atom_length(EndNode, NodeSize3),
+            PartitionSize is NodeSize3 / 3),
+        [Side1]),
+    Side2 is NNodes - Side1,
+    Answer is Side1*Side2,
+    write(Answer), nl.
+
+iterate(Node, Node, Graph, Graph) :- length(Graph.Node, 3), !.
+iterate(Node0, Node, Graph0, Graph) :-
+    countall(Graph0.Node0, NeighborCounts),
+    NeighborCounts = [_-Max|_],
+    member(Neighbor-Max, NeighborCounts),
+    combine(Node0, Neighbor, Node1, Graph0, Graph1),
+    iterate(Node1, Node, Graph1, Graph).
+    
+% combine 2 nodes into one, keep all outbound connections
+combine(Node1, Node2, Node12, Graph0, Graph) :-
+    % delete N1 -> N2's and N2 -> N1's
+    del_dict(Node1, Graph0, OldN1Outs, Graph1),
+    del_dict(Node2, Graph1, OldN2Outs, Graph2),
+    remove_all(Node2, OldN1Outs, N1Outs),
+    remove_all(Node1, OldN2Outs, N2Outs),
+    % replace N1 -> X and N2 -> Y with N12 -> [X|Y]
+    atom_concat(Node1, Node2, Node12),
+    append(N1Outs, N2Outs, N12Outs),
+    Graph3 = Graph2.put(Node12, N12Outs),
+    % replace X -> N1 or X -> N2 with X -> N12 (twice if needed)
+    foldl(replace_outbound_node(Node1, Node12), N1Outs, Graph3, Graph4),
+    foldl(replace_outbound_node(Node2, Node12), N2Outs, Graph4, Graph).
+
+replace_outbound_node(Node1, Node2, Node, Graph0, Graph) :-
+    replace_all(Node1, Graph0.Node, Node2, NewList),
+    Graph = Graph0.put(Node, NewList).
+
+% List has all items in List but with all ItemOut instances replaced with ItemIn
+replace_all(_, [], _, []).
+replace_all(ItemOut, [ItemOut|List0], ItemIn, [ItemIn|List]) :-
+    replace_all(ItemOut, List0, ItemIn, List).
+replace_all(ItemOut, [X|List0], ItemIn, [X|List]) :-
+    \+ X = ItemOut,
+    replace_all(ItemOut, List0, ItemIn, List).
+
+remove_all(_, [], []).
+remove_all(X, [X|List], ListOut) :- remove_all(X, List, ListOut).
+remove_all(X, [Y|List], [Y|ListOut]) :- \+ X = Y, remove_all(X, List, ListOut).
+    
+% countall means Counts is pairs of Item-Count where Item in List, sorted >
+countall(List, Counts) :-
+    foldl(increment, List, count{}, CountsMap),
+    dict_pairs(CountsMap, _, CountsList),
+    sort(2, @>=, CountsList, Counts).
+
+increment(X, Ns0, Ns) :- Next is Ns0.get(X, 0) + 1, Ns = Ns0.put(X, Next).
+    
+% input parsing stuff below.
+input(FileName, Conns) :-
+    phrase_from_file(conns(ConnsList), FileName),
+    to_bidi_graph(ConnsList, Conns).
+
+conns([]) --> eos, !.
+conns([From-Tos|Conns]) --> node(From), ": ", tos(Tos), conns(Conns).
+tos([To]) --> node(To), "\n".
+tos([To|Tos]) --> node(To), " ", tos(Tos).
+node(Node) --> string_without(": \n", NodeStr), {atom_codes(Node, NodeStr)}.
+
+to_bidi_graph(ConnsList, BidiConnsGraph) :-
+    dict_pairs(Graph0, conn, ConnsList),
+    foldl(add_reverse_conns_for, ConnsList, Graph0, BidiConnsGraph).
+
+add_reverse_conns_for(Node-Outbounds, Conns0, Conns1) :-
+    foldl(add_conn(Node), Outbounds, Conns0, Conns1).
+
+add_conn(ToNode, FromNode, Conns0, Conns1) :-
+    Current = Conns0.get(FromNode, []),
+    Conns1 = Conns0.put(FromNode, [ToNode|Current]).
+
+% debug
+print(Graph) :- dict_pairs(Graph, _, Lines), maplist(format('~w~n'), Lines).

25/test.txt

@@ -0,0 +1,13 @@
+jqt: rhn xhk nvd
+rsh: frs pzl lsr
+xhk: hfx
+cmg: qnr nvd lhk bvb
+rhn: xhk bvb hfx
+bvb: xhk hfx
+pzl: lsr hfx nvd
+qnr: nvd
+ntq: jqt hfx bvb xhk
+nvd: lhk
+lsr: lhk
+rzs: qnr cmg lsr rsh
+frs: qnr lhk lsr