day-12.lisp (2894B)
1 (defpackage #:aoc/day-12 2 (:use #:cl #:aoc/utils) 3 (:export 4 #:possible-arrangements 5 #:day-12)) 6 (in-package #:aoc/day-12) 7 8 (defun parse-line (line) 9 (let* ((space-pos (position #\Space line)) 10 (springs (subseq line 0 space-pos)) 11 (groups (read-number-list line :start (1+ space-pos)))) 12 (values springs groups))) 13 14 (defun possible-arrangements (springs groups) 15 (let ((cache (make-hash-table))) 16 (labels ((next (springs groups current-group-length) 17 (when (null springs) 18 (when (if groups 19 (and (= (length groups) 1) 20 (= (car groups) current-group-length)) 21 (= current-group-length 0)) 22 (return-from next 1)) 23 (return-from next 0)) 24 (let ((current (car springs)) 25 (not-in-group (= current-group-length 0)) 26 (group-filled? (and groups 27 (= (car groups) current-group-length))) 28 (count 0)) 29 (when group-filled? 30 (pop groups)) 31 (cond 32 ((char= current #\.) 33 (when (or not-in-group group-filled?) 34 (incf count (next-cache (cdr springs) groups 0)))) 35 ((char= current #\#) 36 (unless group-filled? 37 (incf count (next-cache (cdr springs) groups (1+ current-group-length))))) 38 ((char= current #\?) 39 (when (or not-in-group group-filled?) 40 (incf count (next-cache (cdr springs) groups 0))) 41 (unless group-filled? 42 (incf count (next-cache (cdr springs) groups (1+ current-group-length)))))) 43 count)) 44 (next-cache (springs groups current-group-length) 45 (let ((key (logior (ash (length springs) 16) 46 (ash (length groups) 8) 47 current-group-length))) 48 (or (gethash key cache) 49 (setf (gethash key cache) 50 (next springs groups current-group-length)))))) 51 (next-cache springs groups 0)))) 52 53 (defun day-12 (input) 54 (loop with task-1 = 0 55 with task-2 = 0 56 for line = (read-line input nil) 57 while line 58 do (multiple-value-bind (springs groups) 59 (parse-line line) 60 (incf task-1 (possible-arrangements (coerce springs 'list) groups)) 61 (incf task-2 (possible-arrangements (coerce (string-join (loop repeat 5 collect springs) #\?) 62 'list) 63 (loop repeat 5 append groups)))) 64 finally (return (values task-1 task-2))))