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

added checksum calculation

Browse Source
This commit is contained in:
Matthias Felleisen 2012-10-14 14:32:20 -04:00
parent 4be0219855
commit 1ccedf5eb2
1 changed files with 37 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
collects/tests/racket/benchmarks/shootout/fannkuch-redux.rkt
View File

@ -1,5 +1,7 @@
#lang racket/base #lang racket/base
(require racket/unsafe/ops)
;; fannkuch benchmark for The Computer Language Shootout ;; fannkuch benchmark for The Computer Language Shootout
;; Written by Dima Dorfman, 2004 ;; Written by Dima Dorfman, 2004
;; Slightly improved by Sven Hartrumpf, 2005-2006 ;; Slightly improved by Sven Hartrumpf, 2005-2006
@ -15,45 +17,56 @@
[count (make-vector n)]) [count (make-vector n)])
(let loop ([flips 0] (let loop ([flips 0]
[perms 0] [perms 0]
[r n]) [r n]
[checksum 0]
[even-parity? #t])
(for ([i (in-range r)]) (for ([i (in-range r)])
(vector-set! count i (add1 i))) (unsafe-vector-set! count i (unsafe-fx+ 1 i)))
(let ((flips2 (max (count-flips pi tmp) flips))) (let* ((next-flips (count-flips pi tmp))
(flips2 (max next-flips flips))
(next-checksum (unsafe-fx+ checksum (if even-parity? next-flips (unsafe-fx- 0 next-flips)))))
(let loop2 ([r 1]) (let loop2 ([r 1])
(if (= r n) (if (unsafe-fx= r n)
flips2 (values flips2 next-checksum)
(let ((perm0 (vector-ref pi 0))) (let ((perm0 (unsafe-vector-ref pi 0)))
(for ([i (in-range r)]) (for ([i (in-range r)])
(vector-set! pi i (vector-ref pi (add1 i)))) (unsafe-vector-set! pi i (unsafe-vector-ref pi (unsafe-fx+ 1 i))))
(vector-set! pi r perm0) (unsafe-vector-set! pi r perm0)
(vector-set! count r (sub1 (vector-ref count r))) (unsafe-vector-set! count r (unsafe-fx- (unsafe-vector-ref count r) 1))
(cond (cond
[(<= (vector-ref count r) 0) [(<= (unsafe-vector-ref count r) 0)
(loop2 (add1 r))] (loop2 (unsafe-fx+ 1 r))]
[else (loop flips2 (add1 perms) r)])))))))) [else (loop flips2
(unsafe-fx+ 1 perms)
r
next-checksum
(not even-parity?))]))))))))
(define (count-flips pi rho) (define (count-flips pi rho)
(vector-copy! rho 0 pi) (vector-copy! rho 0 pi)
(let loop ([i 0]) (let loop ([i 0])
(if (= (vector-ref rho 0) 0) (if (unsafe-fx= (unsafe-vector-ref rho 0) 0)
i i
(begin (begin
(vector-reverse-slice! rho 0 (add1 (vector-ref rho 0))) (vector-reverse-slice! rho 0 (unsafe-fx+ 1 (unsafe-vector-ref rho 0)))
(loop (add1 i)))))) (loop (unsafe-fx+ 1 i))))))
(define (vector-reverse-slice! v i j) (define (vector-reverse-slice! v i j)
(let loop ([i i] (let loop ([i i]
[j (sub1 j)]) [j (unsafe-fx- j 1)])
(when (> j i) (when (unsafe-fx> j i)
(vector-swap! v i j) (vector-swap! v i j)
(loop (add1 i) (sub1 j))))) (loop (unsafe-fx+ 1 i) (unsafe-fx- j 1)))))
(define (vector-swap! v i j) (define-syntax-rule (vector-swap! v i j)
(let ((t (vector-ref v i))) (let ((t (unsafe-vector-ref v i)))
(vector-set! v i (vector-ref v j)) (unsafe-vector-set! v i (unsafe-vector-ref v j))
(vector-set! v j t))) (unsafe-vector-set! v j t)))
(command-line #:args (n) (command-line #:args (n)
(printf "Pfannkuchen(~a) = ~a\n" (define-values (answer checksum)
(fannkuch (string->number n)))
(printf "~a\nPfannkuchen(~a) = ~a\n"
checksum
n n
(fannkuch (string->number n)))) answer))