aoc18/day5.lisp -rw-r--r-- 1.6 KiB View raw
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
(in-package :aoc18)

(defparameter *alphabet* "abcdefghijklmnopqrstuvwxyz ")

(declaim (inline unit-react-p))
(defun unit-react-p (a b)
  (declare (optimize (speed 3) (safety 1))
	   (type standard-char a b))
  (and (not (eql a b))
       (eql (char-upcase a) (char-upcase b))))

(defun polymer-react-once (in)
  (declare (optimize (speed 3) (safety 1))
	   (type simple-string in))
  (loop for i fixnum from 0 below (- (length in) 1) do
       (when (unit-react-p (aref in i) (aref in (+ 1 i)))
	 (return-from polymer-react-once (cl-strings:replace-all in (format nil "~a~a" (aref in i) (aref in (+ 1 i))) ""))))
  in)

(defun find-fix-point (f start &optional (eq #'equal))
  (declare (optimize (speed 3) (safety 1))
	   (type function eq f))
  (let ((result (funcall f start)))
    (if (funcall eq start result)
	start
	(find-fix-point f result eq))))

(defun solve-day5-part1 (in)
  (let ((poly (find-fix-point #'polymer-react-once in)))
    (values (length poly) poly)))

(defun read-day5-input (path)
  (string-trim '(#\Space #\Newline #\Backspace #\Tab #\Linefeed #\Page #\Return #\Rubout) (file-string path)))

(test day5-part1
  (is (= 10638 (solve-day5-part1 (read-day5-input "day5.input")))))

(defun remove-unit (p u)
  (remove (char-upcase u) (remove u p)))

(defun solve-day5-part2 (p)
  (declare (optimize (speed 3)))
  (let ((preprocessed (nth-value 1 (solve-day5-part1 p))))
    (apply #'min (mapcar (lambda (u) (solve-day5-part1 (remove-unit preprocessed u))) (coerce *alphabet* 'list)))))

(test day5-part2
  (is (= 4944 (solve-day5-part2 (read-day5-input "day5.input")))))