Rewrote spectral-norm benchmark based on Lua version.
This commit is contained in:
parent
75bd26d326
commit
c0a9704ebc
|
@ -1,68 +1,49 @@
|
|||
#lang racket/base
|
||||
|
||||
;; The Computer Language Benchmarks Game
|
||||
;; http://shootout.alioth.debian.org/
|
||||
;; Translated from Mike Pall's Lua version.
|
||||
|
||||
;; Translated directly from the C# version, which was:
|
||||
;; contributed by Isaac Gouy
|
||||
(require racket/cmdline racket/trace racket/contract
|
||||
racket/unsafe/ops racket/flonum)
|
||||
|
||||
(require racket/cmdline
|
||||
racket/require (for-syntax racket/base)
|
||||
(rename-in
|
||||
(filtered-in
|
||||
(lambda (name) (regexp-replace #rx"unsafe-" name ""))
|
||||
racket/unsafe/ops)
|
||||
[fx->fl ->fl])
|
||||
(only-in racket/flonum make-flvector))
|
||||
|
||||
|
||||
(define (Approximate n)
|
||||
(let ([u (make-flvector n 1.0)]
|
||||
[v (make-flvector n 0.0)])
|
||||
;; 20 steps of the power method
|
||||
(for ([i (in-range 10)])
|
||||
(MultiplyAtAv n u v)
|
||||
(MultiplyAtAv n v u))
|
||||
|
||||
;; B=AtA A multiplied by A transposed
|
||||
;; v.Bv /(v.v) eigenvalue of v
|
||||
(let loop ([i 0][vBv 0.0][vv 0.0])
|
||||
(if (= i n)
|
||||
(flsqrt (fl/ vBv vv))
|
||||
(let ([vi (flvector-ref v i)])
|
||||
(loop (add1 i)
|
||||
(fl+ vBv (fl* (flvector-ref u i) vi))
|
||||
(fl+ vv (fl* vi vi))))))))
|
||||
|
||||
;; return element i,j of infinite matrix A
|
||||
(define (A i j)
|
||||
(fl/ 1.0 (fl+ (fl* (->fl (+ i j))
|
||||
(fl/ (->fl (+ i (+ j 1))) 2.0))
|
||||
(->fl (+ i 1)))))
|
||||
|
||||
;; multiply vector v by matrix A
|
||||
(define (MultiplyAv n v Av)
|
||||
(for ([i (in-range n)])
|
||||
(flvector-set! Av i
|
||||
(for/fold ([r 0.0])
|
||||
([j (in-range n)])
|
||||
(fl+ r (fl* (A i j) (flvector-ref v j)))))))
|
||||
|
||||
;; multiply vector v by matrix A transposed
|
||||
(define (MultiplyAtv n v Atv)
|
||||
(for ([i (in-range n)])
|
||||
(flvector-set! Atv i
|
||||
(for/fold ([r 0.0])
|
||||
([j (in-range n)])
|
||||
(fl+ r (fl* (A j i) (flvector-ref v j)))))))
|
||||
|
||||
;; multiply vector v by matrix A and then by matrix A transposed
|
||||
(define (MultiplyAtAv n v AtAv)
|
||||
(let ([u (make-flvector n 0.0)])
|
||||
(MultiplyAv n v u)
|
||||
(MultiplyAtv n u AtAv)))
|
||||
|
||||
(printf "~a\n"
|
||||
(real->decimal-string
|
||||
(Approximate (command-line #:args (n) (string->number n)))
|
||||
9))
|
||||
(let* ([A (lambda (i j)
|
||||
(let ([ij (unsafe-fx+ i j)])
|
||||
(unsafe-fl/ 1.0 (unsafe-fl+ (unsafe-fl* (unsafe-fl* (unsafe-fx->fl ij)
|
||||
(unsafe-fx->fl (unsafe-fx+ ij 1)))
|
||||
0.5)
|
||||
(unsafe-fx->fl (unsafe-fx+ i 1))))))]
|
||||
[Av
|
||||
(lambda (x y N)
|
||||
(for ([i (in-range N)])
|
||||
(unsafe-flvector-set!
|
||||
y i
|
||||
(let L ([a 0.0] [j 0])
|
||||
(if (unsafe-fx= j N) a
|
||||
(L (unsafe-fl+ a (unsafe-fl* (unsafe-flvector-ref x j) (A i j)))
|
||||
(unsafe-fx+ j 1)))))))]
|
||||
[Atv
|
||||
(lambda (x y N)
|
||||
(for ([i (in-range N)])
|
||||
(unsafe-flvector-set!
|
||||
y i
|
||||
(let L ([a 0.0] [j 0])
|
||||
(if (unsafe-fx= j N) a
|
||||
(L (unsafe-fl+ a (unsafe-fl* (unsafe-flvector-ref x j) (A j i)))
|
||||
(unsafe-fx+ j 1)))))))]
|
||||
[AtAv (lambda (x y t N) (Av x t N) (Atv t y N))]
|
||||
[N (command-line #:args (n) (string->number n))]
|
||||
[u (make-flvector N 1.0)]
|
||||
[v (make-flvector N)]
|
||||
[t (make-flvector N)])
|
||||
(for ([i (in-range 10)])
|
||||
(AtAv u v t N)
|
||||
(AtAv v u t N))
|
||||
(displayln (real->decimal-string
|
||||
(unsafe-flsqrt
|
||||
(let L ([vBv 0.0] [vv 0.0] [i 0])
|
||||
(if (unsafe-fx= i N) (unsafe-fl/ vBv vv)
|
||||
(let ([ui (unsafe-flvector-ref u i)] [vi (unsafe-flvector-ref v i)])
|
||||
(L (unsafe-fl+ vBv (unsafe-fl* ui vi))
|
||||
(unsafe-fl+ vv (unsafe-fl* vi vi))
|
||||
(unsafe-fx+ i 1))))))
|
||||
9)))
|
Loading…
Reference in New Issue
Block a user