master
Matthew Butterick 7 years ago
parent 5090ded0bc
commit bbfca5f2a4

@ -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))

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

@ -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>

@ -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>