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

new shootout comment, indentation, parens, etc

Browse Source 
svn: r11583
This commit is contained in:
Eli Barzilay 2008-09-09 04:21:56 +00:00
parent d793555e1d
commit d574d1461a
1 changed files with 65 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,5 +1,5 @@
#!/usr/bin/mzscheme -qu #!/usr/bin/mzscheme -qu
;; The Great Computer Language Shootout ;; The Computer Language Benchmarks Game
;; http://shootout.alioth.debian.org/ ;; http://shootout.alioth.debian.org/
;; ;;
;; Imperative-style implementation based on the SBCL implementation by ;; Imperative-style implementation based on the SBCL implementation by
@ -71,78 +71,76 @@ Correct output N = 1000 is
;; ------------------------------- ;; -------------------------------
(define (offset-momentum system) (define (offset-momentum system)
(let loop-i ((i system) (px 0.0) (py 0.0) (pz 0.0)) (let loop-i ([i system] [px 0.0] [py 0.0] [pz 0.0])
(if (null? i) (if (null? i)
(begin (begin
(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+)))
(let ([i1 (car i)]) (let ([i1 (car i)])
(loop-i (cdr i) (loop-i (cdr i)
(+ px (* (body-vx i1) (body-mass i1))) (+ px (* (body-vx i1) (body-mass i1)))
(+ py (* (body-vy i1) (body-mass i1))) (+ py (* (body-vy i1) (body-mass i1)))
(+ pz (* (body-vz 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* ([o1 (car o)] (let* ([o1 (car o)]
[e (+ e (* (* 0.5 (body-mass o1)) [e (+ e (* (* 0.5 (body-mass o1))
(+ (+ (* (body-vx o1) (body-vx o1)) (+ (+ (* (body-vx o1) (body-vx o1))
(* (body-vy o1) (body-vy o1))) (* (body-vy o1) (body-vy o1)))
(* (body-vz o1) (body-vz 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* ([i1 (car i)]
(let* ((i1 (car i)) [dx (- (body-x o1) (body-x i1))]
(dx (- (body-x o1) (body-x i1))) [dy (- (body-y o1) (body-y i1))]
(dy (- (body-y o1) (body-y i1))) [dz (- (body-z o1) (body-z i1))]
(dz (- (body-z o1) (body-z i1))) [distance (sqrt (+ (+ (* dx dx) (* dy dy)) (* dz dz)))])
(distance (sqrt (+ (+ (* dx dx) (* dy dy)) (* dz dz))))) (let ([e (- e (/ (* (body-mass o1) (body-mass i1)) distance))])
(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* ((o1 (car o)) (let* ([o1 (car o)]
(o1x (body-x o1)) [o1x (body-x o1)]
(o1y (body-y o1)) [o1y (body-y o1)]
(o1z (body-z o1)) [o1z (body-z o1)]
(om (body-mass o1))) [om (body-mass o1)])
(let loop-i ((i (cdr o)) (let loop-i ([i (cdr o)]
(vx (body-vx o1)) [vx (body-vx o1)]
(vy (body-vy o1)) [vy (body-vy o1)]
(vz (body-vz o1))) [vz (body-vz o1)])
(if (null? i) (if (null? i)
(begin (begin (set-body-vx! o1 vx)
(set-body-vx! o1 vx) (set-body-vy! o1 vy)
(set-body-vy! o1 vy) (set-body-vz! o1 vz))
(set-body-vz! o1 vz)) (let* ([i1 (car i)]
(let* ((i1 (car i)) [dx (- o1x (body-x i1))]
(dx (- o1x (body-x i1))) [dy (- o1y (body-y i1))]
(dy (- o1y (body-y i1))) [dz (- o1z (body-z i1))]
(dz (- o1z (body-z i1))) [distance (sqrt (+ (+ (* dx dx) (* dy dy)) (* dz dz)))]
(distance (sqrt (+ (+ (* dx dx) (* dy dy)) (* dz dz)))) [mag (/ dt (* (* distance distance) distance))]
(mag (/ dt (* (* distance distance) distance))) [dxmag (* dx mag)]
(dxmag (* dx mag)) [dymag (* dy mag)]
(dymag (* dy mag)) [dzmag (* dz mag)]
(dzmag (* dz mag)) [im (body-mass i1)])
(im (body-mass i1))) (let ([vx (- vx (* dxmag im))]
(let ([vx (- vx (* dxmag im))] [vy (- vy (* dymag im))]
[vy (- vy (* dymag im))] [vz (- vz (* dzmag im))])
[vz (- vz (* dzmag im))]) (set-body-vx! i1 (+ (body-vx i1) (* dxmag om)))
(set-body-vx! i1 (+ (body-vx i1) (* dxmag om))) (set-body-vy! i1 (+ (body-vy i1) (* dymag om)))
(set-body-vy! i1 (+ (body-vy i1) (* dymag om))) (set-body-vz! i1 (+ (body-vz i1) (* dzmag om)))
(set-body-vz! i1 (+ (body-vz i1) (* dzmag om))) (loop-i (cdr i) vx vy vz))))))
(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])
(unless (null? o) (unless (null? o)
(let ([o1 (car o)]) (let ([o1 (car o)])
(set-body-x! o1 (+ (body-x o1) (* dt (body-vx o1)))) (set-body-x! o1 (+ (body-x o1) (* dt (body-vx o1))))
@ -152,14 +150,14 @@ Correct output N = 1000 is
;; ------------------------------- ;; -------------------------------
(let ((n (command-line #:args (n) (string->number n))) (let ([n (command-line #:args (n) (string->number n))]
(system (list *sun* *jupiter* *saturn* *uranus* *neptune*))) [system (list *sun* *jupiter* *saturn* *uranus* *neptune*)])
(offset-momentum system) (offset-momentum system)
(printf "~a~%" (real->decimal-string (energy system) 9)) (printf "~a~%" (real->decimal-string (energy system) 9))
(for ([i (in-range 0 n)]) (for ([i (in-range 0 n)])
(advance system 0.01)) (advance system 0.01))
(printf "~a~%" (real->decimal-string (energy system) 9))) (printf "~a~%" (real->decimal-string (energy system) 9)))