markov-realization 0.3.0 → 0.3.1
raw patch · 8 files changed
+139/−134 lines, 8 filesdep −contravariantdep −discriminationdep −generic-derivingdep ~HTFdep ~MonadRandomdep ~comonad
Dependencies removed: contravariant, discrimination, generic-deriving
Dependency ranges changed: HTF, MonadRandom, comonad, configuration-tools, matrix
Files
- ChangeLog.md +12/−1
- markov-realization.cabal +50/−45
- src/Markov.hs +23/−55
- src/Markov/Example.hs +14/−22
- src/Markov/Extra.hs +2/−0
- src/Markov/Generic.hs +29/−0
- src/Markov/Instance.hs +0/−8
- test/Test.hs +9/−3
ChangeLog.md view
@@ -1,3 +1,14 @@ # Changelog for markov -## Unreleased changes+## 0.3.1+Removed dependency on Data.Discrimination.++Removed dependency on Generics.Deriving.++Removed dependency on Data.Functor.Contravariant.++Removed Markov.Instance.++Added Markov.Generic.++Tests now expect sorted output.
markov-realization.cabal view
@@ -1,55 +1,60 @@ cabal-version: 1.12-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++-- 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.3.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 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.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+ exposed-modules:+ Markov+ Markov.Example+ Markov.Extra+ Markov.Generic+ other-modules:+ Paths_markov_realization+ hs-source-dirs:+ src+ build-depends:+ base >=4.7 && <5+ , comonad+ , configuration-tools+ , matrix+ , MonadRandom+ default-language: Haskell2010 test-suite markov-test- 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+ 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
src/Markov.hs view
@@ -1,9 +1,9 @@-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-}+ {- | Module : Markov Description : Realization of Markov processes with known parameters.@@ -14,9 +14,12 @@ Markov chains with known parameters. 'Markov0' is intended to list possible outcomes, 'Markov' should allow for more sophisticated analysis.-See "Examples" for examples.+A more general definition can be found in "Markov.Generic"+that allows for containers other than lists.+See "Markov.Example" for examples. See README for a detailed description. -}+ module Markov ( -- *Markov0 Markov0 (..)@@ -33,15 +36,8 @@ , Product (..) ) where --- import Configuration.Utils.Operators ((<*<)) import Control.Comonad (Comonad, extract)-import Data.Discrimination (Grouping, grouping)-import Generics.Deriving (Generic) -import Markov.Instance ()--import qualified Data.Discrimination as DD-import qualified Data.Functor.Contravariant as FC import qualified Data.List as DL import qualified Data.List.NonEmpty as NE @@ -50,16 +46,15 @@ --------------------------------------------------------------- -- |A basic implementation of Markov chains.-class (Eq m) => Markov0 m where- transition0 :: m -> [m -> m]- step0 :: m -> [m]- -- |Iterated steps.+class (Eq s) => Markov0 s where+ transition0 :: s -> [s -> s]+ step0 :: s -> [s] transition0 x = const <$> step0 x step0 x = ($ x) <$> transition0 x {-# MINIMAL transition0 | step0 #-} --- |Itterated steps, with equal states combined.-chain0 :: Markov0 m => [m] -> [[m]]+-- |Iterated steps, with equal states combined.+chain0 :: Markov0 s => [s] -> [[s]] chain0 = DL.iterate' $ DL.nub . concatMap step0 ---------------------------------------------------------------------------------------@@ -67,49 +62,27 @@ --------------------------------------------------------------------------------------- -- |An implementation of Markov chains.-class (Applicative t, Comonad t) => Markov t m where- transition :: m -> [t (m -> m)]- step :: t m -> [t m]- sequential :: [m -> [t (m -> m)]]+class (Applicative t, Comonad t) => Markov t s where+ transition :: s -> [t (s -> s)]+ step :: t s -> [t s]+ sequential :: [s -> [t (s -> s)]] transition = fmap (fmap const) . step . pure step x = foldr (concatMap . step') [x] sequential where step' f y = (<*> y) <$> f (extract y) sequential = [transition] {-# MINIMAL transition | step | sequential #-}- -- Could also be defined as follows:- --- -- transition = foldr compose stayPut sequential- -- where stayPut = const [pure id]- -- compose g f a = composeWith g a =<< f a- -- composeWith g a x = (<*< x) <$> g (extract $ fmap ($ a) x)- -- step x = (<*> x) <$> transition (extract x)- -- sequential = [fmap (fmap const) . step . pure] -- |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' #-}--}+chain :: (Combine (t s), Ord (t s), Markov t s) => [t s] -> [[t s]]+chain = DL.iterate'+ $ fmap summarize . NE.group . DL.sort . concatMap step --------------------------------------------------------------------------------------- -- Combine --------------------------------------------------------------------------------------- -- |Within equivalence classes, @combine@ should be associative,--- commutative, and should be idempotent up to equivalence.+-- commutative, and idempotent (up to equivalence). -- I.e. if @x == y == z@, -- -- prop> (x `combine` y) `combine` z = x `combine` (y `combine` z)@@ -138,9 +111,7 @@ -- where different values mean states should not be combined. -- E.g., strings with concatenation. newtype Merge a = Merge a- deriving (Eq, Generic)- deriving newtype (Semigroup, Monoid, Enum, Num, Fractional, Show)- deriving anyclass Grouping+ deriving newtype (Eq, Semigroup, Monoid, Enum, Num, Ord, Fractional, Show) instance Combine (Merge a) where combine = const @@ -148,13 +119,11 @@ -- Sum --------------------------------------------------------------------------------------- --- |Values which are added each step+-- |Values which are added each step, -- where different values mean states should not be combined. -- E.g., number of times a red ball is picked from an urn. newtype Sum a = Sum a- deriving Generic- deriving newtype (Eq, Enum, Num, Fractional, Show)- deriving anyclass Grouping+ deriving newtype (Eq, Enum, Num, Ord, Fractional, Show) instance Combine (Sum a) where combine = const @@ -172,11 +141,10 @@ -- and combined additively for equal states. -- E.g., probabilities. newtype Product a = Product a- deriving Generic deriving newtype (Num, Fractional, Enum, Show) -instance Grouping (Product a) where- grouping = FC.contramap (const ()) grouping+instance Ord (Product a) where+ compare _ _ = EQ -- This causes Data.List.group to act more like Data.Discrimination.group -- |WARNING! Defined @_ == _ = True@!
src/Markov/Example.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-}@@ -17,6 +16,7 @@ Several examples of Markov chains. It is probably more helpful to read the source code than the Haddock documentation. -}+ module Markov.Example ( FromLists (..) , Simple (..)@@ -31,9 +31,7 @@ import Markov import Markov.Extra--import Data.Discrimination (Grouping)-import Generics.Deriving (Generic)+import qualified Markov.Generic as MG --------------------------------------------------------------- -- From a matrix@@ -46,9 +44,7 @@ -- , (0.201219512195122,'t') -- , (0.29268292682926833,'l') ] newtype FromLists = FromLists Char- deriving Generic- deriving newtype (Eq, Show)- deriving anyclass Grouping+ deriving newtype (Eq, Ord, Show) instance Combine FromLists where combine = const @@ -93,9 +89,7 @@ -- [ (2,-2), (1,-1), (1,0), (0,0), (0,1), (0,2) ] newtype Simple = Simple Int- deriving Generic deriving newtype (Num, Enum, Eq, Ord, Show)- deriving anyclass Grouping instance Combine Simple where combine = const @@ -123,9 +117,7 @@ -- At each step, a ball is chosen uniformly at random from the urn -- and a ball of the same color is added. newtype Urn = Urn (Int,Int)- deriving Generic deriving newtype (Eq, Ord, Show)- deriving anyclass Grouping instance Combine Urn where combine = const @@ -133,6 +125,10 @@ transition x = [ probLeft x >*< addLeft , 1 - probLeft x >*< addRight ] +instance MG.Markov [] ((,) (Product Double)) Urn where+ transition x = [ probLeft x >*< addLeft+ , 1 - probLeft x >*< addRight ]+ addLeft :: Urn -> Urn addLeft (Urn (a,b)) = Urn (a+1,b) @@ -148,9 +144,7 @@ -- |This is the chain from the README. newtype Extinction = Extinction Int- deriving Generic deriving newtype (Eq, Num, Show)- deriving anyclass Grouping instance Combine Extinction where combine = const @@ -172,8 +166,7 @@ -- and falling back from a shore at the origin. data Tidal = Tidal { time :: Double , position :: Int }- deriving (Eq, Ord, Show, Generic)- deriving anyclass Grouping+ deriving (Eq, Ord, Show) instance Combine Tidal where combine = const @@ -200,8 +193,8 @@ -- |A hidden Markov model. -- -- >>> :{ filter (\((_,Merge xs),_) -> xs == "aaa") $ chain--- [1 >*< Merge "" >*< 1 :: Product Rational :* Merge String :* Room] !! 3--- :}+-- [1 >*< Merge "" >*< 1 :: Product Rational :* Merge String :* Room] !! 3+-- :} -- [ ((3243 % 200000,"aaa"),Room 1) -- , ((9729 % 500000,"aaa"),Room 2) -- , ((4501 % 250000,"aaa"),Room 3) ]@@ -210,9 +203,8 @@ -- there is a probability of approximately @0.34@ -- that the current room is @Room 3@. newtype Room = Room Int- deriving (Generic, Show)- deriving newtype (Eq, Num)- deriving anyclass Grouping+ deriving Show+ deriving newtype (Eq, Num, Ord) instance Combine Room where combine = const @@ -259,7 +251,7 @@ -- If it is in a gap, it is assigned to an adjacent bin, -- which expands to contain it and any intervening spaces, -- and then the space filled.-data FillBin = End Gap | Ext Gap Bin FillBin deriving (Eq, Ord, Generic, Grouping)+data FillBin = End Gap | Ext Gap Bin FillBin deriving (Eq, Ord) instance Show FillBin where show (Ext g b s) = show g ++ " " ++ show b ++ " " ++ show s@@ -413,7 +405,7 @@ -- -- >>> expectedLoss [pure $ initial [1,0,3] :: (Product Double, FillBin)] -- 2.0-expectedLoss :: (Fractional a, Markov ((,) (Product a)) FillBin) +expectedLoss :: (Fractional a, Ord a, Markov ((,) (Product a)) FillBin) => [Product a :* FillBin] -> a expectedLoss xs = sum . map probLoss $ chain xs !! idx where idx = slots . snd . head $ xs
src/Markov/Extra.hs view
@@ -1,10 +1,12 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeOperators #-}+ {-| Module : Markov.Extra Maintainer : atloomis@math.arizona.edu Stability : Experimental -}+ module Markov.Extra ( fromLists , randomPath
+ src/Markov/Generic.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE MultiParamTypeClasses #-}++{- |+Module : Markov.Generic+Description : Realization of Markov processes with known parameters.+Maintainer : atloomis@math.arizona.edu+Stability : Experimental++An implementation of Markov chains allowing non-list containers.+-}++module Markov.Generic (+ Markov (..)+ ) where++import Control.Comonad (Comonad, extract)++-- |An implementation of Markov chains with non-list containers.+--+-- prop> Markov.Markov t s = Markov.Generic.Markov [] t s+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 #-}
− src/Markov/Instance.hs
@@ -1,8 +0,0 @@-module Markov.Instance where--import Data.Discrimination (Grouping, grouping)-import Data.Functor.Contravariant (contramap)-import GHC.Float (castFloatToWord32, castDoubleToWord64)--instance Grouping Float where grouping = contramap castFloatToWord32 grouping-instance Grouping Double where grouping = contramap castDoubleToWord64 grouping
test/Test.hs view
@@ -6,6 +6,7 @@ import Markov import Markov.Example+import Markov.Extra main = htfMain htf_thisModulesTests @@ -14,8 +15,8 @@ assertEqual (chain [pure (FromLists 't') :: (Product Double, FromLists)] !! 100) [ (0.5060975609756099, FromLists 'a')- , (0.201219512195122, FromLists 't')- , (0.29268292682926833, FromLists 'l') ]+ , (0.29268292682926833, FromLists 'l')+ , (0.201219512195122, FromLists 't') ] test_m0Simple = assertEqual@@ -41,7 +42,7 @@ test_siSimple = assertEqual (chain [pure 0 :: (Sum Int, Simple)] !! 2)- [ (2,-2), (1,-1), (1,0), (0,0), (0,1), (0,2) ]+ [ (0,0), (0,1), (0,2), (1,-1), (1,0), (2,-2) ] test_HMM = assertEqual@@ -55,3 +56,8 @@ assertEqual (expectedLoss [pure $ initial [1,0,3] :: (Product Double, FillBin)]) 2++test_expLossMore =+ assertEqual+ (expectedLoss [pure $ initial [1,0,3,2,2,5] :: (Product Double, FillBin)])+ 9.764425505050506