packages feed

total-maps (empty) → 1.0.0.0

raw patch · 10 files changed

+785/−0 lines, 10 filesdep +adjunctionsdep +basedep +bytessetup-changed

Dependencies added: adjunctions, base, bytes, containers, distributive, keys, linear, reflection, semigroups, vector

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Paweł Nowak++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Data/Total/Array.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE TypeFamilies #-}+-----------------------------------------------------------------------------+-- |+-- Description :  Bounded, dense, total map implemented as a vector.+-- License     :  MIT+-- Maintainer  :  Paweł Nowak <pawel834@gmail.com>+-- Stability   :  provisional+-- Portability :  GHC >= 7.10+--+-- Bounded, dense, total map implemented as a vector.+-----------------------------------------------------------------------------+module Data.Total.Array (+    TotalArray(..)+    ) where++import           Data.Bytes.Serial+import           Data.Distributive+import           Data.Functor.Rep+import           Data.Key+import           Data.Proxy+import           Data.Vector (Vector)+import qualified Data.Vector as Vector+import           Linear+import           Prelude hiding (zip, zipWith)++infixr 9 .:++-- | A total map from keys k to values a, represented as an immutable vector.+--+-- Warning: the number of keys MUST fit into an Int.+--+-- n is equal to the number of keys.+newtype TotalArray k a = TotalArray (Vector a)+    deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable)++keyCount :: forall k. (Enum k, Bounded k) => Proxy k -> Int+keyCount _ = fromEnum (maxBound :: k) - fromEnum (minBound :: k) + 1++toIndex :: forall k. (Enum k, Bounded k) => k -> Int+toIndex k = fromEnum k - fromEnum (minBound :: k)++fromIndex :: forall k. (Enum k, Bounded k) => Int -> k+fromIndex i = toEnum (i + fromEnum (minBound :: k))++keys :: forall k. (Enum k, Bounded k) => TotalArray k k+keys = TotalArray $ Vector.fromListN (keyCount (Proxy :: Proxy k)) [minBound .. maxBound]++(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d+(f .: g) x y = f (g x y)++-- | Zippy applicative. Complexity: 'pure' O(n), '<*>' O(n).+instance (Enum k, Bounded k) => Applicative (TotalArray k) where+    pure = TotalArray . Vector.replicate (keyCount (Proxy :: Proxy k))+    (<*>) = zap++-- Keys instances.++type instance Key (TotalArray k) = k++-- | Complexity: 'mapWithKey' O(n)+instance (Enum k, Bounded k) => Keyed (TotalArray k) where+    mapWithKey f v = zipWith f keys v++-- | Complexity: all O(n)+instance Zip (TotalArray k) where+    zipWith f (TotalArray a) (TotalArray b) =+        TotalArray $ Vector.zipWith f a b++-- | Complexity: all O(n)+instance (Enum k, Bounded k) => ZipWithKey (TotalArray k) where+    zipWithKey f a b = zipWith (uncurry . f) keys (zip a b)++-- | Complexity: 'lookup' O(1)+instance (Enum k, Bounded k) => Lookup (TotalArray k) where+    lookup k (TotalArray v) = Just $ Vector.unsafeIndex v (toIndex k)++-- | Complexity: 'index' O(1)+instance (Enum k, Bounded k) => Indexable (TotalArray k) where+    index (TotalArray v) k = Vector.unsafeIndex v (toIndex k)++-- | Complexity: 'adjust' O(n)+instance (Enum k, Bounded k) => Adjustable (TotalArray k) where+    adjust f k (TotalArray v) = TotalArray $ Vector.unsafeUpd v [(i, x)]+      where+        i = toIndex k+        x = f $ Vector.unsafeIndex v i++-- | Complexity: 'foldMapWithKey' O(n)+instance (Enum k, Bounded k) => FoldableWithKey (TotalArray k) where+    foldMapWithKey f v = foldMap (uncurry f) (zip keys v)++-- | Complexity: 'traverseWithKey' O(n)+instance (Enum k, Bounded k) => TraversableWithKey (TotalArray k) where+    traverseWithKey f v = traverse (uncurry f) (zip keys v)++-- Linear instances.++-- | Complexity: all O(n)+instance (Enum k, Bounded k) => Additive (TotalArray k) where+    zero = pure 0++-- | Complexity: all O(n)+instance (Enum k, Bounded k) => Metric (TotalArray k)++-- Serial instances.++-- | Complexity: 'serializeWith' O(n), 'deserializeWith' O(n)+instance (Enum k, Bounded k) => Serial1 (TotalArray k) where+    serializeWith f (TotalArray v) = Vector.mapM_ f v+    deserializeWith f = TotalArray+        <$> Vector.replicateM (keyCount (Proxy :: Proxy k)) f++-- | Complexity: 'serialize' O(n), 'deserialize' O(n)+instance (Enum k, Bounded k, Serial a) => Serial (TotalArray k a) where+    serialize m = serializeWith serialize m+    deserialize = deserializeWith deserialize++-- | Complexity: 'distribute' O(n * fmap)+instance (Enum k, Bounded k) => Distributive (TotalArray k) where+    distribute x = TotalArray $ Vector.generate+        (keyCount (Proxy :: Proxy k)) (\i -> fmap (index' i) x)+      where+        index' i (TotalArray v) = Vector.unsafeIndex v i++-- | Convert from and to a total function.+--+-- Complexity: tabulate O(n), index O(1)+instance (Enum k, Bounded k) => Representable (TotalArray k) where+    type Rep (TotalArray k) = k+    tabulate f = fmap f keys+    index = Data.Key.index
+ src/Data/Total/Array/Subset.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE TypeFamilies #-}+-----------------------------------------------------------------------------+-- |+-- Description :  Subset, dense, total map implemented as a vector.+-- License     :  MIT+-- Maintainer  :  Paweł Nowak <pawel834@gmail.com>+-- Stability   :  provisional+-- Portability :  GHC >= 7.10+--+-- Subset, dense, total map implemented as a vector.+-----------------------------------------------------------------------------+module Data.Total.Array.Subset (+    Subset,+    TotalSubsetArray(..)+    ) where++import           Data.Bytes.Serial+import           Data.Distributive+import           Data.Functor.Rep+import           Data.Key+import           Data.Proxy+import           Data.Reflection+import           Data.Set (Set)+import qualified Data.Set as Set+import           Data.Total.Subset+import           Data.Vector (Vector)+import qualified Data.Vector as Vector+import           Linear+import           Prelude hiding (zip, zipWith)++infixr 9 .:++-- | A total map from a subset s of keys k to values a, e.g. a restriction+-- of a partial function @k -> a@ to a subset of its domain on which the+-- function is defined. Implemented as a vector.+--+-- n is equal to the number of keys.+newtype TotalSubsetArray s k a = TotalSubsetArray (Vector a)+    deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable)++keyCount :: Subset s k => Proxy s -> Int+keyCount p = Set.size (reflect p)++keys' :: Subset s k => Proxy s -> Vector k+keys' p = Vector.fromListN (keyCount p) $ Set.toAscList (reflect p)++toIndex :: (Ord k, Subset s k) => Proxy s -> k -> Int+toIndex p k = Set.findIndex k (reflect p)++-- | Maps each key to itself.+--+-- Complexity: O(n)+keys :: forall s k. Subset s k => TotalSubsetArray s k k+keys = TotalSubsetArray (keys' (Proxy :: Proxy s))++(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d+(f .: g) x y = f (g x y)++-- | Zippy applicative. Complexity: 'pure' O(n), '<*>' O(n).+instance Subset s k => Applicative (TotalSubsetArray s k) where+    pure = TotalSubsetArray . Vector.replicate (keyCount (Proxy :: Proxy s))+    (<*>) = zap++-- Keys instances.++type instance Key (TotalSubsetArray s k) = k++-- | Complexity: 'mapWithKey' O(n)+instance Subset s k => Keyed (TotalSubsetArray s k) where+    mapWithKey f v = zipWith f keys v++-- | Complexity: all O(n)+instance Zip (TotalSubsetArray s k) where+    zipWith f (TotalSubsetArray a) (TotalSubsetArray b) =+        TotalSubsetArray $ Vector.zipWith f a b++-- | Complexity: all O(n)+instance Subset s k => ZipWithKey (TotalSubsetArray s k) where+    zipWithKey f a b = zipWith (uncurry . f) keys (zip a b)++-- | Complexity: 'lookup' O(log n)+instance (Ord k, Subset s k) => Lookup (TotalSubsetArray s k) where+    lookup k (TotalSubsetArray v) =+        Just $ Vector.unsafeIndex v (toIndex (Proxy :: Proxy s) k)++-- | Complexity: 'index' O(log n)+instance (Ord k, Subset s k) => Indexable (TotalSubsetArray s k) where+    index (TotalSubsetArray v) k =+        Vector.unsafeIndex v (toIndex (Proxy :: Proxy s) k)++-- | Complexity: 'adjust' O(n)+instance (Ord k, Subset s k) => Adjustable (TotalSubsetArray s k) where+    adjust f k (TotalSubsetArray v) = TotalSubsetArray $ Vector.unsafeUpd v [(i, x)]+      where+        i = toIndex (Proxy :: Proxy s) k+        x = f $ Vector.unsafeIndex v i++-- | Complexity: 'foldMapWithKey' O(n)+instance Subset s k => FoldableWithKey (TotalSubsetArray s k) where+    foldMapWithKey f v = foldMap (uncurry f) (zip keys v)++-- | Complexity: 'traverseWithKey' O(n)+instance Subset s k => TraversableWithKey (TotalSubsetArray s k) where+    traverseWithKey f v = traverse (uncurry f) (zip keys v)++-- Linear instances.++-- | Complexity: all O(n)+instance Subset s k => Additive (TotalSubsetArray s k) where+    zero = pure 0++-- | Complexity: all O(n)+instance Subset s k => Metric (TotalSubsetArray s k)++-- Serial instances.++-- | Complexity: 'serializeWith' O(n), 'deserializeWith' O(n)+instance Subset s k => Serial1 (TotalSubsetArray s k) where+    serializeWith f (TotalSubsetArray v) = Vector.mapM_ f v+    deserializeWith f = TotalSubsetArray+        <$> Vector.replicateM (keyCount (Proxy :: Proxy s)) f++-- | Complexity: 'serialize' O(n), 'deserialize' O(n)+instance (Subset s k, Serial a) => Serial (TotalSubsetArray s k a) where+    serialize m = serializeWith serialize m+    deserialize = deserializeWith deserialize++-- | Complexity: 'distribute' O(n * fmap)+instance Subset s k => Distributive (TotalSubsetArray s k) where+    distribute x = TotalSubsetArray $ Vector.generate+        (keyCount (Proxy :: Proxy s)) (\i -> fmap (index' i) x)+      where+        index' i (TotalSubsetArray v) = Vector.unsafeIndex v i++-- | Convert from and to a partial function that would be total if+-- restricted to s.+--+-- Complexity: tabulate O(n), index O(log n)+instance (Ord k, Subset s k) => Representable (TotalSubsetArray s k) where+    type Rep (TotalSubsetArray s k) = k+    tabulate f = fmap f keys+    index = Data.Key.index
+ src/Data/Total/Internal/SparseFold.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE RankNTypes #-}+-----------------------------------------------------------------------------+-- |+-- License     :  MIT+-- Maintainer  :  Paweł Nowak <pawel834@gmail.com>+-- Stability   :  experimental+-- Portability :  GHC only+-----------------------------------------------------------------------------+module Data.Total.Internal.SparseFold where++import Data.Proxy+import Data.Reflection+import Data.Semigroup++-- | `mpower x n` raises x to the power n taking advantage of associativity.+mpower :: Monoid m => m -> Integer -> m+mpower _ 0 = mempty+mpower x 1 = x+mpower x n = mpower x r `mappend` mpower (x `mappend` x) q+  where (q, r) = quotRem n 2++-- | A semigroup used to quickly fold a sparse finite domain.+data SparseFold s m = SparseFold (Min Integer) m (Max Integer)++-- TODO: caching the powers would reduce complexity+-- from O(k * log (n/k)) to O(k + log n).+instance (Reifies s m, Monoid m) => Semigroup (SparseFold s m) where+    SparseFold min x max <> SparseFold min' y max' =+        SparseFold+          (min <> min')+          (x `mappend` mpower filler gapSize `mappend` y)+          (max <> max')+      where+        gapSize = getMin min' - getMax max - 1+        filler = reflect (Proxy :: Proxy s)++foldPoint :: Integer -> a -> Option (SparseFold s a)+foldPoint k v = Option $ Just $ SparseFold (Min k) v (Max k)++runSparseFold :: Monoid m => m+              -> (forall s. Reifies s m => Proxy s -> Option (SparseFold s m))+              -> m+runSparseFold d f = reify d $ \p -> extract (f p)+  where extract (Option Nothing) = mempty+        extract (Option (Just (SparseFold _ v _))) = v
+ src/Data/Total/Map.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE Trustworthy #-}+-----------------------------------------------------------------------------+-- |+-- Description :  Bounded, dense, total map.+-- License     :  MIT+-- Maintainer  :  Paweł Nowak <pawel834@gmail.com>+-- Stability   :  provisional+-- Portability :  GHC >= 7.10+--+-- Dense, total, maps for bounded types.+-----------------------------------------------------------------------------+module Data.Total.Map where++import           Data.Bytes.Serial+import           Data.Distributive+import           Data.Functor.Rep+import           Data.Key+import           Data.List (sort)+import           Data.Map (Map)+import qualified Data.Map as Map+import           Linear+import           Prelude hiding (zip)++-- | A total map from keys k to values a.+--+-- Most functions are derived from 'Data.Map.Map'.+--+-- n is equal to the number of keys.+--+-- Unfortunately I cannot find any law linking Enum with Ord, so we cannot+-- be sure that @[minBound .. maxBound]@ is sorted. Because of that functions+-- like 'pure' and 'tabulate' have complexity O(n * log n), while they could be O(n).+newtype TotalMap k a = TotalMap (Map k a)+    deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable)++-- | Zippy applicative. Complexity: 'pure' O(n * log n), '<*>' O(n).+instance (Ord k, Enum k, Bounded k) => Applicative (TotalMap k) where+    pure x = TotalMap $ Map.fromList [(k, x) | k <- [minBound .. maxBound]]+    (<*>)  = zap++-- Keys instances.++type instance Key (TotalMap k) = k++-- TODO: it would be nice to document these, but haddock doesn't allow that.++deriving instance Keyed (TotalMap k)+deriving instance Ord k => Zip (TotalMap k)+deriving instance Ord k => ZipWithKey (TotalMap k)+deriving instance Ord k => Lookup (TotalMap k)+deriving instance Ord k => Indexable (TotalMap k)+deriving instance Ord k => Adjustable (TotalMap k)+deriving instance Ord k => FoldableWithKey (TotalMap k)++-- | Complexity: 'traverseWithKey' O(n)+instance Ord k => TraversableWithKey (TotalMap k) where+    traverseWithKey f (TotalMap m) = TotalMap <$> traverseWithKey f m++-- Linear instances.++-- | Complexity: 'zero' O(n * log n), rest O(n)+instance (Ord k, Enum k, Bounded k) => Additive (TotalMap k) where+    zero = pure 0++-- | Complexity: all O(n)+instance (Ord k, Enum k, Bounded k) => Metric (TotalMap k)++-- Serial instances.++-- | Complexity: 'serializeWith' O(n), 'deserializeWith' O(n * log n)+instance (Ord k, Enum k, Bounded k) => Serial1 (TotalMap k) where+    serializeWith f (TotalMap m) = serializeWith f (Map.elems m)+    deserializeWith f = do+        elems <- deserializeWith f+        let assocs = zip (sort [minBound .. maxBound]) elems+        return $ TotalMap (Map.fromDistinctAscList assocs)++-- | Complexity: 'serialize' O(n), 'deserialize' O(n * log n)+instance (Ord k, Enum k, Bounded k, Serial a) => Serial (TotalMap k a) where+    serialize m = serializeWith serialize m+    deserialize = deserializeWith deserialize++-- Distributive and representable.++-- | Complexity: 'distribute' O(n * log n + n * fmap)+instance (Ord k, Enum k, Bounded k) => Distributive (TotalMap k) where+    distribute = TotalMap . Map.fromDistinctAscList+               . zip keys+               . distributeList . fmap asList+      where+        keys = sort [minBound .. maxBound]+        asList (TotalMap m) = Map.elems m+        distributeList x = map (fmap head) $ iterate (fmap tail) x++-- | Convert from and to a @(k -> a)@ function.+--+-- Complexity: tabulate O(n * log n), index O(log n)+instance (Ord k, Enum k, Bounded k) => Representable (TotalMap k) where+    type Rep (TotalMap k) = k+    tabulate f = TotalMap $ Map.fromList [(k, f k) | k <- [minBound .. maxBound]]+    index = Data.Key.index
+ src/Data/Total/Map/Sparse.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE Trustworthy #-}+-----------------------------------------------------------------------------+-- |+-- Description :  Bounded, sparse, total map.+-- License     :  MIT+-- Maintainer  :  Paweł Nowak <pawel834@gmail.com>+-- Stability   :  provisional+-- Portability :  GHC >= 7.10+--+-- Sparse, total maps for bounded types.+-----------------------------------------------------------------------------+module Data.Total.Map.Sparse where++import           Data.Bytes.Serial+import           Data.Key+import           Data.List (sort)+import           Data.Map (Map)+import qualified Data.Map as Map+import           Data.Maybe+import           Data.Monoid (First(..))+import           Data.Semigroup hiding (First, getFirst)+import           Data.Total.Internal.SparseFold+import           Data.Total.Map+import           Linear+import           Prelude hiding (zip, lookup)++-- | A total sparse map from keys k to values a. This map is implemented as a+-- partial map and a default value. 'pure' creates an all-default values map+-- with the given default value.+--+-- n is equal to the number of keys, k is the number of non-default values.+-- If there are two maps involved k is taken to be the number of non-default+-- values of their union.+data TotalSparseMap k a = TotalSparseMap (Map k a) a+    deriving (Show, Read, Functor)++-- | Complexity: O(k * log (n/k)) - arises from fold+instance (Ord k, Enum k, Bounded k, Eq a) => Eq (TotalSparseMap k a) where+    a == b = and ((==) <$> a <*> b)++-- | Complexity: O(k * log (n/k)) - arises from fold+instance (Ord k, Enum k, Bounded k, Ord a) => Ord (TotalSparseMap k a) where+    compare a b = fromMaybe EQ $ getFirst $ foldMap (First . notEq) (compare <$> a <*> b)+      where+        notEq EQ = Nothing+        notEq x  = Just x++-- | Zippy applicative. Complexity: 'pure' O(1), '<*>' O(k1 + k2)+instance Ord k => Applicative (TotalSparseMap k) where+    pure x = TotalSparseMap Map.empty x+    (<*>)  = zap++-- | Folds over the whole domain, including the default values.+--+-- >>> sum (pure 1 :: TotalSparseMap Int Integer)+-- 18446744073709551616+--+-- Complexity: foldMap O(k * log (n/k)), the rest are defined using foldMap+instance (Ord k, Enum k, Bounded k) => Foldable (TotalSparseMap k) where+    foldMap f (TotalSparseMap m d) = runSparseFold (f d) $ \_ ->+           foldPoint (toInteger (fromEnum (minBound :: k)) - 1) mempty+        <> Map.foldMapWithKey (\k v -> foldPoint (toInteger (fromEnum k)) (f v)) m+        <> foldPoint (toInteger (fromEnum (maxBound :: k)) + 1) mempty++-- Keys instances.++type instance Key (TotalSparseMap k) = k++-- | Complexity: 'lookup' O(log k)+instance Ord k => Lookup (TotalSparseMap k) where+    lookup k (TotalSparseMap m d) =+      case lookup k m of+        Nothing -> Just d+        x -> x++-- | Complexity: 'index' O(log k)+instance Ord k => Indexable (TotalSparseMap k) where+    index (TotalSparseMap m d) k =+      case lookup k m of+        Nothing -> d+        Just x -> x++-- | Complexity: all O(log k)+instance Ord k => Adjustable (TotalSparseMap k) where+    adjust f k (TotalSparseMap m d) = TotalSparseMap (Map.alter f' k m) d+      where+        f' (Just x) = Just (f x)+        f' Nothing = Just (f d)+    replace k v (TotalSparseMap m d) = TotalSparseMap (replace k v m) d++-- | Complexity: all O(k1 + k2)+instance Ord k => Zip (TotalSparseMap k) where+    zip (TotalSparseMap m1 d1) (TotalSparseMap m2 d2) =+      TotalSparseMap+        (Map.mergeWithKey+          (\_ a b -> Just (a, b))+          (fmap (, d2))+          (fmap (d1, ))+          m1 m2)+        (d1, d2)++-- Linear instances.++-- | Complexity: 'zero' O(1), rest O(k1 + k2)+instance Ord k => Additive (TotalSparseMap k) where+    zero = pure 0++-- | Complexity: all O(k * log (n/k)) - arises from fold+instance (Ord k, Enum k, Bounded k) => Metric (TotalSparseMap k)++-- Serial instances.++-- | Complexity: 'serializeWith' O(n), 'deserializeWith' O(n * log n)+instance (Ord k, Enum k, Bounded k, Serial k) => Serial1 (TotalSparseMap k) where+    serializeWith f (TotalSparseMap m d) = do+        serializeWith f m+        f d+    deserializeWith f = TotalSparseMap+        <$> deserializeWith f+        <*> f++-- | Complexity: 'serialize' O(n), 'deserialize' O(n * log n)+instance (Ord k, Enum k, Bounded k, Serial k, Serial a)+         => Serial (TotalSparseMap k a) where+    serialize m = serializeWith serialize m+    deserialize = deserializeWith deserialize++-- | Convert the sparse map to a dense one.+--+-- Complexity: O(n * log n)+toDenseMap :: (Ord k, Enum k, Bounded k) => TotalSparseMap k a -> TotalMap k a+toDenseMap (TotalSparseMap m d) = TotalMap (Map.union m fallback)+  where+    TotalMap fallback = pure d
+ src/Data/Total/Map/Subset.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE Trustworthy #-}+-----------------------------------------------------------------------------+-- |+-- Description :  Subset, dense, total map.+-- License     :  MIT+-- Maintainer  :  Paweł Nowak <pawel834@gmail.com>+-- Stability   :  provisional+-- Portability :  GHC >= 7.10+--+-- Dense, total, maps parametrized by a set of keys.+-----------------------------------------------------------------------------+module Data.Total.Map.Subset (+    Subset,+    TotalSubsetMap(..),+    restrict+    ) where++import           Data.Bytes.Serial+import           Data.Distributive+import           Data.Functor.Rep+import           Data.Key+import           Data.List (sort)+import           Data.Map (Map)+import qualified Data.Map as Map+import           Data.Proxy+import           Data.Reflection+import qualified Data.Set as Set+import           Data.Total.Subset+import           Linear+import           Prelude hiding (zip)++-- | A total map from a subset s of keys k to values a, e.g. a restriction+-- of a partial function @k -> a@ to a subset of its domain on which the+-- function is defined.+--+-- Most functions are derived from 'Data.Map.Map'.+--+-- n is equal to the size of the key set.+newtype TotalSubsetMap s k a = TotalSubsetMap (Map k a)+    deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable)++-- | Zippy applicative. Complexity: 'pure' O(n), '<*>' O(n).+instance (Ord k, Subset s k) => Applicative (TotalSubsetMap s k) where+    pure x = TotalSubsetMap $ Map.fromSet (const x) (reflect (Proxy :: Proxy s))+    (<*>)  = zap++-- Keys instances.++type instance Key (TotalSubsetMap s k) = k++-- TODO: it would be nice to document these, but haddock doesn't allow that.++deriving instance Keyed (TotalSubsetMap s k)+deriving instance Ord k => Zip (TotalSubsetMap s k)+deriving instance Ord k => ZipWithKey (TotalSubsetMap s k)+deriving instance Ord k => Lookup (TotalSubsetMap s k)+deriving instance Ord k => Indexable (TotalSubsetMap s k)+deriving instance Ord k => Adjustable (TotalSubsetMap s k)+deriving instance Ord k => FoldableWithKey (TotalSubsetMap s k)++-- | Complexity: 'traverseWithKey' O(n)+instance Ord k => TraversableWithKey (TotalSubsetMap s k) where+    traverseWithKey f (TotalSubsetMap m) = TotalSubsetMap <$> traverseWithKey f m++-- Linear instances.++-- | Complexity: all O(n)+instance (Ord k, Subset s k) => Additive (TotalSubsetMap s k) where+    zero = pure 0++-- | Complexity: all O(n)+instance (Ord k, Subset s k) => Metric (TotalSubsetMap s k)++-- Serial instances.++-- | Complexity: 'serializeWith' O(n), 'deserializeWith' O(n * log n)+instance (Ord k, Subset s k) => Serial1 (TotalSubsetMap s k) where+    serializeWith f (TotalSubsetMap m) = serializeWith f (Map.elems m)+    deserializeWith f = do+        elems <- deserializeWith f+        let keys = reflect (Proxy :: Proxy s)+            assocs = zip (Set.toAscList keys) elems+        return $ TotalSubsetMap (Map.fromDistinctAscList assocs)++-- | Complexity: 'serialize' O(n), 'deserialize' O(n * log n)+instance (Ord k, Subset s k, Serial a) => Serial (TotalSubsetMap s k a) where+    serialize m = serializeWith serialize m+    deserialize = deserializeWith deserialize++-- Distributive and representable.++-- | Complexity: 'distribute' O(n * fmap)+instance (Ord k, Subset s k) => Distributive (TotalSubsetMap s k) where+    distribute = TotalSubsetMap . Map.fromDistinctAscList+               . zip keys+               . distributeList . fmap asList+      where+        keys = Set.toAscList (reflect (Proxy :: Proxy s))+        asList (TotalSubsetMap m) = Map.elems m+        distributeList x = map (fmap head) $ iterate (fmap tail) x++-- | Convert from and to a partial function that would be total if+-- restricted to s.+--+-- Complexity: tabulate O(n), index O(log n)+instance (Ord k, Subset s k) => Representable (TotalSubsetMap s k) where+    type Rep (TotalSubsetMap s k) = k+    tabulate f = TotalSubsetMap $ Map.fromSet f (reflect (Proxy :: Proxy s))+    index = Data.Key.index++-- | Restrict a partial map to a total map.+--+-- Complexity: O(n)+restrict :: forall k a r. Map k a+         -> (forall s. Subset s k => TotalSubsetMap s k a -> r)+         -> r+restrict m r = reify (Map.keysSet m) f+  where+    f :: forall s. Subset s k => Proxy s -> r+    f _ = r (TotalSubsetMap m :: TotalSubsetMap s k a)
+ src/Data/Total/Subset.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE Safe #-}+-----------------------------------------------------------------------------+-- |+-- License     :  MIT+-- Maintainer  :  Paweł Nowak <pawel834@gmail.com>+-- Stability   :  provisional+-- Portability :  GHC only+--+-- Subset relation.+-----------------------------------------------------------------------------+module Data.Total.Subset where++import Data.Reflection+import Data.Set (Set)++-- | @Subset s k@ means that @s@ reifies a subset of @k@.+type Subset s k = Reifies s (Set k)
+ total-maps.cabal view
@@ -0,0 +1,47 @@+name:                total-maps+version:             1.0.0.0+synopsis:            Dense and sparse total maps.+description:+  Total maps are maps that contain a value for every key. This library provides+  various flavors of total maps.+  .+  Dense maps store values for all keys. Sparse maps store a default value+  and the values which differ from the default. Sparse maps trade the lack+  of Traversable for a very fast Foldable instance (if the data is really sparse).+  .+  Bounded maps require the key type to be enumerable and bounded (have a+  finite number of values) for most of their functionality. Subset maps do not+  require the key to be bounded, instead they are parametized by a finite set of+  valid keys. The key subset is retrieved with help of the excellent+  'reflection' library.+  .+  The Data.Total.Array modules provide total map implementations based on vectors.+  It should usually be faster then Maps, unless you need to adjust single elements.+  .+  Maps in this library provide most of their functions in typeclasses and so+  the modules are designed to be imported unqualified.+license:             MIT+license-file:        LICENSE+author:              Paweł Nowak+maintainer:          pawel834@gmail.com+copyright:           2015 Paweł Nowak+category:            Data,Data Structures,Containers+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:     Data.Total.Subset+                       Data.Total.Map+                       Data.Total.Map.Subset+                       Data.Total.Map.Sparse+                       Data.Total.Array+                       Data.Total.Array.Subset+                       Data.Total.Internal.SparseFold+  default-extensions:  FlexibleContexts, FlexibleInstances,+                       ScopedTypeVariables, AutoDeriveTypeable+  build-depends:       base <5, containers >=0.3 && <1, reflection == 1.*,+                       keys ==3.*, linear >=1.1 && <2, bytes >=0.2 && <1,+                       distributive ==0.*, adjunctions ==4.*,+                       semigroups ==0.*, vector >=0.10 && <1+  hs-source-dirs:      src+  default-language:    Haskell2010