You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
51 lines
2.0 KiB
Racket
51 lines
2.0 KiB
Racket
7 years ago
|
#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))
|