path: root/day12.lisp

(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