reimplement day21 but still stuck
This commit is contained in:
parent
28881608de
commit
669e47f572
2 changed files with 252 additions and 132 deletions
|
|
@ -9,15 +9,16 @@
|
|||
#:part2
|
||||
#:key-to-pos
|
||||
#:press-key
|
||||
#:type-code
|
||||
#:type-manual
|
||||
#:complexity
|
||||
#:combinations
|
||||
#:press-key-combinations
|
||||
#:path-invalid-p
|
||||
#:easiest-to-type
|
||||
#:easy-key-combinations
|
||||
#:easy-type-code
|
||||
#:decode
|
||||
#:decode3
|
||||
#:fewest-presses
|
||||
#:fill-leg-table
|
||||
))
|
||||
|
||||
(in-package :aoc/2024/21)
|
||||
|
|
@ -71,121 +72,6 @@
|
|||
;; - sum it.
|
||||
|
||||
|
||||
(defun key-to-pos (c)
|
||||
(cond
|
||||
((eq c #\0) (make-pos :x 1 :y 0))
|
||||
((eq c #\A) (make-pos :x 2 :y 0))
|
||||
((eq c #\^) (make-pos :x 1 :y 0))
|
||||
((eq c #\<) (make-pos :x 0 :y 1))
|
||||
((eq c #\v) (make-pos :x 1 :y 1))
|
||||
((eq c #\>) (make-pos :x 2 :y 1))
|
||||
((digit-char-p c) (make-pos
|
||||
:x (mod (1- (digit-char-p c)) 3)
|
||||
:y (floor (/ (+ 2 (digit-char-p c)) 3))))
|
||||
(t nil)))
|
||||
|
||||
(defun press-key (start target &optional (numeric t))
|
||||
(let ((diff (pos-subtract
|
||||
(key-to-pos target)
|
||||
(key-to-pos start))))
|
||||
(coerce
|
||||
(append
|
||||
(loop for x from 0 below (pos-x diff) collect #\>)
|
||||
(loop for y from 0 below (pos-y diff) collect (if numeric #\^ #\v))
|
||||
(loop for y from 0 below (- (pos-y diff)) collect (if numeric #\v #\^))
|
||||
(loop for x from 0 below (- (pos-x diff)) collect #\<)
|
||||
'(#\A))
|
||||
'string)))
|
||||
|
||||
(defun type-code (code &optional (numeric t))
|
||||
(let ((keys (coerce code 'list)))
|
||||
(format
|
||||
nil "~{~A~}"
|
||||
(loop
|
||||
for start in (cons #\A keys)
|
||||
for target in keys
|
||||
collect (press-key start target numeric)))))
|
||||
|
||||
|
||||
|
||||
(defun combinations (as bs &optional (acc '()))
|
||||
(cond
|
||||
((emptyp as) (list (append bs acc)))
|
||||
((emptyp bs) (list (append as acc)))
|
||||
(t (append
|
||||
(combinations (cdr as) bs (cons (car as) acc))
|
||||
(combinations as (cdr bs) (cons (car bs) acc))))))
|
||||
|
||||
(defun pos-step (pos c &optional (numeric t))
|
||||
(case c
|
||||
((#\< #\>) (pos-move pos c))
|
||||
(#\^ (pos-move pos (if numeric #\v #\^)))
|
||||
(#\v (pos-move pos (if numeric #\^ #\v)))))
|
||||
|
||||
(defun path-invalid-p (start moves &optional (numeric t))
|
||||
(loop
|
||||
for dir in moves
|
||||
for pos = (pos-step (or pos start) dir numeric)
|
||||
thereis (and (zerop (pos-x pos)) (zerop (pos-y pos)))))
|
||||
|
||||
(defun press-key-combinations (start target &optional (numeric t))
|
||||
(let* ((start-pos (key-to-pos start))
|
||||
(diff (pos-subtract
|
||||
(key-to-pos target)
|
||||
start-pos))
|
||||
(hp (loop
|
||||
for x from 0 below (abs (pos-x diff))
|
||||
collect (if (plusp (pos-x diff)) #\> #\<)))
|
||||
(vp (loop
|
||||
for y from 0 below (abs (pos-y diff))
|
||||
collect (if (equal numeric (plusp (pos-y diff))) #\^ #\v)))
|
||||
)
|
||||
(mapcar
|
||||
#'(lambda (c) (coerce (append c '(#\A)) 'string))
|
||||
(remove-if
|
||||
#'(lambda (moves) (path-invalid-p start-pos moves))
|
||||
(combinations hp vp)))
|
||||
))
|
||||
|
||||
(defun easiest-to-type (codes &optional (numeric t))
|
||||
(format t "~A ~A~%" codes numeric)
|
||||
(let ((min-taps (loop
|
||||
for code in codes
|
||||
minimize (length (type-code (type-code code t) nil)))))
|
||||
(loop
|
||||
for code in codes
|
||||
if (= min-taps (length (type-code (type-code code numeric))))
|
||||
collect code)))
|
||||
|
||||
|
||||
(defun easy-key-combinations (start target &optional (numeric t))
|
||||
(easiest-to-type
|
||||
(press-key-combinations start target numeric)
|
||||
t))
|
||||
|
||||
(defun type-numpad (code)
|
||||
(let ((keys (coerce code 'list)))
|
||||
(format nil "~{~A~}"
|
||||
(loop
|
||||
for start in (cons #\A keys)
|
||||
for target in keys
|
||||
collect (first (easy-key-combinations start target t))))))
|
||||
|
||||
(defun type-dirpads (code n)
|
||||
(loop
|
||||
for i from 1 to n
|
||||
do (setf code (type-code code nil))
|
||||
finally (return code)))
|
||||
|
||||
|
||||
(defun type-manual (code n)
|
||||
(type-dirpads (type-numpad code) n))
|
||||
|
||||
(defun complexity (code n)
|
||||
(let ((l (length (type-manual code n)))
|
||||
(v (parse-integer (ppcre:scan-to-strings "\\d+" code))))
|
||||
(* l v)))
|
||||
|
||||
(defun pos-to-key (pos &optional (numeric t))
|
||||
(cond
|
||||
((zerop (pos-y pos)) (if numeric
|
||||
|
|
@ -226,17 +112,248 @@
|
|||
nil)
|
||||
t))
|
||||
|
||||
(defun decoden (code n numeric)
|
||||
(if (zerop n)
|
||||
(decode code numeric)
|
||||
(decode (decoden code (1- n) nil) numeric))
|
||||
)
|
||||
|
||||
(defun key-to-pos (c)
|
||||
(cond
|
||||
((eq c #\0) (make-pos :x 1 :y 0))
|
||||
((eq c #\A) (make-pos :x 2 :y 0))
|
||||
((eq c #\^) (make-pos :x 1 :y 0))
|
||||
((eq c #\<) (make-pos :x 0 :y 1))
|
||||
((eq c #\v) (make-pos :x 1 :y 1))
|
||||
((eq c #\>) (make-pos :x 2 :y 1))
|
||||
((digit-char-p c) (make-pos
|
||||
:x (mod (1- (digit-char-p c)) 3)
|
||||
:y (floor (/ (+ 2 (digit-char-p c)) 3))))
|
||||
(t nil)))
|
||||
|
||||
(defun press-key (start target &optional (numeric t))
|
||||
(let ((diff (pos-subtract
|
||||
(key-to-pos target)
|
||||
(key-to-pos start))))
|
||||
(coerce
|
||||
(append
|
||||
(loop for x from 0 below (pos-x diff) collect #\>)
|
||||
(loop for y from 0 below (pos-y diff) collect (if numeric #\^ #\v))
|
||||
(loop for y from 0 below (- (pos-y diff)) collect (if numeric #\v #\^))
|
||||
(loop for x from 0 below (- (pos-x diff)) collect #\<)
|
||||
'(#\A))
|
||||
'string)))
|
||||
|
||||
(defun pos-step (pos c &optional (numeric t))
|
||||
(case c
|
||||
((#\< #\>) (pos-move pos c))
|
||||
(#\^ (pos-move pos (if numeric #\v #\^)))
|
||||
(#\v (pos-move pos (if numeric #\^ #\v)))))
|
||||
|
||||
(defun path-invalid-p (start moves &optional (numeric t))
|
||||
(loop
|
||||
for dir in moves
|
||||
for pos = (pos-step (or pos start) dir numeric)
|
||||
thereis (and (zerop (pos-x pos)) (zerop (pos-y pos)))))
|
||||
|
||||
(defun press-key-combinations (start target &optional (numeric t))
|
||||
(let* ((start-pos (key-to-pos start))
|
||||
(diff (pos-subtract
|
||||
(key-to-pos target)
|
||||
start-pos))
|
||||
(hp (loop
|
||||
for x from 0 below (abs (pos-x diff))
|
||||
collect (if (plusp (pos-x diff)) #\> #\<)))
|
||||
(vp (loop
|
||||
for y from 0 below (abs (pos-y diff))
|
||||
collect (if (equal numeric (plusp (pos-y diff))) #\^ #\v)))
|
||||
)
|
||||
(mapcar
|
||||
#'(lambda (moves) (coerce (append moves '(#\A)) 'string))
|
||||
(remove-if
|
||||
#'(lambda (moves) (path-invalid-p start-pos moves))
|
||||
(list
|
||||
(append hp vp)
|
||||
(append vp hp))))
|
||||
)
|
||||
)
|
||||
|
||||
(defparameter *tl-cache* (make-hash-table :test #'equal))
|
||||
(defun reset-cache ()
|
||||
(setf *tl-cache* (make-hash-table :test #'equal)))
|
||||
|
||||
(defun _type-length (code level numeric)
|
||||
(if (zerop level)
|
||||
(length code)
|
||||
(loop
|
||||
for part in (list code)
|
||||
sum (let ((keys (coerce code 'list)))
|
||||
(loop
|
||||
for start in (cons #\A keys)
|
||||
for target in keys
|
||||
sum (loop
|
||||
for c in (press-key-combinations start target numeric)
|
||||
minimizing (type-length c (1- level) nil)
|
||||
)))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defun type-length (code level numeric)
|
||||
(multiple-value-bind (v found) (gethash (cons code level) *tl-cache*)
|
||||
(if found
|
||||
v
|
||||
(let ((l (_type-length code level numeric)))
|
||||
(setf (gethash (cons code level) *tl-cache*) l) ))))
|
||||
|
||||
|
||||
|
||||
(defun print-lengths (data)
|
||||
(reset-cache)
|
||||
(loop
|
||||
for n from 1 to 26
|
||||
do (format t "~%n: ~A~%" n)
|
||||
(loop
|
||||
for code in data
|
||||
do (format t "~15A~%" (type-length code n t))
|
||||
)))
|
||||
|
||||
(defparameter dir-map
|
||||
(make-array
|
||||
'(2 3) :initial-contents
|
||||
#(
|
||||
#(#\SPACE #\^ #\A)
|
||||
#( #\< #\v #\>)
|
||||
)))
|
||||
|
||||
(defparameter num-map
|
||||
(make-array
|
||||
'(4 3)
|
||||
:initial-contents
|
||||
#(
|
||||
#(#\7 #\8 #\9)
|
||||
#(#\4 #\5 #\6)
|
||||
#(#\1 #\2 #\3)
|
||||
#(#\SPACE #\0 #\A))))
|
||||
|
||||
|
||||
(defun dir-pos (c)
|
||||
(car (loop
|
||||
for x from 0 below (array-dimension dir-map 1)
|
||||
append (loop
|
||||
for y from 0 below (array-dimension dir-map 0)
|
||||
if (eq c (aref dir-map y x))
|
||||
collect (cons x y)))))
|
||||
|
||||
(defun num-pos (c)
|
||||
(car (loop
|
||||
for x from 0 below (array-dimension num-map 1)
|
||||
append (loop
|
||||
for y from 0 below (array-dimension num-map 0)
|
||||
if (eq c (aref num-map y x))
|
||||
collect (cons x y)))))
|
||||
|
||||
(defvar leg-lengths (make-hash-table :test #'equal))
|
||||
|
||||
(defun fewest-presses (layer ks)
|
||||
(loop
|
||||
for ki in (cons #\A (coerce ks 'list))
|
||||
for kf in (coerce ks 'list)
|
||||
sum (let ((ll (gethash (list layer ki kf) leg-lengths)))
|
||||
ll)))
|
||||
|
||||
(defun fill-leg-table (n-robots)
|
||||
(setf leg-lengths (make-hash-table :test #'equal))
|
||||
|
||||
(loop
|
||||
for ki from 0 below (array-total-size dir-map)
|
||||
do (loop
|
||||
for kf from 0 below (array-total-size dir-map)
|
||||
do (setf
|
||||
(gethash
|
||||
(list
|
||||
0
|
||||
(row-major-aref dir-map ki)
|
||||
(row-major-aref dir-map kf))
|
||||
leg-lengths)
|
||||
1)
|
||||
))
|
||||
(loop
|
||||
for layer from 1 to n-robots
|
||||
do (let* ((key-map (if (= layer n-robots) num-map dir-map))
|
||||
(key-pos (if (= layer n-robots) #'num-pos #'dir-pos))
|
||||
(space-pos (funcall key-pos #\SPACE)))
|
||||
(loop
|
||||
for i from 0 below (array-total-size key-map)
|
||||
for ki = (row-major-aref key-map i)
|
||||
for pos-i = (funcall key-pos ki)
|
||||
for xi = (car pos-i)
|
||||
for yi = (cdr pos-i)
|
||||
do (loop
|
||||
for j from 0 below (array-total-size key-map)
|
||||
for kf = (row-major-aref key-map j)
|
||||
for pos-f = (funcall key-pos kf)
|
||||
for xf = (car pos-f)
|
||||
for yf = (cdr pos-f)
|
||||
do (let* (
|
||||
(dx (- xf xi))
|
||||
(dy (- yf yi))
|
||||
(hp (loop
|
||||
for x from 0 below (abs dx)
|
||||
collect (if (plusp dx) #\> #\<)))
|
||||
(vp (loop
|
||||
for y from 0 below (abs dy)
|
||||
collect (if (minusp dy) #\^ #\v)))
|
||||
(hf (coerce (append hp vp '(#\A)) 'string))
|
||||
(h-first (if (equal (cons xf yi) space-pos)
|
||||
999
|
||||
(fewest-presses (1- layer) hf)))
|
||||
(vf (coerce (append vp hp '(#\A)) 'string))
|
||||
(v-first (if (equal (cons xi yf) space-pos)
|
||||
999
|
||||
(fewest-presses (1- layer) vf))))
|
||||
;;(format t "h ~A ~A ~A ~A~%" xi yf hf h-first)
|
||||
;;(format t "v ~A ~A ~A ~A~%" xf yi vf v-first)
|
||||
;;(format t "ll[~A ~A ~A] ~A~%" layer ki kf (min h-first v-first))
|
||||
(setf
|
||||
(gethash (list layer ki kf) leg-lengths)
|
||||
(min h-first v-first)))))
|
||||
|
||||
))
|
||||
)
|
||||
|
||||
(defun complexity (code n)
|
||||
(let ((l (fewest-presses n code))
|
||||
(v (parse-integer (ppcre:scan-to-strings "\\d+" code))))
|
||||
(* l v)))
|
||||
|
||||
|
||||
(defun print-llengths (data)
|
||||
(reset-cache)
|
||||
(loop
|
||||
for n from 1 to 26
|
||||
do (format t "~%n: ~A~%" n)
|
||||
(fill-leg-table n)
|
||||
(loop
|
||||
for code in data
|
||||
do (format t "~15A~%" (fewest-presses n code))
|
||||
)))
|
||||
|
||||
|
||||
(defun part1 (data)
|
||||
(fill-leg-table 3)
|
||||
(loop
|
||||
for code in data
|
||||
sum (complexity code 2)))
|
||||
sum (complexity code 3)))
|
||||
|
||||
(defun part2 (data)
|
||||
(fill-leg-table 26)
|
||||
(loop
|
||||
for code in data
|
||||
sum (complexity code 25)))
|
||||
sum (complexity code 26)))
|
||||
|
||||
(defun solve-day ()
|
||||
(reset-cache)
|
||||
(format t "part1: ~A~%" (part1 input-data))
|
||||
(format t "part2: ~A~%" (part2 input-data)))
|
||||
|
||||
|
|
|
|||
|
|
@ -37,23 +37,26 @@
|
|||
|
||||
(define-test test-complexity
|
||||
:parent suite-2024-21
|
||||
(is = (* 68 29) (complexity "029A" 2))
|
||||
(is = (* 60 980) (complexity "980A" 2))
|
||||
(is = (* 68 179) (complexity "179A" 2))
|
||||
(is = (* 64 456) (complexity "456A" 2))
|
||||
(is = (* 64 379) (complexity "379A" 2)))
|
||||
(is = (* 68 29) (complexity "029A" 3))
|
||||
(is = (* 60 980) (complexity "980A" 3))
|
||||
(is = (* 68 179) (complexity "179A" 3))
|
||||
(is = (* 64 456) (complexity "456A" 3))
|
||||
(is = (* 64 379) (complexity "379A" 3)))
|
||||
|
||||
(define-test test-manual
|
||||
(define-test test-fewest-presses
|
||||
:parent suite-2024-21
|
||||
(is equal
|
||||
"<v<A>>^AvA^A<vA<AA>>^AAvA<^A>AAvA^A<vA>^AA<A>A<v<A>A>^AAAvA<^A>A"
|
||||
(type-manual "379A" 2)))
|
||||
(fill-leg-table 3)
|
||||
(is = 68 (fewest-presses 3 "029A"))
|
||||
(is = 60 (fewest-presses 3 "980A"))
|
||||
(is = 68 (fewest-presses 3 "179A"))
|
||||
(is = 64 (fewest-presses 3 "456A"))
|
||||
(is = 64 (fewest-presses 3 "379A")))
|
||||
|
||||
|
||||
(define-test+run test-part1
|
||||
:parent suite-2024-21
|
||||
(is equal 126384 (part1 sample-data)))
|
||||
|
||||
(define-test+run test-part2
|
||||
:parent suite-2024-21
|
||||
(is equal nil (part2 sample-data)))
|
||||
|
||||
;; 143919110618572
|
||||
;; 167389793580400
|
||||
|
|
|
|||
Loading…
Reference in a new issue