aoc18/day12.lisp -rw-r--r-- 3.9 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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
(in-package :aoc18)

(defun parse-plants (str &optional (offset 0))
  (let ((state (make-hash-table :test #'equal)))
    (loop for x from 0 below (length str) do
	 (when (equal #\# (aref str x))
	   (setf (gethash (- x offset) state) #\#)))
    state))

(defun parse-plant-rule (in)
  (cl-ppcre:register-groups-bind (req prod) ("(.*) => (.*)" in)
    (cons req (aref prod 0))))

(defun parse-day12-input (in)
  (let* ((lines (remove "" (read-lines in) :test #'equal))
	 (init (parse-plants (subseq (car lines) 15)))
	 (rules-list (mapcar #'parse-plant-rule (cdr lines)))
	 (rules (make-hash-table :test #'equalp)))
    (loop for r in rules-list do
	 (when (equalp #\# (cdr r))
	   (setf (gethash (car r) rules) (cdr r))))
    (list init rules)))

(defun get-plant-area (state idx)
  (let ((area '()))
    (coerce  (loop for x from (- idx 2) to (+ idx 2) collecting (gethash x state #\.)) 'string)))

(defun plant-state-to-string (state)
  (let* ((min (- (loop for k being the hash-key of state minimizing k) 5))
	 (max (+ (loop for k being the hash-key of state maximizing k) 6))
	 (str (make-string (+ (abs min) (abs max)) :initial-element #\.)))
    (loop for idx being the hash-key of state do
	 (setf (aref str (+ idx (abs min))) #\#))
    str))

(defun find-all-str (where what)
  (let ((found '())
	(start 0))
    (loop
       (let ((pos (search what where :start2 start)))
	 (if pos
	     (progn
	       (push pos found)
	       (setf start (1+ pos)))
	     (return))))
    (reverse found)))

(defun plant-grow-turn (state rules)
  (let ((new-state (make-hash-table :test #'equalp))
	(min (- (loop for k being the hash-key of state minimizing k) 5))
	(state-str (plant-state-to-string state)))
  ; (format t "min: ~a~%" min)
   ; (format t "start state: ~a~%" state-str)
    (loop for pattern being the hash-key of rules using (hash-value prod) do
	 (when (equalp prod #\#)

	   (let ((found (find-all-str state-str pattern)))
	     (when found
	 ;      (format t "rule ~a: ~a~%" pattern found)
	       (loop for idx in found do
		    (setf (gethash (- (+ idx 2) (abs min)) new-state) #\#))))))
    new-state))

(defun plant-near (id state)
  (coerce (loop for i from (- id 2) to (+ id 2) collecting (gethash i state #\.)) 'string))

(defun plant-grow-turn2 (state rules)
  (declare (optimize (speed 3) (safety 1)))
  (let ((new-state (make-hash-table :test #'equalp)))
    (loop for plant fixnum being the hash-key of state do
	 (loop for id fixnum from (- plant 2) to (+ plant 2) do
	      (let ((area (plant-near id state)))
		;(format t "checking '~a' in rules~%" area)
		(when (equalp #\# (gethash area rules #\.))
		  (setf (gethash id new-state) #\#)))))
    new-state))

(defun tmp (state)
  (sort (loop for i being the hash-key of state collecting i) #'<))

(defun score (state)
  (loop for idx being the hash-key of state summing idx))

(defun plant-grow-many-turns (state rules turns)
 ; (format t "state 0: ~a~%" (plant-state-to-string state))
  (let ((curent state)
	(prev 0)
	(delta 0))
    (loop for x from 0 below turns do
	 (let ((new-state (plant-grow-turn2 curent rules)))
	   (setf curent new-state)
	   (let* ((s (score curent))
		 (d (- s prev)))
	  ;   (format t "score ~a: ~a (~a) ~%" (1+ x) s d)
	     (setf prev s)
	     (setf delta d))
	   ;(format t "~a~%" (tmp curent))
	 
	   ;(format t "score ~a; state ~a: ~a~%~%"	   (loop for idx being the hash-key of curent summing idx)		   (1+ x) (plant-state-to-string curent))
	   ))
    ;(print-hash curent)
    (values (score curent) delta)))

;; 10985 to high

(defun solve-day12-part1 (input)
  (plant-grow-many-turns (car input) (cadr input) 20))

(defun big-score (n input)
  (multiple-value-bind (s d) (plant-grow-many-turns (car input) (cadr input) 1000)
    (+ s (* (- n 1000) d))))

(defun solve-day12-part2 (input)
  (big-score 50000000000 input))

(test day12-part1
  (is (= 3793 (solve-day12-part1 (parse-day12-input "day12.input")))))

(test day12-part2
  (is (= 4300000002414 (solve-day12-part2 (parse-day12-input "day12.input")))))