Some things: Map benchmark. Applicative parsing of automata

.gitignore

@@ -0,0 +1,3 @@
+dist
+*.o
+*.hi

Applicative.cabal

@@ -0,0 +1,24 @@
+-- Initial Applicative.cabal generated by cabal init.  For further 
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                Applicative
+version:             0.1.0.0
+-- synopsis:            
+-- description:         
+-- license:             
+license-file:        LICENSE
+author:              Joshua Moerman
+maintainer:          lakseru@gmail.com
+-- copyright:           
+-- category:            
+build-type:          Simple
+-- extra-source-files:  
+cabal-version:       >=1.10
+
+executable Applicative
+  main-is:             Main.hs
+  -- other-modules:       
+  -- other-extensions:    
+  build-depends:       base >=4.7 && <4.8, parsec, transformers, vector
+  -- hs-source-dirs:      
+  default-language:    Haskell2010

AutomataReader.hs

@@ -0,0 +1,73 @@
+import Control.Applicative hiding (many, (<|>), optional)
+import Data.ByteString (getContents)
+import Data.Char (isAlphaNum, ord)
+import Data.List
+import Data.Maybe (catMaybes)
+import Data.Monoid
+import Prelude hiding (getContents)
+import System.Environment (getArgs)
+import Text.Parsec
+import Text.Parsec.ByteString
+import Text.Parsec.Char
+import Text.Parsec.Combinator
+import qualified Data.Attoparsec.ByteString as A
+
+data Transition s i o = Transition s i s o
+	deriving (Show, Read, Eq, Ord)
+
+parseInt :: Parser Int
+parseInt = read <$> many1 digit
+
+decimal :: A.Parser Int
+decimal = foldl' step 0 `fmap` A.takeWhile1 isDecimal
+	where
+		step a c = a * 10 + fromIntegral (ord c - 48)
+		isDecimal c = c >= '0' && c <= '9'
+
+
+parseString :: Parser String
+parseString = many1 $ satisfy (liftA2 (||) isAlphaNum isAllowed)
+	where isAllowed = flip elem "._"
+
+parseEndoSimao :: Parser [Transition Int Int Int]
+parseEndoSimao = trans `endBy` newline
+	where
+		toTransition s i o t = Transition s i t o
+		trans = (toTransition <$> parseInt <* string " -- " <*> parseInt <* string " / " <*> parseInt <* string " -> " <*> parseInt)
+
+aparseEndoSimao :: A.Parser [Transition Int Int Int]
+aparseEndoSimao = trans `A.sepBy` (char '\n')
+	where
+		toTransition s i o t = Transition s i t o
+		trans = (toTransition <$> decimal <* string " -- " <*> decimal <* string " / " <*> decimal <* string " -> " <*> decimal)
+
+parseYevtushenko :: Parser [Transition Int Int Int]
+parseYevtushenko = header `endBy` newline *> (trans `endBy` newline)
+	where
+		header = choice
+			[ () <$ char 'F' <* space <* parseInt
+			, () <$ char 's' <* space <* parseInt
+			, () <$ char 'i' <* space <* parseInt
+			, () <$ char 'o' <* space <* parseInt
+			, () <$ string "n0" <* space <* parseInt
+			, () <$ char 'p' <* spaces <* parseInt
+			]
+		trans = Transition <$> parseInt <* space <*> parseInt <* space <*> parseInt <* space <*> parseInt
+
+parseDot :: Parser [Transition String String String]
+parseDot = header *> (catMaybes <$> many1 transOrNothing) <* footer
+	where
+		header = manyTill anyChar (char '{') *> manyTill anyChar newline
+		footer = spaces *> char '}'
+		transOrNothing = optionMaybe trans <* manyTill anyChar newline
+		trans = toTransition <$> trimmedString <* string "->" <*> trimmedString <*> io
+		io = between (char '[') (char ']') ((string "label=" *> (between (char '"') (char '"') ((,) <$> trimmedString <* char '/' <*> trimmedString))))
+		toTransition s t (i, o) = Transition s i t o
+		trimmedString = spaces *> parseString <* spaces
+
+main = do
+	input <- getContents
+	let m = parse parseEndoSimao "" input
+	case m of 
+		Right ts -> print $ length ts
+		Left e -> print e

Main.hs

@@ -0,0 +1,23 @@
+import Text.Parsec.String
+import Text.Parsec.Combinator
+import Text.Parsec.Prim
+import Text.Parsec.Token
+import Text.Parsec.Language
+import Control.Applicative
+import Data.Functor.Identity
+import Data.Functor.Compose
+import Data.Functor.Constant
+import Data.Functor.Product
+import Data.Vector
+
+type WithOutput o = Product Identity (Constant o)
+
+data FSM t s i = FSM (s -> i -> t s)
+type DeterministicFSM s i o = FSM (WithOutput o) s i
+type PartialFSM s i o = FSM (Compose Maybe (WithOutput o)) s i
+type NondeterministicFSM s i o = FSM (Compose [] (WithOutput o)) s i
+
+-- createMachine :: Vector (Vector (t Int)) -> FSM t Int Int
+createMachine v = FSM (\s i -> v ! s ! i)
+
+main = print 10

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

map_test.hs

@@ -0,0 +1,79 @@
+{-# LANGUAGE RankNTypes #-}
+
+import Criterion.Main
+import Data.List
+import Data.Functor
+import Data.Hashable
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString as BSC
+
+import qualified Data.HashMap.Strict as HashMap (HashMap, insertWith, size, empty)
+import qualified Data.HashMap.Lazy as LazyHashMap (HashMap, insertWith, size, empty)
+
+import qualified Data.Map.Strict as TreeMap (Map, insertWith, size, empty)
+import qualified Data.Map.Lazy as LazyTreeMap (Map, insertWith, size, empty)
+
+import qualified Data.Trie as TrieMap (Trie, size, empty)
+import qualified Data.Trie.Convenience as TrieMap (insertWith)
+
+import qualified Data.Discrimination.Grouping as EKmett (nub)
+
+data MapImpl m k a = MapImpl {
+	insertWith :: (Ord k, Hashable k) => (a -> a -> a) -> k -> a -> m -> m,
+	size :: m -> Int,
+	empty :: m
+}
+
+update impl str m = (insertWith impl) (flip const) str ((size impl) m) m
+computeMap impl = foldr (update impl) (empty impl)
+test impl list = (size impl) (computeMap impl list)
+
+main = do
+	list <- map BSC.unpack . filter (not . BS.null) . BS.split '\n' <$> BS.getContents
+	defaultMain [ bench "hashMap"      $ whnf (test hashMap) list
+	            , bench "lazyHashMap"  $ whnf (test lazyHashMap) list
+	            , bench "treeMap"      $ whnf (test treeMap) list
+	            , bench "lazyTreeMap"  $ whnf (test lazyTreeMap) list
+	            --, bench "trieMap"      $ whnf (test trieMap) list
+	            , bench "ekmett nub"   $ whnf (length . EKmett.nub) list
+	            , bench "group . sort" $ whnf (length . group . sort) list
+	            , bench "nub"          $ whnf (length . nub) list
+	            ]
+
+--main = do
+--	list <- filter (not . BS.null) . BS.split '\n' <$> BS.getContents
+--	print $ test hashMap list
+--	print $ test lazyHashMap list
+--	print $ test treeMap list
+--	print $ test lazyTreeMap list
+--	print $ test trieMap list
+
+hashMap = MapImpl {
+	insertWith = HashMap.insertWith,
+	size = HashMap.size,
+	empty = HashMap.empty
+}
+
+lazyHashMap = MapImpl {
+	insertWith = LazyHashMap.insertWith,
+	size = LazyHashMap.size,
+	empty = LazyHashMap.empty
+}
+
+treeMap = MapImpl {
+	insertWith = TreeMap.insertWith,
+	size = TreeMap.size,
+	empty = TreeMap.empty
+}
+
+lazyTreeMap = MapImpl {
+	insertWith = LazyTreeMap.insertWith,
+	size = LazyTreeMap.size,
+	empty = LazyTreeMap.empty
+}
+
+trieMap = MapImpl {
+	insertWith = TrieMap.insertWith,
+	size = TrieMap.size,
+	empty = TrieMap.empty
+}

test.txt

@@ -0,0 +1,22 @@
+foo
+bar
+foo
+bar
+foo
+bar
+foo
+bar
+blalba
+baz
+baz
+baz
+baz
+foo
+bar
+baz
+foo
+iewn
+bar
+baz
+vaeji
+