Ticket #4303: Fisher.hs

module Fisher (
    fromMessages
    ) where

import Control.Monad.ST( unsafeIOToST )
import Debug.Trace( putTraceMsg )

import Numeric.LinearAlgebra

import History( History )
import Model( Model )
import Types

import qualified Model as Model
import qualified Vars as Vars
import qualified GHC.ST

        
fromMessages :: Model -> [(Message, History)] -> Herm Matrix Double
fromMessages m mhs0 = runHermMatrix $ do
    f <- newMatrix (p,p) 0
    go 0 f mhs0
  where
    p = Vars.dim $ Model.vars m
    
    go :: Integer -> STMatrix s Double -> [(Message,History)] -> GHC.ST.ST s (Herm (STMatrix s) Double)
    go n f [] = return $ Herm defaultCovUplo f
    go n f ((msg,h):mhs) = let
        (Herm _ f') = Model.covVars m h (messageFrom msg)
        l = fromIntegral $ length $ messageTo msg
        in do
            unsafeIOToST $ putTraceMsg $ show n
            addToMatrixWithScales 1 f l f' f
            go (n+1) f mhs