You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
92 lines
2.9 KiB
92 lines
2.9 KiB
#+title: Solution to p23 |
|
|
|
* Solution |
|
Load links as a cons list; in hindsight, we could just load them as |
|
a list of pairs, but heh… |
|
|
|
#+begin_src emacs-lisp :results none |
|
(require 'dash) |
|
(with-temp-buffer |
|
(insert-file-contents "input") |
|
(goto-char (point-min)) |
|
(advent/replace-multiple-regex-buffer |
|
'(("^\\(.*\\)-\\(.*\\)$" . "(\"\\1\" . \"\\2\")"))) |
|
(insert "(setq data-asym '(") |
|
(goto-char (point-max)) |
|
(insert "))") |
|
(eval-buffer)) |
|
|
|
(setq data (--mapcat (list it (cons (cdr it) (car it))) data-asym) |
|
computer-list (-distinct (-map #'car data))) |
|
#+end_src |
|
|
|
The following is for part 1 |
|
#+begin_src emacs-lisp |
|
(defun triples (dataset) |
|
(-distinct |
|
(--map (-sort #'string< it) |
|
(-mapcat (lambda (pair) |
|
(--map (list (car pair) (cdr pair) it) |
|
(-intersection (neighbours (car pair)) |
|
(neighbours (cdr pair))))) |
|
dataset)))) |
|
|
|
(defun neighbours (computer) |
|
(-map #'cdr (--filter (string= (car it) computer) data))) |
|
|
|
(defun good-computer-p (s) |
|
(string-match-p "t." s) |
|
) |
|
|
|
(defun good-link-p (link) |
|
(or (good-computer-p (car link)) |
|
(good-computer-p (cdr link)))) |
|
|
|
(length (triples (-filter #'good-link-p data-asym))) |
|
#+end_src |
|
|
|
#+RESULTS: |
|
: 1218 |
|
|
|
This one is an auxiliary function that plays well with unfold |
|
#+begin_src emacs-lisp :results none |
|
(defun split (l) |
|
(when l (cons l l))) |
|
#+end_src |
|
|
|
This is a rather ad-hoc function: takes a list of sets and returns a |
|
list of disjoint sets such that each set in the original list |
|
intersects with one set in the returned list. |
|
#+begin_src emacs-lisp |
|
(defun disjoint-core (clusters) |
|
(let ((remove-list (car clusters)) |
|
(remainder (cdr clusters))) |
|
(when remove-list |
|
(cons remove-list |
|
(disjoint-core (--remove |
|
(-intersection it remove-list) |
|
remainder)))))) |
|
#+end_src |
|
|
|
This is the core of part 2: it is an inductive procedure. We start |
|
from a set of clusters of rank n and we find all clusters of rank n+1 |
|
that intersect those clusters; we can iterate starting from links and |
|
eventually we will get to the top cluster. In order to optimize the |
|
induction, at each step we can only work with a disjoint core of |
|
clusters the clusters obtained at the previous step |
|
#+begin_src emacs-lisp |
|
(defun grow-clusters (dataset) |
|
(disjoint-core |
|
(-mapcat (lambda (cluster) |
|
(--map (cons it cluster) |
|
(-reduce #'-intersection |
|
(-map #'neighbours cluster)))) |
|
dataset))) |
|
|
|
(setq links (disjoint-core (--map (list (car it) (cdr it)) data-asym)) |
|
poly-sequence (--unfold (split (grow-clusters it)) links)) |
|
; |
|
(mapconcat #'identity |
|
(-sort #'string< (car (-last-item poly-sequence))) |
|
",") |
|
#+end_src
|
|
|