syntaxnet-haskell (empty) → 0.1.1.0
raw patch · 8 files changed
+609/−0 lines, 8 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, cassava, containers, data-default, haskell-conll, hspec, lens, protolude, safe, split, text, text-format, vector
Files
- LICENSE +0/−0
- README.md +39/−0
- Setup.hs +2/−0
- src/NLP/SyntaxNet/SyntaxNet.hs +162/−0
- src/NLP/SyntaxNet/Types/CoNLL.hs +179/−0
- src/NLP/SyntaxNet/Types/ParseTree.hs +145/−0
- syntaxnet-haskell.cabal +60/−0
- test/Spec.hs +22/−0
+ LICENSE view
+ README.md view
@@ -0,0 +1,39 @@+# Google's SyntaxNet API in Haskell++[](https://travis-ci.com/mgajda/syntaxnet-haskell)++Haskell library for using [Google's SyntaxNet](https://github.com/tensorflow/models/tree/master/syntaxnet).+SyntaxNet is natural language parser including:+* Part of Speech tagger,+* syntax tree generator,+* recognition of referential expressions.++This API allows:+1. Reading saved SyntaxNet parse tree, POS, or reference assignment from file.+2. Easy manipulation of the parse trees with extra information (given by POS and/or reference assignment.)++# Documentation+Documentation will put into [docs](docs/) folder.++# Tests+Examples of parsed [SyntaxNet inputs](test/examples/) are attached.++There are following files there for each test:+* `.txt` file contains the input+* `.cnll` file contains the SyntaxNet output from `run.sh` script (parsed by the library)+* `.tree` file contains the SyntaxNet output from `demo.sh` script (if present)++# Usage++```+1) stack repl+2) :load src/NLP/SyntaxNet/SyntaxNet.hs +3) > tr <- readParseTree "test/examples/test1.tree"+4) > drawTree' $ fromJust $ tr+for Testing.+```++# Acknowledgements++- [Michał J. Gajda](https://github.com/mgajda)+- [Sergey Bushnyak](https://github.com/sigrlami)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/NLP/SyntaxNet/SyntaxNet.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RecordWildCards #-}++module NLP.SyntaxNet.SyntaxNet+ ( readCnll+ , readParseTree+ ) where++import Control.Applicative+import Control.Concurrent+import qualified Control.Exception as E+import Control.Lens hiding (at)+import Control.Monad+import Control.Monad.IO.Class+import Data.Aeson+import Data.Char+import qualified Data.Csv as Csv+import Data.Tree+import Data.Maybe+import Protolude+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy as BSL+import Data.Functor ((<$>))+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TEL+import qualified Data.Vector as V+import Safe as S+import Data.String++import Data.ConllToken+import Data.ParsedSentence+import Data.SyntaxTree+import Data.TagLabel+import NLP.SyntaxNet.Types.CoNLL+import NLP.SyntaxNet.Types.ParseTree++--------------------------------------------------------------------------------++readCnll :: FilePath -> IO [SnConllToken Text]+readCnll fpath = do + csvData <- BSL.readFile fpath + case TEL.decodeUtf8' csvData of+ Left err -> do+ putStrLn $ "error decoding" ++ (show err)+ return []+ Right dat -> do+ let res = (Csv.decodeWith cnllOptions Csv.NoHeader $ TEL.encodeUtf8 dat) :: Either String (V.Vector (SnConllToken Text))+ case res of+ Left err -> do+ putStrLn $ "error decoding" ++ (show err)+ return [] + Right vals -> + return $ V.toList vals++preprocess :: TL.Text -> TL.Text+preprocess txt = TL.cons '\"' $ TL.snoc escaped '\"'+ where escaped = TL.concatMap escaper txt++escaper :: Char -> TL.Text+escaper c+ | c == '\t' = "\"\t\""+ | c == '\n' = "\"\n\""+ | c == '\"' = "\"\""+ | otherwise = TL.singleton c+++-- | Define custom options to read tab-delimeted files+cnllOptions =+ Csv.defaultDecodeOptions+ { Csv.decDelimiter = fromIntegral (ord '\t')+ }++--------------------------------------------------------------------------------+-- Dealing with trees++readParseTree :: FilePath -> IO (Maybe (Tree (SnConllToken Text)))+readParseTree fpath = do+ treeData <- BSC.readFile fpath+ let ls = BSC.lines treeData++ let lls = map ( \x -> BSC.split ' ' x) ls + lln = map parseNode lls++ let tree = fromList lln + + return $ tree++-- | Same as readParseTree but for debugging+-- +readParseTree' :: FilePath -> IO ()+readParseTree' fpath = do+ treeData <- BSC.readFile fpath+ let ls = BSC.lines treeData++ mapM_ (putStrLn . T.pack . show ) ls++ let lls = map ( \x -> BSC.split ' ' x) ls+ + lln <- mapM parseNode' ls + + tree <- fromList' $ lln++ mapM_ (putStrLn . T.pack . show ) lln+ putStrLn $ T.pack $ "----\n"+ putStrLn $ T.pack $ show $ drawTree' $ fromJust tree+ + return $ ()+ +parseNode :: [BSC.ByteString] -> SnConllToken Text+parseNode llbs = do+ let llss = map BSC.unpack llbs+ lenLB = 3 -- useful labels like TOKEN POS ER+ lenWP = (length $ filter (==" ") llss ) -- each identation takes 2 spaces++ let lls = map T.pack llss+ lvl = (length lls) - lenLB - lenWP -- calculate actual level + lbls = drop ((length lls) - 3) lls -- extract only lables ++ ConllToken lvl -- reuse id to indicate level, when working with trees + (lbls `at` 0)+ ""+ UnkCg+ (parsePosFg $ lbls `at` 1)+ ""+ 0+ (parseGER $ lbls `at` 2)+ ""+ ""+ +parseNode' :: BSC.ByteString -> IO (SnConllToken Text)+parseNode' bs = do+ let llbs = filter (/="|") $ BSC.split ' ' bs+ llss = map BSC.unpack llbs+ lenLB = 3 -- useful labels like TOKEN POS ER+ lenWP = (length $ filter (=="") llss) -- always have 1 in front, each identation takes 2 spaces++ + let llt = map T.pack llss+ llsf = filter (/="") llt+ lvl = ((mod lenWP 2))+1 -- calculate actual level + lbls = drop ((length llt) - 3) llt -- extract only lables++ putStrLn $ T.pack $ show $ llss+ putStrLn $ T.pack $ show $ llsf+ putStrLn $ T.pack $ show $ lenWP+ putStrLn $ T.pack $ show $ lvl++ return $ ConllToken lvl -- reuse id to indicate level, when working with trees + (lbls `at` 0)+ ""+ UnkCg+ (parsePosFg $ lbls `at` 1)+ ""+ 0+ (parseGER $ lbls `at` 2)+ ""+ ""
+ src/NLP/SyntaxNet/Types/CoNLL.hs view
@@ -0,0 +1,179 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}++module NLP.SyntaxNet.Types.CoNLL where++import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import Data.Char (toUpper, isUpper, toLower)+import Data.Csv as Csv+import Data.Maybe+import Data.Default+import Protolude+import Data.List.Split+import qualified Data.Text as T+import GHC.Generics++import Data.ConllToken (ConllToken(..), SyntaxErrorCoNLL(..))+import Data.SyntaxTree (SyntaxtTree(..), createSyntaxTree)+import Model.PennTreebank+import Model.UniversalTreebank+import Data.TagLabel++--------------------------------------------------------------------------------++type SnConllToken a = ConllToken PosCG POS REL T.Text a+type SnConllTree a = SyntaxtTree PosCG POS REL T.Text a++-- | See "A Universal Part-of-Speech Tagset" by Slav Petrov, Dipanjan Das and Ryan McDonald+-- for more details http://arxiv.org/abs/1104.2086+-- Sum type for 12 universal part-of-speech tags, coarse-grained+data PosCG =+ VERB -- verbs (all tenses and modes)+ | NOUN -- nouns (common and proper)+ | PRON -- pronouns + | ADJ -- adjectives+ | ADV -- adverbs+ | ADP -- adpositions (prepositions and postpositions)+ | CONJ -- conjunctions+ | DET -- determiners+ | NUM -- cardinal numbers+ | PRT -- particles or other function words+ | X -- other: foreign words, typos, abbreviations+ | PUNCT -- punctuation+ | UnkCg -- unknown+ deriving (Show, Eq, Generic) ++--------------------------------------------------------------------------------+ +instance Csv.FromRecord (SnConllToken T.Text) where + parseRecord v = do+ a0 <- v .! 0+ a1 <- v .! 1+ a2 <- v .! 2+ a3 <- ( parsePosCf <$> v .! 3)+ a4 <- ( parsePosFg <$> v .! 4)+ a5 <- v .! 5+ a6 <- v .! 6+ a7 <- ( parseGER <$> v .! 7)+ a8 <- v .! 8+ a9 <- v .! 9+ return (ConllToken a0 a1 a2 a3 a4 a5 a6 a7 a8 a9)+ +-- | Converting coarse-grained textual types int+-- ADT representation+parsePosCf :: T.Text -> PosCG+parsePosCf s =+ case (map toUpper $ T.unpack s) of+ "VERB" -> VERB+ "NOUN" -> NOUN+ "PRON" -> PRON+ "ADJ" -> ADJ+ "ADV" -> ADV+ "ADP" -> ADP + "CONJ" -> CONJ + "DET" -> DET + "NUM" -> NUM + "PRT" -> PRT + "X" -> X + "." -> PUNCT + otherwise -> UnkCg+ +-- | Converting fine-grained textual types into+-- ADT representation+parsePosFg :: T.Text -> POS+parsePosFg s =+ case (map toUpper $ T.unpack s) of+ "CC" -> CC + "CD" -> CD+ "DT" -> DT+ "EX" -> EX+ "FW" -> FW+ "IN" -> IN+ "JJ" -> JJ+ "JJR" -> JJR+ "JJS" -> JJS+ "LS" -> LS+ "MD" -> MD+ "NN" -> NN+ "NNS" -> NNS+ "NNP" -> NNP+ "NNPS"-> NNPS+ "PDT" -> PDT+ "POS" -> POS+ "PRP" -> PRP+ "PRP$"-> fromJust $ fromLabelText "RPR$"+ "RB" -> RB+ "RBR" -> RBR+ "RBS" -> RBS+ "RP" -> RP+ "SYM" -> SYM+ "TO" -> TO+ "UH" -> UH+ "VB" -> VB+ "VBD" -> VBD+ "VBG" -> VBG+ "VBN" -> VBN+ "VBP" -> VBP+ "VBZ" -> VBZ+ "WDT" -> WDT+ "WP" -> WP+-- "WPS" -> WPS+ "WRB" -> WRB+ otherwise -> CC -- haskell-conll doesn't support fallback+ +parseGER :: T.Text -> REL+parseGER s =+ case s of+ "acl" -> Acl+ "acl:relcl" -> fromJust $ fromLabelText "acl:relcl"+ "advck" -> Advcl+ "advmod" -> Advmod+ "amod" -> Amod+ "appos" -> Appos+ "aux" -> Aux+ "auxpass" -> Auxpass+ "case" -> Case+ "cc" -> Cc+ "cc:preconj" -> fromJust $ fromLabelText "cc:preconj"+ "ccomp" -> Ccomp+ "compound" -> Compound+ "compound:prt"-> fromJust $ fromLabelText "compound:prt"+ "conj" -> Conj+ "cop" -> Cop+ "csubj" -> Csubj+ "csubjpass" -> Csubjpass+ "dep" -> Dep+ "det" -> Det+ "det:predet" -> fromJust $ fromLabelText "det:predet" -- haskell-conll have inconsistency in naming, why use _ whee you have camelcase+ "discource" -> Discourse+ "discolated" -> Dislocated + "dobj" -> Dobj+ "expl" -> Expl+ "fixed" -> fromJust $ fromLabelText "fixed"+ "fixed:not" -> fromJust $ fromLabelText "fixed:not" -- haskell-conll doesn't support this one+ "flat" -> Flat+ "foreign" -> Foreign+ "goeswith" -> Goeswith+ "iobj" -> Iobj+ "list" -> List+ "mark" -> Mark+ "neg" -> Neg+ "nmod" -> Nmod+ "nmod:npmod" -> fromJust $ fromLabelText "nmod:npmod"+ "nmod:poss" -> fromJust $ fromLabelText "nmod:poss"+ "nmod:tmod" -> fromJust $ fromLabelText "nmod:tmod"+ "nsubj" -> Nsubj+ "nsubjpass" -> Nsubjpass+ "nummod" -> Nummod+ "orphan" -> Orphan+ "parataxis" -> Parataxis+ "punct" -> Punct+ "reparandum" -> Reparandum+ "ROOT" -> ROOT+ "vocatile" -> Vocative+ "xcomp" -> Xcomp+ otherwise -> Punct -- haskell-conll doesn't support uknown type, like UnkGer, so fall back ro Punct
+ src/NLP/SyntaxNet/Types/ParseTree.hs view
@@ -0,0 +1,145 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE ViewPatterns #-}++module NLP.SyntaxNet.Types.ParseTree where++import Control.Lens+import Data.Default+import Data.Text+import Data.Tree+import Data.Tree.Lens+import qualified Data.Map as M+import Prelude as P++import Data.ConllToken+--import Data.SyntaxTree (SyntaxtTree(..), createSyntaxTree)+import Model.PennTreebank+import Model.UniversalTreebank+import Data.TagLabel++import NLP.SyntaxNet.Types.CoNLL++--------------------------------------------------------------------------------++-- |A 'Tree' of 'SnConllToken Text's+type TokenTree = Tree (SnConllToken Text)++-- |A 'Forest' of 'SnConllToken Text's+type TokenForest = [Tree (SnConllToken Text)]++-- |A Map of text values the appropriate tree+type TokenMap = M.Map Text TokenTree++drawTree' :: TokenTree -> String+drawTree' = P.unlines . draw++-- | Neat 2-dimensional drawing of a forest.+drawForest' :: TokenForest -> String+drawForest' = P.unlines . P.map drawTree'++draw :: TokenTree -> [String]+draw (Node tkn ts0) =+ P.lines ((unpack $ _tnWord tkn)+ ++ " "+ ++ (show $ _tnPosFG tkn)+ ++ " "+ ++ (unpack $ toLabelText $ _tnRel tkn)) ++ drawSubTrees ts0+ where+ drawSubTrees [] = []+ drawSubTrees [t] = shift " +-- " " " (draw t)+ drawSubTrees (t:ts) = shift " +-- " " | " (draw t) ++ drawSubTrees ts++ shift first other = P.zipWith (++) (first : repeat other)++--------------------------------------------------------------------------------++-- |Given a list of 'TokenTree's, return the top-level 'token's.+forestTokens :: [TokenTree] -> [Text]+forestTokens = P.map forestToken++-- |Given a 'TokenTree', return the top-level 'token'.+forestToken :: TokenTree -> Text+forestToken (Node tkn subf) = _tnWord tkn++-- |Given a list of 'TokenTree's, return a map of each token with+-- the appropriate tree.+mkMap :: TokenForest -> TokenMap+mkMap =+ M.fromList . tokenTreeAlist+ where+ tokenTreeAlist frs = P.zip (forestTokens frs) frs++-- | Return the elements at level i from a forest. 0-based indexing.+-- +getLevel :: Forest a -> Int -> [a]+getLevel fs 0 = P.map rootLabel fs+getLevel fs n = P.concatMap (\fs' -> getLevel (subForest fs') (n-1)) fs++-- | Convert list of nodes with defined level+-- into Tree structure+fromList :: [(SnConllToken Text)] -> Maybe TokenTree+fromList (n:nodes) =+ Just $ Node n (fromListAux nodes []) + where fromListAux :: [(SnConllToken Text)] -- ^ List of parsed Tokens+ -> [TokenTree] -- ^ Building Forest+ -> [TokenTree] -- ^ Final Forest+ fromListAux [] f = f+ fromListAux (t:ts:tss) f+ -- check current and next level+ | _tnId t == _tnId ts = do+ -- next element on the same level, attach only + fromListAux (ts:tss) (f ++ [Node t []])+ | _tnId t < _tnId ts = do+ -- attach and move recursevly deep+ fromListAux (ts:tss) (f ++ [(Node t (fromListAux (ts:tss) [] ))])+ | _tnId t > _tnId ts = do+ -- next level is higher, attach only and move forest up + f ++ [Node t []]++-- | Debug version of fromList inside IO monad+-- +fromList' :: [(SnConllToken Text)] -> IO (Maybe TokenTree)+fromList' (n:nodes) = do+ forest <- fromListAux nodes []+ return $ Just $ Node n forest + where fromListAux :: [(SnConllToken Text)] -- ^ List of parsed Tokens+ -> [TokenTree] -- ^ Building Forest+ -> IO [TokenTree] -- ^ Final Forest+ fromListAux [] f = return $ f+ fromListAux (t:ts:tss) f+ -- check current and next level+ | _tnId t == _tnId ts = do+ -- next element on the same level, attach only+ let lvl = P.replicate (_tnId t) '-'+ lvl'= P.replicate (_tnId t) ' '+ putStrLn $ lvl + putStrLn $ lvl' ++ "ch: 1; " ++ "lv: " ++ (show $ _tnId t) ++ " ; wr: " ++ (unpack $ _tnWord $ t)+ + fromListAux (ts:tss) (f ++ [Node t []])+ | _tnId t < _tnId ts = do+ -- attach and move recursevly deep+ let lvl = P.replicate (_tnId t) '-'+ lvl'= P.replicate (_tnId t) ' '+ putStrLn $ lvl + putStrLn $ lvl' ++ "ch: 2; " ++ "lv: " ++ (show $ _tnId t) ++ " ; wr: " ++ (unpack $ _tnWord $ t)++ sforest <- fromListAux (ts:tss) [] -- <+ fromListAux (ts:tss) (f ++ [(Node t sforest)])+ | _tnId t > _tnId ts = do+ -- next level is higher, attach only and move forest up+ let lvl = P.replicate (_tnId t) '-'+ lvl'= P.replicate (_tnId t) ' '+ putStrLn $ lvl + putStrLn $ lvl' ++ "ch: 2; " ++ "lv: " ++ (show $ _tnId t) ++ " ; wr: " ++ (unpack $ _tnWord t)+ + return $ f ++ [Node t []]++ +-- | Convert Tree structure to a sequantial list structure+-- +toList :: TokenTree -> [(SnConllToken Text)]+toList t =+ toListAux t []+ where+ toListAux (Node x ts) xs = x : P.foldr toListAux xs ts
+ syntaxnet-haskell.cabal view
@@ -0,0 +1,60 @@+name: syntaxnet-haskell+version: 0.1.1.0+synopsis: Working with Google's SyntaxNet output files - CoNLL, Tree+description: Allows to parse SyntaxNet output files in CoNLL or Syntax Tree formats. +homepage: https://github.com/mgajda/syntaxnet-haskell#readme+license: MIT+license-file: LICENSE+author: Sergey Bushnyak, Michal Gajda+maintainer: sergey.bushnyak@sigrlami.eu+copyright: Copyright: (c) 2017 Michal Gajda, Sergey Bushnyak+category: NLP+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: NLP.SyntaxNet.SyntaxNet+ other-modules: NLP.SyntaxNet.Types.ParseTree+ , NLP.SyntaxNet.Types.CoNLL+ build-depends: base >= 4.7 && < 5+ , bytestring+ , aeson+ , lens+ , vector+ , text+ , text-format+ , data-default+ , cassava+ , containers+ , protolude+ , safe+ , split+ , haskell-conll+ default-extensions: OverloadedStrings+ , TemplateHaskell+ other-extensions: ScopedTypeVariables+ , FlexibleContexts+ , DeriveGeneric++ default-language: Haskell2010+ default-extensions: NoImplicitPrelude+ , OverloadedStrings+test-suite test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , aeson+ , hspec+ , haskell-conll+ , cassava+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010+ default-extensions: NoImplicitPrelude+ , OverloadedStrings+ +source-repository head+ type: git+ location: https://github.com/sigrlami/syntaxnet-haskell
+ test/Spec.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++module Main (main) where++import Test.Hspec++--------------------------------------------------------------------------------++main :: IO ()+main =+ hspec spec++spec :: Spec+spec =+ describe "Testing CoNLL parsing" $ do+ it "" $ do++ -- Do Golden testing against + it "" $ do+ input <- liftIO $ readFile "examples/test-simple.conll"+ output <- liftIO $ readFile "examples/test-simple.conll.dump"