d20

2017/d20/main.rkt

@@ -0,0 +1,50 @@
+#lang br/quicklang
+(require "../helper.rkt")
+(provide read-syntax (rename-out [#%mb #%module-begin]) ★ ★★)
+
+(define (read-syntax path port)
+  (define str (let* ([str  (port->string port)]
+                     [str (string-replace str "," " ")]
+                     [str (string-replace str "<" "(")]
+                     [str (string-replace str ">" ")")])
+                str))
+  (strip-context #`(module mod "main.rkt"
+                     #,@(for/list ([line (in-lines (open-input-string str))])
+                          (for/list ([datum (in-port read (open-input-string line))])
+                            datum)))))
+
+(define-macro (#%mb (STARS) (p= PNUMS v= VNUMS a= ANUMS) ...)
+  #`(#%module-begin
+     (time (STARS (particle 'PNUMS 'VNUMS 'ANUMS) ...))))
+
+(struct particle (pos vel acc) #:transparent)
+
+(define (do-tick p)
+  (define next-vel (map + (particle-vel p) (particle-acc p)))
+  (define next-pos (map + (particle-pos p) next-vel))
+  (particle next-pos next-vel (particle-acc p)))
+
+(define (dist p) (apply + (map abs (particle-pos p))))
+
+(define (remove-collisions particles)
+  (define (find-duplicate-particle ps) (check-duplicates ps #:key particle-pos))
+  (for/fold ([ps particles]
+              [dup (find-duplicate-particle particles)]
+              #:result ps)
+             ([i (in-naturals)]
+              #:break (not dup))
+    (values (filter-not (λ (p) (andmap = (particle-pos dup) (particle-pos p))) ps)
+            (find-duplicate-particle ps))))
+
+(define (closest particles #:collisions [collisions? #f])
+  (for/fold ([particles particles]
+             #:result (if collisions?
+                          (length particles)
+                          (argmin cdr (for/list ([(p pidx) (in-indexed particles)])
+                                        (cons pidx (dist p))))))
+            ([i (in-range 1000)])
+    ((if collisions? remove-collisions values) (map do-tick particles))))
+
+(define (★ . particles) (closest particles))
+
+(define (★★ . particles) (closest particles #:collisions #t))

2017/d20/test1.rkt

@@ -0,0 +1,3 @@
+#lang reader "main.rkt" ★ ; 0
+p=< 3,0,0>, v=< 2,0,0>, a=<-1,0,0>
+p=< 4,0,0>, v=< 0,0,0>, a=<-2,0,0>

2017/d20/test2.rkt

@@ -0,0 +1,5 @@
+#lang reader "main.rkt" ★★ 
+p=<-6,0,0>, v=< 3,0,0>, a=< 0,0,0>    
+p=<-4,0,0>, v=< 2,0,0>, a=< 0,0,0>  ;   -6 -5 -4 -3 -2 -1  0  1  2  3
+p=<-2,0,0>, v=< 1,0,0>, a=< 0,0,0>  ; (0)   (1)   (2)            (3)
+p=< 3,0,0>, v=<-1,0,0>, a=< 0,0,0>