diff --git a/src/2024/day21.lisp b/src/2024/day21.lisp
index fcff4bf..926b0f8 100644
--- a/src/2024/day21.lisp
+++ b/src/2024/day21.lisp
@@ -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)))
diff --git a/tests/2024/day21-test.lisp b/tests/2024/day21-test.lisp
index 86a7ddf..58f22e5 100644
--- a/tests/2024/day21-test.lisp
+++ b/tests/2024/day21-test.lisp
@@ -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