mend.hs

data Genotype = AA | Aa | Xaa deriving Show
--data Poss = Poss Double Double Double deriving Show
type Poss = (Double, Double, Double)

mate :: Genotype -> Genotype -> Poss
mate AA AA = (1, 0, 0)
mate AA Aa = (0.5, 0.5, 0)
mate AA Xaa = (0, 1, 0)
mate Aa Aa = (0.25, 0.5, 0.25)
mate Aa Xaa = (0, 0.5, 0.5)
mate Xaa Xaa = (0, 0, 1)
mate x y = mate y x

sumPoss :: Poss -> Poss -> Poss
sumPoss (a0, a1, a2) (b0, b1, b2) = (a0+b0, a1+b1, a2+b2)

t :: Double -> Poss -> Poss
t k (a0, a1, a2) = (a0*k, a1*k, a2*k)

matePoss :: Poss -> Poss -> Poss
matePoss (xAA, aA, aa) (xBB, bB, bb) =
    ((xAA*xBB) `t` (mate AA AA)) `sumPoss` ((xAA*bB) `t` (mate AA Aa)) `sumPoss` ((xAA*bb) `t` (mate AA Xaa)) `sumPoss`
    ((aA*xBB) `t` (mate Aa AA)) `sumPoss` ((aA*bB) `t` (mate Aa Aa)) `sumPoss` ((aA*bb) `t` (mate Aa Xaa)) `sumPoss`
    ((aa*xBB) `t` (mate Xaa AA)) `sumPoss` ((aa*bB) `t` (mate Xaa Aa)) `sumPoss` ((aa*bb) `t` (mate Xaa Xaa))