forward-backward examle from AIMA ch. 15

forward_backward.hs

{-# Language FlexibleContexts #-}

import Data.Packed.Matrix
import Numeric.Container

normalize :: (Container Vector e) => Matrix e -> Matrix e
normalize m = let scaleFactor = sumElements m
              in (fromLists . map (map (/scaleFactor)) . toLists) m

forward :: (Product e, Container Vector e) =>
           [Matrix e] -> Matrix e -> Matrix e -> [Matrix e]
forward []     _ _ = []
forward (e:es) t f = let f' = normalize $ e `mXm` t `mXm` f
                     in  f':forward es t f'

backward :: (Product e, Container Vector e) =>
            [Matrix e] -> Matrix e -> Matrix e -> [Matrix e]
backward []     _ _ = []
backward (e:es) t b = let b' = normalize $ t `mXm` e `mXm` b
                      in  b':backward es t b'

forwardBackward :: (Product e, Container Vector e) =>
                   [Matrix e] -> Matrix e -> Matrix e -> Matrix e -> [Matrix e]
forwardBackward [] _ _ _ = []
forwardBackward e  t f b = map (normalize . fromLists) $ rowMult bs fs
    where fs      = map toLists $ f:forward e t f
          bs      = (map toLists . reverse) $ b:backward e t b
          rowMult = zipWith (zipWith (zipWith (*)))

main = let umbrella   = fromLists [[0.9,0.0],
                                   [0.0,0.2]]
           noUmbrella = fromLists [[0.1,0.0],
                                   [0.0,0.8]]
           t          = fromLists [[0.7,0.3]
                                  ,[0.3,0.7]]
           f00        = fromLists [[0.5],
                                   [0.5]]
           b55        = fromLists [[1.0],
                                   [1.0]]
           e          = [umbrella, umbrella, noUmbrella, umbrella, umbrella]
       in mapM_ (putStr . dispf 4) $ forwardBackward e t f00 b55