packages feed

morfeusz (empty) → 0.3.0

raw patch · 7 files changed

+424/−0 lines, 7 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, mtl, text

Files

+ LICENSE view
@@ -0,0 +1,29 @@+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.++    * Neither the name of IPI PAN 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.
+ NLP/Morfeusz.hsc view
@@ -0,0 +1,271 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveFunctor #-}++-- | The module provides 'asDAG', 'asPaths' and 'asPath' wrapper functions+-- which use the Morfeusz library to analyse input sentences. +-- The first one represents analysis results as a directed acylic graph+-- (DAG) with edges labeled with 'Token's.  The DAG representation is needed+-- when the input word has multiple correct segmentations.+--+-- >>> :m NLP.Morfeusz+-- >>> :set -XOverloadedStrings+-- >>> let wordAsDAG = head . lefts . asDAG+-- >>> mapM_ print . wordAsDAG $ "miałem"+-- Edge {from = 0, to = 1, label = Token {orth = "mia\322", interps = [Interp {base = "mie\263", msd = "praet:sg:m1.m2.m3:imperf"}]}}+-- Edge {from = 0, to = 2, label = Token {orth = "mia\322em", interps = [Interp {base = "mia\322", msd = "subst:sg:inst:m3"}]}}+-- Edge {from = 1, to = 2, label = Token {orth = "em", interps = [Interp {base = "by\263", msd = "aglt:sg:pri:imperf:wok"}]}}+--+-- Alternatively you can use the 'asPaths' function to see all paths instead of a DAG.+--+-- >>> let wordAsPaths = head . lefts . asPaths+-- >>> mapM_ print . wordAsPaths $ "miałem"+-- [Token {orth = "mia\322em", interps = [Interp {base = "mia\322", msd = "subst:sg:inst:m3"}]}]+-- [Token {orth = "mia\322", interps = [Interp {base = "mie\263", msd = "praet:sg:m1.m2.m3:imperf"}]},Token {orth = "em", interps = [Interp {base = "by\263", msd = "aglt:sg:pri:imperf:wok"}]}]+--+-- The last analysis function, 'asPath', takes paths extracted using the 'asPaths' function+-- and arbitrarily chooses one of them.  While it returns only part of the analysis result,+-- it is also the easiest to use.+-- +-- >>> mapM_ print . asPath $ "zdanie ze spacjami"+-- Left (Token {orth = "zdanie", interps = [Interp {base = "zda\263", msd = "ger:sg:nom.acc:n2:perf:aff"},Interp {base = "zdanie", msd = "subst:sg:nom.acc.voc:n2"}]})+-- Right " "+-- Left (Token {orth = "ze", interps = [Interp {base = "z", msd = "prep:inst:wok"},Interp {base = "z", msd = "prep:gen.acc:wok"}]})+-- Right " "+-- Left (Token {orth = "spacjami", interps = [Interp {base = "spacja", msd = "subst:pl:inst:f"}]})+--+-- Use the 'lefts' function when you want to remove spaces from the result. ++module NLP.Morfeusz+(+-- * Types+  DAG+, Edge (..)+, Token (..)+, Interp (..)+, Space++-- * Sentence analysis+, asDAG+, asPaths+, asPath++-- * Utilities+, toPaths+, mapL+, concatL+, concatMapL++, module Data.Either+) where++import System.IO.Unsafe (unsafePerformIO)+import Control.Applicative ((<$>), (<*>))+import Control.Monad (when)+import Control.Monad.State (evalState, put, get)+import Data.Function (on)+import Data.List (groupBy)+import Data.Char (isSpace)+import Data.Either+import qualified Data.Map as M+import qualified Data.ByteString as B+import qualified Data.Text as T+import qualified Data.Text.Encoding as T++import Foreign hiding (unsafePerformIO)+import Foreign.C.Types+import Foreign.C.String (CString)++import NLP.Morfeusz.Lock (lock)++#include "morfeusz.h"++-- | Morfeusz options+newtype MorfOption = MorfOption { unMorfOption :: CInt }+    deriving (Eq, Show)++newtype Encoding = Encoding { unEncoding :: CInt }+    deriving (Eq, Show)++newtype WhiteSpace = WhiteSpace { unWhiteSpace :: CInt }+    deriving (Eq, Show)++#{ enum MorfOption, MorfOption+ , encoding   = MORFOPT_ENCODING+ , whitespace = MORFOPT_WHITESPACE }++#{ enum Encoding, Encoding+ , utf8         = MORFEUSZ_UTF_8+ , iso8859_2    = MORFEUSZ_ISO8859_2+ , cp1250       = MORFEUSZ_CP1250+ , cp852        = MORFEUSZ_CP852 }++#{ enum WhiteSpace, WhiteSpace+ , skip_whitespace = MORFEUSZ_SKIP_WHITESPACE+ , keep_whitespace = MORFEUSZ_KEEP_WHITESPACE }++-- | Set the encoding.+setEncoding :: Encoding -> IO Bool+setEncoding enc = (1 ==) <$>+    c_morfeusz_set_option (unMorfOption encoding) (unEncoding enc)++-- | Set the Morfeusz whitespace option.+setSpace :: WhiteSpace -> IO Bool+setSpace spc = (1 ==) <$>+    c_morfeusz_set_option (unMorfOption whitespace) (unWhiteSpace spc)++-- | A directed edge with label of type @a@ between nodes of type 'Int'.+data Edge a = Edge+    { from  :: Int+    , to    :: Int+    , label :: a }+    deriving (Eq, Ord, Show, Functor)++-- | Raw morphosyntactic interpretation as presented by the Morfeusz.+data RawInterp = RawInterp+    { _orth :: T.Text+    , _base :: Maybe T.Text+    , _msd  :: Maybe T.Text }+    deriving (Eq, Ord, Show)++-- | A token with a list of recognized interpretations.  If the list of+-- interpretations is empty, the token is unknown to the Morfeusz.+data Token = Token+    { orth      :: T.Text+    , interps   :: [Interp] }+    deriving (Show)++-- | An interpretation of the word.+data Interp = Interp+    { base :: T.Text+    , msd  :: T.Text }+    deriving (Show)++-- | A space. +type Space = T.Text++-- | We only provide the peek functionality.+instance Storable (Edge RawInterp) where+    sizeOf    _ = (#size InterpMorf)+    alignment _ = alignment (undefined :: CString)  -- or CInt ?+    peek ptr = do+        from <- getInt ((#peek InterpMorf, p) ptr)+        to <- getInt ((#peek InterpMorf, k) ptr)+        (orth, base, msd) <- if from == -1+            then return ("", Nothing, Nothing)+            else (,,)+                <$> getText ((#peek InterpMorf, forma) ptr)+                <*> getTextMaybe ((#peek InterpMorf, haslo) ptr)+                <*> getTextMaybe ((#peek InterpMorf, interp) ptr)+        return $ Edge from to (RawInterp orth base msd)+      where+        getInt = fmap fromIntegral :: IO CInt -> IO Int+        getText cStrIO = peekText =<< cStrIO+        getTextMaybe cStrIO = cStrIO >>= \cStr -> do+            if cStr == nullPtr+                then return Nothing+                else Just <$> peekText cStr+        peekText xs = T.decodeUtf8 <$> B.packCString xs++foreign import ccall unsafe "morfeusz_analyse"+    -- InterpMorf *morfeusz_analyse(char *tekst)+    c_morfeusz_analyse :: CString -> IO (Ptr (Edge RawInterp))++foreign import ccall unsafe "morfeusz_set_option"+    -- int morfeusz_set_option(int option, int value)+    c_morfeusz_set_option :: CInt -> CInt -> IO CInt++-- | A DAG with annotated edges. +type DAG a = [Edge a]++-- | Analyse the word and output raw Morfeusz results.+analyse :: T.Text -> DAG RawInterp+analyse word = run $ \cword -> lock $ do+    _ <- setEncoding utf8+    _ <- setSpace skip_whitespace+    interp_ptr <- c_morfeusz_analyse cword+    when (interp_ptr == nullPtr) (fail $ "analyse: null pointer")+    retrieve 0 interp_ptr+  where+    run = unsafePerformIO . B.useAsCString (T.encodeUtf8 word)+    retrieve k ptr = do+        x <- peekElemOff ptr k+        if from x == -1+            then return []+            else (:) <$> return x <*> retrieve (k + 1) ptr++-- | Translate the DAG of raw Morfeusz interpretations to+-- DAG labeled with tokens.+properDAG :: DAG RawInterp -> DAG Token+properDAG dag =+    [Edge p q t | ((p, q), t) <- M.toAscList m]+  where+    m = M.fromListWith (<>) [((p, q), fromRaw r) | Edge p q r <- dag]+    fromRaw (RawInterp o (Just b) (Just m)) = Token o [Interp b m] +    fromRaw (RawInterp o _ _)               = Token o [] +    Token orth xs <> Token _ ys = Token orth (xs ++ ys)++-- | Analyse the input sentence as a DAG of tokens interspersed by spaces.+-- The sentence is divided on spaces first and only individual words are+-- delivererd to Morfeusz library for morphosyntactic analysis.+asDAG :: T.Text -> [Either (DAG Token) Space]+asDAG =+    flip evalState 0 . mapM updateIxs . map mkElem . T.groupBy cmp+  where+    cmp x y = isSpace x == isSpace y+    mkElem x+        | T.any isSpace x   = Right x+        | otherwise         = Left . properDAG . analyse $ x+    updateIxs (Right x) = return (Right x)+    updateIxs (Left xs) = Left <$> updateDAG xs+    updateDAG xs        = do+        n <- get+        let m  = maximum . map to $ xs+            ys = map (shift n) xs+        put (n + m)+        return ys+    shift k Edge{..} = Edge (from + k) (to + k) label++-- | Retrieve all paths from the root to leaves.+toPaths :: DAG a -> [[a]]+toPaths dag =+    doIt .fst . M.findMin $ m+  where+    m = M.fromListWith (++) [(from e, [e]) | e <- dag]+    doIt p = case M.lookup p m of+        Just es -> [(label e : path) | e <- es, path <- doIt (to e)]+        Nothing -> [[]]++-- | Similar to the 'asDAG' function but instead of a token DAG it returns+-- all DAG paths (using the 'toPaths' function) for each word in the+-- input sentence.+asPaths :: T.Text -> [Either [[Token]] Space]+asPaths = mapL toPaths . asDAG++-- | Analyse the input sentence and arbitrarily choose one path+-- from the output DAG.+asPath :: T.Text -> [Either Token Space]+asPath = +    let hd []     = error "asPath.head: empty list"+        hd (x:xs) = x+    in  concatMapL hd . asPaths++-- | Map the function over left elements.+mapL :: (a -> a') -> [Either a b] -> [Either a' b]+mapL f =+    let g (Left x)  = Left (f x)+        g (Right y) = Right y+    in  map g++-- | Concatenate left elements.+concatL :: [Either [a] b] -> [Either a b]+concatL =+    let liftL (Left xs) = [Left x | x <- xs]+        liftL (Right y) = [Right y]+    in  concat . map liftL++-- | Map the function over left elements and concatenate results.+concatMapL :: (a -> [b]) -> [Either a c] -> [Either b c]+concatMapL f = concatL . mapL f
+ NLP/Morfeusz/Lock.hs view
@@ -0,0 +1,15 @@+-- | Provides a single global lock for @'IO'@ actions. Implementation borrowed+-- from the http://hackage.haskell.org/package/global-lock package.+module NLP.Morfeusz.Lock+    ( lock+    ) where++import Control.Concurrent.MVar++import NLP.Morfeusz.Lock.Internal ( get )++-- | Take the global lock for the duration of an @'IO'@ action.+--+-- Two actions executed via @'lock'@ will never run simultaneously.+lock :: IO a -> IO a+lock act = get >>= flip withMVar (const act)
+ NLP/Morfeusz/Lock/Internal.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- | Internals of global locking.  Implementation borrowed from the+-- http://hackage.haskell.org/package/global-lock package.+-- Use with caution!+module NLP.Morfeusz.Lock.Internal+    ( get+    ) where++import Foreign+import Foreign.C+import Control.Monad+import Control.Concurrent.MVar+++{- Importing c_get_global with 'unsafe' decreases locking latency by+about 50%. The C function just reads a static variable, so it's+okay to use 'unsafe'.++c_set_global must not be imported 'unsafe' because it uses GCC+atomic-operation builtins which, in the worst case, might call a+blocking library function. -}++{- If you are copying this file to your own Haskell project, see the+note in cbits/global.c regarding naming. -}++foreign import ccall unsafe "hs_morfeusz_get_global"+    c_get_global :: IO (Ptr ())++foreign import ccall "hs_morfeusz_set_global"+    c_set_global :: Ptr () -> IO CInt++set :: IO ()+set = do+    mv <- newMVar ()+    ptr <- newStablePtr mv+    ret <- c_set_global (castStablePtrToPtr ptr)+    when (ret == 0) $+        -- The variable was already set; our StablePtr is unused.+        freeStablePtr ptr++-- | Get the single @'MVar'@ used for global locking.+get :: IO (MVar ())+get = do+    p <- c_get_global+    if p == nullPtr+        then set >> get+        else deRefStablePtr (castPtrToStablePtr p)
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ cbits/global.c view
@@ -0,0 +1,28 @@+// Atomic builtins were added in GCC 4.1.+#if !defined(__GNUC__) \+|| (__GNUC__ < 4) \+|| (__GNUC__ == 4 && __GNUC_MINOR__ < 1)+#error global-lock requires GCC 4.1 or later.+#endif++static void* global = 0;++/*+If you are copying this file to your own Haskell project, you should+probably change these function names. I suggest replacing 'morfeusz'+with your package's z-encoded name, following+<http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/SymbolNames>+*/++// Imported 'unsafe' in Haskell code. Must not block!+void* hs_morfeusz_get_global(void) {+    return global;+}++int hs_morfeusz_set_global(void* new_global) {+    // Set 'global', if it was previously zero.+    void* old = __sync_val_compare_and_swap(&global, 0, new_global);++    // Return true iff we set it successfully.+    return (old == 0);+}
+ morfeusz.cabal view
@@ -0,0 +1,29 @@+name:               morfeusz+version:            0.3.0+synopsis:           Bindings to the morphological analyser Morfeusz+description:+    The library provides bindings to the morphological analyser Morfeusz+    <http://sgjp.pl/morfeusz/>.+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/morfeusz+build-type:         Simple++library+  exposed-modules:  NLP.Morfeusz+  other-modules:    NLP.Morfeusz.Lock, NLP.Morfeusz.Lock.Internal+  build-depends:    base >= 4 && < 5, containers, text, bytestring, mtl+  includes:         morfeusz.h+  extra-libraries:  morfeusz+  extensions:       ForeignFunctionInterface+  c-sources:        cbits/global.c++source-repository head+    type: git+    location: git://github.com/kawu/morfeusz.git