aoc2021 day9

aoc2021-day9.lisp

;;;; +----------------------------------------------------------------+
;;;; | Advent of Code 2021                                            |
;;;; +----------------------------------------------------------------+

(defpackage #:snippets/aoc2021/day9
  (:use #:cl)
  (:export
   #:day9))

(in-package #:snippets/aoc2021/day9)

(defun make-heightmap (lines)
  (coerce lines 'vector))

(defun rows (heightmap)
  (length heightmap))

(defun cols (heightmap)
  (length (aref heightmap 0)))

(defun get-height (heightmap location)
  (digit-char-p (aref (aref heightmap (realpart location)) (imagpart location))))

(defun out-of-bounds-p (heightmap location)
  (let ((i (realpart location))
        (j (imagpart location)))
    (or (minusp i)
        (minusp j)
        (>= i (rows heightmap))
        (>= j (cols heightmap)))))

(defun neighbors (heightmap location)
  (loop for direction in '(#C(-1 0) #C(+1 0) #C(0 -1) #C(0 +1))
        for neighbor = (+ location direction)
        unless (out-of-bounds-p heightmap neighbor)
        collect neighbor))

(defun low-point-p (heightmap location)
  (every (lambda (neighbor)
           (< (get-height heightmap location)
              (get-height heightmap neighbor)))
         (neighbors heightmap location)))

(defun find-basin-size (heightmap low-point-location)
  (let ((visited (make-hash-table))
        (agenda (list low-point-location))
        (size 0))
    (loop until (null agenda)
          do (let ((location (pop agenda)))
               (unless (gethash location visited)
                 (setf (gethash location visited) t)
                 (when (< (get-height heightmap location) 9)
                   (incf size)
                   (dolist (neighbor (neighbors heightmap location))
                     (unless (gethash neighbor visited)
                       (when (>= (get-height heightmap neighbor)
                                 (get-height heightmap location))
                         (push neighbor agenda))))))))
    size))

(defun find-low-points (heightmap)
  (let ((low-points '()))
    (dotimes (i (rows heightmap))
      (dotimes (j (cols heightmap))
        (let ((location (complex i j)))
          (when (low-point-p heightmap location)
            (push (list (get-height heightmap location)
                        (find-basin-size heightmap location))
                  low-points)))))
    low-points))

(defun risk-level (low-point)
  (1+ (first low-point)))

(defun sum-risk-levels (low-points)
  (reduce #'+ low-points :key #'risk-level))

(defun basin-size (low-point)
  (second low-point))

(defun multiply-largest-basin-sizes (low-points n)
  (reduce #'* (sort (mapcar #'basin-size low-points) #'>) :end n))

(defun day9 (input)
  (let ((low-points (find-low-points (make-heightmap input))))
    (list (sum-risk-levels low-points)
          (multiply-largest-basin-sizes low-points 3))))