detrospector 0.1 → 0.2

raw patch · 8 files changed

+59/−26 lines, 8 filesdep +unordered-containersdep −hashmap

Dependencies added: unordered-containers

Dependencies removed: hashmap

Files

Detrospector/Main.hs +1/−0
Detrospector/Modes/Neolog.hs +1/−1
Detrospector/Modes/Run.hs +4/−4
Detrospector/Modes/Train.hs +25/−15
Detrospector/Types.hs +2/−2
LICENSE +1/−1
README +6/−0
detrospector.cabal +19/−3

Detrospector/Main.hs view

@@ -16,6 +16,7 @@       += Arg.program "detrospector"       += Arg.summary "detrospector: Markov chain text generator"       += Arg.help    "Build and run Markov chains for text generation"+      += Arg.helpArg [Arg.name "h"]   where    train = Arg.record Train{}

Detrospector/Modes/Neolog.hs view

@@ -22,7 +22,7 @@    loop !wd = do     xs  <- fmap toLower <$> make emptyQ emptyQ-    wdd <- if (qLength xs >= minLen) && HS.notMember xs wd+    wdd <- if (qLength xs >= minLen) && not (HS.member xs wd)       then putStrLn (queueToList xs) >> return (HS.insert xs wd)       else return wd     loop wdd

Detrospector/Modes/Run.hs view

@@ -7,10 +7,10 @@  go :: Chain -> RNG -> IO () go c@(Chain n _) g = loop emptyQ where-    loop s = do-      (x,_) <- pick c s g-      putChar x-      loop $! shift n x s+  loop s = do+    (x,_) <- pick c s g+    putChar x+    loop $! shift n x s  run :: ModeFun run Run{chain} = withChain chain go

Detrospector/Modes/Train.hs view

@@ -7,13 +7,13 @@ import Detrospector.Modes  import System.IO-import qualified Data.Text         as TS-import qualified Data.Text.Lazy    as TL-import qualified Data.Text.Lazy.IO as TL-import qualified Data.HashMap      as H-import qualified Data.IntMap       as IM-import qualified Data.Sequence     as S-import qualified Data.Foldable     as F+import qualified Data.Text           as TS+import qualified Data.Text.Lazy      as TL+import qualified Data.Text.Lazy.IO   as TL+import qualified Data.HashMap.Strict as H+import qualified Data.IntMap         as IM+import qualified Data.Sequence       as S+import qualified Data.Foldable       as F  -- foldl' with progress dots progFold :: (a -> b -> a) -> a -> [b] -> IO a@@ -21,6 +21,9 @@   go !v []     = return v   go !v (x:xs) = putChar '.' >> go (f v x) xs +-- The guts of a Chain, before we apply 'cumulate'.+type FreqChain = H.HashMap (S.Seq Char) FreqTable+ -- Build a Markov chain with n-Char history from some input text. train :: ModeFun train Train{num,out} = do@@ -31,16 +34,23 @@   putStrLn "done."   writeChain out . Chain num $ H.map cumulate h where -  roll (!s,!h) x-    = (shift num x s, F.foldr (H.alter $ ins x) h $ S.tails s)+  -- Process another character, updating a fold state of the Markov chain+  -- history and the accumulated FreqChain.+  roll :: (S.Seq Char, FreqChain) -> Char -> (S.Seq Char, FreqChain)+  roll (!s, !fci) x = (shift num x s, F.foldr occur fci $ S.tails s) where -  ins x Nothing  = Just $! sing x-  ins x (Just v) = Just $! incr x v+    -- Increment the occurrence count for 'x' following history 'hist'.+    occur :: S.Seq Char -> FreqChain -> FreqChain+    occur hist fc = H.insert hist (bump $ H.lookup hist fc) fc -  sing x = IM.singleton (fromEnum x) 1+    -- Given a FreqTable (or Nothing), return a FreqTable with one more+    -- count for 'x'.+    bump :: Maybe FreqTable -> FreqTable+    bump Nothing  = IM.singleton (fromEnum x) 1+    bump (Just v) = IM.alter incMaybe (fromEnum x) v -  incr x = IM.alter f $ fromEnum x where-    f Nothing  = Just 1-    f (Just v) = Just $! (v+1)+    incMaybe :: Maybe Int -> Maybe Int+    incMaybe Nothing  = Just 1+    incMaybe (Just n) = Just $! (n+1)  train _ = error "impossible: wrong mode passed to train"

Detrospector/Types.hs view

@@ -16,7 +16,7 @@ import Data.Maybe import Data.List import Control.Applicative-import qualified Data.HashMap           as H+import qualified Data.HashMap.Strict    as H import qualified Data.Hashable          as H import qualified Data.IntMap            as IM import qualified System.Random.MWC      as RNG@@ -106,7 +106,7 @@ -- orphan instance: Binary serialization of HashMap instance (Bin.Binary k, Bin.Binary v, H.Hashable k, Ord k)        => Bin.Binary (H.HashMap k v) where-  put = Bin.put . H.assocs+  put = Bin.put . H.toList   get = H.fromList <$> Bin.get    instance Bin.Binary PickTable where

LICENSE view

@@ -1,4 +1,4 @@-Copyright (c) Keegan McAllister 2010+Copyright (c) Keegan McAllister 2010 - 2012  All rights reserved.

+ README view

@@ -0,0 +1,6 @@+detrospector is a Markov chain text generator.++See detrospector.cabal for more information, as well as++  http://hackage.haskell.org/package/detrospector+  http://mainisusuallyafunction.blogspot.com/2010/10/tour-of-real-toy-haskell-program-part-1.html

detrospector.cabal view

@@ -1,5 +1,5 @@ name:                detrospector-version:             0.1+version:             0.2 license:             BSD3 license-file:        LICENSE synopsis:            Markov chain text generator@@ -7,7 +7,7 @@ author:              Keegan McAllister <mcallister.keegan@gmail.com> maintainer:          Keegan McAllister <mcallister.keegan@gmail.com> build-type:          Simple-cabal-version:       >=1.2+cabal-version:       >=1.6 description:   The `detrospector' program generates random text conforming to the general   style and diction of a given source document.  It associates each@@ -23,7 +23,19 @@   .   Design goals include speed and full Unicode support.  I welcome suggestions   and patches regarding any aspect of this program.+  .+  New in version 0.2:+  .+    * Use the @unordered-containers@ library instead of @hashmap@.  Also fixes+      a build failure.+  .+    * Accept @-h@ for help, in addition to @-?@.+  .+    * Added public GitHub repository. +extra-source-files:+    README+ executable detrospector   main-is:       detrospector.hs   other-modules:@@ -43,5 +55,9 @@     cmdargs    >= 0.6,     mwc-random >= 0.8,     hashable   >= 1.0,-    hashmap    >= 1.1+    unordered-containers >= 0.1   ghc-options: -Wall++source-repository head+  type:     git+  location: git://github.com/kmcallister/detrospector.git