f2dc2027f6
in the original GitHub fork: https://github.com/ntoronto/racket Some things about this are known to be broken (most egregious is that the array tests DO NOT RUN because of a problem in typed/rackunit), about half has no coverage in the tests, and half has no documentation. Fixes and docs are coming. This is committed now to allow others to find errors and inconsistency in the things that appear to be working, and to give the author a (rather incomplete) sense of closure.
53 lines
2.1 KiB
Racket
53 lines
2.1 KiB
Racket
#lang typed/racket/base
|
|
|
|
(require racket/sequence
|
|
racket/list
|
|
"../../base.rkt"
|
|
"../../flonum.rkt"
|
|
"expected-values.rkt"
|
|
"statistics-utils.rkt")
|
|
|
|
(provide covariance/means
|
|
correlation/means
|
|
covariance
|
|
correlation)
|
|
|
|
(: covariance* (Symbol Real Real (Sequenceof Real) (Sequenceof Real) (Option (Sequenceof Real))
|
|
(U #t #f Real) -> Real))
|
|
(define (covariance* name mx my xs ys ws bias)
|
|
(define-values (zs n)
|
|
(cond [ws (let-values ([(xs ws) (sequences->weighted-samples name xs ws)]
|
|
[(ys) (sequence->list ys)])
|
|
(check-lengths! name "value sequences" xs ys (length xs) (length ys))
|
|
(values (map (λ: ([x : Real] [y : Real] [w : Real]) (* w (- x mx) (- y my)))
|
|
xs ys ws)
|
|
(max 0 (sum ws))))]
|
|
[else (let ([xs (sequence->list xs)]
|
|
[ys (sequence->list ys)])
|
|
(check-lengths! name "value sequences" xs ys (length xs) (length ys))
|
|
(values (map (λ: ([x : Real] [y : Real]) (* (- x mx) (- y my))) xs ys)
|
|
(length xs)))]))
|
|
(define m2 (/ (sum zs) n))
|
|
(adjust-covariance m2 n bias))
|
|
|
|
(: covariance/means (Correlation/Means-Fun Real))
|
|
(define (covariance/means mx my xs ys [ws #f] #:bias [bias #f])
|
|
(covariance* 'covariance/means mx my xs ys ws bias))
|
|
|
|
(: covariance (Correlation-Fun Real))
|
|
(define (covariance xs ys [ws #f] #:bias [bias #f])
|
|
(covariance* 'covariance (mean xs ws) (mean ys ws) xs ys ws bias))
|
|
|
|
(: correlation/means (Correlation/Means-Fun Real))
|
|
(define (correlation/means mx my xs ys [ws #f] #:bias [bias #f])
|
|
(define g (covariance/means mx my xs ys ws #:bias bias))
|
|
(define sx (stddev/mean mx xs ws #:bias bias))
|
|
(define sy (stddev/mean my ys ws #:bias bias))
|
|
(cond [(zero? sx) +nan.0]
|
|
[(zero? sy) +nan.0]
|
|
[else (/ g sx sy)]))
|
|
|
|
(: correlation (Correlation-Fun Real))
|
|
(define (correlation xs ys [ws #f] #:bias [bias #f])
|
|
(correlation/means (mean xs ws) (mean ys ws) xs ys ws #:bias bias))
|