data-named (empty) → 0.1.0

raw patch · 6 files changed

+403/−0 lines, 6 filesdep +attoparsecdep +basedep +containerssetup-changed

Dependencies added: attoparsec, base, containers, text

Files

Data/Named/Graph.hs +99/−0
Data/Named/IOB.hs +127/−0
LICENSE +26/−0
Setup.lhs +4/−0
Text/Named/Enamex.hs +102/−0
data-named.cabal +45/−0

+ Data/Named/Graph.hs view

@@ -0,0 +1,99 @@+-- | Implementation of a graph with each node identified by a unique key.+-- It is a provisional module and it might be replaced by the standard+-- graph from containers package in the future.++module Data.Named.Graph+( Graph (..)+, mkGraph+, node+, edges+, roots+, toTree+, toKeyTree+, toForestWith+, toForest+) where++import qualified Data.Set as S+import qualified Data.Map as M+import qualified Data.Tree as T+import Data.List (mapAccumL, foldl', sortBy)+import Data.Maybe (mapMaybe, fromJust)+import Data.Ord (comparing)++-- | A graph.+data Graph k v = Graph+    { nodeMap :: M.Map k v+    , edgeMap :: M.Map k [k] }++-- | Make a graph from a list of (key, value, [children keys]) tuples.+mkGraph :: Ord k => [(k, v, [k])] -> Graph k v+mkGraph xs = +    Graph ns es+  where+    ns = M.fromList [(k, v)  | (k, v, _)  <- xs]+    es = M.fromList [(k, ks) | (k, _, ks) <- xs]++-- | Get node with the given key.+node :: (Show k, Ord k) => Graph k v -> k -> v+node g k = case M.lookup k (nodeMap g) of+    Nothing -> error $ "node: key " ++ show k ++ " not in the nodes map"+    Just v  -> v+{-# INLINE node #-}++-- | Get keys of adjacent nodes for the given node key.+edges :: (Show k, Ord k) => Graph k v -> k -> [k]+edges g k = case M.lookup k (edgeMap g) of+    Nothing -> error $ "edges: key " ++ show k ++ " not in the edges map"+    Just v  -> v+{-# INLINE edges #-}++-- | Return all graph roots (i.e. nodes with no parents).+roots :: Ord k => Graph k v -> [k]+roots g =+    [ k+    | (k, _) <- M.assocs (nodeMap g)+    , not (k `S.member` desc) ]+  where+    desc = S.fromList . concat . M.elems $ edgeMap g++-- | Make a tree rooted in the node with respect to the graph.+toTree :: (Show k, Ord k) => Graph k v -> k -> T.Tree v+toTree g = fmap (node g) . toKeyTree g++-- | Make a key tree rooted in the node with respect to the graph.+toKeyTree :: (Show k, Ord k) => Graph k v -> k -> T.Tree k+toKeyTree g k = T.Node k+    [ toKeyTree g k'+    | k' <- edges g k ]++-- | Transform graph into a forest given the priority function.+-- That is, trees with higher priorities will be taken first,+-- while those with lower priorities might be trimmed down+-- (since we don't want to have nodes with multiple parents in+-- the resulting forest).+toForestWith :: (Show k, Ord k, Ord a)+             => (T.Tree v -> a) -> Graph k v -> T.Forest v+toForestWith pr g = map valTr . snd $+    mapAccumL trim S.empty sortedTrees+  where+    valTr = fmap (node g) -- Make value tree from a key tree+    trees = map (toKeyTree g) (roots g)+    sortedTrees =+        let f = pr . valTr+        in  sortBy (comparing f) trees++-- | Transform graph into a forest. It removes duplicate+-- nodes from trees chosing trees in an arbitrary order.+toForest :: (Show k, Ord k) => Graph k v -> T.Forest v+toForest = toForestWith $ const (0 :: Int)++trim :: Ord k => S.Set k -> T.Tree k -> (S.Set k, T.Tree k)+trim visited tree =+    (visited', tree')+  where+    tree'    = fromJust (doIt tree)+    visited' = foldl' (flip S.insert) visited (T.flatten tree')+    doIt (T.Node x ts)+        | x `S.member` visited = Nothing+        | otherwise = Just $ T.Node x (mapMaybe doIt ts)

+ Data/Named/IOB.hs view

@@ -0,0 +1,127 @@+{- |+    IOB encoding method extended to forests.++    Example:++>>> :m Data.Tree Data.Text Text.Named.Enamex Data.Named.IOB+>>> let enamex = pack "<x>w1.1\\ w1.2</x> w2 <y><z>w3</z> w4</y>"+>>> let parseIt = fmap (mapTwo id id . fmap unpack) . parseForest++>>> putStr . drawForest . fmap (fmap show) . parseIt $ enamex+Left "x"+|+`- Right "w1.1 w1.2"+,+Right "w2"+,+Left "y"+|++- Left "z"+|  |+|  `- Right "w3"+|+`- Right "w4"++>>> mapM_ print . encodeForest . parseIt $ enamex+IOB {word = "w1.1 w1.2", label = [B "x"]}+IOB {word = "w2", label = []}+IOB {word = "w3", label = [B "y",B "z"]}+IOB {word = "w4", label = [I "y"]}+-}++module Data.Named.IOB+( IOB (..)+, Label+, Atom (..)+, encodeForest+, decodeForest+) where++import Control.Applicative ((<$>))+import Data.Maybe (fromJust)+import Data.Tree++-- | An 'IOB' data structure consists of a word with a corresponding+-- compound label.+data IOB w a = IOB+    { word  :: w+    , label :: Label a+    } deriving (Show)++-- | A 'Label' consists of a list of atomic 'Atom' labels.+type Label a = [Atom a]++-- | An 'Atom' is the atomic label with additional marker.+data Atom a  = B a      -- ^ Beginning marker+             | I a      -- ^ Inside marker +             deriving (Show, Eq, Ord)++push :: Atom a -> IOB w a -> IOB w a+push x (IOB w xs) = IOB w (x:xs)++popMaybe :: IOB w a -> Maybe (Atom a, IOB w a)+popMaybe (IOB w (x:xs)) = Just (x, IOB w xs)+popMaybe (IOB _ [])     = Nothing++topMaybe :: IOB w a -> Maybe (Atom a)+topMaybe iob = fst <$> popMaybe iob++pop :: IOB w a -> (Atom a, IOB w a)+pop = fromJust . popMaybe++-- top :: IOB w a -> Atom a+-- top = fromJust . topMaybe++raw :: Atom a -> a+raw (B x) = x+raw (I x) = x++-- isB :: Atom a -> Bool+-- isB (B _) = True+-- isB _     = False++isI :: Atom a -> Bool+isI (I _) = True+isI _     = False++-- | Encode the forest with the IOB method.+encodeForest :: Forest (Either a w) -> [IOB w a]+encodeForest [] = []+encodeForest (x:xs) = encodeTree x ++ encodeForest xs++-- | Encode the tree using the IOB method.+encodeTree :: Tree (Either a w) -> [IOB w a]++encodeTree (Node (Left _) []) =+    error "encodeTree: label node with no children"+encodeTree (Node (Left e) forest) =+    let addLayer (x:xs) = push (B e) x : map (push $ I e) xs+        addLayer []     = []+    in  addLayer (encodeForest forest)++encodeTree (Node (Right _) (_:_)) =+    error "encodeTree: word node with children"+encodeTree (Node (Right w) _) = [IOB w []]++-- | Decode the forest using the IOB method.+decodeForest :: Eq a => [IOB w a] -> Forest (Either a w)+decodeForest [] = []+decodeForest xs =+    tree : decodeForest xs'+  where+    (chunk, xs') = followTop xs+    tree = case topMaybe $ head chunk of+        Nothing -> Node (Right . word $ head chunk) []+        Just e  -> Node (Left $ raw e) (decodeForest $ map rmTop chunk)+    rmTop = snd . pop++-- | Take iob elements as long as the top label doesn't change.  +-- Return obtained part together with the rest of iob.+followTop :: Eq a => [IOB w a] -> ([IOB w a], [IOB w a])+followTop [] = error "followTop: empty iob"+followTop (x:xs) =+    (x:chunk, rest)+  where+    (chunk, rest) = span (cond (topMaybe x) . topMaybe) xs+    cond (Just a) (Just b) = raw a == raw b && isI b+    cond _ _ = False

+ 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/Named/Enamex.hs view

@@ -0,0 +1,102 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+    Parsing text in the Enamex data format.  Each node is enclosed between+    opening and closing tags with tag name representing the label and contents+    representing children of the node.  Both leaf and label values should be+    escaped by prepending the '\' character before special ' ' (space), '>',+    '<' and '\' characters.++    Example:++>>> :m Data.Tree Data.Text Text.Named.Enamex+>>> let drawIt = putStr . drawForest . fmap (fmap unpack) . parseForest+>>> drawIt $ pack "<x>w1.1\\ w1.2</x> <y><z>w2</z> w3</y>"+x+|+`- w1.1 w1.2+,+y+|++- z+|  |+|  `- w2+|+`- w3+-}++module Text.Named.Enamex+( parseForest+, parseEnamex+, mapTwo+) where++import Control.Applicative+import Control.Monad+import Data.Attoparsec.Text+import qualified Data.Text as T+import qualified Data.Text.Lazy as L+import qualified Data.Tree as Tree+++type Tree = Tree.Tree T.Text+type Forest = Tree.Forest T.Text++-- | Map the first function over internal nodes+-- and the second one over leaves.+mapTwo :: (a -> b) -> (a -> c) -> Tree.Tree a -> Tree.Tree (Either b c)+mapTwo _ g (Tree.Node x [])   = Tree.Node (Right $ g x) []+mapTwo f g (Tree.Node x kids) = Tree.Node (Left $ f x) (map (mapTwo f g) kids)++pForest :: Parser Forest+pForest = pTree `sepBy` (space *> skipSpace)++pTree :: Parser Tree+pTree = pNode+    <|> pLeaf++pLeaf :: Parser Tree+pLeaf = Tree.Node <$> pWord <*> pure []++pNode :: Parser Tree+pNode = do+    x    <- pOpenTag+    kids <- pForest+    x'   <- pCloseTag+    when (x /= x') (fail "Tag start/end mismatch")+    return $ Tree.Node x kids++pOpenTag :: Parser T.Text+pOpenTag = "<" .*> pWord <*. ">"++pCloseTag :: Parser T.Text+pCloseTag = "</" .*> pWord <*. ">"++pWord :: Parser T.Text+pWord =+    unEscape <$> scan False special+  where+    special False c =+      case c == ' ' || c == '<' || c == '>' of+        True    -> Nothing+        False   -> if c == '\\'+            then Just True+            else Just False+    special True _  = Just False++-- | TODO: Use lazy text builder to avoid slowness in the pessimistic case.+unEscape :: T.Text -> T.Text+unEscape xs = x `T.append` case drop1 rest of+    Just (y, ys) -> y `T.cons` unEscape ys+    Nothing      -> ""+  where+    drop1 = T.uncons <=< return . snd <=< T.uncons+    (x, rest) = T.breakOn "\\" xs ++-- | Parse the enamex forest.+parseForest :: T.Text -> Forest+parseForest = either error id . parseOnly (pForest <* endOfInput)++-- | Parse the enamex file.+parseEnamex :: L.Text -> [Forest]+parseEnamex = map (parseForest . L.toStrict) . L.lines

+ data-named.cabal view

@@ -0,0 +1,45 @@+name:               data-named+version:            0.1.0+synopsis:           Data types for named entities+description:+    The library provides data types which can be used to represent+    forest structures with labels stored in internal nodes and+    words kept in leaves.  In particular, those types are well suited+    for representing the layer of named entities (NEs).+    .+    The IOB method is implemented in the Data.Named.IOB module and can+    be used to translate between a forest of entities and a sequence+    of compound IOB labels.  This method can be used together with a+    sequence classifier to indirectly model forest structures.+    .+    The Data.Named.Graph module can be used to represent more general,+    graph structures of entities.  The module provides also a lossy+    conversion from a DAG to a forest of entities.+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/data-named+build-type:         Simple++library+    build-depends:+        base >= 4 && < 5+      , containers+      , text+      , attoparsec++    exposed-modules:+        Data.Named.Graph+      , Data.Named.IOB+      , Text.Named.Enamex++    ghc-options: -Wall++source-repository head+    type: git+    location: git://github.com/kawu/data-named.git