commit b70c7b2a5c6627168ec3652c3841e54b97f55bc5
parent db0986abd6d2a985fff0dd0baa13c97a708a6b53
Author: Lukas Henkel <lh@entf.net>
Date: Fri, 6 Dec 2024 19:11:53 +0100
Optimize
Diffstat:
3 files changed, 67 insertions(+), 33 deletions(-)
diff --git a/src/day-4.lisp b/src/day-4.lisp
@@ -9,7 +9,7 @@
for new-point = (point+ point (cons (* nx m)
(* ny m)))
for cell = nil
- unless (point-in-bounds-p new-point map)
+ unless (point-in-map-p new-point map)
do (return 0)
do (setf cell (map-cell map new-point))
unless (char= cell char)
@@ -19,7 +19,7 @@
(defun mas-p (map point t-x)
(let ((ps (list (point+ point (cons t-x -1))
(point+ point (cons (* t-x -1) 1)))))
- (unless (every (rcurry #'point-in-bounds-p map) ps)
+ (unless (every (rcurry #'point-in-map-p map) ps)
(return-from mas-p nil))
(let ((cs (mapcar (curry #'map-cell map) ps)))
(and (member #\M cs)
diff --git a/src/day-6.lisp b/src/day-6.lisp
@@ -27,44 +27,72 @@
(:down :left)
(:left :up)))
-(defun walk-map (map pos)
+(declaim (ftype (function (fixnum fixnum) (simple-array t (* * 4))) make-visited-cache))
+(defun make-visited-cache (width height)
+ (make-array (list width height 4)
+ :initial-element nil))
+
+(declaim (inline visited-p
+ (setf visited-p)))
+
+(defun visited-p (cache point dir)
+ (destructuring-bind (x . y) point
+ (aref cache x y (ecase dir
+ (:up 0)
+ (:left 1)
+ (:right 2)
+ (:down 3)))))
+
+(defun (setf visited-p) (new-value cache point dir)
+ (destructuring-bind (x . y) point
+ (setf (aref cache x y (ecase dir
+ (:up 0)
+ (:left 1)
+ (:right 2)
+ (:down 3)))
+ new-value)))
+
+(defun walk-map (map pos &optional check-loops)
(loop with dir = :up
- with visited = (list pos)
- with visited-dir = (make-hash-table :test #'equal)
with map-width = (input-map-width map)
with map-height = (input-map-height map)
- with in-bounds-p = (lambda (point)
- (and (>= (point-x point) 0)
- (>= (point-y point) 0)
- (< (point-x point) map-width)
- (< (point-y point) map-height)))
- while (funcall in-bounds-p pos)
- when (gethash (cons pos dir) visited-dir)
+ with visited-dir = (make-visited-cache map-width map-height)
+ with visited = (make-array (list map-width map-height)
+ :initial-element nil)
+ with count-visited fixnum = 0
+ while (point-in-bounds-p pos map-width map-height)
+ when (and check-loops (visited-p visited-dir pos dir))
do (return :loop)
- do (setf (gethash (cons pos dir) visited-dir) t
- pos (loop with next = (next pos dir)
- while (and (funcall in-bounds-p next)
+ when check-loops
+ do (setf (visited-p visited-dir pos dir) t)
+ do (destructuring-bind (x . y) pos
+ (unless (aref visited x y)
+ (incf count-visited)
+ (setf (aref visited x y) t)))
+ (setf pos (loop with next = (next pos dir)
+ while (and (point-in-bounds-p next map-width map-height)
(char= (map-cell map next) #\#))
do (setf dir (turn dir)
next (next pos dir))
finally (return next)))
- (push pos visited)
- finally (return (remove-duplicates (cdr visited) :test #'equal))))
+ finally (return (values count-visited visited))))
(defun task-2 (map initial-pos visited)
(loop with task-2 = 0
- for point in visited
- for cell = (map-cell map point)
- when (char= cell #\.)
- do (setf (map-cell map point) #\#)
- (when (eq (walk-map map initial-pos) :loop)
- (incf task-2))
- (setf (map-cell map point) #\.)
+ for x from 0 below (input-map-width map)
+ do (loop for y from 0 below (input-map-height map)
+ for point = (cons x y)
+ when (and (aref visited x y)
+ (char= (map-cell map point) #\.))
+ do (setf (map-cell map point) #\#)
+ (when (eq (walk-map map initial-pos t) :loop)
+ (incf task-2))
+ (setf (map-cell map point) #\.))
finally (return task-2)))
(defun day-6 (input)
(let* ((map (make-map input))
- (pos (find-guard map))
- (visited (walk-map map pos)))
- (values (length visited)
- (task-2 map pos visited))))
+ (pos (find-guard map)))
+ (multiple-value-bind (task-1 visited)
+ (walk-map map pos)
+ (values task-1 (task-2 map pos visited)))))
diff --git a/src/utils.lisp b/src/utils.lisp
@@ -21,6 +21,7 @@
#:point-x
#:point-y
#:point-in-bounds-p
+ #:point-in-map-p
#:*map-neighbours*
#:point-neighbours
#:manhattan-distance
@@ -136,11 +137,16 @@
(the fixnum (- (point-y point-a)
(point-y point-b)))))
-(defun point-in-bounds-p (point map)
- (and (>= (point-x point) 0)
- (>= (point-y point) 0)
- (< (point-x point) (input-map-width map))
- (< (point-y point) (input-map-height map))))
+(declaim (inline point-in-bounds-p point-in-map-p))
+(defun point-in-bounds-p (point width height)
+ (destructuring-bind (x . y) point
+ (and (>= x 0) (>= y 0)
+ (< x width) (< y height))))
+
+(defun point-in-map-p (point map)
+ (point-in-bounds-p point
+ (input-map-width map)
+ (input-map-height map)))
(declaim (inline map-cell map-integer-at (setf map-cell))
(ftype (function (input-map cons) character) map-cell)
