new shootout comment, indentation, parens, etc

svn: r11583
This commit is contained in:
Eli Barzilay 2008-09-09 04:21:56 +00:00
parent d793555e1d
commit d574d1461a

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,7 +71,7 @@ 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+))
@ -85,7 +85,7 @@ Correct output N = 1000 is
;; ------------------------------- ;; -------------------------------
(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)]
@ -93,46 +93,44 @@ Correct output N = 1000 is
(+ (+ (* (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))])
@ -142,7 +140,7 @@ Correct output N = 1000 is
(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,8 +150,8 @@ 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)