142 lines
5.0 KiB
Common Lisp
142 lines
5.0 KiB
Common Lisp
;; https://adventofcode.com/2022/day/22
|
|
|
|
(defpackage :day-22
|
|
(:use :cl))
|
|
(in-package :day-22)
|
|
|
|
(ql:quickload 'alexandria)
|
|
(ql:quickload 'fiveam)
|
|
(ql:quickload 'cl-ppcre)
|
|
|
|
(5am:def-suite :day-22-test)
|
|
|
|
(defun read-map-to-array (filename)
|
|
(let* ((lines (uiop:read-file-lines filename))
|
|
(rows (length lines))
|
|
(cols (apply #'max (mapcar #'length lines)))
|
|
(arr (make-array (list (+ 2 rows) (+ 2 cols)) ; adding for padding row of empty space
|
|
:initial-element #\ )))
|
|
(loop for row from 0 below rows
|
|
for line = (coerce (nth row lines) 'array)
|
|
do (loop for col from 0 below cols
|
|
for char = (if (array-in-bounds-p line col) (aref line col) #\ )
|
|
do (setf (aref arr (1+ row) (1+ col)) char)))
|
|
arr))
|
|
|
|
(defun print-map (arr)
|
|
(loop for row from 0 below (array-dimension arr 0)
|
|
do (let ((line (make-array (array-dimension arr 1)
|
|
:displaced-to arr
|
|
:displaced-index-offset (* row (array-dimension arr 1)))))
|
|
;; (format t "~a~%" (coerce line 'string))
|
|
)))
|
|
|
|
(defconstant *movements*
|
|
'((left . (0 -1))
|
|
(right . (0 1))
|
|
(down . (1 0))
|
|
(up . (-1 0))))
|
|
(defun opposite-movement (movement)
|
|
(let ((alist '((left . right) (down . up))))
|
|
(or (alexandria:assoc-value alist movement)
|
|
(alexandria:rassoc-value alist movement))))
|
|
|
|
(defun move-coord-one-step (coord direction)
|
|
(mapcar #'+ coord (alexandria:assoc-value *movements* direction)))
|
|
|
|
(5am:def-test move-coord-left (:suite :day-22-test)
|
|
(5am:is (equalp (move-coord-one-step '(2 2) 'left)
|
|
'(2 1))))
|
|
(5am:def-test move-coord-right (:suite :day-22-test)
|
|
(5am:is (equalp (move-coord-one-step '(2 2) 'right)
|
|
'(2 3))))
|
|
(5am:def-test move-coord-up (:suite :day-22-test)
|
|
(5am:is (equalp (move-coord-one-step '(2 2) 'up)
|
|
'(1 2))))
|
|
(5am:def-test move-coord-down (:suite :day-22-test)
|
|
(5am:is (equalp (move-coord-one-step '(2 2) 'down)
|
|
'(3 2))))
|
|
|
|
(defun move-with-possible-wrap (coord direction map)
|
|
(let ((initial (move-coord-one-step coord direction)))
|
|
(if (not (equal #\ (apply #'aref map initial)))
|
|
;; when not wrapping
|
|
initial
|
|
;; when map on initial movement is empty - wrap
|
|
(do
|
|
((mov-coord coord
|
|
(move-coord-one-step mov-coord (opposite-movement direction))))
|
|
((equal #\ (apply #'aref map mov-coord)) (move-coord-one-step mov-coord direction))))))
|
|
|
|
(defun display-coord (coord map)
|
|
(let ((copied (alexandria:copy-array map)))
|
|
(setf (apply #'aref copied coord) #\X)
|
|
(print-map copied)))
|
|
|
|
(defun move (n direction coord map)
|
|
(do* ((prev-coord coord next-coord)
|
|
(next-coord (move-with-possible-wrap coord direction map) (move-with-possible-wrap next-coord direction map))
|
|
(count 0 (1+ count)))
|
|
((or (= count n)
|
|
(equal #\# (apply #'aref map next-coord)))
|
|
prev-coord)
|
|
;; (format t "before move, iter ~a~%" n)
|
|
;; (display-coord prev-coord map)
|
|
;; (format t "after move, iter ~a~%" n)
|
|
;; (display-coord next-coord map)
|
|
))
|
|
|
|
(defun new-direction (direction turn-to)
|
|
(let* ((directions-cycle '(UP RIGHT DOWN LEFT))
|
|
(turn-mod '((L . -1) (R . 1)))
|
|
(cur-dir-pos (position direction directions-cycle))
|
|
(new-pos (mod
|
|
(+ cur-dir-pos (alexandria:assoc-value turn-mod turn-to))
|
|
4)))
|
|
(nth new-pos directions-cycle)))
|
|
|
|
(defun parse-integer-or-symbol (str)
|
|
(let ((maybe-int (parse-integer str :junk-allowed t)))
|
|
(if maybe-int
|
|
maybe-int
|
|
(intern (string-upcase str)))))
|
|
|
|
(defun read-path (filename)
|
|
(mapcar #'parse-integer-or-symbol
|
|
(ppcre:split "(L|R)" (uiop:read-file-string filename) :with-registers-p t )))
|
|
|
|
|
|
(defun get-topmost-left-coords (map)
|
|
(loop for col from 0 below (array-dimension map 1)
|
|
do (when (equal #\. (aref map 1 col))
|
|
(return (list 1 col)))))
|
|
|
|
|
|
(defun walk-path (path-filename map-filename)
|
|
(let* ((padded-path (append (read-path path-filename)
|
|
(list 'L)))
|
|
(direction 'right)
|
|
; to be calculated
|
|
(map (read-map-to-array map-filename))
|
|
(coords (get-topmost-left-coords map))
|
|
(walk-result
|
|
|
|
(loop
|
|
for (n turn-direction)
|
|
on padded-path by #'cddr
|
|
|
|
do (progn
|
|
(setq coords (move n direction coords map))
|
|
(setq direction (new-direction direction turn-direction)))
|
|
finally (return (list coords direction)))))
|
|
(destructuring-bind ((row col) over-direction)
|
|
walk-result
|
|
(list row col (new-direction over-direction 'R)))))
|
|
|
|
(defun calc-password (row col direction)
|
|
(let* ((direction-scores '((right . 0) (down . 1) (left . 2) (up . 3)))
|
|
(direction-score (alexandria:assoc-value direction-scores direction)))
|
|
(+ (* 1000 row) (* 4 col) direction-score)))
|
|
|
|
(5am:run! ':day-22-test)
|