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)