packages feed

tagset-positional (empty) → 0.1.0

raw patch · 5 files changed

+273/−0 lines, 5 filesdep +basedep +containersdep +parsecsetup-changed

Dependencies added: base, containers, parsec, text

Files

+ Data/Tagset/Positional.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE PatternGuards #-}++module Data.Tagset.Positional+( Tagset (..)+, Attr+, POS+, Optional+, domain+, rule++, Tag (..)+, expand+, tagSim+) where++import Control.Arrow (first)+import qualified Data.Text as T+import qualified Data.Map as M+import qualified Data.Set as S++-- | Attribute name.+type Attr = T.Text++-- | Part of speech.+type POS = T.Text++-- | Is the attribute optional?+type Optional = Bool++-- | The tagset consists of a domain for each attribute name and of a+-- parsing rule for each part of speech.+data Tagset = Tagset+    { domains   :: M.Map Attr (S.Set T.Text)+    , rules     :: M.Map POS  [(Attr, Optional)]+    } deriving (Show)++-- | Set of potential values for the given attribute.+domain :: Tagset -> Attr -> S.Set T.Text+domain Tagset{..} x =+  case x `M.lookup` domains of+    Just y  -> y+    Nothing -> error $ "domain: unknown attribute " ++ T.unpack x++-- | Parsing rule for the given POS.+rule :: Tagset -> POS -> [(Attr, Optional)]+rule Tagset{..} x =+  case x `M.lookup` rules of+    Just y  -> y+    Nothing -> error $ "rule: unknown POS " ++ T.unpack x++-- | The morphosyntactic tag consists of the POS value and corresponding+-- attribute values.+data Tag = Tag+    { pos   :: POS+    , atts  :: M.Map Attr T.Text+    } deriving (Show, Read, Eq, Ord)++-- | Expand optional attributes of the tag.+expand :: Tagset -> Tag -> [Tag]+expand tagset tag = do+    values <- sequence (map attrVal rl)+    let attrMap = M.fromList $ zip (map fst rl) values+    return $ Tag (pos tag) attrMap+  where+    rl = rule tagset (pos tag)+    attrVal (attr, False) = [atts tag M.! attr]+    attrVal (attr, True)+        | Just x <- M.lookup attr (atts tag) = [x]+        | otherwise = S.toList $ domain tagset attr++-- | Measure of similarity between two tags.+tagSim :: Tag -> Tag -> Int+tagSim t t' =+    S.size (xs `S.intersection` xs')+  where+    xs  = S.fromList $ (Nothing, pos t)  : assocs t+    xs' = S.fromList $ (Nothing, pos t') : assocs t'+    assocs = map (first Just) . M.assocs . atts
+ LICENSE view
@@ -0,0 +1,26 @@+Copyright (c) 2012, IPI PAN+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.++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.
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ Text/Tagset/Positional.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternGuards #-}++-- | Parsing and printing positional tags and tagsets.++module Text.Tagset.Positional+( parseTag+, showTag+, parseTagset+) where++import Control.Applicative ((<$>), (<*>), (<*), (*>))+import Text.Parsec+import Data.Char (isSpace)+import Data.Maybe (catMaybes)+import qualified Data.Set as S+import qualified Data.Map as M+import qualified Data.Text as T++import Data.Tagset.Positional++-- | Parse the tag given the corresponding tagset.+parseTag :: Tagset -> T.Text -> Tag+parseTag tagset inp =+    Tag _pos . M.fromList $ parseRule (rule tagset _pos) attrVals+  where+    (_pos : attrVals) = T.split (==':') inp+    parseRule ((attr, opt):restAtts) (x:xs)+        | x `S.member` domain tagset attr+            = (attr, x) : parseRule restAtts xs+        | opt == True   = parseRule restAtts (x:xs)+        | otherwise     = error $ "parseRule:"+            ++ " no value for " ++ T.unpack attr+            ++ " attribute in tag " ++ T.unpack inp+    parseRule [] [] = []+    parseRule ((_, True):restAtts) [] = parseRule restAtts []+    parseRule _ [] = error $ "parseRule: unexpected end of input in tag "+        ++ T.unpack inp+    parseRule [] _ = error $ "parseRule: input too long in tag "+        ++ T.unpack inp++-- | Print the tag given the corresponding tagset.+showTag :: Tagset -> Tag -> T.Text+showTag tagset tag =+    T.intercalate ":" (pos tag : catMaybes attrVals)+  where+    attrVals = map showAttr $ rule tagset (pos tag)+    showAttr (attr, opt)+        | Just x <- M.lookup attr (atts tag) = Just x+        | opt == True = Nothing+        | otherwise = error $+            "showTag: no value for mandatory attribute " ++ T.unpack attr++-- | Below we defined the parser for the positional tagset.++type Parser = Parsec String ()++tagsetFile :: Parser Tagset+tagsetFile = spaces *> (Tagset <$> attrSec <*> ruleSec)++attrSec :: Parser (M.Map Attr (S.Set T.Text))+attrSec = do+    secName "ATTR" *> spaces+    defs <- attrLine `endBy` spaces+    return $ M.fromList defs++attrLine :: Parser (Attr, S.Set T.Text)+attrLine = do+    attr <- ident+    _ <- spaces *> char '=' *> lineSpaces+    values <- map T.pack <$> ident `endBy` lineSpaces+    return (T.pack attr, S.fromList values)++ruleSec :: Parser (M.Map POS [(Attr, Optional)])+ruleSec = do+    secName "RULE" *> spaces+    M.fromList <$> ruleLine `endBy` spaces++ruleLine :: Parser (POS, [(Attr, Optional)])+ruleLine = do+    _pos <- ident+    _ <- lineSpaces *> char '=' *> lineSpaces+    actionAtts <- attrName `endBy` lineSpaces+    return $ (T.pack _pos, actionAtts)++attrName :: Parser (Attr, Optional)+attrName = optionalAttrName <|> plainAttrName <?> "attribute name"++optionalAttrName :: Parser (Attr, Optional)+optionalAttrName = do+    name <- char '[' *> ident <*  char ']'+    return (T.pack name, True)++plainAttrName :: Parser (Attr, Optional)+plainAttrName = do+    name <- ident+    return $ (T.pack name, False)++lineSpace :: Parser Char+lineSpace = satisfy $ \c -> (isSpace c) && (not $ c == '\n')++lineSpaces :: Parser String+lineSpaces = many lineSpace++ident :: Parser String+ident = many1 $ oneOf $ ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "."++secName :: String -> Parser Char+secName name = char '[' *> string name *> char ']'++-- | Parse the textual representation of the tagset.  The first argument+-- should be the name of the source.+parseTagset :: String -> String -> Tagset+parseTagset src contents = do+    case parse tagsetFile src filtered of+        Left e  -> error $ "parseTagset: Error parsing input:\n" ++ show e+        Right r -> r+  where+     filtered = unlines $ map (removeComment '#') $ lines contents++removeComment :: Char -> String -> String+removeComment commChar s = case findComment s of+    Just i -> fst $ splitAt i s+    Nothing -> s+  where+    findComment xs = doFind xs 0 False+    doFind (x:xs) acc inQuot+        | x == commChar && not inQuot = Just acc+        | x == '"' = doFind xs (acc + 1) (not inQuot)+        | otherwise =  doFind xs (acc + 1) inQuot+    doFind [] _ _ = Nothing
+ tagset-positional.cabal view
@@ -0,0 +1,33 @@+name:               tagset-positional+version:            0.1.0+synopsis:           Handling positional tags and tagsets+description:+    The library provides printing and parsing functions for positional+    tags and tagsets.+license:            BSD3+license-file:       LICENSE+cabal-version:      >= 1.6+copyright:          Copyright (c) 2012 IPI PAN+author:             Jakub Waszczuk+maintainer:         waszczuk.kuba@gmail.com+stability:          experimental+category:           Natural Language Processing+homepage:           https://github.com/kawu/positional-tagset+build-type:         Simple++library+    build-depends:+        base >= 4 && < 5+      , containers+      , parsec+      , text++    exposed-modules:+        Data.Tagset.Positional+      , Text.Tagset.Positional++    ghc-options: -Wall++source-repository head+    type: git+    location: git://github.com/kawu/tagset-positional.git