hmm 0.1 → 0.1.1

raw patch · 3 files changed

+26/−97 lines, 3 filesdep +logfloatPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: logfloat

API changes (from Hackage documentation)

Files

• Data/HMM.hs +23/−41
• Data/Lognum.hs +0/−50
• hmm.cabal +3/−6

@@ -1,33 +1,37 @@+{-# LANGUAGE ParallelListComp #-}+ module Data.HMM     (Prob, HMM, train, bestSequence, sequenceProb)     where  import qualified Data.Map as M-import Data.List (sort, groupBy, maximumBy)+import Data.List (sort, groupBy, maximumBy, foldl') import Data.Maybe (fromMaybe, fromJust)-import System.IO.Unsafe (unsafeInterleaveIO)-import System.Environment (getArgs)+import Data.Ord (comparing)+import Data.Function (on) import Control.Monad-import qualified Data.Foldable-import Debug.Trace-import Data.Lognum+import Data.Number.LogFloat -type Prob = Lognum Double+type Prob = LogFloat  -- | The type of Hidden Markov Models. data HMM state observation = HMM [state] [Prob] [[Prob]] (observation -> [Prob]) +instance (Show state, Show observation) => Show (HMM state observation) where+    show (HMM states probs tpm _) = "HMM " ++ show states ++ " "+                                           ++ show probs ++ " " ++ show tpm ++ " <func>"+ -- | Perform a single step in the Viterbi algorithm. --   --   Takes a list of path probabilities, and an observation, and returns the updated --   list of (surviving) paths with probabilities.-viterbi :: Ord observation =>-               HMM state observation+viterbi ::     HMM state observation             -> [(Prob, [state])]             -> observation             -> [(Prob, [state])]-viterbi (HMM states _ state_transitions observations) prev x = -    [maximumBy (compare `on` fst)+viterbi (HMM states _ state_transitions observations) prev x =+    deepSeq prev `seq`+    [maximumBy (comparing fst)             [(transition_prob * prev_prob * observation_prob,                new_state:path)                     | transition_prob <- transition_probs@@ -37,6 +41,9 @@         | new_state <- states]     where         observation_probs = observations x+        deepSeq ((x, y:ys):xs) = x `seq` y `seq` (deepSeq xs)+        deepSeq ((x, _):xs) = x `seq` (deepSeq xs)+        deepSeq [] = []  -- | The initial value for the Viterbi algorithm viterbi_init :: HMM state observation -> [(Prob, [state])]@@ -46,12 +53,12 @@ --  --   Each item in the input and output list is the probability that the system --   ended in the respective state.-forward :: Ord observation =>-               HMM state observation+forward ::     HMM state observation             -> [Prob]             -> observation             -> [Prob] forward (HMM _ _ state_transitions observations) prev x =+    last prev `seq`     [sum [transition_prob * prev_prob * observation_prob                 | transition_prob <- transition_probs                 | prev_prob <- prev@@ -79,17 +86,9 @@                             . histogram  histogram :: (Ord a, Fractional prob) => [a] -> M.Map a prob-histogram xs = let hist = foldr (flip (M.insertWith (+)) 1) M.empty xs in+histogram xs = let hist = foldl' (flip $ flip (M.insertWith (+)) 1) M.empty xs in                 M.map (/ M.fold (+) 0 hist) hist -readBrownFile :: FilePath -> IO [(String, String)]-readBrownFile = (liftM (map split . words)) . readFile-    where-        split [] = ([], [])-        split ('/':xs) = ([], xs)-        split (x:xs) = let (first, snd) = split xs in-                        (x:first, snd)- -- | Calculate the parameters of an HMM from a list of observations --   and the corresponding states. train :: (Ord observation, Ord state) =>@@ -124,29 +123,12 @@                                            else                                             p : fill states xs' --- | Test Viterbi's algorithm on an HMM by comparing the predicted states---   against known states for the observations.-testViterbi :: (Ord observation, Ord state) =>-                   HMM state observation-                -> [(observation, state)]-                -> Rational-testViterbi hmm testData = (fromIntegral $ length $ filter id $ zipWith (==) (bestSequence hmm observations) states) -                            / (fromIntegral $ length testData)-    where-        observations = map fst testData-        states = map snd testData--train2 :: FilePath -> IO (HMM String String)-train2 = (liftM train) . readBrownFile- -- | Calculate the most likely sequence of states for a given sequence of observations --   using Viterbi's algorithm bestSequence :: (Ord observation) => HMM state observation -> [observation] -> [state]-bestSequence hmm = (reverse . tail . snd . (maximumBy (compare `on` fst))) . (foldl (viterbi hmm) (viterbi_init hmm))+bestSequence hmm = (reverse . tail . snd . (maximumBy (comparing fst))) . (foldl' (viterbi hmm) (viterbi_init hmm))  -- | Calculate the probability of a given sequence of observations --    using the forward algorithm. sequenceProb :: (Ord observation) => HMM state observation -> [observation] -> Prob-sequenceProb hmm = sum . (foldl (forward hmm) (forward_init hmm))--on f g a b = f (g a) (g b)+sequenceProb hmm = sum . (foldl' (forward hmm) (forward_init hmm))

@@ -1,50 +0,0 @@-module Data.Lognum (Lognum)-    where--import Data.Ratio--data Lognum t = L !Int !t deriving (Eq, Ord)--fromFloating :: (Floating t, Ord t) => t -> Lognum t-fromFloating a = case a `compare` 0 of-                LT -> L (-1) (log $ -a)-                EQ -> L 0 0-                GT -> L 1 (log a)--toFloating :: (Floating t, Ord t) => Lognum t -> t-toFloating (L s m) = case s of-                        -1 -> negate $ exp m-                        0  -> 0-                        1  -> exp m--logify2 :: (Floating t, Ord t) => (t -> t -> t) -> (Lognum t -> Lognum t -> Lognum t)-logify2 (*) a b = fromFloating $ toFloating a * toFloating b--instance (Floating t, Ord t) => Show (Lognum t) where-    show = show . toFloating--instance (Floating t, Ord t) => Num (Lognum t) where-    (+) = logify2 (+)--    (L s m) * (L s' m') =   if s == 0 || s' == 0 then-                                L 0 0-                            else-                                L (s*s') (m+m')--    (-) = logify2 (-)--    negate (L s m) = L (negate s) m--    abs (L s m) = L (abs s) m--    signum (L s m) = (L s 0)--    fromInteger = fromFloating . fromInteger--instance (Floating t, Ord t) => Fractional (Lognum t) where-    _ / (L 0 _) = error "division by zero"-    (L s m) / (L s' m') = L (s*s') (m-m')-    -    recip (L s m) = L s (-m)-    -    fromRational x = (fromInteger $ numerator x) / (fromInteger $ denominator x)

@@ -1,5 +1,5 @@ Name:               hmm-Version:            0.1+Version:            0.1.1 Description:     A simple library for working with Hidden Markov Models.     Should be usable even by people who are not familiar with@@ -20,15 +20,12 @@  Library     if flag(small_base)-        Build-Depends:  base >= 3, containers+        Build-Depends:  base >= 3, containers, logfloat     else-        Build-Depends:  base < 3+        Build-Depends:  base < 3, logfloat              Exposed-Modules:         Data.HMM--    Other-Modules:-        Data.Lognum      Extensions:         ParallelListComp