Browse Source

Some things: Map benchmark. Applicative parsing of automata

master
Joshua Moerman 8 years ago
commit
80b31d78d9
  1. 3
      .gitignore
  2. 24
      Applicative.cabal
  3. 73
      AutomataReader.hs
  4. 0
      LICENSE
  5. 23
      Main.hs
  6. 2
      Setup.hs
  7. 272803
      big_test.txt
  8. 79
      map_test.hs
  9. 900
      map_test.html
  10. 900
      map_test2.html
  11. 22
      test.txt

3
.gitignore

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

24
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

73
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

0
LICENSE

23
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

2
Setup.hs

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

272803
big_test.txt

File diff suppressed because it is too large

79
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
}

900
map_test.html

File diff suppressed because one or more lines are too long

900
map_test2.html

File diff suppressed because one or more lines are too long

22
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