day12

1 files changed, 70 insertions, 0 deletions

diff --git a/day12.lisp b/day12.lisp
new file mode 100644
index 0000000..e2b1801
--- /dev/null
+++ b/day12.lisp
@@ -0,0 +1,70 @@
+(defun read-lines (filespec)
+  (with-open-file (stream filespec)
+    (loop for line = (read-line stream nil)
+          while line
+          collect line)))
+
+(defun parse-integers (string &key (start 0))
+  (loop for i = start then (1+ (cadr o))
+        while (< i (length string))
+        as o = (multiple-value-list (parse-integer string :start i :junk-allowed t))
+        as n = (car o)
+        while n
+        collect n))
+
+(defun repeat-string (n string &optional sep)
+  (with-output-to-string (stream)
+    (loop for i from 1 upto n
+          do (write-string string stream)
+          if (and sep (< i n))
+            do (write-string sep stream))))
+
+(defun repeat-groups (n groups)
+  (loop repeat n append groups))
+
+(defun solve-line (line &key (nfolds 1))
+  (let* ((p (position #\Space line))
+         (springs (subseq line 0 p))
+         (groups (parse-integers line :start (1+ p)))
+         (dptab (make-hash-table :test #'equalp)))
+    (labels ((f (springs groups &optional (start 0) group)
+               (let ((dpkey (list start group (length groups))))
+                 (multiple-value-bind (val found-p)
+                     (gethash dpkey dptab)
+                 (if found-p val
+                     (setf (gethash dpkey dptab)
+                           (if (>= start (length springs))
+                               (if (or groups (and group (/= group 0))) 0 1)
+                               (let ((c (aref springs start)))
+                                 (cond ((equal c #\.)
+                                        (if (and group (> group 0)) 0
+                                            (f springs groups (1+ start))))
+                                       ((equal c #\#)
+                                        (if group
+                                            (if (= group 0) 0
+                                                (f springs groups (1+ start) (1- group)))
+                                            (if (not groups) 0
+                                                (f springs (cdr groups) (1+ start) (1- (car groups))))))
+                                       ((equal c #\?)
+                                        (if group
+                                            (if (= group 0)
+                                                (f springs groups (1+ start))
+                                                (f springs groups (1+ start) (1- group)))
+                                            (if groups
+                                                (+ (f springs (cdr groups) (1+ start) (1- (car groups)))
+                                                   (f springs groups (1+ start)))
+                                                (f springs groups (1+ start))))))))))))))
+      (f (repeat-string nfolds springs "?") (repeat-groups nfolds groups)))))
+
+(defun solve1 (filespec)
+  (let ((lines (read-lines filespec)))
+    (reduce #'+ (mapcar #'solve-line lines))))
+
+(defun solve2 (filespec)
+  (let ((lines (read-lines filespec)))
+    (loop for line in lines sum (solve-line line :nfolds 5))))
+
+(print (solve1 "data/12/example.txt"))  ;; 21
+(print (solve1 "data/12/input.txt"))    ;; 6871
+(print (solve2 "data/12/example.txt"))  ;; 525152
+(print (solve2 "data/12/input.txt"))    ;; 2043098029844