From 086382d077dc4a86d6631b91ff439dffb7f619f0 Mon Sep 17 00:00:00 2001
From: Alex Karle <alex@alexkarle.com>
Date: Sat, 10 Dec 2022 13:56:57 -0500
Subject: [PATCH] day9: Add part1 unoptimized (slow) sol

---
 2022/09/sol.scm | 118 ++++++++++++++++++++++++++++++++++++++++++++--------------------------------------------------------------------------
 1 file changed, 44 insertions(+), 74 deletions(-)
 mode change 100644 => 100755 2022/09/sol.scm

diff --git a/2022/09/sol.scm b/2022/09/sol.scm
old mode 100644
new mode 100755
index bbd51a5..910c977
--- 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))
--
libgit2 1.8.1