suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

nbody binary arithmetic etc.

Browse Source 
svn: r11319
This commit is contained in:
Matthew Flatt 2008-08-19 03:29:04 +00:00
parent 85405bc80b
commit 13182685e6
1 changed files with 47 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
collects/tests/mzscheme/benchmarks/shootout/nbody.ss
View File

@ -77,56 +77,69 @@ Correct output N = 1000 is
(set-body-vx! (car system) (/ (- px) +solar-mass+)) (set-body-vx! (car system) (/ (- px) +solar-mass+))
(set-body-vy! (car system) (/ (- py) +solar-mass+)) (set-body-vy! (car system) (/ (- py) +solar-mass+))
(set-body-vz! (car system) (/ (- pz) +solar-mass+))) (set-body-vz! (car system) (/ (- pz) +solar-mass+)))
(loop-i (cdr i) (let ([i1 (car i)])
(+ px (* (body-vx (car i)) (body-mass (car i)))) (loop-i (cdr i)
(+ py (* (body-vy (car i)) (body-mass (car i)))) (+ px (* (body-vx i1) (body-mass i1)))
(+ pz (* (body-vz (car i)) (body-mass (car i)))))))) (+ py (* (body-vy i1) (body-mass i1)))
(+ pz (* (body-vz i1) (body-mass i1))))))))
;; ------------------------------- ;; -------------------------------
(define (energy system) (define (energy system)
(let loop-o ((o system) (e 0.0)) (let loop-o ((o system) (e 0.0))
(if (null? o) (if (null? o)
e e
(let ([e (+ e (* 0.5 (body-mass (car o)) (let* ([o1 (car o)]
(+ (* (body-vx (car o)) (body-vx (car o))) [e (+ e (* (* 0.5 (body-mass o1))
(* (body-vy (car o)) (body-vy (car o))) (+ (+ (* (body-vx o1) (body-vx o1))
(* (body-vz (car o)) (body-vz (car o))))))]) (* (body-vy o1) (body-vy o1)))
(* (body-vz o1) (body-vz o1)))))])
(let loop-i ((i (cdr o)) (e e)) (let loop-i ((i (cdr o)) (e e))
(if (null? i) (if (null? i)
(loop-o (cdr o) e) (loop-o (cdr o) e)
(let* ((dx (- (body-x (car o)) (body-x (car i)))) (let* ((i1 (car i))
(dy (- (body-y (car o)) (body-y (car i)))) (dx (- (body-x o1) (body-x i1)))
(dz (- (body-z (car o)) (body-z (car i)))) (dy (- (body-y o1) (body-y i1)))
(distance (sqrt (+ (* dx dx) (* dy dy) (* dz dz))))) (dz (- (body-z o1) (body-z i1)))
(let ([e (- e (/ (* (body-mass (car o)) (body-mass (car i))) distance))]) (distance (sqrt (+ (+ (* dx dx) (* dy dy)) (* dz dz)))))
(let ([e (- e (/ (* (body-mass o1) (body-mass i1)) distance))])
(loop-i (cdr i) e))))))))) (loop-i (cdr i) e)))))))))
;; ------------------------------- ;; -------------------------------
(define (advance system dt) (define (advance system dt)
(let loop-o ((o system)) (let loop-o ((o system))
(unless (null? o) (unless (null? o)
(let loop-i ((i (cdr o))) (let* ((o1 (car o))
(unless (null? i) (o1x (body-x o1))
(let* ((o1 (car o)) (o1y (body-y o1))
(i1 (car i)) (o1z (body-z o1))
(dx (- (body-x o1) (body-x i1))) (om (body-mass o1)))
(dy (- (body-y o1) (body-y i1))) (let loop-i ((i (cdr o))
(dz (- (body-z o1) (body-z i1))) (vx (body-vx o1))
(distance (sqrt (+ (* dx dx) (* dy dy) (* dz dz)))) (vy (body-vy o1))
(mag (/ dt (* distance distance distance))) (vz (body-vz o1)))
(dxmag (* dx mag)) (if (null? i)
(dymag (* dy mag)) (begin
(dzmag (* dz mag)) (set-body-vx! o1 vx)
(om (body-mass o1)) (set-body-vy! o1 vy)
(im (body-mass i1))) (set-body-vz! o1 vz))
(set-body-vx! o1 (- (body-vx o1) (* dxmag im))) (let* ((i1 (car i))
(set-body-vy! o1 (- (body-vy o1) (* dymag im))) (dx (- o1x (body-x i1)))
(set-body-vz! o1 (- (body-vz o1) (* dzmag im))) (dy (- o1y (body-y i1)))
(set-body-vx! i1 (+ (body-vx i1) (* dxmag om))) (dz (- o1z (body-z i1)))
(set-body-vy! i1 (+ (body-vy i1) (* dymag om))) (distance (sqrt (+ (+ (* dx dx) (* dy dy)) (* dz dz))))
(set-body-vz! i1 (+ (body-vz i1) (* dzmag om))) (mag (/ dt (* (* distance distance) distance)))
(loop-i (cdr i))))) (dxmag (* dx mag))
(dymag (* dy mag))
(dzmag (* dz mag))
(im (body-mass i1)))
(let ([vx (- vx (* dxmag im))]
[vy (- vy (* dymag im))]
[vz (- vz (* dzmag im))])
(set-body-vx! i1 (+ (body-vx i1) (* dxmag om)))
(set-body-vy! i1 (+ (body-vy i1) (* dymag om)))
(set-body-vz! i1 (+ (body-vz i1) (* dzmag om)))
(loop-i (cdr i) vx vy vz))))))
(loop-o (cdr o)))) (loop-o (cdr o))))
(let loop-o ((o system)) (let loop-o ((o system))