Day 10: Part 2.

lib.rkt

@@ -9,6 +9,7 @@
 
 (provide problem-input
          show-solution
+         uncurry
          sum
          neq?
          nzero?
@@ -19,6 +20,7 @@
          list-ref*
          chunks-of
          transpose
+         zip
          list->queue
          vector-ref*
          vector-set!*)
@@ -38,6 +40,13 @@
   (printf "Part 1: ~a\nPart 2: ~a\n" part1 part2))
 
 
+;; Function helpers ;;
+
+;; uncurry : (a1 -> ... -> an -> b) -> ((listof a) -> b)
+(define uncurry
+  (curry apply))
+
+
 ;; Number helpers ;;
 
 ;; sum : (listof number) -> number
@@ -107,6 +116,10 @@
             [layers (map cdr layers)])
         (cons pixels (transpose layers)))))
 
+;; zip : (a1 -> ... -> an -> b) -> (listof a1) -> ... -> (listof an) -> (listof b)
+(define (zip f . lsts)
+  (map (curry apply f) (transpose lsts)))
+
 ;; list->queue : (listof any) -> (queueof any)
 ;; Creates a queue and adds elements of list in order
 (define (list->queue lst)

src/10.rkt

@@ -8,53 +8,66 @@
 (define width (string-length (car input)))
 (define height (length input))
 
-(define (coprime? ij)
-  (= 1 (gcd (first  ij)
-            (second ij))))
+(define (out-of-range? x y)
+  (or (< x 0)
+      (< y 0)
+      (>= x width)
+      (>= y height)))
+
+(define (coprime? i j)
+  (= 1 (gcd i j)))
 
 (define (offsets x y)
-  (define is
-    (range (negate x) (- width x)))
-  (define js
-    (range (negate y) (- height y)))
-  (filter coprime? (cartesian-product is js)))
+  (let ([is (range (negate x) (- width  x))]
+        [js (range (negate y) (- height y))])
+    (filter (uncurry coprime?) (cartesian-product is js))))
 
-(define (asteroid? xy)
-  (define row (list-ref input (second xy)))
-  (eq? #\# (string-ref row (first xy))))
+(define (asteroid? x y)
+  (define row (list-ref input y))
+  (eq? #\# (string-ref row x)))
 
-(define (asteroid-offset? x y ij)
-  (define i (first  ij))
-  (define j (second ij))
-  (define max-multiple
-    (let ([max-x
-           (cond
-             [(zero? i) width]
-             [(positive? i) (truncate (/ (- (sub1 width) x) i))]
-             [else (abs (truncate (/ x i)))])]
-          [max-y
-           (cond
-             [(zero? j) height]
-             [(positive? j) (truncate (/ (- (sub1 height) y) j))]
-             [else (abs (truncate (/ y j)))])])
-      (min max-x max-y)))
-  (ormap (λ (m) (asteroid? `(,(+ x (* m i))
-                             ,(+ y (* m j)))))
-         (range 1 (add1 max-multiple))))
+(define (asteroid-offset x y i j)
+  (let loop ([m 1])
+    (let ([x* (+ x (* i m))]
+          [y* (+ y (* j m))])
+      (cond
+        [(out-of-range? x* y*) #f]
+        [(asteroid? x* y*) (list x* y*)]
+        [else (loop (add1 m))]))))
 
-(define (asteroids xy)
-  (define x (first xy))
-  (define y (second xy))
-  (count (curry asteroid-offset? x y) (offsets x y)))
+(define (asteroids x y)
+  (filter-map (uncurry (curry asteroid-offset x y)) (offsets x y)))
 
-(define-values (part1 location)
+(define-values (part1 location in-view)
   (let* ([cols (range width)]
          [rows (range height)]
-         [locations (filter asteroid? (cartesian-product cols rows))]
-         [asteroid-counts (map asteroids locations)]
-         [maximum (apply max asteroid-counts)]
-         [index (index-of asteroid-counts maximum)]
-         [location (list-ref locations index)])
-    (values maximum location)))
+         [locations (filter (uncurry asteroid?) (cartesian-product cols rows))]
+         [in-views (map (uncurry asteroids) locations)]
+         [counts (map length in-views)]
+         [maximum (apply max counts)]
+         [index (index-of counts maximum)])
+    (values maximum
+            (list-ref locations index)
+            (list-ref in-views index))))
 
-(show-solution part1 #f)
+(define (offset<? xy1 xy2)
+  (let ([x1 (first  xy1)]
+        [y1 (second xy1)]
+        [x2 (first  xy2)]
+        [y2 (second xy2)])
+    (or ; (0, -) < (+, y) < (0, +) < (-, y)
+     (and (zero? x1)  (negative? y1))
+     (and (positive? x1)
+          (or (negative? x2)
+              (and (zero? x2) (positive? y2))))
+     (and (zero? x1)  (negative? x2))
+     (and (nzero? x1) (nzero? x2)
+          (< (atan (/ y1 x1)) (atan (/ y2 x2)))))))
+
+(define part2
+  (let* ([offsets (map (λ (ast) (zip - ast location)) in-view)]
+         [offsets (sort offsets offset<?)]
+         [200th (zip + location (list-ref offsets (sub1 200)))])
+    (+ (* (first 200th) 100) (second 200th))))
+
+(show-solution part1 part2)