NaturalLanguageAlphabets 0.0.1.0 → 0.0.2.0

raw patch · 12 files changed

+286/−176 lines, 12 filesdep +QuickCheckdep +aesondep +binarydep ~attoparsecdep ~basedep ~bimapsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: QuickCheck, aeson, binary, cereal, cereal-text, test-framework, test-framework-quickcheck2, test-framework-th, text-binary

Dependency ranges changed: attoparsec, base, bimaps, file-embed, stringable, text, vector

API changes (from Hackage documentation)

Files

• NLP/Alphabet/IMMC.hs +26/−0
• NLP/Alphabet/IMMC/Internal.hs +7/−11
• NLP/Alphabet/MultiChar.hs +2/−6
• NLP/Scoring/SimpleUnigram/Default.hs +1/−1
• NaturalLanguageAlphabets.cabal +59/−22
• README.md +6/−6
• changelog.md +7/−0
• scoring/simpleunigram.score +42/−0
• scoring/simpleunigram.txt +0/−42
• src/Benchmark.hs +0/−88
• tests/Benchmark.hs +88/−0
• tests/properties.hs +48/−0

@@ -3,10 +3,16 @@  module NLP.Alphabet.IMMC where +import           Control.Applicative import           Control.DeepSeq (NFData(..))+import           Data.Aeson as A+import           Data.Binary      as DB import           Data.Hashable+import           Data.Serialize   as DS+import           Data.Serialize.Text import           Data.Stringable as SA import           Data.String as IS+import           Data.Text.Binary import           Data.Vector.Unboxed.Deriving import           GHC.Generics import qualified Data.ByteString.Short as BS@@ -67,4 +73,24 @@ instance NFData IMMC where   rnf = rnf . getIMMC   {-# Inline rnf #-}++instance Binary IMMC where+  put = DB.put . toText+  get = fromText <$> DB.get+  {-# Inline put #-}+  {-# Inline get #-}++instance Serialize IMMC where+  put = DS.put . toText+  get = fromText <$> DS.get+  {-# Inline put #-}+  {-# Inline get #-}++instance FromJSON IMMC where+  parseJSON s = fromText <$> parseJSON s+  {-# Inline parseJSON #-}++instance ToJSON IMMC where+  toJSON = toJSON . toText+  {-# Inline toJSON #-} 

@@ -26,22 +26,18 @@ -- direction.  immcBimapAdd :: InternedMultiChar -> Int-immcBimapAdd k = unsafeDupablePerformIO $ do-  m <- readIORef immcBimap-  case lookupL m k of-    Just i  -> return i-    Nothing -> do let s = size m-                  atomicModifyIORef' immcBimap $ \m -> (insert m (k,s) , s)+immcBimapAdd k = unsafeDupablePerformIO $ atomicModifyIORef' immcBimap $ \m ->+  case lookupL m k of Just i  -> (m,i)+                      Nothing -> let s = size m+                                 in  (insert m (k,s) , s) {-# Inline immcBimapAdd #-}  -- | Lookup the @InternedMultiChar@ based on an @Int@ key. Unsafe totality -- assumption.  immcBimapLookupInt :: Int -> InternedMultiChar-immcBimapLookupInt r = seq r . unsafeDupablePerformIO $ do    -- need to @seq r@, otherwise the lookup will sometimes find Nothing.-  m <- readIORef immcBimap-  case lookupR m r of-    Just l  -> return l-    Nothing -> error "immcBimapLookupInt: totality assumption invalidated"+immcBimapLookupInt r = seq r . unsafeDupablePerformIO $ atomicModifyIORef' immcBimap $ \m ->+  case lookupR m r of Just l  -> (m,l)+                      Nothing -> error "immcBimapLookupInt: totality assumption invalidated" {-# Inline immcBimapLookupInt #-} 

@@ -1,9 +1,5 @@ --- | An alphabet, where each character is a short bytestring.------ Due to the overhead this incurs, we use 'ShortByteString's internally. We--- also provide an 'Interned' instance to further reduce overhead using--- hash-consing.+-- | An alphabet, where each character is a short piece of @Text@.  module NLP.Alphabet.MultiChar where @@ -115,7 +111,7 @@ instance Interned InternedMultiChar where   type Uninterned InternedMultiChar = MultiChar   newtype Description InternedMultiChar = DMC MultiChar deriving (Eq,Hashable)-  describe = DMC -- . MultiChar . T.copy . getMultiChar -- @DMC@ alone is type-correct. With 'T.copy' we make sure not to keep long @Text@s. TODO benchmark!+  describe = DMC . MultiChar . T.copy . getMultiChar -- @DMC@ alone is type-correct. With 'T.copy' we make sure not to keep long @Text@s. TODO benchmark!   identify = InternedMultiChar   cache    = imcCache   {-# Inline describe #-}

@@ -12,5 +12,5 @@ -- | Default simple unigram scores for a system of consonants, liquid -- consonants, and vowels of arbitrary scale. -clvDefaults = genSimpleScoring $ decodeUtf8 $(embedFile "scoring/simpleunigram.txt")+clvDefaults = genSimpleScoring $ decodeUtf8 $(embedFile "scoring/simpleunigram.score") 

@@ -1,8 +1,9 @@ name:           NaturalLanguageAlphabets-version:        0.0.1.0+version:        0.0.2.0 author:         Christian Hoener zu Siederdissen maintainer:     choener@bioinf.uni-leipzig.de-homepage:       http://www.bioinf.uni-leipzig.de/~choener/+homepage:       https://github.com/choener/NaturalLanguageAlphabets+bug-reports:    https://github.com/choener/NaturalLanguageAlphabets/issues copyright:      Christian Hoener zu Siederdissen, 2014-2015 category:       Natural Language Processing license:        BSD3@@ -10,7 +11,7 @@ build-type:     Simple stability:      experimental cabal-version:  >= 1.10.0-tested-with:    GHC == 7.8.4, GHC == 7.10.1+tested-with:    GHC == 7.8.4, GHC == 7.10.2 synopsis:       Alphabet and word representations description:                 Provides different encoding for characters and words in natural@@ -20,14 +21,17 @@                 Internal encoding of IMMC symbols are 0-based integers, which                 allows for the use of unboxed containers.                 .-                A very simple unigram-based scoring scheme is also provided.+                A very simple unigram-based scoring scheme and DSL to write+                such schemes are also provided.+                .+                <https://github.com/choener/NaturalLanguageAlphabets/blob/master/README.md>    extra-source-files:   README.md   changelog.md-  scoring/simpleunigram.txt+  scoring/simpleunigram.score   @@ -39,22 +43,28 @@   library-  build-depends: base                  >  4.7     && < 4.9-               , array                 >= 0.5     && < 0.6-               , attoparsec            >= 0.10    && < 0.13-               , bimaps                >= 0.0.0   && < 0.0.1-               , bytestring            >= 0.10.4-               , deepseq               >= 1.3     && < 1.5-               , file-embed            >= 0.0.6   && < 0.0.9-               , hashable              >= 1.2     && < 1.3-               , hashtables            >= 1.1     && < 1.3-               , intern                >= 0.9     && < 0.10-               , stringable            >= 0.1.2   && < 0.2-               , system-filepath       >= 0.4.9   && < 0.5-               , text                  >= 0.11    && < 1.3-               , unordered-containers  >= 0.2.3   && < 0.3-               , vector                >= 0.10    && < 0.11-               , vector-th-unbox       >= 0.2     && < 0.3+  build-depends: base                   >  4.7      && < 4.9+               , aeson                  >= 0.8      && < 0.11+               , array                  >= 0.5      && < 0.6+               , attoparsec             >= 0.10     && < 0.14+               , bimaps                 >= 0.0.0.4  && < 0.0.1+               , binary                 >= 0.7      && < 0.8+               , bytestring             >= 0.10.4+               , cereal                 >= 0.4      && < 0.5+               , cereal-text            >= 0.1      && < 0.2+               , deepseq                >= 1.3      && < 1.5+               , file-embed             >= 0.0.6    && < 0.0.10+               , hashable               >= 1.2      && < 1.3+               , hashtables             >= 1.1      && < 1.3+               , intern                 >= 0.9      && < 0.10+               , QuickCheck             >= 2.7      && < 2.9+               , stringable             >= 0.1.2    && < 0.2+               , system-filepath        >= 0.4.9    && < 0.5+               , text                   >= 0.11     && < 1.3+               , text-binary            >= 0.1      && < 0.3+               , unordered-containers   >= 0.2.3    && < 0.3+               , vector                 >= 0.10     && < 0.12+               , vector-th-unbox        >= 0.2      && < 0.3    exposed-modules:     NLP.Alphabet.IMMC@@ -94,7 +104,7 @@                , unordered-containers                , vector   hs-source-dirs:-    src+    tests   main-is:     Benchmark.hs   type:@@ -114,6 +124,33 @@       -fllvm       -optlo-O3 -optlo-std-compile-opts       -fllvm-tbaa++++test-suite properties+  type:+    exitcode-stdio-1.0+  main-is:+    properties.hs+  ghc-options:+    -threaded -rtsopts -with-rtsopts=-N+  hs-source-dirs:+    tests+  default-language:+    Haskell2010+  default-extensions: ScopedTypeVariables+                    , TemplateHaskell+  build-depends: base+               , aeson+               , binary+               , cereal+               , NaturalLanguageAlphabets+               , QuickCheck+               , stringable+               , test-framework               >= 0.8  && < 0.9+               , test-framework-quickcheck2   >= 0.3  && < 0.4+               , test-framework-th            >= 0.2  && < 0.3+               , text   

@@ -1,8 +1,7 @@-Natural Language Alphabets-==========================- [![Build Status](https://travis-ci.org/choener/NaturalLanguageAlphabets.svg?branch=master)](https://travis-ci.org/choener/NaturalLanguageAlphabets) +# Natural Language Alphabets+ Efficient, alphabet symbols. The symbols are interned, and hashed. This is quite useful for k-gram scoring, where we have different sets of symbols with different scores. IMMC symbols are internally represented via Ints in the range@@ -13,7 +12,8 @@  #### Contact -Christian Hoener zu Siederdissen-choener@bioinf.uni-leipzig.de-Leipzig University, Leipzig, Germany+Christian Hoener zu Siederdissen  +Leipzig University, Leipzig, Germany  +choener@bioinf.uni-leipzig.de  +http://www.bioinf.uni-leipzig.de/~choener/   

@@ -1,3 +1,10 @@+0.0.2.0+-------++- internalisation was *not* thread-safe, now it is+- some property tests+- scoring file suffix is now .score+ 0.0.1.0 ------- 

@@ -0,0 +1,42 @@+-- !!! THIS FILE ASSUMES UTF-8 ENCODING !!!+--+-- These are all vowels, but all 'a's are equivalent with respect to this+-- scoring. It is only required to give 'EqSet's if you have more than one+-- equivalent character. In this EqSet, everything gets a score of 'Eq Vowel'+-- (==2).+EqSet Vowel a â ã+EqSet Vowel e+EqSet Vowel i+EqSet Vowel o+EqSet Vowel u+-- These are sets of characters belonging to a certain class. In this case, we+-- have consonants.+Set Conso    b c d f g h j k m n p q s t v w x y z+Set Liquid   l r+Set Vowel    a\' e\' i\' o\' u\'   ə ɐ æ œ   æh ɔh ɒ ɔ+-- Here we say that whenever we see a consonant aligned to the same consonant+-- in the other word, give this score.+Eq Conso   4+Eq Liquid  3+Eq Vowel   2+-- Whenever we align two consonants that are not equal (or equivalent) we give+-- this score.+InSet   Conso    Conso     0+InSet   Conso    Liquid   -1+InSet   Conso    Vowel    -999999+InSet   Liquid   Conso    -1+InSet   Liquid   Liquid   -1+InSet   Liquid   Vowel    -1+InSet   Vowel    Conso    -999999+InSet   Vowel    Liquid   -1+InSet   Vowel    Vowel     0+-- How to score a gap in a sequence+Gap         -4+-- Later on we want affine gap scoring, it's already here but not used+GapOpen     -4+GapExtend   -4+-- This score is used when we align the same character but it's one we didn't+-- specify in our sets+Match        1+-- And finally how to score a mismatch that doesn't fit into the above+Mismatch    -999999

@@ -1,42 +0,0 @@--- !!! THIS FILE ASSUMES UTF-8 ENCODING !!!------ These are all vowels, but all 'a's are equivalent with respect to this--- scoring. It is only required to give 'EqSet's if you have more than one--- equivalent character. In this EqSet, everything gets a score of 'Eq Vowel'--- (==2).-EqSet Vowel a â ã-EqSet Vowel e-EqSet Vowel i-EqSet Vowel o-EqSet Vowel u--- These are sets of characters belonging to a certain class. In this case, we--- have consonants.-Set Conso    b c d f g h j k m n p q s t v w x y z-Set Liquid   l r-Set Vowel    a\' e\' i\' o\' u\'   ə ɐ æ œ   æh ɔh ɒ ɔ--- Here we say that whenever we see a consonant aligned to the same consonant--- in the other word, give this score.-Eq Conso   4-Eq Liquid  3-Eq Vowel   2--- Whenever we align two consonants that are not equal (or equivalent) we give--- this score.-InSet   Conso    Conso     0-InSet   Conso    Liquid   -1-InSet   Conso    Vowel    -999999-InSet   Liquid   Conso    -1-InSet   Liquid   Liquid   -1-InSet   Liquid   Vowel    -1-InSet   Vowel    Conso    -999999-InSet   Vowel    Liquid   -1-InSet   Vowel    Vowel     0--- How to score a gap in a sequence-Gap         -4--- Later on we want affine gap scoring, it's already here but not used-GapOpen     -4-GapExtend   -4--- This score is used when we align the same character but it's one we didn't--- specify in our sets-Match        1--- And finally how to score a mismatch that doesn't fit into the above-Mismatch    -999999

@@ -1,88 +0,0 @@---- | Working with natural languages entails having large, sparse scoring--- matrices. Here, we run through a bunch of options for these.------ We create a table to look things up, and two sets of queries: one of--- known elements, one of unknown elements.--module Main where--import           Criterion.Main-import qualified Data.Vector.Unboxed as VU-import qualified Data.Vector.Generic as VG-import qualified Data.Vector as VV-import           Text.Printf-import           Data.Tuple (swap)-import           Control.Applicative ((<$>))-import           System.Random.MWC-import           System.Random-import           Control.DeepSeq-import           Control.Monad-import qualified Data.HashMap.Strict as UCHS-import qualified Data.IntMap.Strict  as CIS-import           Data.String-import qualified Data.HashTable.IO as HT-import           System.IO.Unsafe (unsafePerformIO)--import NLP.Alphabet.IMMC----main :: IO ()-main = do ( !keys , !unks , (!hmsH,!cisH,!htH) , (!hmsK,!cisK,!htK) ) <- setupEnv-          printf "We have %d keys, and %d / %d / %d resp. %d / %d / %d keys in the lookup maps\n"-                    (VU.length keys)-                    (UCHS.size hmsH) (CIS.size cisH) (-1 :: Int)-                    (UCHS.size hmsK) (CIS.size cisK) (-1 :: Int)-          defaultMain-            [ bgroup "  100 keys" [ bench "uchs" $ whnf (\k -> UCHS.lookupDefault  0 k hmsH) (VU.head keys)-                                  , bench " cis" $ whnf (\k -> CIS.findWithDefault 0 k cisH) (getIMMC $ VU.head keys)-                                  , bench " htB" $ whnf (\k -> htLookup htH k)               (VU.head keys)-                                  ]-            , bgroup "10000 keys" [ bench "uchs" $ whnf (\k -> UCHS.lookupDefault  0 k hmsK) (VU.head keys)-                                  , bench " cis" $ whnf (\k -> CIS.findWithDefault 0 k cisK) (getIMMC $ VU.head keys)-                                  , bench " htB" $ whnf (\k -> htLookup htK k)               (VU.head keys)-                                  ]---            , bgroup "  100 known"   [ bench "uchsH" $ whnf (\ks -> VU.sum $ VU.map (\k -> UCHS.lookupDefault  0 k hmsH) ks) (VU.take 100 keys)---                                     , bench " cisH" $ whnf (\ks -> VU.sum $ VU.map (\k -> CIS.findWithDefault 0 k cisH) ks) (VU.map getIMMC $ VU.take 100 keys)---                                     ]---            , bgroup "    1 unknown" [ bench "uchsH" $ whnf (\k -> UCHS.lookupDefault  0 k hmsH) (VU.head unks)---                                     , bench " cisH" $ whnf (\k -> CIS.findWithDefault 0 k cisH) (getIMMC $ VU.head unks)---                                     ]-            ]--htLookup ht k = unsafePerformIO $ do-  l <- HT.lookup ht k-  case l of-    Nothing -> return 0-    Just v  -> return v-{-# Inline htLookup #-}---type HTB = HT.BasicHashTable IMMC Double--setupEnv = do-  -- create keys-  strs :: [String] <- replicateM 10000 rString-  -- scores to look up-  scrs :: [Double] <- replicateM 10000 $ randomRIO (0 , 9)-  -- create IMMC keys-  let keys = map (immc . fromString) strs-  -- create random keys, mostly not in strs-  unks :: [String] <- replicateM 10000 rString-  let sknu = map (immc . fromString) unks-  -- for 100 keys-  let hmsK = UCHS.fromList $ take 100 $ zip keys               scrs-  let cisK =  CIS.fromList $ take 100 $ zip (map getIMMC keys) scrs-  htH :: HTB <- HT.fromList $ take 100 $ zip keys scrs-  -- for 10 000 keys-  let hmsM = UCHS.fromList $ zip keys               scrs-  let cisM =  CIS.fromList $ zip (map getIMMC keys) scrs-  htK :: HTB <- HT.fromList $ zip keys scrs-  return (VU.fromList keys , VU.fromList sknu , (hmsK,cisK,htH) , (hmsM,cisM,htK) )--rString :: IO String-rString = do-  k :: Int <- randomRIO (1,4)-  replicateM k $ randomRIO ('A','Z')-

@@ -0,0 +1,88 @@++-- | Working with natural languages entails having large, sparse scoring+-- matrices. Here, we run through a bunch of options for these.+--+-- We create a table to look things up, and two sets of queries: one of+-- known elements, one of unknown elements.++module Main where++import           Criterion.Main+import qualified Data.Vector.Unboxed as VU+import qualified Data.Vector.Generic as VG+import qualified Data.Vector as VV+import           Text.Printf+import           Data.Tuple (swap)+import           Control.Applicative ((<$>))+import           System.Random.MWC+import           System.Random+import           Control.DeepSeq+import           Control.Monad+import qualified Data.HashMap.Strict as UCHS+import qualified Data.IntMap.Strict  as CIS+import           Data.String+import qualified Data.HashTable.IO as HT+import           System.IO.Unsafe (unsafePerformIO)++import NLP.Alphabet.IMMC++++main :: IO ()+main = do ( !keys , !unks , (!hmsH,!cisH,!htH) , (!hmsK,!cisK,!htK) ) <- setupEnv+          printf "We have %d keys, and %d / %d / %d resp. %d / %d / %d keys in the lookup maps\n"+                    (VU.length keys)+                    (UCHS.size hmsH) (CIS.size cisH) (-1 :: Int)+                    (UCHS.size hmsK) (CIS.size cisK) (-1 :: Int)+          defaultMain+            [ bgroup "  100 keys" [ bench "HashMap.Strict" $ whnf (\k -> UCHS.lookupDefault  0 k hmsH) (VU.head keys)+                                  , bench "IntMap.Strict" $ whnf (\k -> CIS.findWithDefault 0 k cisH) (getIMMC $ VU.head keys)+                                  , bench "HashTable" $ whnf (\k -> htLookup htH k)               (VU.head keys)+                                  ]+            , bgroup "10000 keys" [ bench "HashMap.Strict" $ whnf (\k -> UCHS.lookupDefault  0 k hmsK) (VU.head keys)+                                  , bench "IntMap.Strict" $ whnf (\k -> CIS.findWithDefault 0 k cisK) (getIMMC $ VU.head keys)+                                  , bench "HashTable" $ whnf (\k -> htLookup htK k)               (VU.head keys)+                                  ]+--            , bgroup "  100 known"   [ bench "uchsH" $ whnf (\ks -> VU.sum $ VU.map (\k -> UCHS.lookupDefault  0 k hmsH) ks) (VU.take 100 keys)+--                                     , bench " cisH" $ whnf (\ks -> VU.sum $ VU.map (\k -> CIS.findWithDefault 0 k cisH) ks) (VU.map getIMMC $ VU.take 100 keys)+--                                     ]+--            , bgroup "    1 unknown" [ bench "uchsH" $ whnf (\k -> UCHS.lookupDefault  0 k hmsH) (VU.head unks)+--                                     , bench " cisH" $ whnf (\k -> CIS.findWithDefault 0 k cisH) (getIMMC $ VU.head unks)+--                                     ]+            ]++htLookup ht k = unsafePerformIO $ do+  l <- HT.lookup ht k+  case l of+    Nothing -> return 0+    Just v  -> return v+{-# Inline htLookup #-}+++type HTB = HT.BasicHashTable IMMC Double++setupEnv = do+  -- create keys+  strs :: [String] <- replicateM 10000 rString+  -- scores to look up+  scrs :: [Double] <- replicateM 10000 $ randomRIO (0 , 9)+  -- create IMMC keys+  let keys = map (immc . fromString) strs+  -- create random keys, mostly not in strs+  unks :: [String] <- replicateM 10000 rString+  let sknu = map (immc . fromString) unks+  -- for 100 keys+  let hmsK = UCHS.fromList $ take 100 $ zip keys               scrs+  let cisK =  CIS.fromList $ take 100 $ zip (map getIMMC keys) scrs+  htH :: HTB <- HT.fromList $ take 100 $ zip keys scrs+  -- for 10 000 keys+  let hmsM = UCHS.fromList $ zip keys               scrs+  let cisM =  CIS.fromList $ zip (map getIMMC keys) scrs+  htK :: HTB <- HT.fromList $ zip keys scrs+  return (VU.fromList keys , VU.fromList sknu , (hmsK,cisK,htH) , (hmsM,cisM,htK) )++rString :: IO String+rString = do+  k :: Int <- randomRIO (1,4)+  replicateM k $ randomRIO ('A','Z')+

@@ -0,0 +1,48 @@++module Main where++import           Control.Applicative+import           Data.String+import           Data.Stringable hiding (fromString)+import           Debug.Trace+import qualified Data.Aeson as A+import qualified Data.Binary as B+import qualified Data.Serialize as S+import           Test.Framework.Providers.QuickCheck2+import           Test.Framework.TH++import           NLP.Alphabet.IMMC++++-- * IMMC++-- basic property of interning++prop_IMMC (t :: String)+  | t == u    = True+  | otherwise = traceShow (t, getIMMC i, u) False+  where i :: IMMC = fromString t+        u         = toString   i++-- binary++prop_Binary (t :: String) = t == toString j+  where i :: IMMC = fromString t+        j :: IMMC = B.decode $ B.encode i++-- cereal++prop_Serialize (t :: String) = Right t == (toString <$> j)+  where i ::               IMMC = fromString t+        j :: Either String IMMC = S.decode $ S.encode i++-- aeson (more complicated to due the json format!++prop_Aeson (t :: String) = Just [t] == (map toString <$> j)+  where i ::       [IMMC] = [fromString t]+        j :: Maybe [IMMC] = A.decode $ A.encode i++main :: IO ()+main = $(defaultMainGenerator)+