Changeset 21858 in project


Ignore:
Timestamp:
12/08/10 02:04:47 (9 years ago)
Author:
petercrlane
Message:

statistics: fixed error in fisher-exact-test and added test

Location:
release/4/statistics/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/statistics/trunk/statistics.scm

    r21795 r21858  
    965965  (define (fisher-exact-test a b c d . args)
    966966    (let ((tails (get-keyword #:tails args (lambda () ':both))))
    967       (define (table-probability a b c d)
    968         (let ((n (+ a b c d)))
    969           (/ (* (factorial (+ a b)) (factorial (+ c d))
    970                 (factorial (+ a c)) (factorial (+ b d)))
    971              (* (factorial n) (factorial a) (factorial b)
    972                 (factorial c) (factorial d)))))
     967      (define (table-probability ta tb tc td)
     968        (let ((tn (+ ta tb tc td)))
     969          (/ (* 1.0 (factorial (+ ta tb)) (factorial (+ tc td))
     970                (factorial (+ ta tc)) (factorial (+ tb td)))
     971             (* 1.0 (factorial tn) (factorial ta) (factorial tb)
     972                (factorial tc) (factorial td)))))
    973973      (let* ((row-margin1 (+ a b))
    974974             (row-margin2 (+ c d))
     
    10041004                           (table-probability test-a test-b test-c test-d)))
    10051005            (loop (+ 1 i))))
    1006         (let ((above 0)
    1007               (below 0))
     1006        (let ((above 0.0)
     1007              (below 0.0))
    10081008          (let loop ((i 0))
    10091009            (unless (= i (vector-length table-probabilities))
    10101010              (if (< i (+ 1 a))
    10111011                (set! above (+ above (vector-ref table-probabilities i)))
    1012                 (set! below (+ below (vector-ref table-probabilities i))))))
     1012                (set! below (+ below (vector-ref table-probabilities i))))
     1013              (loop (+ 1 i))))
    10131014          (case tails
    10141015            ((:both) (* 2 (min above below)))
  • release/4/statistics/trunk/tests/run.scm

    r21671 r21858  
    270270
    271271(check (t-test-one-sample-sse 5.0 5.2 0.5)
    272        => 163.0)
     272       => 163)
    273273
    274274(let-values (((n1 n2) (t-test-two-sample-sse 5.1 0.5 5.2 0.3)))
     
    311311       (=> =5) 0.460224906289046)
    312312
     313(check (fisher-exact-test 10 20 30 40)
     314       (=> =5) 0.5066621427235114)
     315
    313316;; -- summarise results of tests
    314317
Note: See TracChangeset for help on using the changeset viewer.