markov-realization 0.2.1 → 0.3.0

raw patch · 6 files changed

+139/−112 lines, 6 filesdep +matrixdep ~HTFdep ~MonadRandomdep ~comonadPVP ok

version bump matches the API change (PVP)

Dependencies added: matrix

Dependency ranges changed: HTF, MonadRandom, comonad, configuration-tools, contravariant, discrimination, generic-deriving

API changes (from Hackage documentation)

Files

• README.md +10/−3
• markov-realization.cabal +45/−51
• src/Markov.hs +18/−46
• src/Markov/Example.hs +9/−7
• src/Markov/Extra.hs +52/−0
• test/Test.hs +5/−5

@@ -28,17 +28,24 @@ We will make a new type for the state.  ```haskell-data Extinction = Extinction Int+newtype Extinction = Extinction Int     deriving Generic     deriving newtype (Eq, Num, Show)     deriving anyclass Grouping ``` +Combining identical states should not change the state,+so we make an instance of `Combine` as follows.++```haskell+instance Combine Extinction where combine = const+```+ All that remains is to make an instance of `Markov`.  ```haskell-instance Markov (Sum Int, Product Rational) Extinction where-    transition x = case state x of+instance Markov ((,) (Sum Int, Product Rational)) Extinction where+    transition = \case         0 -> [ 0 >*< (q+r) >*< id              , 0 >*< s >*< (+1) ]         _ -> [ 1 >*< q >*< const 0

@@ -1,61 +1,55 @@ cabal-version: 1.12---- This file has been generated from package.yaml by hpack version 0.31.1.------ see: https://github.com/sol/hpack------ hash: b164fe328e9edef0858d48e61b56997280bd4bb2ea6ffe923afb24084a14efe6--name:           markov-realization-version:        0.2.1-description:    Please see the README on GitHub at <https://github.com/alexloomis/markov#markov-tutorial>-homepage:       https://github.com/alexloomis/markov-bug-reports:    https://github.com/alexloomis/markov/issues-author:         Alex Loomis-maintainer:     atloomis@math.arizona.edu-copyright:      2019 Alex Loomis-license:        BSD3-license-file:   LICENSE-build-type:     Simple+name: markov-realization+version: 0.3.0+license: BSD3+license-file: LICENSE+copyright: 2019 Alex Loomis+maintainer: atloomis@math.arizona.edu+author: Alex Loomis+homepage: https://github.com/alexloomis/markov+bug-reports: https://github.com/alexloomis/markov/issues+synopsis: Realizations of Markov chains.+description:+    Please see the README on GitHub at <https://github.com/alexloomis/markov#markov-tutorial>+category: Statistics+build-type: Simple extra-source-files:     README.md     ChangeLog.md-category:       Statistics-synopsis:       Realizations of Markov chains.  source-repository head-  type: git-  location: git://github.com/alexloomis/markov.git+    type: git+    location: git://github.com/alexloomis/markov.git  library-  exposed-modules:-      Markov-      Markov.Example-      Markov.Instance-  other-modules:-      Paths_markov_realization-  hs-source-dirs:-      src-  build-depends:-      base >=4.7 && <5-    , comonad-    , configuration-tools-    , contravariant-    , discrimination-    , generic-deriving-    , MonadRandom-  default-language: Haskell2010+    exposed-modules:+        Markov+        Markov.Example+        Markov.Extra+        Markov.Instance+    hs-source-dirs: src+    other-modules:+        Paths_markov_realization+    default-language: Haskell2010+    build-depends:+        base >=4.7 && <5,+        comonad >=5.0.5 && <5.1,+        configuration-tools >=0.4.1 && <0.5,+        contravariant >=1.5.1 && <1.6,+        discrimination ==0.4.*,+        generic-deriving >=1.12.4 && <1.13,+        matrix >=0.3.6.1 && <0.4,+        MonadRandom >=0.5.1.1 && <0.6  test-suite markov-test-  type: exitcode-stdio-1.0-  main-is: Test.hs-  other-modules:-      Paths_markov_realization-  hs-source-dirs:-      test-  ghc-options: -threaded -rtsopts -with-rtsopts=-N-  build-depends:-      base >=4.7 && <5-    , HTF-    , markov-realization-  default-language: Haskell2010+    type: exitcode-stdio-1.0+    main-is: Test.hs+    hs-source-dirs: test+    other-modules:+        Paths_markov_realization+    default-language: Haskell2010+    ghc-options: -threaded -rtsopts -with-rtsopts=-N+    build-depends:+        base >=4.7 && <5,+        HTF >=0.13.2.5 && <0.14,+        markov-realization -any

@@ -4,12 +4,11 @@ {-# LANGUAGE FlexibleContexts           #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE TypeOperators              #-} {- | Module      : Markov Description : Realization of Markov processes with known parameters. Maintainer  : atloomis@math.arizona.edu-Stability   : experimental+Stability   : Experimental  Three type classes for deterministically analyzing Markov chains with known parameters.@@ -32,23 +31,15 @@      , Merge (..)      , Sum (..)      , Product (..)--     -- *Misc-     , (:*)-     , (>*<)-     , fromLists-     , randomProduct-     , randomPath      ) where  -- import Configuration.Utils.Operators ((<*<))-import Control.Comonad+import Control.Comonad (Comonad, extract) import Data.Discrimination (Grouping, grouping) import Generics.Deriving (Generic)  import Markov.Instance () -import qualified Control.Monad.Random as MR import qualified Data.Discrimination as DD import qualified Data.Functor.Contravariant as FC import qualified Data.List as DL@@ -67,6 +58,7 @@     step0 x = ($ x) <$> transition0 x     {-# MINIMAL transition0 | step0 #-} +-- |Itterated steps, with equal states combined. chain0 :: Markov0 m => [m] -> [[m]] chain0 = DL.iterate' $ DL.nub . concatMap step0 @@ -93,11 +85,25 @@     -- step x = (<*> x) <$> transition (extract x)     -- sequential = [fmap (fmap const) . step . pure] --- WARNING: DD.group does not currently respect equivalence classes. -- |Iterated steps, with equal states combined using 'summarize' operation.+-- WARNING: 'Data.Discrimination.group' does not currently+-- respect equivalence classes, only 'Grouping'. chain :: (Combine (t m), Grouping (t m), Markov t m) => [t m] -> [[t m]] chain = DL.iterate' $ fmap (summarize . NE.fromList) .  DD.group . concatMap step +{-+-- |An implementation of Markov chains with non-list containers.+class (Applicative t, Comonad t, Monad c) => Markov' c t s where+    transition' :: s -> c (t (s -> s))+    step'       :: t s -> c (t s)+    sequential' :: [s -> c (t (s -> s))]+    transition' = fmap (fmap const) . step' . pure+    step' x = foldr ((=<<) . step'') (pure x) sequential'+      where step'' f y = (<*> y) <$> f (extract y)+    sequential' = pure transition'+    {-# MINIMAL transition' | step' | sequential' #-}+-}+ --------------------------------------------------------------------------------------- -- Combine ---------------------------------------------------------------------------------------@@ -123,19 +129,6 @@     combine (a,w,x) (b,y,z) = (combine a b, combine w y, combine x z)  ------------------------------------------------------------------------------------------ Easier way to write nested 2-tuples-------------------------------------------------------------------------------------------- |Easier way to write nested 2-tuples.-type a :* b = (a,b)--- |Easier way to write nested 2-tuples.--- Left associative, binds weaker than @+@--- but stronger than @==@.-(>*<) :: a -> b -> a :* b-a >*< b = (a,b)-infixl 5 >*<----------------------------------------------------------------------------------------- -- Merge --------------------------------------------------------------------------------------- @@ -194,24 +187,3 @@ instance Num a => Semigroup (Product a) where x <> y = x * y  instance Num a => Monoid (Product a) where mempty = 1-------------------------------------------------------------------------------------------- Misc-------------------------------------------------------------------------------------------- |Randomly choose from a list by probability.-randomProduct :: (Real a, MR.MonadRandom m) => [(a, b)] -> m (a, b)-randomProduct = MR.fromList . fmap (\x -> (x, toRational $ fst x))---- |Returns a single realization of a Markov chain.-randomPath :: (Markov ((,) a) b, Real a, MR.RandomGen g) => (a,b) -> g -> [(a,b)]-randomPath x g = fmap (`MR.evalRand` g) . iterate (>>= (randomProduct . step)) $ pure x---- |Create a transition function from a transition matrix.------ prop> all (== length matrix) (map length matrix)--- prop> length matrix == length states-fromLists :: Eq  b => [[a]] -> [b] -> b -> [(a, c -> b)]-fromLists matrix states b = case DL.elemIndex b states of-    Nothing -> []-    Just n  -> zip (matrix!!n) $ fmap const states

@@ -12,13 +12,13 @@ Module      : Markov.Example Description : Examples of Markov chains implemented using "Markov". Maintainer  : atloomis@math.arizona.edu-Stability   : experimental+Stability   : Experimental  Several examples of Markov chains. It is probably more helpful to read the source code than the Haddock documentation. -} module Markov.Example-     ( FromMatrix (..)+     ( FromLists (..)      , Simple (..)      , Urn (..)      , Extinction (..)@@ -30,8 +30,10 @@      ) where  import Markov-import Generics.Deriving (Generic)+import Markov.Extra+ import Data.Discrimination (Grouping)+import Generics.Deriving (Generic)  --------------------------------------------------------------- -- From a matrix@@ -43,18 +45,18 @@ -- [ (0.5060975609756099,'a') -- , (0.201219512195122,'t') -- , (0.29268292682926833,'l') ]-newtype FromMatrix = FromMatrix Char+newtype FromLists = FromLists Char     deriving Generic     deriving newtype (Eq, Show)     deriving anyclass Grouping -instance Combine FromMatrix where combine = const+instance Combine FromLists where combine = const -instance Markov ((,) (Product Double)) FromMatrix where+instance Markov ((,) (Product Double)) FromLists where     transition = let mat = [ [0.4, 0.3, 0.3]                            , [0.2, 0.1, 0.7]                            , [0.9, 0.1, 0.0] ]-                     chars = map FromMatrix ['a','t','l']+                     chars = map FromLists ['a','t','l']                  in fromLists mat chars  ---------------------------------------------------------------

@@ -0,0 +1,52 @@+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE TypeOperators              #-}+{-|+Module      : Markov.Extra+Maintainer  : atloomis@math.arizona.edu+Stability   : Experimental+-}+module Markov.Extra+     ( fromLists+     , randomPath+     , (:*)+     , (>*<)+     ) where++import Markov+import qualified Control.Monad.Random as MR+import qualified Data.List as DL++---------------------------------------------------------------------------------------+-- Misc+---------------------------------------------------------------------------------------++-- |Randomly choose from a list by probability.+randomProduct :: (Real a, MR.MonadRandom m) => [(a, b)] -> m (a, b)+randomProduct = MR.fromList . fmap (\x -> (x, toRational $ fst x))++-- |Returns a single realization of a Markov chain.+randomPath :: (Markov ((,) a) b, Real a, MR.RandomGen g) => (a,b) -> g -> [(a,b)]+randomPath x g = fmap (`MR.evalRand` g) . iterate (>>= (randomProduct . step)) $ pure x++-- |Create a transition function from a transition matrix.+-- Inputs should obey:+--+-- > all (== length matrix) (map length matrix)+-- > length matrix == length states+fromLists :: Eq  b => [[a]] -> [b] -> b -> [(a, c -> b)]+fromLists matrix states b = case DL.elemIndex b states of+    Nothing -> []+    Just n  -> zip (matrix!!n) $ fmap const states++---------------------------------------------------------------------------------------+-- Easier way to write nested 2-tuples+---------------------------------------------------------------------------------------++-- |Easier way to write nested 2-tuples.+type a :* b = (a,b)+-- |Easier way to write nested 2-tuples.+-- Left associative, binds weaker than @+@+-- but stronger than @==@.+(>*<) :: a -> b -> a :* b+a >*< b = (a,b)+infixl 5 >*<

@@ -10,12 +10,12 @@ main = htfMain htf_thisModulesTests  -- Examples in the documentation.-test_fromMatrix =+test_fromLists =     assertEqual-    (chain [pure (FromMatrix 't') :: (Product Double, FromMatrix)] !! 100)-    [ (0.5060975609756099, FromMatrix 'a')-    , (0.201219512195122, FromMatrix 't')-    , (0.29268292682926833, FromMatrix 'l') ]+    (chain [pure (FromLists 't') :: (Product Double, FromLists)] !! 100)+    [ (0.5060975609756099, FromLists 'a')+    , (0.201219512195122, FromLists 't')+    , (0.29268292682926833, FromLists 'l') ]  test_m0Simple =     assertEqual