module ELynx.Data.MarkovProcess.MixtureModel
(
Weight
, Component (Component)
, MixtureModel (MixtureModel)
, name
, getAlphabet
, getWeights
, getSubstitutionModels
, fromSubstitutionModels
, concatenate
, scale
, normalize
, appendName
, isValid
, summarizeComponent
, summarize
) where
import qualified Data.ByteString.Builder as L
import qualified Data.ByteString.Lazy.Char8 as L
import ELynx.Data.Alphabet.Alphabet
import qualified ELynx.Data.MarkovProcess.SubstitutionModel as S
import ELynx.Tools.Equality (allEqual)
type Weight = Double
data Component = Component
{ weight :: Weight
, substModel :: S.SubstitutionModel
}
deriving (Show, Read)
data MixtureModel = MixtureModel
{ name :: S.Name
, components :: [Component]
}
deriving (Show, Read)
getAlphabet :: MixtureModel -> Alphabet
getAlphabet mm = if isValid mm
then S.alphabet . substModel $ head (components mm)
else error "Mixture model is invalid."
getWeights :: MixtureModel -> [Weight]
getWeights = map weight . components
getSubstitutionModels :: MixtureModel -> [S.SubstitutionModel]
getSubstitutionModels = map substModel . components
fromSubstitutionModels :: S.Name -> [Weight] -> [S.SubstitutionModel] -> MixtureModel
fromSubstitutionModels n ws sms = MixtureModel n comps
where comps = zipWith Component ws sms
concatenate :: S.Name -> [MixtureModel] -> MixtureModel
concatenate n mms = MixtureModel n $ concatMap components mms
scaleComponent :: Double -> Component -> Component
scaleComponent s c = c {substModel = s'}
where s' = S.scale s $ substModel c
scale :: Double -> MixtureModel -> MixtureModel
scale s m = m {components = cs'}
where cs = components m
cs' = map (scaleComponent s) cs
normalize :: MixtureModel -> MixtureModel
normalize mm = scale (1/c) mm
where c = sum $ zipWith (*) weights scales
weights = getWeights mm
scales = map S.totalRate $ getSubstitutionModels mm
appendNameComponent :: S.Name -> Component -> Component
appendNameComponent n c = c {substModel = s'}
where s' = S.appendName n $ substModel c
appendName :: S.Name -> MixtureModel -> MixtureModel
appendName n m = m {components = cs'}
where cs = components m
cs' = map (appendNameComponent n) cs
isValid :: MixtureModel -> Bool
isValid m = not (null $ components m) && allEqual alphabets
where alphabets = map (S.alphabet . substModel) $ components m
summarizeComponent :: Component -> [L.ByteString]
summarizeComponent c =
L.pack "Weight: " <> (L.toLazyByteString . L.doubleDec $ weight c)
: S.summarize (substModel c)
summarize :: MixtureModel -> [L.ByteString]
summarize m =
[ L.pack $ "Mixture model: " ++ name m ++ "."
, L.pack $ "Number of components: " ++ show n ++ "." ]
++ detail
where
n = length $ components m
detail = if n <= 100
then concat [ L.pack ("Component " ++ show i ++ ":") : summarizeComponent c
| (i, c) <- zip [1 :: Int ..] (components m) ]
else []