module Math.HiddenMarkovModel.Utility where

import qualified Numeric.LAPACK.Matrix.Hermitian as Hermitian
import qualified Numeric.LAPACK.Matrix.Layout as Layout
import qualified Numeric.LAPACK.Matrix.Extent as Extent
import qualified Numeric.LAPACK.Matrix.Square as Square
import qualified Numeric.LAPACK.Matrix.Array as ArrMatrix
import qualified Numeric.LAPACK.Matrix as Matrix
import qualified Numeric.LAPACK.Vector as Vector
import Numeric.LAPACK.Matrix.Array (ArrayMatrix)
import Numeric.LAPACK.Vector (Vector, (.*|))

import qualified Numeric.Netlib.Class as Class

import qualified Data.Array.Comfort.Storable as StorableArray
import qualified Data.Array.Comfort.Boxed as Array
import qualified Data.Array.Comfort.Shape as Shape

import Foreign.Storable (Storable)

import qualified System.Random as Rnd

import qualified Control.Monad.Trans.State as MS


normalizeProb :: (Shape.C sh, Class.Real a) => Vector sh a -> Vector sh a
normalizeProb :: Vector sh a -> Vector sh a
normalizeProb = (a, Vector sh a) -> Vector sh a
forall a b. (a, b) -> b
snd ((a, Vector sh a) -> Vector sh a)
-> (Vector sh a -> (a, Vector sh a)) -> Vector sh a -> Vector sh a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector sh a -> (a, Vector sh a)
forall sh a. (C sh, Real a) => Vector sh a -> (a, Vector sh a)
normalizeFactor

normalizeFactor :: (Shape.C sh, Class.Real a) => Vector sh a -> (a, Vector sh a)
normalizeFactor :: Vector sh a -> (a, Vector sh a)
normalizeFactor Vector sh a
xs =
   let c :: a
c = Vector sh a -> a
forall sh a. (C sh, Floating a) => Vector sh a -> a
Vector.sum Vector sh a
xs
   in  (a
c, a -> a
forall a. Fractional a => a -> a
recip a
c a -> Vector sh a -> Vector sh a
forall sh a. (C sh, Floating a) => a -> Vector sh a -> Vector sh a
.*| Vector sh a
xs)

-- see htam:Stochastic
randomItemProp ::
   (Rnd.RandomGen g, Rnd.Random b, Num b, Ord b) =>
   [(a,b)] -> MS.State g a
randomItemProp :: [(a, b)] -> State g a
randomItemProp [(a, b)]
props =
   let ([a]
keys,[b]
ps) = [(a, b)] -> ([a], [b])
forall a b. [(a, b)] -> ([a], [b])
unzip [(a, b)]
props
   in  do b
p <- (g -> (b, g)) -> StateT g Identity b
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
MS.state ((b, b) -> g -> (b, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
Rnd.randomR (b
0, [b] -> b
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [b]
ps))
          a -> State g a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> State g a) -> a -> State g a
forall a b. (a -> b) -> a -> b
$
             (a, b) -> a
forall a b. (a, b) -> a
fst ((a, b) -> a) -> (a, b) -> a
forall a b. (a -> b) -> a -> b
$ [(a, b)] -> (a, b)
forall a. [a] -> a
head ([(a, b)] -> (a, b)) -> [(a, b)] -> (a, b)
forall a b. (a -> b) -> a -> b
$ ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((b
0b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<=) (b -> Bool) -> ((a, b) -> b) -> (a, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> b
forall a b. (a, b) -> b
snd) ([(a, b)] -> [(a, b)]) -> [(a, b)] -> [(a, b)]
forall a b. (a -> b) -> a -> b
$
             [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
keys ([b] -> [(a, b)]) -> [b] -> [(a, b)]
forall a b. (a -> b) -> a -> b
$ [b] -> [b]
forall a. [a] -> [a]
tail ([b] -> [b]) -> [b] -> [b]
forall a b. (a -> b) -> a -> b
$ (b -> b -> b) -> b -> [b] -> [b]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (-) b
p [b]
ps

attachOnes :: (Num b) => [a] -> [(a,b)]
attachOnes :: [a] -> [(a, b)]
attachOnes = (a -> (a, b)) -> [a] -> [(a, b)]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b -> (a, b)) -> b -> a -> (a, b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) b
1)


vectorDim :: Shape.C sh => Vector sh a -> Int
vectorDim :: Vector sh a -> Int
vectorDim = sh -> Int
forall sh. C sh => sh -> Int
Shape.size (sh -> Int) -> (Vector sh a -> sh) -> Vector sh a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector sh a -> sh
forall sh a. Array sh a -> sh
StorableArray.shape


hermitianFromList ::
   (Shape.C sh, Class.Floating a) => sh -> [a] -> Hermitian.Hermitian sh a
hermitianFromList :: sh -> [a] -> Hermitian sh a
hermitianFromList = Order -> sh -> [a] -> Hermitian sh a
forall sh a.
(C sh, Floating a) =>
Order -> sh -> [a] -> Hermitian sh a
Hermitian.fromList Order
Layout.RowMajor


squareConstant ::
   (Shape.C sh, Class.Real a) => sh -> a -> Matrix.Square sh a
squareConstant :: sh -> a -> Square sh a
squareConstant =
   (Array (Square sh) a -> Square sh a
forall pack prop lower upper meas vert horiz height width shape a.
(FromPlain pack prop lower upper meas vert horiz height width,
 Plain pack prop lower upper meas vert horiz height width ~ shape,
 Measure meas, C vert, C horiz, C height, C width, Floating a) =>
Array shape a
-> ArrayMatrix pack prop lower upper meas vert horiz height width a
ArrMatrix.fromVector (Array (Square sh) a -> Square sh a)
-> (a -> Array (Square sh) a) -> a -> Square sh a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a -> Array (Square sh) a) -> a -> Square sh a)
-> (sh -> a -> Array (Square sh) a) -> sh -> a -> Square sh a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   Square sh -> a -> Array (Square sh) a
forall sh a. (C sh, Floating a) => sh -> a -> Vector sh a
Vector.constant (Square sh -> a -> Array (Square sh) a)
-> (sh -> Square sh) -> sh -> a -> Array (Square sh) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Order -> sh -> Square sh
forall sh. Order -> sh -> Square sh
Layout.square Order
Layout.RowMajor

squareFromLists ::
   (Shape.C sh, Eq sh, Storable a) => sh -> [Vector sh a] -> Matrix.Square sh a
squareFromLists :: sh -> [Vector sh a] -> Square sh a
squareFromLists sh
sh =
   Full Size Big Big sh sh a -> Square sh a
forall meas vert horiz sh a.
(Measure meas, C vert, C horiz, Eq sh) =>
Full meas vert horiz sh sh a -> Square sh a
Square.fromFull (Full Size Big Big sh sh a -> Square sh a)
-> ([Vector sh a] -> Full Size Big Big sh sh a)
-> [Vector sh a]
-> Square sh a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sh -> Array sh (Vector sh a) -> Full Size Big Big sh sh a
forall height width a.
(C height, C width, Eq width, Storable a) =>
width -> Array height (Vector width a) -> General height width a
Matrix.fromRowArray sh
sh (Array sh (Vector sh a) -> Full Size Big Big sh sh a)
-> ([Vector sh a] -> Array sh (Vector sh a))
-> [Vector sh a]
-> Full Size Big Big sh sh a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sh -> [Vector sh a] -> Array sh (Vector sh a)
forall sh a. C sh => sh -> [a] -> Array sh a
Array.fromList sh
sh

diagonal :: (Shape.C sh, Class.Real a) => Vector sh a -> Matrix.Diagonal sh a
diagonal :: Vector sh a -> Diagonal sh a
diagonal = Order -> Vector sh a -> Diagonal sh a
forall property pack lower upper sh a.
(Diagonal property, Quadratic pack property lower upper, C sh,
 Floating a) =>
Order -> Vector sh a -> Quadratic pack property lower upper sh a
Matrix.diagonal Order
Layout.RowMajor


newtype Distance f a = Distance {Distance f a -> f a -> f a -> a
getDistance :: f a -> f a -> a}

distance ::
   (Shape.C sh, Eq sh, Class.Real a) =>
   Vector sh a -> Vector sh a -> a
distance :: Vector sh a -> Vector sh a -> a
distance =
   Distance (Array sh) a -> Vector sh a -> Vector sh a -> a
forall (f :: * -> *) a. Distance f a -> f a -> f a -> a
getDistance (Distance (Array sh) a -> Vector sh a -> Vector sh a -> a)
-> Distance (Array sh) a -> Vector sh a -> Vector sh a -> a
forall a b. (a -> b) -> a -> b
$
   Distance (Array sh) Float
-> Distance (Array sh) Double -> Distance (Array sh) a
forall a (f :: * -> *). Real a => f Float -> f Double -> f a
Class.switchReal
      ((Array sh Float -> Array sh Float -> Float)
-> Distance (Array sh) Float
forall (f :: * -> *) a. (f a -> f a -> a) -> Distance f a
Distance ((Array sh Float -> Array sh Float -> Float)
 -> Distance (Array sh) Float)
-> (Array sh Float -> Array sh Float -> Float)
-> Distance (Array sh) Float
forall a b. (a -> b) -> a -> b
$ (Array sh Float -> Float
forall sh a. (C sh, Floating a) => Vector sh a -> RealOf a
Vector.normInf (Array sh Float -> Float)
-> (Array sh Float -> Array sh Float) -> Array sh Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Array sh Float -> Array sh Float) -> Array sh Float -> Float)
-> (Array sh Float -> Array sh Float -> Array sh Float)
-> Array sh Float
-> Array sh Float
-> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array sh Float -> Array sh Float -> Array sh Float
forall sh a.
(C sh, Eq sh, Floating a) =>
Vector sh a -> Vector sh a -> Vector sh a
Vector.sub)
      ((Array sh Double -> Array sh Double -> Double)
-> Distance (Array sh) Double
forall (f :: * -> *) a. (f a -> f a -> a) -> Distance f a
Distance ((Array sh Double -> Array sh Double -> Double)
 -> Distance (Array sh) Double)
-> (Array sh Double -> Array sh Double -> Double)
-> Distance (Array sh) Double
forall a b. (a -> b) -> a -> b
$ (Array sh Double -> Double
forall sh a. (C sh, Floating a) => Vector sh a -> RealOf a
Vector.normInf (Array sh Double -> Double)
-> (Array sh Double -> Array sh Double)
-> Array sh Double
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Array sh Double -> Array sh Double) -> Array sh Double -> Double)
-> (Array sh Double -> Array sh Double -> Array sh Double)
-> Array sh Double
-> Array sh Double
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array sh Double -> Array sh Double -> Array sh Double
forall sh a.
(C sh, Eq sh, Floating a) =>
Vector sh a -> Vector sh a -> Vector sh a
Vector.sub)

matrixDistance ::
   (Extent.Measure meas, Extent.C vert, Extent.C horiz) =>
   (Shape.C height, Shape.C width, Eq height, Eq width, Class.Real a) =>
   ArrayMatrix pack prop lower upper meas vert horiz height width a ->
   ArrayMatrix pack prop lower upper meas vert horiz height width a ->
   a
matrixDistance :: ArrayMatrix pack prop lower upper meas vert horiz height width a
-> ArrayMatrix pack prop lower upper meas vert horiz height width a
-> a
matrixDistance ArrayMatrix pack prop lower upper meas vert horiz height width a
a ArrayMatrix pack prop lower upper meas vert horiz height width a
b = Vector (Omni pack prop lower upper meas vert horiz height width) a
-> Vector
     (Omni pack prop lower upper meas vert horiz height width) a
-> a
forall sh a.
(C sh, Eq sh, Real a) =>
Vector sh a -> Vector sh a -> a
distance (ArrayMatrix pack prop lower upper meas vert horiz height width a
-> Vector
     (Omni pack prop lower upper meas vert horiz height width) a
forall pack property lower upper meas vert horiz height width a.
ArrayMatrix
  pack property lower upper meas vert horiz height width a
-> OmniArray
     pack property lower upper meas vert horiz height width a
ArrMatrix.unwrap ArrayMatrix pack prop lower upper meas vert horiz height width a
a) (ArrayMatrix pack prop lower upper meas vert horiz height width a
-> Vector
     (Omni pack prop lower upper meas vert horiz height width) a
forall pack property lower upper meas vert horiz height width a.
ArrayMatrix
  pack property lower upper meas vert horiz height width a
-> OmniArray
     pack property lower upper meas vert horiz height width a
ArrMatrix.unwrap ArrayMatrix pack prop lower upper meas vert horiz height width a
b)