advent-of-code-2024

My solutions to AoC 2024
Log | Files | Refs

day-12.lisp (2974B)


      1 (defpackage #:aoc/day-12
      2   (:use #:cl #:aoc/utils)
      3   (:export #:day-12))
      4 (in-package #:aoc/day-12)
      5 
      6 (defparameter *neighbour-diffs* '((0 . -1) (-1 . 0) (1 . 0) (0 . 1)))
      7 
      8 (defun walk-line (pos-1 pos-2 positions visited diff)
      9   (loop for current-1 = (point+ (or current-1 pos-1) diff)
     10         for current-2 = (point+ (or current-2 pos-2) diff)
     11         for set = (list current-1 current-2)
     12         while (and (gethash set positions)
     13                    (not (gethash set visited)))
     14         do (setf (gethash set visited) t)))
     15 
     16 (defun find-straight-fences (positions)
     17   (loop with visited = (make-hash-table :test #'equal)
     18         with fences = 0
     19         for set being the hash-key of positions
     20         for diffs = (if (= (point-x (point- (first set) (second set))) 0)
     21                         '((-1 . 0) (1 . 0))
     22                         '((0 . -1) (0 . 1)))
     23         do (unless (gethash set visited)
     24              (loop for diff in diffs
     25                    do (walk-line (first set) (second set) positions visited diff))
     26              (incf fences)
     27              (setf (gethash set visited) t))
     28         finally (return fences)))
     29 
     30 (defun region-properties (map point visited width height)
     31   (setf (gethash point visited) t)
     32   (loop with plant = (map-cell map point)
     33         with fences = 0
     34         with fence-positions = (make-hash-table :test #'equal)
     35         with todo = (list point)
     36         with area = 0
     37         while todo
     38         for current = (pop todo)
     39         do (incf area)
     40            (loop for neighbour-diff in *neighbour-diffs*
     41                  for neighbour = (point+ current neighbour-diff)
     42                  for in-bounds = (point-in-bounds-p neighbour width height)
     43                  for neighbour-plant = (and in-bounds (map-cell map neighbour))
     44                  do (if (and in-bounds (char= plant neighbour-plant))
     45                         (unless (gethash neighbour visited)
     46                           (push neighbour todo)
     47                           (setf (gethash neighbour visited) t))
     48                         (progn
     49                           (incf fences)
     50                           (setf (gethash (list current neighbour) fence-positions) t))))
     51         finally (return (values area fences (find-straight-fences fence-positions)))))
     52 
     53 (defun day-12 (input)
     54   (loop with map = (make-map input)
     55         with visited = (make-hash-table :test #'equal)
     56         with cost-1 = 0
     57         with cost-2 = 0
     58         with width = (input-map-width map)
     59         with height = (input-map-height map)
     60         for y from 0 below height
     61         do (loop for x from 0 below width
     62                  for point = (cons x y)
     63                  unless (gethash point visited)
     64                    do (multiple-value-bind (area fences straight-fences)
     65                           (region-properties map point visited width height)
     66                         (incf cost-1 (* area fences))
     67                         (incf cost-2 (* area straight-fences))))
     68         finally (return (values cost-1 cost-2))))