nerf 0.2.2 → 0.3.0
raw patch · 4 files changed
+180/−9 lines, 4 filesdep +tokenizedep ~data-named
Dependencies added: tokenize
Dependency ranges changed: data-named
Files
- NLP/Nerf.hs +19/−4
- NLP/Nerf/Tokenize.hs +151/−0
- nerf.cabal +5/−3
- tools/nerf.hs +5/−2
NLP/Nerf.hs view
@@ -13,16 +13,20 @@ import Control.Applicative ((<$>), (<*>)) import Data.Binary (Binary, put, get)+import Data.Foldable (foldMap)+import Data.List (intercalate)+import qualified Data.Text as T import qualified Data.Text.Lazy.IO as L import Text.Named.Enamex (parseEnamex)-import qualified Data.Named.Tree as Tr+import qualified Data.Named.Tree as N import qualified Data.Named.IOB as IOB import Numeric.SGD (SgdArgs) import qualified Data.CRF.Chain1 as CRF import NLP.Nerf.Types+import NLP.Nerf.Tokenize (tokenize, moveNEs) import NLP.Nerf.Schema (SchemaConf, Schema, fromConf, schematize) -- | A Nerf consists of the observation schema configuration and the CRF model.@@ -34,7 +38,7 @@ put Nerf{..} = put schemaConf >> put crf get = Nerf <$> get <*> get -flatten :: Schema a -> Tr.NeForest NE Word -> CRF.SentL Ob Lb+flatten :: Schema a -> N.NeForest NE Word -> CRF.SentL Ob Lb flatten schema forest = [ CRF.annotate x y | (x, y) <- zip xs ys ]@@ -43,8 +47,19 @@ xs = schematize schema (map IOB.word iob) ys = map IOB.label iob +-- | Tokenize sentence with the Nerf tokenizer.+reTokenize :: N.NeForest NE Word -> N.NeForest NE Word+reTokenize ft = + moveNEs ft ((doTok . leaves) ft)+ where + doTok = map T.pack . tokenize . intercalate " " . map T.unpack+ leaves = concatMap $ foldMap (either (const []) (:[]))++readDeep :: FilePath -> IO [N.NeForest NE Word]+readDeep path = map reTokenize . parseEnamex <$> L.readFile path+ readFlat :: Schema a -> FilePath -> IO [CRF.SentL Ob Lb]-readFlat schema path = map (flatten schema) . parseEnamex <$> L.readFile path+readFlat schema path = map (flatten schema) <$> readDeep path drawSent :: CRF.SentL Ob Lb -> IO () drawSent sent = do@@ -74,7 +89,7 @@ return $ Nerf cfg _crf -- | Perform named entity recognition (NER) using the Nerf.-ner :: Nerf -> [Word] -> Tr.NeForest NE Word+ner :: Nerf -> [Word] -> N.NeForest NE Word ner nerf ws = let schema = fromConf (schemaConf nerf) xs = CRF.tag (crf nerf) (schematize schema ws)
+ NLP/Nerf/Tokenize.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}++-- | The module implements the tokenization used within Nerf+-- and some other tokenization-related stuff.++module NLP.Nerf.Tokenize+(+-- * Tokenization+ tokenize+-- * Synchronization+, Word+, moveNEs+) where++import Control.Monad ((>=>))+import Data.Foldable (foldMap)+import qualified Data.Char as Char+import qualified Data.List as L+import qualified Data.Tree as T+import qualified Data.Traversable as Tr+import qualified Data.Text as Text+import qualified Data.Text.Lazy as LazyText+import qualified NLP.Tokenize as Tok++import Data.Named.Tree (NeForest, NeTree, groupForestLeaves)++---------------------------+-- Tokenization definition.+---------------------------++-- | Default tokenizator.+defaultTokenizer :: Tok.Tokenizer+defaultTokenizer+ = Tok.whitespace+ >=> Tok.uris+ >=> Tok.punctuation++-- | Tokenize sentence using the default tokenizer.+tokenize :: String -> [String]+tokenize = Tok.run defaultTokenizer++---------------------------------------------------------------+-- Synchronizing named entities with new sentence tokenization.+---------------------------------------------------------------++-- | A class of objects with size.+class Word a where+ size :: a -> Int+ rmSpaces :: a -> a++instance Word String where+ size = length+ rmSpaces = filter (not . Char.isSpace)++instance Word Text.Text where+ size = Text.length+ rmSpaces = Text.filter (not . Char.isSpace)++instance Word LazyText.Text where+ size = fromInteger . toInteger . LazyText.length+ rmSpaces = LazyText.filter (not . Char.isSpace)++essence :: Word a => a -> Int+essence = size . rmSpaces+{-# INLINE essence #-}++-- | Syncronization between two sentences. Each (xs, ys) pair represents+-- tokens from the two input sentences which corresponds to each other.+type Sync a = [([a], [a])]++-- | Synchronize two tokenizations of the sentence.+sync :: Word a => [a] -> [a] -> Sync a+sync = sync' 0++sync' :: Word a => Int -> [a] -> [a] -> Sync a+sync' r (x:xs) (y:ys)+ | n + r == m = ([x], [y]) : sync' 0 xs ys+ | n + r < m = join x $ sync' (n + r) xs (y:ys)+ | otherwise = swap . join y $ sync' (m - r) ys (x:xs)+ where+ n = essence x+ m = essence y+ join l ((ls, rs) : ps) = (l:ls, rs) : ps+ join _ [] = error "sync'.join: bad arguments"+ swap ((ls, rs) : ps) = (rs, ls) : swap ps+ swap [] = []+sync' 0 [] [] = []+sync' _ _ _ = error "sync': bad arguments"++-- | Match the `Sync` with the given list, return the matching result+-- (snd elements of the `Sync` list) and the rest of the `Sync` list.+match :: Word a => [a] -> Sync a -> ([a], Sync a)+match xs ss =+ let (sl, sr) = splitAcc isMatch 0 ss+ in (concatMap snd sl, sr)+ where+ n = sum (map essence xs)+ isMatch r (ys, _)+ | m + r < n = (m + r, False)+ | m + r == n = (m + r, True)+ | otherwise = error "match.isMatch: no match"+ where+ m = sum (map essence ys)++-- | Split the list with the help of the accumulating function.+splitAcc :: (acc -> a -> (acc, Bool)) -> acc -> [a] -> ([a], [a])+splitAcc _ _ [] = ([], [])+splitAcc f acc (x:xs)+ | cond = ([x], xs)+ | otherwise = join x (splitAcc f acc' xs)+ where+ (acc', cond) = f acc x+ join y (ys, zs) = (y:ys, zs)++-- | List forest leaves.+leaves :: NeForest a b -> [b]+leaves = concatMap $ foldMap (either (const []) (:[]))++unGroupLeaves :: NeForest a [b] -> NeForest a b+unGroupLeaves = concatMap unGroupLeavesT++unGroupLeavesT :: NeTree a [b] -> [NeTree a b]+unGroupLeavesT (T.Node (Left v) xs) =+ [T.Node (Left v) (unGroupLeaves xs)]+unGroupLeavesT (T.Node (Right vs) _) =+ [T.Node (Right v) [] | v <- vs]++substGroups :: Word b => NeForest a [b] -> Sync b -> NeForest a [b]+substGroups fs ss = snd $ L.mapAccumL substGroupsT ss fs++substGroupsT :: Word b => Sync b -> NeTree a [b] -> (Sync b, NeTree a [b])+substGroupsT =+ Tr.mapAccumL f+ where+ f s (Left v) = (s, Left v)+ f s (Right v) =+ let (v', s') = match v s+ in (s', Right v')++-- | Synchronize named entities with tokenization represented+-- by the second function argument. Of course, both arguments+-- should relate to the same sentence.+moveNEs :: Word b => NeForest a b -> [b] -> NeForest a b+moveNEs ft ys+ = unGroupLeaves+ $ substGroups+ (groupForestLeaves true ft)+ (sync (leaves ft) ys)+ where+ true _ _ = True
nerf.cabal view
@@ -1,5 +1,5 @@ name: nerf-version: 0.2.2+version: 0.3.0 synopsis: Nerf, the named entity recognition tool based on linear-chain CRFs description: The package provides the named entity recognition (NER) tool divided into a@@ -35,17 +35,19 @@ , text-binary >= 0.1 && < 0.2 , polysoup >= 0.1 && < 0.2 , crf-chain1 >= 0.2 && < 0.3- , data-named >= 0.5 && < 0.6+ , data-named >= 0.5.1 && < 0.6 , monad-ox >= 0.2 && < 0.3 , sgd >= 0.2.1 && < 0.3 , polimorf >= 0.6.0 && < 0.7 , dawg >= 0.8.1 && < 0.9+ , tokenize == 0.1.3 , cmdargs exposed-modules: NLP.Nerf , NLP.Nerf.Types , NLP.Nerf.Schema+ , NLP.Nerf.Tokenize , NLP.Nerf.Dict , NLP.Nerf.Dict.Base , NLP.Nerf.Dict.PNEG@@ -62,4 +64,4 @@ executable nerf hs-source-dirs: ., tools main-is: nerf.hs- ghc-options: -Wall -O2 -threaded+ ghc-options: -Wall -O2 -threaded -rtsopts
tools/nerf.hs view
@@ -21,6 +21,7 @@ import NLP.Nerf (train, ner, tryOx) import NLP.Nerf.Schema (defaultConf)+import NLP.Nerf.Tokenize (tokenize) import NLP.Nerf.Dict ( extractPoliMorf, extractPNEG, extractNELexicon, extractProlexbase , extractIntTriggers, extractExtTriggers, Dict )@@ -156,10 +157,12 @@ intDict extDict tryOx cfg dataPath +-- | Prepare input data: divide it into a list of sentences and tokenize+-- each sentence using the default tokenizer. parseRaw :: L.Text -> [[T.Text]] parseRaw =- let toStrict = map L.toStrict- in map (toStrict . L.words) . L.lines+ let doTok = map T.pack . tokenize . L.unpack+ in map doTok . L.lines readRaw :: FilePath -> IO [[T.Text]] readRaw = fmap parseRaw . L.readFile