67 lines
2.1 KiB
Scheme
67 lines
2.1 KiB
Scheme
;; The Great Computer Language Shootout
|
|
;; http://shootout.alioth.debian.org/
|
|
|
|
;; Translated directly from the C# version, which was:
|
|
;; contributed by Isaac Gouy
|
|
|
|
#lang scheme/base
|
|
(require scheme/cmdline
|
|
scheme/flonum
|
|
scheme/unsafe/ops)
|
|
|
|
(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)
|
|
(unsafe-flsqrt (unsafe-fl/ vBv vv))
|
|
(let ([vi (unsafe-flvector-ref v i)])
|
|
(loop (unsafe-fx+ 1 i)
|
|
(unsafe-fl+ vBv (unsafe-fl* (unsafe-flvector-ref u i) vi))
|
|
(unsafe-fl+ vv (unsafe-fl* vi vi))))))))
|
|
|
|
;; return element i,j of infinite matrix A
|
|
(define (A i j)
|
|
(unsafe-fl/ 1.0
|
|
(unsafe-fl+
|
|
(unsafe-fl* (unsafe-fx->fl (unsafe-fx+ i j))
|
|
(unsafe-fl/ (unsafe-fx->fl
|
|
(unsafe-fx+ i (unsafe-fx+ j 1)))
|
|
2.0))
|
|
(unsafe-fx->fl (unsafe-fx+ i 1)))))
|
|
|
|
;; multiply vector v by matrix A
|
|
(define (MultiplyAv n v Av)
|
|
(for ([i (in-range n)])
|
|
(unsafe-flvector-set! Av i
|
|
(for/fold ([r 0.0])
|
|
([j (in-range n)])
|
|
(unsafe-fl+ r (unsafe-fl* (A i j) (unsafe-flvector-ref v j)))))))
|
|
|
|
;; multiply vector v by matrix A transposed
|
|
(define (MultiplyAtv n v Atv)
|
|
(for ([i (in-range n)])
|
|
(unsafe-flvector-set! Atv i
|
|
(for/fold ([r 0.0])
|
|
([j (in-range n)])
|
|
(unsafe-fl+ r (unsafe-fl* (A j i) (unsafe-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))
|
|
|