packages feed

hist-pl (empty) → 0.1.0

raw patch · 5 files changed

+358/−0 lines, 5 filesdep +basedep +cmdargsdep +containerssetup-changed

Dependencies added: base, cmdargs, containers, hist-pl-fusion, hist-pl-lexicon, morfeusz, polimorf, text

Files

+ 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
+ hist-pl.cabal view
@@ -0,0 +1,38 @@+name:               hist-pl+version:            0.1.0+synopsis:           Umbrella package for the historical dictionary of Polish+description:+    The package provides a tool for creating and searching the+    historical dictionary of Polish.  +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/hist-pl/tree/master/umbrella+build-type:         Simple++library+  hs-source-dirs:   src+  exposed-modules:    NLP.HistPL.Analyse+  build-depends:      base >= 4 && < 5 +                    , text+                    , hist-pl-lexicon >= 0.4 && < 0.5+                    , morfeusz >= 0.4 && < 0.5++executable hist-pl+  hs-source-dirs: src, tools+  main-is: hist-pl.hs+  build-depends:      base >= 4 && < 5 +                    , containers+                    , cmdargs+                    , polimorf >= 0.7.1 && < 0.8+                    , hist-pl-lexicon >= 0.4 && < 0.5+                    , hist-pl-fusion >= 0.4 && < 0.5++source-repository head+    type: git+    location: https://github.com/kawu/hist-pl.git
+ src/NLP/HistPL/Analyse.hs view
@@ -0,0 +1,180 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+++-- | The module provides functions for dictionary-driven analysis+-- of the input text.+++module NLP.HistPL.Analyse+( Token (..)+, Other (..)+, tokenize+, anaText+, anaWord+, mapL+, showAna+) where+++import Control.Applicative ((<$>), (<*>), pure)+import Data.Maybe (fromJust)+import Data.Monoid (Monoid, mappend, mconcat)+import Data.Ord (comparing)+import Data.List (sortBy, intersperse)+import qualified Data.Map as M+import qualified Data.Char as C+import qualified Data.Text as T+import qualified Data.Text.Lazy as L+import qualified Data.Text.Lazy.Builder as L++import qualified NLP.Morfeusz as R+import qualified NLP.HistPL.Lexicon as H++++-- | A token is an element of the analysis result.+data Token = Token {+    -- | Orthographic form.+      orth  :: T.Text+    -- | Historical interpretations.+    , hist  :: [(H.LexEntry, H.Code)]+    -- | Contemporary interpretations.+    , cont  :: [[R.Interp]] }+    deriving (Show)+++-- | A punctuation or a space.+data Other+    -- | Punctuation+    = Pun T.Text+    -- | Space+    | Space T.Text+    deriving (Show)+++-- | Perform simple tokenization -- spaces and punctuation+-- are treated as token ending markers.+tokenize :: T.Text -> [Either T.Text Other]+tokenize =+    map mkElem . T.groupBy cmp+  where+    cmp x y+        | C.isPunctuation x = False+        | C.isPunctuation y = False+        | otherwise         = C.isSpace x == C.isSpace y+    mkElem x+        | T.any C.isSpace x         = Right (Space x)+        | T.any C.isPunctuation x   = Right (Pun x)+        | otherwise                 = Left x+++-- | Analyse the text.+anaText :: H.HistPL -> T.Text -> IO [Either Token Other]+anaText hpl = mapL (anaWord hpl) . tokenize+++-- | Map the monadic function over left elements.+mapL :: (Functor m, Monad m) => (a -> m a') -> [Either a b] -> m [Either a' b]+mapL f =+    let g (Left x)  = Left <$> f x+        g (Right y) = return (Right y)+    in  mapM g+++-- | Analyse the word.+anaWord :: H.HistPL -> T.Text -> IO Token+anaWord hpl x = do+    _hist <- H.lookupMany hpl [x, T.toLower x]+    _cont <- return (anaCont x)+    return $ Token x _hist _cont+++-- -- | Analyse the word with respect to the historical dictionary.+-- anaHist :: Hist -> T.Text -> IO [(H.Code, H.LexEntry)]+-- anaHist hd word = sequence+--     [ (,) <$> follow (H.Key base uid) <*> pure code+--     | (H.LexKey{..}, H.LexElem{..}) <- M.assocs keys+--     , (base, code) <- M.assocs forms ]+--   where+--     -- Identify lexical entry with the given key.+--     follow = fmap (H.lexEntry . fromJust) . H.withKey (histPL hd)+--     -- Analyse both the original form and the lowercased form.+--     keys = M.unionWith (right (M.unionWith min))+--         (ana word)+--         (ana (T.toLower word))+--     right f (H.LexElem x y) (H.LexElem _ y') = H.LexElem x (f y y')+--     ana = flip H.lookup (fused hd)+++-- | Analyse word using the Morfeusz analyser for contemporary Polish.+anaCont :: T.Text -> [[R.Interp]]+anaCont = map R.interps . head . R.paths . R.analyse False+++-- | Show analysed text.+showAna :: [Either Token Other] -> L.Text+showAna = L.toLazyText . mconcat . newlineSep . buildAna+++buildAna :: [Either Token Other] -> [L.Builder]+buildAna xs = "sent:" :+    map indent (concatMap (either buildTok buildOther) xs)+++-- | List of Text builders for the token.  Individual lines are represented+-- by different builders.+buildTok :: Token -> [L.Builder]+buildTok tok+    =  buildHead tok+    :  map (indent . buildHist) histInterps+    -- ++ concatMap buildCont (cont tok)+  where+    histInterps = sortBy (comparing snd) (hist tok)+++buildHead :: Token -> L.Builder+buildHead tok = "word: " <> L.fromText (orth tok)+++-- | Build a list of historical interpretations.+buildHist :: (H.LexEntry, H.Code) -> L.Builder+buildHist (entry, code)+    =  "hist: " <> buildID (H.lexId entry, code)+    <> " "      <> buildPos+    <> ": "      <> commaRepr (H.lemma entry)+--     <> " " <> "tags: "+  where+    buildID (id', cd') = "[" <> L.fromText id' <> ", " <> buildCode cd' <> "]"+    buildPos = case H.pos entry of+        [] -> "-"+        xs -> mconcat . commaSep . map L.fromText $ xs+    buildCode code' = case code' of+        H.Orig -> "orig"+        H.Both -> "both"+        H.Copy -> "copy"+++buildOther :: Other -> [L.Builder]+buildOther (Space _) = ["<space>"]+buildOther (Pun t)   = ["pun: " <> L.fromText t]+++commaRepr :: H.HasRepr t => t -> L.Builder+commaRepr = mconcat . commaSep . map L.fromText . H.text+++(<>) :: Monoid m => m -> m -> m+(<>) = mappend+++indent :: L.Builder -> L.Builder+indent = ("  " <>)+++commaSep :: [L.Builder] -> [L.Builder]+commaSep = intersperse ", "+++newlineSep :: [L.Builder] -> [L.Builder]+newlineSep = intersperse "\n"
+ tools/hist-pl.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RecordWildCards #-}+++import           Control.Applicative ((<$>))+import           Control.Monad (void, forM_, (<=<))+import           System.Console.CmdArgs+import qualified Data.Set as S+import qualified Data.Map as M+import qualified Data.Text.Lazy as L+import qualified Data.Text.Lazy.IO as L++import qualified Data.PoliMorf as P+import qualified NLP.HistPL.LMF as LMF+import qualified NLP.HistPL.Dict as D+import qualified NLP.HistPL.Lexicon as H+import qualified NLP.HistPL.Fusion as F+import qualified NLP.HistPL.Analyse as A++import           Paths_hist_pl (version)+import           Data.Version (showVersion)+++---------------------------------------+-- Command line options+---------------------------------------+++-- | A description of the Concraft-pl tool+concraftDesc :: String+concraftDesc = "HistPL " ++ showVersion version+++data HistPL+  = Create+    { lmfPath       :: FilePath+    , poliPath      :: FilePath+    , outPath       :: FilePath }+  | Print+    { binPath       :: FilePath }+  | Analyse+    { binPath       :: FilePath }+  deriving (Data, Typeable, Show)+++createMode :: HistPL+createMode = Create+    { lmfPath  = def &= typ "HistPL-LMF" &= argPos 0+    , poliPath = def &= typ "PoliMorf" &= argPos 1+    , outPath  = def &= typ "HistPL-Binary" &= argPos 2 }+++printMode :: HistPL+printMode = Print+    { binPath = def &= typ "HistPL-Binary" &= argPos 0 }+++anaMode :: HistPL+anaMode = Analyse+    { binPath = def &= typ "HistPL-Binary" &= argPos 0 }+++argModes :: Mode (CmdArgs HistPL)+argModes = cmdArgsMode $ modes+    [createMode, printMode, anaMode]+    &= summary concraftDesc+    &= program "hist-pl"+++---------------------------------------+-- Main+---------------------------------------+++main :: IO ()+main = exec =<< cmdArgsRun argModes+++exec :: HistPL -> IO ()+exec Create{..} = do+    -- putStrLn "Reading PoliMorf..."+    poli <- F.mkPoli . filter P.atomic <$> P.readPoliMorf poliPath+    -- putStrLn "Reading historical dictionary of Polish..."+    hist <- LMF.readLMF lmfPath+    -- putStrLn "Creating the binary version of the dictionary..."+    void $ H.save outPath (addForms poli hist)+  where+    addForms poli hist =+        [ ( lexEntry+          , formSet (corr poli lexEntry) )+        | lexEntry <- hist ]+    corr = F.buildCorresp F.byForms F.posFilter F.sumChoice+    formSet lexSet = S.fromList $ concat+        [ M.keys (D.forms val)+        | val <- M.elems lexSet ]+++exec Print{..} = do+    hpl <- H.open binPath+    H.load hpl >>= L.putStr . LMF.showLMF . map snd+++exec Analyse{..} = do+    hpl <- H.open binPath+    xs  <- L.lines <$> L.getContents +    forM_ xs $ L.putStrLn <=< onLine hpl+  where+    onLine hpl x = A.showAna <$> A.anaText hpl (L.toStrict x)