day-23.lisp (2932B)
1 (defpackage #:aoc/day-23 2 (:use #:cl #:aoc/utils) 3 (:export #:day-23)) 4 (in-package #:aoc/day-23) 5 6 (defstruct computer 7 name 8 connected) 9 10 (defun computer-connected-length (computer) 11 (length (computer-connected computer))) 12 13 (defun parse-computers (input) 14 (loop with computers = (make-hash-table :test #'equal) 15 for line = (read-line input nil) 16 until (null line) 17 for dash = (position #\- line) 18 for n-1 = (subseq line 0 dash) 19 for n-2 = (subseq line (1+ dash)) 20 for c-1 = (ensure-gethash n-1 computers (make-computer :name n-1)) 21 for c-2 = (ensure-gethash n-2 computers (make-computer :name n-2)) 22 do (pushnew c-1 (computer-connected c-2)) 23 (pushnew c-2 (computer-connected c-1)) 24 finally (return (hash-table-values computers)))) 25 26 (defun clique-equal (clique-1 clique-2) 27 (and (length= clique-1 clique-2) 28 (length= clique-1 (intersection clique-1 clique-2)))) 29 30 (defun find-cliques (computers) 31 (labels ((%pivot (p x) 32 (let ((all (union p x))) 33 (first (sort all #'> :key #'computer-connected-length)))) 34 (%bron-kerbosch2 (r p x) 35 (if (and (null p) (null x)) 36 (list r) 37 (loop with u = (%pivot p x) 38 for v in (set-difference p (computer-connected u)) 39 for c = (computer-connected v) 40 nconc (%bron-kerbosch2 41 (cons v r) 42 (intersection c p) 43 (intersection c x)))))) 44 (remove-duplicates (%bron-kerbosch2 nil computers nil) :test #'clique-equal))) 45 46 (defun possible-historian-computer-p (computer) 47 (string-prefix-p "t" (computer-name computer))) 48 49 (defun password (computers) 50 (format nil "~{~A~^,~}" (sort (mapcar #'computer-name computers) #'string<))) 51 52 (defun day-23 (input) 53 (loop with computers = (parse-computers input) 54 with seen = (make-hash-table :test #'equal) 55 with task-1 = 0 56 with largest-clique-length = 0 57 with largest-clique = nil 58 for clique in (find-cliques computers) 59 for clique-length = (length clique) 60 when (>= clique-length 3) 61 do (map-combinations (lambda (combo) 62 (setf combo (sort combo #'string< :key #'computer-name)) 63 (when (and (not (gethash combo seen)) 64 (some #'possible-historian-computer-p combo)) 65 (incf task-1) 66 (setf (gethash combo seen) t))) 67 clique 68 :length 3) 69 when (> clique-length largest-clique-length) 70 do (setf largest-clique-length clique-length 71 largest-clique clique) 72 finally (return (values task-1 (password largest-clique)))))