packages feed

order-maintenance (empty) → 0.0.0.0

raw patch · 11 files changed

+654/−0 lines, 11 filesdep +basedep +containersdep +transformerssetup-changed

Dependencies added: base, containers, transformers

Files

+ LICENSE view
@@ -0,0 +1,27 @@+Copyright © 2014, 2015 Denis Firsov, © 2014, 2015 Wolfgang Jeltsch+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 the copyright holders nor the names of the+      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 HOLDERS 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.hs view
@@ -0,0 +1,4 @@+import Distribution.Simple++main :: IO ()+main = defaultMain
+ order-maintenance.cabal view
@@ -0,0 +1,59 @@+Name:          order-maintenance+Version:       0.0.0.0+Cabal-Version: >= 1.16+Build-Type:    Simple+License:       BSD3+License-File:  LICENSE+Copyright:     © 2014, 2015 Denis Firsov; © 2014, 2015 Wolfgang Jeltsch+Author:        Wolfgang Jeltsch+Maintainer:    wolfgang@cs.ioc.ee+Stability:     provisional+Homepage:      http://darcs.wolfgang.jeltsch.info/haskell/order-maintenance+Package-URL:   http://hackage.haskell.org/packages/archive/order-maintenance/0.0.0.0/order-maintenance-0.0.0.0.tar.gz+Synopsis:      Algorithms for the order maintenance problem with a safe+               interface+Description:   This package is about order maintenance.+Category:      Data+Tested-With:   GHC == 7.8.3++Source-Repository head++    Type:     darcs+    Location: http://darcs.wolfgang.jeltsch.info/haskell/order-maintenance/main++Source-Repository this++    Type:     darcs+    Location: http://darcs.wolfgang.jeltsch.info/haskell/order-maintenance/main+    Tag:      order-maintenance-0.0.0.0++Library++    Build-Depends: base         >= 3.0 && < 5,+                   containers   >= 0.5 && < 0.6,+                   transformers >= 0.3 && < 0.5++    Default-Language: Haskell2010++    Default-Extensions: EmptyDataDecls+                        ExistentialQuantification+                        FlexibleContexts+                        GeneralizedNewtypeDeriving+                        RankNTypes+                        TypeFamilies++    if impl(ghc >= 7.8) {+        Default-Extensions: AutoDeriveTypeable+    }++    Exposed-Modules: Control.Monad.Trans.Order+                     Control.Monad.Trans.Order.Algorithm+                     Control.Monad.Trans.Order.Lazy+                     Control.Monad.Trans.Order.Strict++    Other-Modules: Control.Monad.Trans.Order.Algorithm.Dumb+                   Control.Monad.Trans.Order.Algorithm.Type+                   Control.Monad.Trans.Order.Lazy.Internals+                   Control.Monad.Trans.Order.Raw++    HS-Source-Dirs: src
+ src/Control/Monad/Trans/Order.hs view
@@ -0,0 +1,7 @@+module Control.Monad.Trans.Order (++    module Control.Monad.Trans.Order.Lazy++) where++import Control.Monad.Trans.Order.Lazy
+ src/Control/Monad/Trans/Order/Algorithm.hs view
@@ -0,0 +1,83 @@+module Control.Monad.Trans.Order.Algorithm (++    -- * General things++    Algorithm,+    defaultAlgorithm,++    -- * Specific algorithms++    dumb++) where++import Control.Monad.Trans.Order.Algorithm.Type+import Control.Monad.Trans.Order.Algorithm.Dumb as Dumb++{-FIXME:+    Implement the following:++      • an algorithm that uses arbitarily deep log-trees++      • the file maintenance algorithm by Bender et al. combined with log-trees+        of fixed height++      • a function that converts any algorithm into one that shifts elements+        between two orders upon deletion (for avoiding sparsly populated order+        structures)++    Maybe it makes sense to additionally offer the file maintenance algorithm by+    Bender et al. as an order maintenance algorithm in its own right.+-}++{-FIXME:+    For implementing Bender et al., it might be good to store the calibrator+    tree in an array, level by level from top to bottom. The array must then be+    created without initializing its elements. Initially the tree would be+    small; so few array elements would be used. When extending the tree, we+    would face the problem that initializing all the additionally used elements+    would take more than O(1) time. We can maybe use the trick by Barak A.+    Pearlmutter¹ (or a variant of it, specialized for our particular+    initialization pattern) to get O(1) time.++      ¹ See his e-mail to me from 5 December 2014.+-}++{-FIXME:+    More notes regarding implementing Bender et al.:++      • We can store the set of all children of a single node of a log-tree in+        an array of 48 64-bit words. Each word represents one child. Children+        are stored in the temporal order of their allocation. 48 bits of a word+        are the label, 3 are the left sibling index, 3 are the right sibling+        index. The parent pointer (pointer to the array plus index in the array)+        has to be stored only once per such an array, not for every child.++      • A block in the file maintenance data structure could encompass 48 or+        maybe also 64 elements. A 64-bit word could be used to store which of+        the array cells are taken by an element and which are free.++      • I think that on the upper two levels of a log tree, we need up to three+        times as many nodes for storing log-many subtrees, because of overflow+        nodes. This would mean that with the above approach, we could store up+        to 48 × 12 × 12 ≈ 7000 elements in a log tree and ca. 7000 × 48 ≈ 350000+        actual elements per file maintenance block. The total memory use would+        be a bit more than 8 × 350000 = 2.8 MB.++      • The number of actual elements per file maintenance block (350,000) would+        be a bit more than 2^18. Since our k would be 48, we could have up to+        2^48 × 2^18 = 2^66 elements theoretically. So we could reach the maximum+        of 2^64 elements.+-}++-- * General things++-- NOTE: Algorithm is imported from Data.OrderMaintenance.Algorithm.Type.++defaultAlgorithm :: Algorithm+defaultAlgorithm = dumb++-- * Specific algorithms++dumb :: Algorithm+dumb = Dumb.algorithm
+ src/Control/Monad/Trans/Order/Algorithm/Dumb.hs view
@@ -0,0 +1,100 @@+module Control.Monad.Trans.Order.Algorithm.Dumb (++    algorithm++) where++-- Control++import Control.Applicative+import Control.Monad.ST++-- Data++import           Data.Function+import           Data.Ratio+import           Data.STRef+import qualified Data.Set as Set+import           Data.Set (Set)+import           Control.Monad.Trans.Order.Algorithm.Type+import           Control.Monad.Trans.Order.Raw++algorithm :: Algorithm+algorithm = Algorithm rawAlgorithm++data Dumb++type instance OrderCell Dumb s = PureOrder++type instance ElementCell Dumb s = PureElement++type PureOrder = Set PureElement++type PureElement = Rational++rawAlgorithm :: RawAlgorithm Dumb s+rawAlgorithm = RawAlgorithm {+    newOrder        = newSTRef Set.empty,+    compareElements = liftA2 compare `on` readSTRef,+    insertMinimum   = fromPureInsert pureInsertMinimum,+    insertMaximum   = fromPureInsert pureInsertMaximum,+    insertAfter     = relative fromPureInsert pureInsertAfter,+    insertBefore    = relative fromPureInsert pureInsertBefore,+    delete          = relative fromPure pureDelete+}++fromPure :: (PureOrder -> (a, PureOrder)) -> RawOrder Dumb s -> ST s a+fromPure trans rawOrder = do+                              pureOrder <- readSTRef rawOrder+                              let (output, pureOrder') = trans pureOrder+                              writeSTRef rawOrder pureOrder'+                              return output++fromPureInsert :: (PureOrder -> PureElement)+               -> RawOrder Dumb s+               -> ST s (RawElement Dumb s)+fromPureInsert trans rawOrder = fromPure trans' rawOrder >>= newSTRef where++    trans' pureOrder = let++                           pureElement = trans pureOrder++                       in (pureElement, Set.insert pureElement pureOrder)++relative :: ((PureOrder -> a) -> RawOrder Dumb s -> ST s b)+         -> (PureElement -> PureOrder -> a)+         -> RawElement Dumb s+         -> RawOrder Dumb s+         -> ST s b+relative conv trans rawElem rawOrder = do+    pureElem <- readSTRef rawElem+    conv (trans pureElem) rawOrder++pureInsertMinimum :: PureOrder -> PureElement+pureInsertMinimum pureOrder+    | Set.null pureOrder = 1 % 2+    | otherwise          = Set.findMin pureOrder / 2++pureInsertMaximum :: PureOrder -> PureElement+pureInsertMaximum pureOrder+    | Set.null pureOrder = 1 % 2+    | otherwise          = (Set.findMax pureOrder + 1) / 2++pureInsertAfter :: PureElement -> PureOrder -> PureElement+pureInsertAfter pureElement pureOrder = pureElement' where++    greater = snd (Set.split pureElement pureOrder)++    pureElement' | Set.null greater = (pureElement + 1) / 2+                 | otherwise        = (pureElement + Set.findMin greater) / 2++pureInsertBefore :: PureElement -> PureOrder -> PureElement+pureInsertBefore pureElement pureOrder = pureElement' where++    lesser = fst (Set.split pureElement pureOrder)++    pureElement' | Set.null lesser = pureElement / 2+                 | otherwise       = (pureElement + Set.findMax lesser) / 2++pureDelete :: PureElement -> PureOrder -> ((), PureOrder)+pureDelete pureElement pureOrder = ((), Set.delete pureElement pureOrder)
+ src/Control/Monad/Trans/Order/Algorithm/Type.hs view
@@ -0,0 +1,9 @@+module Control.Monad.Trans.Order.Algorithm.Type (++    Algorithm (Algorithm)++) where++import Control.Monad.Trans.Order.Raw++data Algorithm = forall o . Algorithm (forall s . RawAlgorithm o s)
+ src/Control/Monad/Trans/Order/Lazy.hs view
@@ -0,0 +1,148 @@+module Control.Monad.Trans.Order.Lazy (++    -- * The Order monad++    Order,+    evalOrder,+    evalOrderWith,++    -- * The OrderT monad transformer++    OrderT,+    evalOrderT,+    force,++    -- * Elements++    Element,+    newMinimum,+    newMaximum,+    newAfter,+    newBefore++) where++-- Control++import Control.Monad.ST+import Control.Monad.Trans.State.Lazy+import Control.Monad.Trans.Order.Raw+import Control.Monad.Trans.Order.Lazy.Internals+import Control.Monad.Trans.Order.Algorithm+import Control.Monad.Trans.Order.Algorithm.Type++-- Data++import Data.Functor.Identity+import Data.IORef++-- System++import System.IO.Unsafe++-- GHC++import GHC.IORef -- for converting from STRef RealWorld to IORef++{-FIXME:+    Introduce conversions between the lazy and the strict variant, similar to+    the conversions for ST.+-}+{-FIXME:+    Consider introducing a restricted variant of mapStateT (for the lazy and the+    strict OrderT monad):++            mapOrderT :: (forall a . m a -> n a) -> OrderT o m a -> OrderT o n a++    Maybe this should not be called mapOrderT, since it is only a restricted+    variant and a corresponding mapOrder would be trivial.+-}+{-FIXME:+    Probably we should also have variants of liftCallCC, etc., which are present+    for StateT (for the lazy and the strict OrderT monad).+-}++-- * The Order monad++type Order o = OrderT o Identity++evalOrder :: (forall o . Order o a) -> a+evalOrder order = runIdentity (evalOrderT order)++evalOrderWith :: Algorithm -> (forall o . Order o a) -> a+evalOrderWith alg order = runIdentity (evalOrderTWith alg order)++-- * The OrderT monad transformer++evalOrderT :: Monad m => (forall o . OrderT o m a) -> m a+evalOrderT = evalOrderTWith defaultAlgorithm++evalOrderTWith :: Monad m => Algorithm -> (forall o . OrderT o m a) -> m a+evalOrderTWith (Algorithm rawAlg) (OrderT stateT) = monad where++    monad = evalStateT stateT (emptyOrderRep rawAlg)++force :: Monad m => OrderT o m ()+force = OrderT $ get >>= \ order -> order `seq` return ()++-- * Elements++data Element o = Element (RawElement o RealWorld)+                         (RawAlgorithm o RealWorld)+                         Lock+-- NOTE: Evaluation of the Element constructor triggers the I/O for insertions.++instance Eq (Element o) where++    (==) (Element rawElem1 (RawAlgorithm _ _ _ _ _ _ _) _)+         (Element rawElem2 _                            _) = equal where++        equal = rawElem1 == rawElem2++instance Ord (Element o) where++    compare (Element rawElem1 rawAlg lock)+            (Element rawElem2 _      _)    = ordering where++        ordering = unsafePerformIO $+                   criticalSection lock $+                   stToIO $ compareElements rawAlg rawElem1 rawElem2+{-FIXME:+    Introduce the safety measures for unsafePerformIO. It should not matter how+    many times the I/O is performed.+-}++fromInsert :: Monad m+           => (RawAlgorithm o RealWorld+                   -> RawOrder o RealWorld+                   -> ST RealWorld (RawElement o RealWorld))+           -> OrderT o m (Element o)+fromInsert insert = OrderT $ StateT (return . explicitStateInsert) where++    explicitStateInsert order@(OrderRep rawOrder rawAlg lock) = output where++        output = unsafePerformIO $+                 criticalSection lock $+                 do+                     rawElem <- stToIO $ insert rawAlg rawOrder+                     mkWeakIORef (IORef rawElem)+                                 (criticalSection lock $+                                  stToIO $+                                  delete rawAlg rawElem rawOrder)+                     return (Element rawElem rawAlg lock, order)+    {-FIXME:+        Introduce the safety measures for unsafePerformIO. The I/O must occur only+        once.+    -}++newMinimum :: Monad m => OrderT o m (Element o)+newMinimum = fromInsert insertMinimum++newMaximum :: Monad m => OrderT o m (Element o)+newMaximum = fromInsert insertMaximum++newAfter :: Monad m => Element o -> OrderT o m (Element o)+newAfter (~(Element rawElem _ _)) = fromInsert (flip insertAfter rawElem)++newBefore :: Monad m => Element o -> OrderT o m (Element o)+newBefore (~(Element rawElem _ _)) = fromInsert (flip insertBefore rawElem)
+ src/Control/Monad/Trans/Order/Lazy/Internals.hs view
@@ -0,0 +1,71 @@+module Control.Monad.Trans.Order.Lazy.Internals (++    -- * The lazy OrderT monad transformer++    OrderT (OrderT),+    OrderRep (OrderRep),+    emptyOrderRep,++    -- * Locks++    Lock,+    criticalSection++) where++-- Control++import Control.Monad+import Control.Applicative+import Control.Monad.Trans.Class+import Control.Monad.IO.Class+import Control.Monad.Trans.State.Lazy+import Control.Monad.ST+import Control.Concurrent.MVar+import Control.Monad.Trans.Order.Raw++-- System++import System.IO.Unsafe++-- * The lazy OrderT monad transformer++newtype OrderT o m a = OrderT (StateT (OrderRep o) m a) deriving (+    Functor,+    Applicative,+    Alternative,+    Monad,+    MonadPlus,+    MonadTrans,+    MonadIO)+    -- FIXME: Should we also have a MonadFix instance?++data OrderRep o = OrderRep (RawOrder o RealWorld)+                           (RawAlgorithm o RealWorld)+                           Lock+-- FIXME: Maybe use OrderedSet instead of OrderRep.+-- NOTE: Evaluation of the OrderRep constructor triggers the I/O for insertions.++emptyOrderRep :: (forall s . RawAlgorithm o s) -> OrderRep o+emptyOrderRep rawAlg = unsafePerformIO $ do+    rawOrder <- stToIO (newOrder rawAlg)+    lock <- newLock+    return (OrderRep rawOrder rawAlg lock)+{-FIXME:+    Introduce the safety measures for unsafePerformIO. It should not matter+    how many times the I/O is performed.+-}++-- * Locks++type Lock = MVar ()++newLock :: IO Lock+newLock = newEmptyMVar++criticalSection :: Lock -> IO a -> IO a+criticalSection lock act = do+    putMVar lock ()+    val <- act+    takeMVar lock+    return val
+ src/Control/Monad/Trans/Order/Raw.hs view
@@ -0,0 +1,39 @@+module Control.Monad.Trans.Order.Raw (++    RawOrder,+    OrderCell,+    RawElement,+    ElementCell,+    RawAlgorithm (+        RawAlgorithm,+        newOrder,+        compareElements,+        insertMinimum,+        insertMaximum,+        insertAfter,+        insertBefore,+        delete+    )++) where++import Control.Monad.ST+import Data.STRef++type RawOrder o s = STRef s (OrderCell o s)++type family OrderCell o s++type RawElement o s = STRef s (ElementCell o s)++type family ElementCell o s++data RawAlgorithm o s = RawAlgorithm {+    newOrder        :: ST s (RawOrder o s),+    compareElements :: RawElement o s -> RawElement o s -> ST s Ordering,+    insertMinimum   :: RawOrder o s -> ST s (RawElement o s),+    insertMaximum   :: RawOrder o s -> ST s (RawElement o s),+    insertAfter     :: RawElement o s -> RawOrder o s -> ST s (RawElement o s),+    insertBefore    :: RawElement o s -> RawOrder o s -> ST s (RawElement o s),+    delete          :: RawElement o s -> RawOrder o s -> ST s ()+}
+ src/Control/Monad/Trans/Order/Strict.hs view
@@ -0,0 +1,107 @@+module Control.Monad.Trans.Order.Strict (++    -- * The Order monad++    Order,+    evalOrder,+    evalOrderWith,++    -- * The OrderT monad transformer++    OrderT,+    evalOrderT,+    force,++    -- * Elements++    Element,+    newMinimum,+    newMaximum,+    newAfter,+    newBefore,++    -- * Converting between lazy and strict OrderT++    lazyToStrictOrderT,+    strictToLazyOrderT++) where++-- Control++import           Control.Monad+import           Control.Applicative+import           Control.Monad.Trans.Class+import           Control.Monad.IO.Class+import qualified Control.Monad.Trans.State.Lazy+                     as Lazy+import           Control.Monad.Trans.State.Strict+import           Control.Monad.Trans.Order.Lazy+                     (Element)+import qualified Control.Monad.Trans.Order.Lazy+                     as Lazy+import           Control.Monad.Trans.Order.Lazy.Internals+                     (OrderRep, emptyOrderRep)+import qualified Control.Monad.Trans.Order.Lazy.Internals+                     as Lazy+import           Control.Monad.Trans.Order.Algorithm+import           Control.Monad.Trans.Order.Algorithm.Type++-- Data++import Data.Functor.Identity++-- * The Order monad++type Order o = OrderT o Identity++evalOrder :: (forall o . Order o a) -> a+evalOrder order = runIdentity (evalOrderT order)++evalOrderWith :: Algorithm -> (forall o . Order o a) -> a+evalOrderWith alg order = runIdentity (evalOrderTWith alg order)++-- * The OrderT monad transformer++newtype OrderT o m a = OrderT (StateT (OrderRep o) m a) deriving (+    Functor,+    Applicative,+    Alternative,+    Monad,+    MonadPlus,+    MonadTrans,+    MonadIO)+    -- FIXME: Should we also have a MonadFix instance?++evalOrderT :: Monad m => (forall o . OrderT o m a) -> m a+evalOrderT = evalOrderTWith defaultAlgorithm++evalOrderTWith :: Monad m => Algorithm -> (forall o . OrderT o m a) -> m a+evalOrderTWith (Algorithm rawAlg) (OrderT stateT) = monad where++    monad = evalStateT stateT (emptyOrderRep rawAlg)++force :: Monad m => OrderT o m ()+force = lazyToStrictOrderT Lazy.force++-- * Elements++newMinimum :: Monad m => OrderT o m (Element o)+newMinimum = lazyToStrictOrderT Lazy.newMinimum++newMaximum :: Monad m => OrderT o m (Element o)+newMaximum = lazyToStrictOrderT Lazy.newMaximum++newAfter :: Monad m => Element o -> OrderT o m (Element o)+newAfter = lazyToStrictOrderT . Lazy.newAfter++newBefore :: Monad m => Element o -> OrderT o m (Element o)+newBefore = lazyToStrictOrderT . Lazy.newBefore++-- * Converting between lazy and strict OrderT++lazyToStrictOrderT :: Lazy.OrderT o m a -> OrderT o m a+lazyToStrictOrderT (Lazy.OrderT (Lazy.StateT fun)) = OrderT (StateT fun)++strictToLazyOrderT :: OrderT o m a -> Lazy.OrderT o m a+strictToLazyOrderT (OrderT (StateT fun)) = Lazy.OrderT (Lazy.StateT fun)