commit 086382d077dc4a86d6631b91ff439dffb7f619f0 (patch) parent d9c06ab77cf05742d3ee4533e07e6f2edfe34840 Author: Alex Karle <alex@alexkarle.com> Date: Sat, 10 Dec 2022 13:56:57 -0500 day9: Add part1 unoptimized (slow) sol Diffstat:
| M | 2022/09/sol.scm | | | 118 | ++++++++++++++++++++++++++++++------------------------------------------------- |
1 file changed, 44 insertions(+), 74 deletions(-)
diff --git a/2022/09/sol.scm b/2022/09/sol.scm @@ -1,5 +1,5 @@ #!/usr/local/bin/chicken-csi -ss -(import srfi-69 +(import srfi-1 (chicken string) (chicken io)) @@ -14,91 +14,61 @@ '() (cons a (range (update a) b))))) +(define (n-of-v n v) + (if (= 0 n) + '() + (cons v (n-of-v (sub1 n) v)))) + (define (parse-line l) - (let ((parts (string-split l))) - (list (string->symbol (car parts)) - (string->number (cadr parts))))) + (let* ((parts (string-split l)) + (v (string->symbol (car parts))) + (n (string->number (cadr parts)))) + (n-of-v n v))) -(define (move cmd pt) - (let ((dir (car cmd)) - (val (cadr cmd)) - (x (car pt)) - (y (cadr pt))) - (cond ((eq? dir 'U) - (list x (+ y val))) - ((eq? dir 'D) - (list x (- y val))) - ((eq? dir 'L) - (list (+ x val) y)) - ((eq? dir 'R) - (list (- x val) y)) +(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))))) (define (adjacent? a b) - (let ((xa (car a)) - (ya (cadr a)) - (xb (car b)) - (yb (cadr b))) + (let ((xa (car a)) (ya (cadr a)) + (xb (car b)) (yb (cadr b))) (and (<= (abs (- xa xb)) 1) (<= (abs (- ya yb)) 1)))) -(define (vert-walk yh yt x) - (map (lambda (y) (list x y)) (range yt yh))) - -(define (horiz-walk xh xt y) - (map (lambda (y) (list x y)) (range xt xh))) - -;; Get direction of A with respect to B -(define (direction a b) - (let ((xa (car a)) - (ya (cadr a)) - (xb (car b)) - (yb (cadr b))) - (cond ((and (= xa xb) (= ya yb)) 'O) - ((and (= xa xb) (< ya yb)) 'S) - ((and (= xa xb) (> ya yb)) 'N) - ((and (< xa xb) (= ya yb)) 'W) - ((and (> xa xb) (= ya yb)) 'E) - ((and (< xa xb) (< ya yb)) 'SW) - ((and (< xa xb) (> ya yb)) 'NW) - ((and (> xa xb) (< ya yb)) 'SE) - ((and (> xa xb) (> ya yb)) 'NE) - (else (error "Unhandled dir case"))))) +;; 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 (follow h T seen) - (let ((xh (car h)) - (yh (cadr h)) - (xt (car T)) - (yt (cadr T)) - (dir (direction h T))) - ;; One dim should be off by 0 or 1 - ;; given that our last position was <= 1 away - (cond ((eq? dir 'N) - (vert-walk yh yt xh)) - ((eq? dir 'S) - (vert-walk yh yt xh)) - ((eq? dir 'E) - (horiz-walk xh xt yh)) - ((eq? dir 'W) - (horiz-walk xh xt yh)) - ((eq? dir 'NE)) ;; TODO: is this NE with x primary or y primary? matters - ((eq? dir 'NW)) - ((eq? dir 'SE)) - ((eq? dir 'SW)) - (else (error "Bad follow with dir " dir))) +(define (play-out dirs) + (let loop ((h '(0 0)) (t '(0 0)) (dirs dirs) (history '())) + (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)))))) -(define (do-cmd cmd H T seen) - ;; update head first - (let* ((h (move cmd H))) - (if (adjacent? h T) - (values h T seen) - (follow h T seen)))) - (define (main args) - (let ((cmds (map parse-line (read-lines)))) - cmds)) + (let* ((dirs (flatten (map parse-line (read-lines)))) + (history (play-out dirs))) + (print (length (delete-duplicates (map (lambda (state) + (cadr state)) history)))))) ;; For repl (define slines '("R 4" @@ -110,7 +80,7 @@ "L 5" "R 2")) -; (map parse-line slines) +; (flatten (map parse-line slines)) ; (move '(U 2) '(0 0)) ; (move '(D 2) '(0 0)) ; (move '(L 2) '(0 0))