83 lines
2.9 KiB
Racket
83 lines
2.9 KiB
Racket
#lang typed/racket/base
|
|
|
|
(require "../vector/vector.rkt"
|
|
"types.rkt"
|
|
"factorial.rkt"
|
|
"binomial.rkt")
|
|
|
|
(provide bernoulli-number)
|
|
|
|
;; Number of globally memoized Bernoulli numbers
|
|
(define num-global-bs 200)
|
|
;; Globally memoized numbers
|
|
(: global-bs (Vectorof Exact-Rational))
|
|
(define global-bs (make-vector num-global-bs 0))
|
|
(vector-set! global-bs 0 1)
|
|
(vector-set! global-bs 1 -1/2)
|
|
|
|
(: bernoulli* : Natural -> Exact-Rational)
|
|
; compute the n'th Bernoulli number
|
|
; <http://mathworld.wolfram.com/BernoulliNumber.html>
|
|
; <http://en.wikipedia.org/wiki/Bernoulli_number>
|
|
(define (bernoulli* n)
|
|
; Implementation note:
|
|
; - uses Ramanujan's improvement of the standard recurrence relation
|
|
; of the Bernoulli numbers:
|
|
; <http://en.wikipedia.org/wiki/Bernoulli_number#Ramanujan.27s_congruences>
|
|
; - memoizes previous computations
|
|
; - avoids an explicit call to compute the binomials
|
|
(define: local-bs : (Vectorof Exact-Rational)
|
|
(make-vector (max 0 (- (+ n 1) num-global-bs)) 0))
|
|
|
|
(: bs-ref! (Integer (-> Exact-Rational) -> Exact-Rational))
|
|
(define (bs-ref! n thnk)
|
|
(cond [(n . < . num-global-bs)
|
|
(vector-ref! global-bs n thnk exact-zero?)]
|
|
[else
|
|
(vector-ref! local-bs (- n num-global-bs) thnk exact-zero?)]))
|
|
|
|
(: next-binom : Integer Integer Integer -> Integer)
|
|
(define (next-binom old x k)
|
|
; calculate binom(x,k-6) from the old binom(x,k)
|
|
(let ([k-1 (- k 1)] [k-2 (- k 2)] [k-3 (- k 3)] [k-4 (- k 4)] [k-5 (- k 5)])
|
|
(assert
|
|
(* old
|
|
(/ (* k k-1 k-2 k-3 k-4 k-5 )
|
|
(* (- x k-1) (- x k-2) (- x k-3) (- x k-4) (- x k-5) (- x (- k 6)))))
|
|
integer?)))
|
|
|
|
(: A : Natural Integer -> Exact-Rational)
|
|
(define (A m M)
|
|
(cond
|
|
[(< M 1) 0]
|
|
[else
|
|
(define: m-6 : Natural (assert (- m 6) natural?))
|
|
(define-values (sum bin)
|
|
(for/fold: ([sum : Exact-Rational 0]
|
|
[bin : Integer (binomial (+ m 3) m-6)]
|
|
) ([j (in-range 1 (+ M 1))])
|
|
(values (+ sum (* bin (bern (assert (- m (* 6 j)) natural?))))
|
|
(next-binom bin (+ m 3) (- m (* 6 j))))))
|
|
sum]))
|
|
|
|
(: bern : Natural -> Exact-Rational)
|
|
(define (bern n)
|
|
(bs-ref!
|
|
n (λ ()
|
|
(cond
|
|
[(odd? n) 0]
|
|
[else
|
|
(define r (remainder n 6))
|
|
(cond
|
|
[(= r 0) (/ (- (/ (+ n 3) 3) (A n (quotient n 6))) (binomial (+ n 3) n))]
|
|
[(= r 2) (/ (- (/ (+ n 3) 3) (A n (quotient (- n 2) 6))) (binomial (+ n 3) n))]
|
|
[(= r 4) (/ (- (/ (+ n 3) -6) (A n (quotient (- n 4) 6))) (binomial (+ n 3) n))]
|
|
;; n is even, so r can only be 0, 2 or 4
|
|
[else (error 'unreachable-code)])]))))
|
|
(bern n))
|
|
|
|
(: bernoulli-number (Integer -> Exact-Rational))
|
|
(define (bernoulli-number n)
|
|
(cond [(n . < . 0) (raise-argument-error 'bernoulli-number "Natural" n)]
|
|
[else (bernoulli* n)]))
|