HMarkov 1.0.0.2 → 1.0.0.3

raw patch · 3 files changed

+89/−19 lines, 3 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• HMarkov.cabal +1/−1
• src/Data/Markov/HMarkov.hs +42/−8
• src/Data/Markov/HMarkov/Helpers.hs +46/−10

@@ -1,5 +1,5 @@ name:                HMarkov-version:             1.0.0.2+version:             1.0.0.3 synopsis:            Markov-generated sequences description:         Sequences generated by trained Markov models homepage:            https://github.com/swizzard/HMarkov#readme

@@ -1,10 +1,31 @@ {-# LANGUAGE FlexibleContexts, TemplateHaskell #-}+{-|+   Module      : Data.Markov.HMarkov+   Description : Markov sequences, Haskelly+   Copyright   : (c) Sam Raker, 2016+   License     : BSD3+   Maintainer  : sam.raker@gmail.com+   Stability   : experimental+   Portability : POSIX (FlexibleContexts, TemplateHaskell)++   Generate Markov sequences from vectors.+   The main entry points are:+      'buildProc' creates a 'MarkovProcess' from a vector of training elements,+        a starting element, and a 'System.Random.StdGen'+      'runUntil' runs a 'MarkovProcess' until a termination condition is met, and+        returns the resulting sequence+-} module Data.Markov.HMarkov   (+  -- * Data structures+  -- ** Map of frequencies     MarkovMap(..)+  -- ** Complete process   , MarkovProcess(..)+  -- * Construction helpers   , buildMap   , buildProc+  -- * Run processes   , runMarkov   , runUntil   ) where@@ -16,20 +37,30 @@ import Data.Markov.HMarkov.Helpers  -data MarkovProcess m a = MarkovProcess { _pMap :: MarkovMap a,-                                         _g :: StdGen,-                                         _lastT :: a,-                                         _acc :: m a }-                                         deriving (Show)+-- | 'Control.Monad.State.State'-compatible wrapper around a trained+-- 'MarkovMap', which includes a 'System.Random.StdGen' and the most+-- recently-generated element, or the starting element if the process hasn't+-- been run yet+data MarkovProcess m a = MarkovProcess {+-- | Wrapped MarkovMap+  _pMap :: MarkovMap a,+  _g :: StdGen,+-- | Most recently generated element (or starting element)+  _lastT :: a,+-- | MonadPlus of already-generated elements+  _acc :: m a }+  deriving (Show)  makeLenses ''MarkovProcess -buildMap :: (Eq a) => V.Vector a -> MarkovMap a-buildMap xs = toMarkovMap $ V.foldl (vApply updateMarkov) (initMap xs) (makeSlices xs)-+-- | Build a MarkovProcess from a vector of elements, a starting element, and a source+-- of randomness+-- NOTE: the starting element should be a member of the training vector buildProc :: (Eq a, MonadPlus m) => V.Vector a -> a -> StdGen -> MarkovProcess m a buildProc xs x gen = MarkovProcess (buildMap xs) gen x mzero +-- | Run a MarkovProcess once, generating a new element that is appended to the+-- accumulator runMarkov :: (Eq a, MonadPlus m) => MarkovProcess m a -> (m a, MarkovProcess m a) runMarkov p = let (x, g') = random $ p ^. g                   lst = p ^. lastT@@ -37,11 +68,14 @@                   (acc', m) = p & acc <%~ \ac -> mplus ac $ return lst in               (acc', m & g .~ g' & lastT .~ new) +-- | Run a MarkovProcess continually until a termination condition is met runUntil' :: (Eq a, MonadPlus m) => (m a -> Bool) -> MarkovProcess m a -> (m a, MarkovProcess m a) runUntil' p = runState . fix $               \continue -> state runMarkov >>=               \a -> if p a then pure a else continue +-- | Run a MarkovProcess continually until a termination condition is met, returning the+-- accumulator runUntil :: (Eq a, MonadPlus m) => (m a -> Bool) -> MarkovProcess m a -> m a runUntil p m = fst $ runUntil' p m 

@@ -1,68 +1,104 @@ {-# LANGUAGE TemplateHaskell #-}+{-|+   Module      : Data.Markov.HMarkov.Helpers+   Description : Helpers for Data.Markov.HMarkov+   Copyright   : (c) Sam Raker, 2016+   License     : BSD3+   Maintainer  : sam.raker@gmail.com+   Stability   : experimental+   Portability : POSIX+-} module Data.Markov.HMarkov.Helpers   (-    vApply+  -- * Data structures+    CountMarkovMap(..)+  , MarkovMap(..)+  -- * Helper functions+  , vApply   , vidx   , ded-  , initMap-  , updateMarkov   , makeSlices   , nrmlz   , sumP-  , toMarkovMap   , pix   , getNext-  , CountMarkovMap(..)-  , MarkovMap(..)+  , buildMap+  , initMap+  , updateMarkov+  , toMarkovMap   ) where  import Control.Lens import Data.Maybe import Data.Vector as V -data CountMarkovMap a = CMarkovMap (V.Vector a) (V.Vector (V.Vector Double))+-- | Map of counts+data CountMarkovMap a+  = CMarkovMap (V.Vector a) (V.Vector (V.Vector Double)) -- ^ Map of counts -data MarkovMap a = MarkovMap { _idx :: V.Vector a,-                               _mMap :: V.Vector (V.Vector Double) }-                   deriving (Show)+-- | Map of frequencies+data MarkovMap a = MarkovMap {+-- | Index of elements+  _idx :: V.Vector a,+-- | Map of frequencies+   _mMap :: V.Vector (V.Vector Double) }+   deriving (Show)  makeLenses ''MarkovMap +-- | Apply a function to the first two elements in a vector and a third thing vApply :: (a -> a -> b -> c) -> b -> V.Vector a -> c vApply f x v = f (v V.! 0) (v V.! 1) x +-- | Get the index of an element in a vector+-- WARNING: will throw an error if `x` is not in `v` vidx :: (Eq a) => a -> V.Vector a -> Int vidx x v = fromJust $ V.elemIndex x v +-- | Deduplicate a vector ded :: (Eq a) => V.Vector a -> V.Vector a ded = V.foldl f V.empty where             f accm x = if V.elem x accm then accm else V.snoc accm x +-- | Initialize a CountMarkovMap from a vector initMap :: (Eq a) => V.Vector a -> CountMarkovMap a initMap xs = let d = ded xs                  l = V.length xs in              CMarkovMap d (V.replicate l (V.replicate l 0)) +-- | Update a CountMarkovMap+-- `a` and `b` should be sequential elements updateMarkov :: (Eq a) => a -> a -> CountMarkovMap a -> CountMarkovMap a updateMarkov a b (CMarkovMap i m) = CMarkovMap i $ over (ix (vidx a i) . ix (vidx b i)) (+ 1) m +-- | Make 2-element (vector) slices of a vector makeSlices :: V.Vector a -> V.Vector (V.Vector a) makeSlices xs = V.map (\i -> V.slice i 2 xs) $ V.enumFromN 0 (V.length xs - 1) +-- | Normalize a vector of doubles by dividing each element by the sum of the vector nrmlz :: V.Vector Double -> V.Vector Double nrmlz v = V.map (/ V.sum v) v +-- | Progressively sum elements in a vector of doubles, skipping over 0s sumP :: V.Vector Double -> V.Vector Double sumP v = fst $ V.foldl f (V.empty, 0.0) v where     f (accm, n) a = if a > 0 then (V.snoc accm (n + a), n + a) else (V.snoc accm 0, n) +-- | Convert a CountMarkovMap to a MarkovMap by normalizing and summing its elements toMarkovMap :: CountMarkovMap a -> MarkovMap a toMarkovMap (CMarkovMap ci cm) = MarkovMap ci $ V.map (sumP . nrmlz) cm +-- | Get the index of the first element in a vector of doubles that's less than or equal to+-- a value pix :: Double -> V.Vector Double -> Int pix x = V.ifoldr f 0 where     f i p a = if x <= p then i else a +-- | Generate the 'next' element from a MarkovMap getNext :: (Eq a) => a -> Double -> MarkovMap a -> a getNext t x m = (m ^. idx) V.! (pix x ((m ^. mMap) V.! (vidx t $ m ^. idx)))++-- | Build a MarkovMap from a vector of elements+buildMap :: (Eq a) => V.Vector a -> MarkovMap a+buildMap xs = toMarkovMap $ V.foldl (vApply updateMarkov) (initMap xs) (makeSlices xs)