hist-pl-dawg 0.1.0 → 0.2.0

raw patch · 2 files changed

+97/−25 lines, 2 filesdep ~dawgPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: dawg

API changes (from Hackage documentation)

Files

• hist-pl-dawg.cabal +2/−2
• src/NLP/HistPL/DAWG.hs +95/−23

@@ -1,5 +1,5 @@ name:               hist-pl-dawg-version:            0.1.0+version:            0.2.0 synopsis:           A generic, DAWG-based dictionary description:     A generic dictionary implementation based on directed acyclic word graphs.@@ -22,7 +22,7 @@                     , text                     , binary                     , text-binary-                    , dawg >= 0.9 && < 0.10+                    , dawg >= 0.10 && < 0.11    ghc-options: -Wall 

@@ -2,7 +2,7 @@ {-# LANGUAGE TupleSections #-}  --- | A `D.DAWG`-based dictionary with additional information+-- | A `DS.DAWG`-based dictionary with additional information -- assigned to lexical entries and word forms.  @@ -13,21 +13,39 @@ , apply , between --- * DAWG-, DAWG--- ** Entry+-- * Entry , Lex (..) , Key (..) , Val (..)-, Node--- ** Entry set++-- * Entry set , LexSet , mkLexSet , unLexSet--- , encode+, Node , decode+++-- * DAWG+, DAWG++-- ** Initialization+, DAWG'Init+, DM.empty+, insert+, DS.freeze+ -- ** Query , lookup+, submap++-- ** Weight+, DS.Weight+, DS.weigh+, DS.size+, index+, byIndex+ -- ** Conversion , fromList , toList@@ -41,9 +59,11 @@ import           Control.Arrow (first) import           Data.Binary (Binary, get, put) import           Data.Text.Binary ()+import           Data.List (foldl') import qualified Data.Map as M import qualified Data.Text as T-import qualified Data.DAWG.Static as D+import qualified Data.DAWG.Static as DS+import qualified Data.DAWG.Dynamic as DM   ------------------------------------------------------------------------@@ -121,6 +141,11 @@     deriving (Show, Eq, Ord)  +------------------------------------------------------------------------+-- Set of entries +------------------------------------------------------------------------++ -- | A set of dictionary entries. type LexSet i a b = M.Map (Key i) (Val a T.Text b) @@ -135,11 +160,6 @@ unLexSet = map (uncurry Lex) . M.toList  --- | Actual values stored in automaton states contain--- all entry information but `path`.-type Node i a b = M.Map i (Val a Rule b)-- -- | Map function over entry word forms. mapW :: Ord w' => (w -> w') -> Val a w b -> Val a w' b mapW f v =@@ -147,6 +167,11 @@     in  v { forms = g (forms v) }  +-- | Actual values stored in automaton states contain+-- all entry information but `path`.+type Node i a b = M.Map i (Val a Rule b)++ -- | Decode dictionary value given `path`. decode :: Ord i => T.Text -> Node i a b -> LexSet i a b decode x n = M.fromList@@ -162,36 +187,83 @@   ------------------------------------------------------------------------+-- DAWG +------------------------------------------------------------------------   -- | A dictionary parametrized over ID @i@, with info @a@ for every -- (key, i) pair and info @b@ for every (key, i, apply rule key) triple.-type DAWG i a b = D.DAWG Char () (Node i a b)+type DAWG i a b = DS.DAWG Char DS.Weight (Node i a b)  +------------------------------------------------------------------------+-- Initialization +------------------------------------------------------------------------+++-- | A `DAWG` initialization structure (a dynamic DAWG).+type DAWG'Init i a b = DM.DAWG Char (Node i a b)+++-- | Insert a (key, ID, entry info, form, entry\/form info) into a+-- `DAWG'Init` structure.+insert+    :: (Ord i, Ord a, Ord b)+    => (T.Text, i, a, T.Text, b)+    -> DAWG'Init i a b+    -> DAWG'Init i a b+insert (x, i, a, y, b) = DM.insertWith union+    (T.unpack x)+    (M.singleton i (Val a (M.singleton (between x y) b)))+  where+    union = M.unionWith $ both const M.union+    both f g (Val x0 y0) (Val x1 y1) = Val (f x0 x1) (g y0 y1)+++------------------------------------------------------------------------+-- Query +------------------------------------------------------------------------++ -- | Lookup the key in the dictionary. lookup :: Ord i => T.Text -> DAWG i a b -> LexSet i a b-lookup x dict = decode x $ case D.lookup (T.unpack x) dict of+lookup x dict = decode x $ case DS.lookup (T.unpack x) dict of     Just m  -> m     Nothing -> M.empty  +-- | Return the sub-dictionary containing all keys beginning with a prefix.+submap :: Ord i => T.Text -> DAWG i a b -> DAWG i a b+submap x dict = DS.submap (T.unpack x) dict+++-- | Position in a set of all dictionary entries with respect+-- to the lexicographic order.+index :: T.Text -> DAWG i a b -> Maybe Int+index x = DS.index (T.unpack x)+++-- | Find dictionary entry given its index with respect to the+-- lexicographic order.+byIndex :: Int -> DAWG i a b -> Maybe T.Text+byIndex ix = fmap T.pack . DS.byIndex ix+++------------------------------------------------------------------------+-- Conversion+------------------------------------------------------------------------++ -- | List dictionary lexical entries. entries :: Ord i => DAWG i a b -> [Lex i a b]-entries = concatMap f . D.assocs where+entries = concatMap f . DS.assocs where     f (key, val) = unLexSet $ decode (T.pack key) val   -- | Make dictionary from a list of (key, ID, entry info, form, -- entry\/form info) tuples. fromList :: (Ord i, Ord a, Ord b) => [(T.Text, i, a, T.Text, b)] -> DAWG i a b-fromList xs = D.fromListWith union $-    [ ( T.unpack x-      , M.singleton i (Val a (M.singleton (between x y) b)) )-    | (x, i, a, y, b) <- xs ]-  where-    union = M.unionWith $ both const M.union-    both f g (Val x y) (Val x' y') = Val (f x x') (g y y')+fromList = DS.weigh . DS.freeze . foldl' (flip insert) DM.empty   -- | Transform dictionary back into the list of (key, ID, key\/ID info, elem,