monad-ox (empty) → 0.1.0

raw patch · 5 files changed

+293/−0 lines, 5 filesdep +basedep +containersdep +data-memocombinatorssetup-changed

Dependencies added: base, containers, data-memocombinators, mtl, vector

Files

• Control/Monad/Ox.hs +165/−0
• Control/Monad/Ox/String.hs +61/−0
• LICENSE +26/−0
• Setup.lhs +4/−0
• monad-ox.cabal +37/−0

@@ -0,0 +1,165 @@+-- | The Ox monad facilitates writing functional expressions over the+-- input sentence with arbitrary type of sentence token.++module Control.Monad.Ox+( +-- * Types+  Ox+, Id++-- * Functions+, atWith+, atsWith+, save+, saves+, when+, whenJT+, group++-- * Ox monad execution+, execOx++-- * Utilities+, memoize+) where++import Control.Applicative ((<$>), (<*), (*>))+import Control.Arrow (first)+import Control.Monad.State hiding (when)+import Control.Monad.Writer hiding (when)+import Data.Maybe (maybeToList)+import qualified Data.Vector as V+import qualified Data.MemoCombinators as Memo++-- | Observation type identifier.  It consists of a list of+-- integers, each integer representing a state of the Ox+-- monad on the particular level.+type Id = [Int]++-- | Increment the integer component of the top-most level.+inc :: Id -> Id+inc []      = error "incId: null id"+inc (x:xs)  = x+1 : xs++-- | Push new value to the Id stack.+grow :: Id -> Id+grow xs = 1 : xs++-- | Pop value from the stack.+shrink :: Id -> Id+shrink []       = error "shrink: null id"+shrink (_:xs)   = xs++-- | Set the top-most component to the given value.+getTop :: Id -> Int+getTop [] = error "getTop: null id"+getTop (x:_) = x++-- | Set the top-most component to the given value.+setTop :: Int -> Id -> Id+setTop _ [] = error "setTop: null id"+setTop x (_:xs) = x:xs++-- | The Ox is a monad stack with observation type identifier handled by+-- the state monad and the resulting observation values paired with identifiers+-- printed using the writer monad.+type Ox t w a = WriterT [(Id, w)] (State Id) a++-- | Retrieve the current identifier value.+getId :: Ox t w Id+getId = lift get+{-# INLINE getId #-}++-- | Set the new identifier value.+setId :: Id -> Ox t w ()+setId = lift . put+{-# INLINE setId #-}++-- | Update the current identifier of the Ox monad.+updateId :: (Id -> Id) -> Ox t w ()+updateId f = do+    i <- getId+    setId (f i)++-- | Increase the current identifier of the Ox monad.+incId :: Ox t w ()+incId = updateId inc++-- | Perform the identifier-dependent action and increase the identifier.+withId :: (Id -> Ox t w a) -> Ox t w a+withId act = do+    x <- act =<< getId+    incId+    return x++-- | Perform the Ox action on the lower level.+below :: Ox t w a -> Ox t w a+below act = updateId grow *> act <* updateId shrink++-- | Value of the 't -> a' function with respect to the given sentence+-- and sentence position.  Return Nothing if the position is out of+-- bounds.+atWith :: V.Vector t -> (t -> a) -> Int -> Maybe a+atWith xs f k =+    if k < 0 || k >= V.length xs+        then Nothing+        else Just $ f (xs V.! k)++-- | Value of the 't -> [a]' function with respect to the given sentence+-- and sentence position.  Return empty list if the position is out of+-- bounds.+atsWith  :: V.Vector t -> (t -> [a]) -> Int -> [a]+atsWith xs f k =+    if k < 0 || k >= V.length xs+        then []+        else f (xs V.! k)++-- | Save observation values in the writer monad of the Ox stack.+saves :: [w] -> Ox t w ()+saves xs = withId $ \i -> tell [(i, x) | x <- xs]++-- | Save the observation value.+save :: Maybe w -> Ox t w ()+save = saves . maybeToList++-- | Perform the Ox action only when the 'cond' is True.  It works like+-- the standard 'Control.Monad.when' function but also changes the current+-- identifier value.+when :: Bool -> Ox t w a -> Ox t w (Maybe a)+when cond act = do+    x <- case cond of+        False -> return Nothing+        True  -> Just <$> below act+    incId+    return x++-- | Perform the action only when the given condition is equal to Just True.+whenJT :: Maybe Bool -> Ox t w a -> Ox t w (Maybe a)+whenJT cond =+    when (justTrue cond)+  where+    justTrue Nothing  = False+    justTrue (Just x) = x++-- | Make all embedded observations to be indistinguishable with respect+-- to their top-most identifier components.+-- TODO: Perhaps should set only the current level, not the deeper ones.+group :: Ox t w a -> Ox t w a+group act = do +    i <- getId+    let top = getTop i+    x <- censor (map . first . setTop $ top) act+    setId (inc i)+    return x++-- | Memoize a function.  It can be useful when computing observation value+-- for a particular position is expensive and should be performed only once.+memoize :: (Int -> a) -> Int -> a+memoize f = Memo.integral f++-- | Execute the Ox monad and retrieve the saved (with the 'save' and+-- 'saves' functions) results.+execOx :: Ox t w a -> [(Id, w)]+execOx ox =+    (map (first reverse) . fst)+    (runState (execWriterT ox) [1])

@@ -0,0 +1,61 @@+-- | Popular transformation functions for the 'String' observation type.++module Control.Monad.Ox.String+( prefix+, suffix+, substr+, shape+, pack+) where++import qualified Data.Char as C+import qualified Data.List as L++-- | Prefix of the given size or 'Nothing' if the size exceeds the+-- length of the string.+prefix :: Int -> String -> Maybe String+prefix k xs+    | k > 0  && k <= n      = Just $ take k xs+    | k <= 0 && n + k > 0   = Just $ take (n + k) xs+    | otherwise             = Nothing+  where+    n = length xs++-- | Suffix of the given size or 'Nothing' if the size exceeds the+-- length of the string.+suffix :: Int -> String -> Maybe String+suffix k xs+    | k > 0  && k <= n      = Just . reverse . take k . reverse $ xs+    | k <= 0 && n + k > 0   = Just . reverse . take (n + k) . reverse $ xs+    | otherwise             = Nothing+  where+    n = length xs++-- | All substrings of the given size.+substr :: Int -> String -> [String]+substr k xs+    | k > 0 && k <= n   = relevant $ map (take k) (L.tails xs)+    | otherwise         = []+  where+    n = length xs+    relevant+        = reverse+        . dropWhile ((<k).length)+        . reverse++-- | Shape of the string.  All lower-case characters are mapped to 'l',+-- upper-case characters to 'u', digits to 'd' and rest of characters+-- to 'x'.+shape :: String -> String+shape = map translate+  where+    translate char+        | C.isLower char = 'l'+        | C.isUpper char = 'u'+        | C.isDigit char = 'd'+        | otherwise      = 'x'++-- | Pack the string, that is remove all adjacent repetitions,+-- for example /"aabcccdde" -> "abcde"/.+pack :: String -> String+pack = map head . L.group

@@ -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.

@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,37 @@+name:               monad-ox+version:            0.1.0+synopsis:           Monad for observation extraction+description:+    The library provides an Ox monad and accompanying functions which+    are intended to simplify writing functional expressions over input+    sentence with arbitrary type of token.  Values of such functional+    expressions can be subsequently used as observations in input data+    for sequential classifiers.+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:           Control, Natural Language Processing+homepage:           https://github.com/kawu/monad-ox+build-type:         Simple++library+    build-depends:+        base >= 4 && < 5+      , containers+      , vector+      , data-memocombinators >= 0.4.3 && < 0.4.4+      , mtl >= 2++    exposed-modules:+        Control.Monad.Ox+        Control.Monad.Ox.String++    ghc-options: -Wall++source-repository head+    type: git+    location: git://github.com/kawu/monad-ox.git