diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2014, Vjeran Crnjak + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Vjeran Crnjak nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/moan.cabal b/moan.cabal new file mode 100644 --- /dev/null +++ b/moan.cabal @@ -0,0 +1,36 @@ +name: moan +version: 0.1.0.0 +synopsis: Language-agnostic analyzer for positional morphosyntactic tags +description: Implementation of a space-efficient morphosyntactic analyzer. + It solves a problem of providing a set of possible tags for a given word. +license: BSD3 +license-file: LICENSE +author: Vjeran Crnjak +maintainer: vjeran.crnjak@gmail.com +-- copyright: +category: Natural Language Processing +homepage: https://github.com/vjeranc/moan +build-type: Simple +-- extra-source-files: +cabal-version: >=1.10 + +source-repository head + type: git + location: https://github.com/vjeranc/moan.git + +library + exposed-modules: NLP.Morphosyntax.Analyzer + -- other-modules: + other-extensions: RecordWildCards + build-depends: base >=4.7 && <4.8 + , zlib >=0.5 && <0.6 + , binary >=0.7 && <0.8 + , bytestring >=0.10 && <0.11 + , containers >=0.5 && <0.6 + , text >=1.1 && <1.2 + , dawg ==0.11.* + , tagset-positional ==0.3.* + , regex-tdfa-text + , regex-tdfa + hs-source-dirs: src + default-language: Haskell2010 diff --git a/src/NLP/Morphosyntax/Analyzer.hs b/src/NLP/Morphosyntax/Analyzer.hs new file mode 100644 --- /dev/null +++ b/src/NLP/Morphosyntax/Analyzer.hs @@ -0,0 +1,316 @@ +{-# LANGUAGE RecordWildCards #-} +{-| +Module : NLP.Morphosyntax.Analyzer +Description : Language-agnostic analyzer for positional morphosyntactic tags +Copyright : (c) Vjeran Crnjak, 2014 +License : BSD3 +Maintainer : vjeran.crnjak@gmail.com +Stability : experimental +Portability : portable + + +Implementation of a space-efficient morphosyntactic analyzer. + +It solves a problem of providing a set of possible tags for a given word. +Instead of just matching on the word-set pair, one can assume that suffixes of +an unknown word also hold some information about the set. + +This library provides the functionality of that kind of analysis. One example of +where this might be useful is 'concraft' tagging library. Before the POS-tagging +one needs to have a set of possible tags for a word from which the correct one is +disambiguated. + +For a sufficiently large construction corpus this analyzer might only benefit from +additional regular expressions for punctuation and number matching. There is a +possibility of returning a set of possible tags that isn't complete - the set doesn't +contain a correct tag. If construction corpus isn't sufficiently large, there might +be a fair amount of incomplete sets on unseen named entities (person names, corporation +names etc.). + +If one needs the analyzer to be less aggressive, it is recommended to extend the +functionality and remove the sets of possible tags from words which might be named (ex. +capitalized words in the middle of a sentence). This is present mostly in use cases +where part-of-speech tags of a language contain information whether a word represents a +named entity or not, so if this is not a case, there will be no need to extend the +current functionality. + +A simple example of using @GHCi@ for construction: + +> :set -XOverloadedStrings +> import qualified Data.Text.IO as T +> import qualified Data.Tagset.Positional as P +> f <- readFile "tagset.cfg" +> let tset = P.parseTagset "tagset1" f +> f <- T.readFile "fulldict.txt" +> let train = map (\(word:tags) -> (word, map (P.parseTag tset) tags)) . map T.words . filter (not . T.null) . T.lines $ f +> let an = create tset (AConf 3 [] M.empty) train +> save "analyzer.gz" an + +It is assumed that tag attributes are separated with @:@ for 'P.parseTag'. One could write a +different parsing function. +-} +module NLP.Morphosyntax.Analyzer +( +-- * Model + Analyzer +, elem +, getTags +, save +, load +, create +-- * Configuration +, AConf(..) +) where + +import qualified Codec.Compression.GZip as GZip +import Control.Applicative ((<$>), (<*>)) +import Control.Arrow (first, second, (&&&), (***)) +import Control.Monad (when) +import Data.Binary (Binary, get, put) +import qualified Data.Binary as Binary +import qualified Data.ByteString.Lazy as BL +import qualified Data.DAWG.Static as D +import qualified Data.IntMap as IntMap +import qualified Data.IntSet as IntSet +import qualified Data.Map as M +import Data.Maybe (mapMaybe) +import qualified Data.Set as S +import qualified Data.Tagset.Positional as P +import qualified Data.Text as T +import Data.Tuple (swap) +import Text.Regex.TDFA ((=~)) +import Text.Regex.TDFA.Text () + +import Prelude hiding (elem, notElem) + + +--------------------- +-- Morphological analyzer +--------------------- + + +modelVersion :: String +modelVersion = "0.1.0.0" + +-- | Configuration for the analyzer. +data AConf = AConf + { + -- | If word isn't known this is the smallest suffix length that will be matched. + suffixLen :: Int + -- | A list of regular expressions (POSIX) and accompanying set of tags. + -- If a word matches a regular expression, the accompanying set of tags + -- will be given as the set of possible tags. + , regexMatch :: [(T.Text, S.Set P.Tag)] + -- | Provides the analyzer with the ability to analyze the word on a single 'P.POS'-tag in + -- case incomplete construction corpus is present. (Ex. Croatian adjectives and pronouns) + -- It might be the case that words that can be adjectives can + -- also be pronouns. If the analyzer isn't thorough enough (the provided + -- construction data doesn't have all cases covered) one would also like that + -- words that are adjectives are also interpreted as being pronouns. What can happen + -- is, an unknown word has a very long suffix that matches an adjective, but it can + -- also be a pronoun. In that case one would like pronoun tags too. + -- If your construction data is very large this doesn't have to be used. + , separationLayout :: M.Map P.POS (S.Set P.POS) + } deriving (Eq, Show) + +instance Binary AConf where + put AConf{..} = do + put suffixLen + put regexMatch + put separationLayout + get = AConf <$> get <*> get <*> get + +{-| + This is a layout of conflicts that POS tags might have. + If there are conflicts the specialized DAWGs are used to resolve them. + For example. It might be the case that words that can be adjectives can + also be pronouns. If the analyzer isn't thorough enough (the provided + construction data doesn't have all cases covered) one would also like that + words that are adjectives are also interpreted as being pronouns. If a word + has only data about being an adjective but one wants it to be treated as a + pronouns too (in some contexts) this is a useful thing to set up. What can happen + is that a word has a very long suffix which matches an adjective but it can + also be a pronoun. In that case one would like pronoun tags too. +-} +data ConstLayout = CSL { + -- | Contains for each POS a set of POS for which the specialized DAWGs can be fetched. + sdawgs :: M.Map P.POS (S.Set P.POS) + -- | Map containing all the specialized DAWGs. + -- * Specialized DAWG contains only words linked with a POS which is the key in the map. + , posToDawg :: M.Map P.POS (D.DAWG Char Int IntSet.IntSet) + } deriving (Eq, Show) + +instance Binary ConstLayout where + put CSL{..} = do + put sdawgs + put posToDawg + get = CSL <$> get <*> get + +-- | Representation of the analyzer. +data Analyzer = Analyzer -- TODO Change to Analyzer t, to remove the P.Tag dependency + { + -- | This field represents the possible tagset of words used in this analyzer. + tagset :: P.Tagset + -- | Analyzer configuration, check 'AConf'. + , conf :: AConf + -- | Maps 'Int' to 'P.Tag'. + -- Used primarily for space compression. + , numToTag :: IntMap.IntMap P.Tag + -- | Compressed map of words to their possible set of tags. + , dawg :: D.DAWG Char Int IntSet.IntSet + -- | Check 'ConstLayout' for detailed info. + , csl :: ConstLayout + } deriving Eq + + +instance Binary Analyzer where + put Analyzer{..} = do + put modelVersion + put tagset + put conf + put numToTag + put dawg + put csl + get = do + comp <- get + when (comp /= modelVersion) $ error $ + "Incompatible analyzer code version: " ++ comp ++ + ", expected: " ++ modelVersion + Analyzer <$> get <*> get <*> get <*> get <*> get + +-- | Gives back a set of 'P.Tag' given the indices. +toTags :: Analyzer -> IntSet.IntSet -> S.Set P.Tag +toTags Analyzer{..} = + S.fromList . map (numToTag IntMap.!) . IntSet.toList + +-- | Gives a set of possible tags for a given word. It is possible that +-- the set of possible tags is empty. +getTags :: Analyzer -> T.Text -> S.Set P.Tag +getTags a@Analyzer{..} w + | not $ S.null rm = rm + | otherwise = ts + where rw = T.reverse w + ts = (if M.null (sdawgs csl) -- if no separation layout is given + then id -- just get the tags + else expandTags a rw ) $ -- otherwise expand them if necessary + toTags a $ getPureTags a rw + rm = matchOnRegex conf w + +-- | Matches all the provided regular expressions and takes the accompanying set +-- of the first one that matches. +matchOnRegex :: AConf -> T.Text -> S.Set P.Tag +matchOnRegex AConf{..} w = + let testR = map (first $ \regex -> w =~ regex) regexMatch + in case dropWhile (not . fst) testR of + [] -> S.empty + ((_,x):_) -> x + +-- | Returns a set of tags from the 'D.DAWG' without any conditions or adjustments. +-- @w@ should be in reversed form for 'D.DAWG'. +getPureTags :: Analyzer -> T.Text -> IntSet.IntSet +getPureTags a@Analyzer{..} w = + case (lookUp wl, lookUp wu) of + (Nothing, Nothing) -> suffixSet a w -- trying to fetch sets of word suffixes + (Just ss, Nothing) -> ss + (Nothing, Just ss) -> ss + (Just ss, Just sp) -> IntSet.union ss sp + where + lookUp = flip D.lookup dawg . T.unpack + wu = w + wl = T.toLower w + +-- | Adds the possible tags from specialized dawgs containing MSDs with +-- one kind of POS attribute. +expandTags :: Analyzer -> T.Text -> S.Set P.Tag -> S.Set P.Tag +expandTags a@Analyzer{..} w st = S.union st . toTags a $ getNew csl + where allpos = S.map P.pos st -- get all POS being present in set of possible tags + getNew CSL{..} = + let npos = S.unions . mapMaybe (`M.lookup` sdawgs) $ S.toList allpos -- get all the conflicting pos + uqpos= S.toList $ S.difference npos allpos -- get only pos tags which weren't fetched (aren't present in the current set of possible tags) + in IntSet.unions $ map (\pos -> getPureTags (a {dawg = posToDawg M.! pos}) w) uqpos + +suffixSet :: Analyzer -> T.Text -> IntSet.IntSet +suffixSet Analyzer{..} w = numTags + where suffixes = reverse . drop (suffixLen conf) $ T.inits w -- only interested in proper suffixes (suffixLen) + -- | @dawgs@ starts with the largest matched suffix + dawgs = dropWhile ((==0) . D.size) $ map ((`D.submap` dawg) . T.unpack) suffixes -- fusion? + numTags + | null dawgs = IntSet.empty + | otherwise = IntSet.unions . D.elems $ head dawgs + +-- | Save analyzer in a file. Data is compressed using the gzip format. +save :: FilePath -> Analyzer -> IO () +save path = BL.writeFile path . GZip.compress . Binary.encode + +-- | Load analyzer from a file. +load :: FilePath -> IO Analyzer +load path = do + x <- Binary.decode . GZip.decompress <$> BL.readFile path + x `seq` return x + +-- | Creates a morphological analyzer given a tagset, a list of regex for additional matching, +-- smallest suffix length and a construction corpus. +create :: P.Tagset -- ^ Tagset used in the construction corpus. + -> AConf -- ^ Configuration of the analyzer. + -> [(T.Text, [P.Tag])] -- ^ Construction corpus. + -> Analyzer -- ^ Morphological analyzer. +create tset cnf@AConf{..} xs = + Analyzer { tagset = tset + , conf = cnf + , numToTag = ntt + , dawg = dwg + , csl = cnls + } + where + -- | Reverses the word and converts the tag to its unique number. + revNttn = (T.unpack . T.reverse) *** (IntSet.fromList . map (ttn M.!)) -- fusion? + -- | Constructs the 'D.DAWG' given the + construct = D.weigh . D.fromListWith IntSet.union + dwg = construct $ map revNttn xs -- reverse the word (suffixes) and convert tag to num constructing the dawg + allTags = S.unions $ map (S.fromList . snd) xs -- set of all tags + ntt = IntMap.fromAscList . zip [1..] $ S.toAscList allTags -- number to tag + ttn = M.fromList . map swap $ IntMap.toAscList ntt -- tag to number + cnls = + if M.null separationLayout + then CSL separationLayout M.empty + else + -- TODO Do everything explicitly with one pass over xs + -- this procedure was changed and is this dirty because + -- [(T.Text, P.Tag)] was consuming too much memory. + let allpos = S.toList . S.unions $ M.elems separationLayout + forp pos = construct . map revNttn $ -- constructs a dawg containing only given pos + filter (not . null . snd) $ -- filters all the words which don't have a pos + map (second $ filter ((==pos) . P.pos)) xs -- filters the pos out of the words + alldwgs = M.fromList $ map (id &&& forp) allpos + in CSL separationLayout alldwgs + +-- TODO +-- The optimal data structure for fetching is suffix dawg but construction can be long +-- Optimal structure for fetching and constructing is a generalized suffix tree. +-- Could change the construction using a suffix to set mapping, this could potentially +-- speed up the retrieval of tags (step of set unions is avoided (suffixSet function) -- submap procedure). +-- 1. Data.List.tails is called on each word and tags associated with +-- the word are paired with it. +-- 2. For each suffix we check if it exists as a word to avoid errors +-- Ex. "10%" has a suffix '%' which is a punctuation, not a numeral +-- that describes a percentage. +-- 3. Then we find all possible sets of tags for each suffix, map them to +-- integers and avoid using the S.unions after submap +-- If a proper data structure is used no additional suffixes would be stored +-- only original words and for each a mapping to a set id. + reverse is removed + +-- | Checks whether a word is in the analyzer. If it is the set of tags +-- returned by the 'getTags' will be non-empty. +elem :: T.Text -> Analyzer -> Bool +elem ts Analyzer{..} = + case D.lookup (T.unpack . T.reverse $ ts) dawg of + Nothing -> False + Just _ -> True + +-- | Transforms a given string to a model suited string. +-- Ex. Nsmnn -> N:s:m:n:n, or Vmp-sf -> V:m:p:9:s:f, all +-- '-' to '9'. +transformToConfig :: T.Text -> T.Text +transformToConfig = T.intersperse ':' . T.map toNine + where toNine :: Char -> Char + toNine x = if x == '-' || x == '=' then '9' else x