... is there a reason you aren't using the Chi-square test?

I'm not trying to solve the sample problem. That was just an example I found on the web and used as a test.

I set out to solve the problem of performing the FET using Perl. First I did it with Math::Pari, but which gives a result of 8.070604647867604097576877668E-7030 in 26ms, but I was unsure about the accuracy. It also imposes a binary dependancy.

#! perl -slw
use strict;
use Benchmark::Timer;
use List::Util qw[ sum reduce ];
use Math::Pari qw[ factorial ];

$a=$b;

sub product{ reduce{ $a *= $b } 1, @_ }

sub FishersExactTest {
    my @data = @_;
    return unless @data == 4;
    my @C = ( sum( @data[ 0, 2 ] ), sum( @data[ 1, 3 ] ) );
    my @R = ( sum( @data[ 0, 1 ] ), sum( @data[ 2, 3 ] ) );
    my $N =  sum @C;
    my $dividend = product map{ factorial $_ } grep $_, @R, @C;
    my $divisor  = product map{ factorial $_ } grep $_, $N, @data;
    return $dividend / $divisor;
}

my $T = new Benchmark::Timer;

$T->start( '' );
print FishersExactTest 989, 9400, 43300, 2400;;
$T->stop( '' );

$T->report;

__END__
P:\test>MP-FET.pl
8.070604647867604097576877668E-7030
  1 trial  of _default ( 25.852ms total), 25.852ms/trial
[download]

So, then I coded it using Math::BigFloat

#! perl -slw
use strict;
use Benchmark::Timer;
use List::Util qw[ reduce ];
use Math::BigFloat;

$a=$b;

sub product{ reduce{ $a *= $b } 1, @_ }
sub sum{ reduce{ $a += $b } 0, @_ }

sub FishersExactTest {
    my @data = map{ Math::BigFloat->new( $_ ) } @_;
    return unless @data == 4;
    my @C = ( sum( @data[ 0, 2 ] ), sum( @data[ 1, 3 ] ) );
    my @R = ( sum( @data[ 0, 1 ] ), sum( @data[ 2, 3 ] ) );
    my $N =  sum @C;
    my $dividend = product map{ $_->bfac } grep $_, @R, @C;
    my $divisor  = product map{ $_->bfac } grep $_, $N, @data;
    return $dividend / $divisor;
}

my $T = new Benchmark::Timer;

$T->start( '' );
print FishersExactTest 989, 9400, 43300, 2400;;
$T->stop( '' );

$T->report;
[download]

But that ran for 20 minutes without producing any output before I killed it (I've set it running again now, and my machines fan has been thrashing at full speed for the last 25 minutes).

Whilst I was waiting for the BigFloat version, I coded this version which attempts to reduce the size of the problem by eliminating (exactly common) factors:

sub FishersExactTest2 {
    my @data = @_;
    return unless @data == 4;
    my @C = ( sum( @data[ 0, 2 ] ), sum( @data[ 1, 3 ] ) );
    my @R = ( sum( @data[ 0, 1 ] ), sum( @data[ 2, 3 ] ) );
    my $N =  sum @C;
    my %dividends; $dividends{ $_ }++ for map{ factors $_ } grep $_, @
+R, @C;
    my %divisors;  $divisors { $_ }++ for map{ factors $_ } grep $_, $
+N, @data;
    for my $i ( keys %divisors ) {
        if( exists $dividends{ $i } ) {
            $divisors{ $i }--, $dividends{ $i }-- 
                while $divisors{ $i } and $dividends{ $i };
            delete $divisors { $i } unless $divisors { $i };
            delete $dividends{ $i } unless $dividends{ $i };
        }
    }
    my $dividend = product( map{ ( $_ ) x $dividends{ $_ } } keys %div
+idends );
    my $divisor  = product( map{ ( $_ ) x $divisors { $_ } } keys %div
+isors  );
    return $dividend / $divisor;
}
[download]

This works well for values smallish values, but cannot handle the example I gave above (NV overflow).

It was then I started thinking about how to eliminate more factors from the equation so as to reduce the size of the intermediate terms, and posted my SoPW. I think that hv's solution of expanding all terms to their prime factorizations before performing the cancelling out will be a winner--but I haven't finished coding that yet.

My Haskell implementation represents numbers as the ratio of products of ordered integer streams. For example, I represent 3!/(4*5) as (R numerator=[1,2,3] denominator=[4,5]). In this representation, multiplication becomes merging the numerator and denominator streams and then canceling the first stream by the second. In this way I can remove all cancelable original terms in the P_cutoff formula before finally multiplying the terms that remain.

*FishersExactTest> fac 6
R {numer = [2,3,4,5,6], denom = []}
*FishersExactTest> fac 3
R {numer = [2,3], denom = []}
*FishersExactTest> fac 6 `rdivide` fac 3
R {numer = [4,5,6], denom = []}
[download]

Here's the example from the MathWorld page:

*FishersExactTest> rpCutoff [ [5,0],
                              [1,4] ]
R {numer = [2,3,4,5], denom = [7,8,9,10]}
*FishersExactTest> fromRational . toRatio $ it 
2.3809523809523808e-2
[download]

The code:

module FishersExactTest (pCutoff) where

import Data.Ratio
import Data.List (transpose)

pCutoff = toRatio . rpCutoff

rpCutoff rows =
    facproduct (rs ++ cs) `rdivide` facproduct (n:xs)
  where
    rs = map sum rows
    cs = map sum (transpose rows)
    n  = sum rs
    xs = concat rows -- cells

facproduct = rproduct . map fac

fac n | n < 2     = runit
      | otherwise = R [2..n] []

-- I represent numbers as ratios of products of integer streams
-- R [1,2,3] [4,5] === (1 * 2 * 3) / (4 * 5)

data Rops = R { numer :: [Int], denom :: [Int] } deriving Show

runit             = R [] [] -- the number 1
toRatio (R ns ds) = bigProduct ns % bigProduct ds
bigProduct        = product . map toInteger

-- multiplication is merging numerator and denominator streams
-- and then canceling the first by the second

rtimes (R xns xds) (R yns yds) =
    uncurry R $ (merge xns yns) `cancel` (merge xds yds)

rproduct = foldr rtimes runit

-- division is multiplication by the inverse

rdivide x (R yns yds) = rtimes x (R yds yns)

-- helpers

merge (x:xs) (y:ys)
    | x < y     = x : merge xs (y:ys)
    | otherwise = y : merge (x:xs) ys
merge [] ys     = ys
merge xs []     = xs

cancel (x:xs) (y:ys)
    | x == y    = cancel xs ys
    | x < y     = let (xs', ys') = cancel xs (y:ys) in (x:xs', ys')
    | otherwise = let (xs', ys') = cancel (x:xs) ys in (xs', y:ys')
cancel xs ys    = (xs, ys)
[download]

Tom Moertel : Blog / Talks / CPAN / LectroTest / PXSL / Coffee / Movie Rating Decoder

Okay. What did I do wrong?

Read more... (795 Bytes)