commit ad4f98207f7b1a6047dc3cb8c39a41d652e3dd29 (patch)
parent 086382d077dc4a86d6631b91ff439dffb7f619f0
Author: Alex Karle <alex@alexkarle.com>
Date: Sun, 11 Dec 2022 00:08:39 -0500
day9: Add part2, optimize part1
Took me WAY too long to realize I needed a chain of 10 (9 knots)..
Diffstat:
2 files changed, 89 insertions(+), 64 deletions(-)
diff --git a/2022/09/sample2 b/2022/09/sample2
@@ -0,0 +1,8 @@
+R 5
+U 8
+L 8
+D 3
+R 17
+D 10
+L 25
+U 20
diff --git a/2022/09/sol.scm b/2022/09/sol.scm
@@ -1,18 +1,7 @@
#!/usr/local/bin/chicken-csi -ss
-(import srfi-1
- (chicken string)
- (chicken io))
-
-(define (set-append set x)
- (if (member x set)
- set
- (cons x set)))
-
-(define (range a b)
- (let ((update (if (< a b) add1 sub1)))
- (if (= a b)
- '()
- (cons a (range (update a) b)))))
+(import srfi-69
+ (chicken string)
+ (chicken io))
(define (n-of-v n v)
(if (= 0 n)
@@ -21,72 +10,100 @@
(define (parse-line l)
(let* ((parts (string-split l))
- (v (string->symbol (car parts)))
- (n (string->number (cadr parts))))
+ (v (string->symbol (car parts)))
+ (n (string->number (cadr parts))))
(n-of-v n v)))
(define (move pt dir)
(let ((x (car pt)) (y (cadr pt)))
(cond ((eq? dir 'U) (list x (add1 y)))
- ((eq? dir 'D) (list x (sub1 y)))
- ((eq? dir 'L) (list (sub1 x) y))
- ((eq? dir 'R) (list (add1 x) y))
- (else (error "Bad dir " dir)))))
-
+ ((eq? dir 'D) (list x (sub1 y)))
+ ((eq? dir 'L) (list (sub1 x) y))
+ ((eq? dir 'R) (list (add1 x) y))
+ (else (error "Bad dir " dir)))))
(define (adjacent? a b)
(let ((xa (car a)) (ya (cadr a))
- (xb (car b)) (yb (cadr b)))
+ (xb (car b)) (yb (cadr b)))
(and (<= (abs (- xa xb)) 1)
- (<= (abs (- ya yb)) 1))))
+ (<= (abs (- ya yb)) 1))))
+
+; -10 -> -1, 4 -> 1, 0 -> 0
+(define (unitize v)
+ (if (= v 0)
+ 0
+ (/ v (abs v))))
+; idea: head has moved, t to follow, returns new t
+; (0 2) (0 0) -> (0 1)
+; (1 3) (0 1) -> (1 2)
+; if one dim is the same -> just move 1 in other dim
+; if both dims diff -> move 1 in both dims
+; IOW, move 1 in all directions changed
+(define (follow h t)
+ (if (adjacent? h t)
+ t
+ (let* ((xh (car h)) (yh (cadr h))
+ (xt (car t)) (yt (cadr t))
+ (dx (- xh xt)) (dy (- yh yt)))
+ (list (+ xt (unitize dx)) (+ yt (unitize dy))))))
-;; key idea: if we look at the positions over
-;; time:
-;; H1 H2 ... Hk
-;; T1 T2 ... Tk
-;; then
-;; if Hk+1 = Tk -> no op (Tk+1 = Tk)
-;; Hk+1 adjacent Tk -> no op (Tk+1 = Tk)
-;; Hk+1 away from Tk -> Tk+1 = Hk
-(define (move-both dir h t)
- (let* ((h2 (move h dir)))
- (if (adjacent? h2 t)
- (list h2 t)
- (list h2 h))))
+(define (move-all dir knots)
+ ; only the head moves according to dir, everything else follows
+ (let ((new-head (move (car knots) dir)))
+ (let loop ((nh new-head) (tails (cdr knots)))
+ (if (null? tails)
+ (begin
+ (hash-table-set! tail-locs nh 'seen)
+ (list nh))
+ (if (adjacent? nh (car tails))
+ ; omptimization: can stop -- nothing else will move
+ (cons nh tails)
+ (cons nh (loop (follow nh (car tails)) (cdr tails))))))))
+;; NOTE: at first I was purely functional with cons-ing the
+;; the h2,t2 to a history and then pulling unique t2's later
+;; but that took 10s and it takes .2s to use a hash table :shrug:
+(define tail-locs (make-hash-table))
(define (play-out dirs)
- (let loop ((h '(0 0)) (t '(0 0)) (dirs dirs) (history '()))
+ (let loop ((knots (n-of-v 10 '(0 0))) (dirs dirs))
(if (null? dirs)
- history
- (let* ((state (move-both (car dirs) h t))
- (h2 (car state))
- (t2 (cadr state)))
- (loop h2 t2 (cdr dirs) (cons state history))))))
+ 'done
+ (let ((ks (move-all (car dirs) knots)))
+ ; (newline)
+ ; (plot-state ks)
+ ; (newline)
+ (loop ks (cdr dirs))))))
(define (main args)
- (let* ((dirs (flatten (map parse-line (read-lines))))
- (history (play-out dirs)))
- (print (length (delete-duplicates (map (lambda (state)
- (cadr state)) history))))))
+ (let* ((dirs (flatten (map parse-line (read-lines)))))
+ (hash-table-set! tail-locs '(0 0) 'start)
+ (play-out dirs)
+ (print (hash-table-size tail-locs))))
-;; For repl
-(define slines '("R 4"
- "U 4"
- "L 3"
- "D 1"
- "R 4"
- "D 1"
- "L 5"
- "R 2"))
-; (flatten (map parse-line slines))
-; (move '(U 2) '(0 0))
-; (move '(D 2) '(0 0))
-; (move '(L 2) '(0 0))
-; (move '(R 2) '(0 0))
+;; helpful for debugging!
+(define (plot-state knots)
+ (print knots)
+ (let loopi ((i -20))
+ (if (<= i 20)
+ (let loopj ((j -20))
+ (if (<= j 20)
+ (begin
+ (if (member (list j (* -1 i)) knots)
+ (display "#")
+ (display "."))
+ (loopj (add1 j)))
+ (begin
+ (newline)
+ (loopi (add1 i))))))))
-; (adjacent? '(0 0) '(1 4))
-; (adjacent? '(1 0) '(0 2))
-; (adjacent? '(0 0) '(0 1))
-; (adjacent? '(0 0) '(1 1))
+;; For repl
+(define slines '("R 4"
+ "U 4"
+ "L 3"
+ "D 1"
+ "R 4"
+ "D 1"
+ "L 5"
+ "R 2"))
