From ad4f98207f7b1a6047dc3cb8c39a41d652e3dd29 Mon Sep 17 00:00:00 2001
From: Alex Karle <alex@alexkarle.com>
Date: Sun, 11 Dec 2022 00:08:39 -0500
Subject: [PATCH] day9: Add part2, optimize part1

Took me WAY too long to realize I needed a chain of 10 (9 knots)..
---
 2022/09/sample2 |   8 ++++++++
 2022/09/sol.scm | 145 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++----------------------------------------------------------------
 2 files changed, 89 insertions(+), 64 deletions(-)
 create mode 100644 2022/09/sample2

diff --git a/2022/09/sample2 b/2022/09/sample2
new file mode 100644
index 0000000..60bd43b
--- /dev/null
+++ 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
index 910c977..66f2df2 100755
--- 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"))
--
libgit2 1.8.1