packages feed

dense 0.1.0.0 → 0.1.0.1

raw patch · 7 files changed

+90/−68 lines, 7 filesdep ~lineardep ~vector

Dependency ranges changed: linear, vector

Files

README.md view
@@ -1,6 +1,6 @@ ## dense -[![Build Status](https://travis-ci.org/cchalmers/dense.svg)](https://travis-ci.org/cchalmers/dense)+[![Build Status](https://travis-ci.org/cchalmers/dense.svg?branch=master)](https://travis-ci.org/cchalmers/dense) [![Haddock](https://rawgit.com/cchalmers/dense/gh-pages/haddock.svg)](https://cchalmers.github.io/dense/) [![Hackage](https://img.shields.io/hackage/v/dense.svg?style=flat)](https://hackage.haskell.org/package/dense)
dense.cabal view
@@ -1,5 +1,5 @@ name:                dense-version:             0.1.0.0+version:             0.1.0.1 synopsis:            Mutable and immutable dense multidimensional arrays description:   Multidimentional array library build on top of the vector package,@@ -46,13 +46,13 @@     ghc-prim,     hashable,     lens,-    linear >= 1.20 && <1.21,+    linear >= 1.20 && <1.22,     primitive,     semigroupoids,     template-haskell,     transformers,     transformers-compat,-    vector+    vector >= 0.12 && < 0.13   hs-source-dirs:   src   ghc-options:      -Wall   default-language: Haskell2010@@ -72,7 +72,7 @@     ghc-prim,     hashable,     lens,-    linear >= 1.20 && <1.21,+    linear >= 1.20 && <1.22,     primitive,     semigroupoids,     template-haskell,
src/Data/Dense/Base.hs view
@@ -11,6 +11,7 @@ {-# LANGUAGE RankNTypes            #-} {-# LANGUAGE StandaloneDeriving    #-} {-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UndecidableInstances  #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.Dense.Base
src/Data/Dense/Generic.hs view
@@ -72,6 +72,7 @@    -- ** Monadic initialisation   , create+  , createT   , replicateM   , generateM   , linearGenerateM@@ -213,6 +214,7 @@ import           Data.Functor.Classes import qualified Data.List                         as L import           Data.Maybe                        (fromMaybe)+import qualified Data.Traversable                  as T import           Data.Typeable import qualified Data.Vector                       as B import           Data.Vector.Fusion.Bundle         (MBundle)@@ -410,6 +412,14 @@ create m = m `seq` runST (m >>= unsafeFreeze) {-# INLINE create #-} +-- | Execute the monadic action and freeze the resulting array.+createT+  :: (Vector v a, Traversable t)+  => (forall s . ST s (t (MArray (G.Mutable v) f s a)))+  -> t (Array v f a)+createT m = m `seq` runST (m >>= T.mapM unsafeFreeze)+{-# INLINE createT #-}+ -- | O(n) Array of the given shape with the same value in each position. replicate :: (Shape f, Vector v a) => f Int -> a -> Array v f a replicate l a@@ -611,7 +621,7 @@         -> Array v f b         -> Array v f c zipWith f a1@(Array l1 v1) a2@(Array l2 v2)-  | eq1 l1 l1 = Array l1 $ G.zipWith f v1 v2+  | eq1 l1 l2 = Array l1 $ G.zipWith f v1 v2   | otherwise = Array l' $ G.unstream $       MBundle.fromStream (Stream.zipWith f (streamSub l' a1) (streamSub l' a2)) (Exact (shapeSize l'))   where l' = shapeIntersect l1 l2
src/Data/Dense/Index.hs view
@@ -81,12 +81,12 @@ class (Eq1 f, Additive f, Traversable f) => Shape f where   -- | Convert a shape to its linear index using the 'Layout'.   shapeToIndex :: Layout f -> f Int -> Int-  shapeToIndex l x = F.foldl (\k (e, a) -> k * e + a) 0 (liftI2 (,) l x)+  shapeToIndex l x = F.foldr (\(e, a) k -> a + e*k) 0 (liftI2 (,) l x)   {-# INLINE shapeToIndex #-}    -- | Convert a linear index to a shape the 'Layout'.   shapeFromIndex :: Layout f -> Int -> f Int-  shapeFromIndex l i = snd $ mapAccumR quotRem i l+  shapeFromIndex l i = snd $ mapAccumL quotRem i l   {-# INLINE shapeFromIndex #-}    -- | Calculate the intersection of two shapes.@@ -148,59 +148,62 @@   shapeInRange m i = i >= 0 && i < m  instance Shape V2 where-  shapeToIndex (V2 _x y) (V2 i j) = y*i + j+  shapeToIndex (V2 x _y) (V2 i j) = i + x*j   {-# INLINE shapeToIndex #-} -  shapeFromIndex (V2 _x y) n = V2 i j-    where (i, j) = n `quotRem` y+  shapeFromIndex (V2 x _y) n = V2 i j+    where (j, i) = n `quotRem` x   {-# INLINE shapeFromIndex #-}    shapeStep (V2 x y) (V2 i j)-    | j + 1 < y  = Just (V2      i  (j + 1))-    | i + 1 < x  = Just (V2 (i + 1)      0 )+    | i + 1 < x  = Just (V2 (i + 1)  j     )+    | j + 1 < y  = Just (V2      0  (j + 1))     | otherwise  = Nothing   {-# INLINE shapeStep #-} -  unsafeShapeStep (V2 _ y) (V2 i j)-    | j + 1 < y  = V2      i  (j + 1)-    | otherwise  = V2 (i + 1)      0+  unsafeShapeStep (V2 x _y) (V2 i j)+    | i + 1 < x  = V2 (i + 1)  j+    | otherwise  = V2      0  (j + 1)   {-# INLINE unsafeShapeStep #-} -  shapeStepBetween (V2 _ia ja) (V2 ib jb) (V2 i j)-    | j + 1 < jb = Just (V2      i  (j + 1))-    | i + 1 < ib = Just (V2 (i + 1)     ja )+  shapeStepBetween (V2 ia _ja) (V2 ib jb) (V2 i j)+    | i + 1 < ib = Just (V2 (i + 1)   j     )+    | j + 1 < jb = Just (V2      ia  (j + 1))     | otherwise  = Nothing   {-# INLINE shapeStepBetween #-}  instance Shape V3 where+  shapeToIndex (V3 x y _z) (V3 i j k) = i + x*(j + y*k)+  {-# INLINE shapeToIndex #-}+   shapeStep (V3 x y z) (V3 i j k)-    | k + 1 < z  = Just (V3      i       j  (k + 1))-    | j + 1 < y  = Just (V3      i  (j + 1)      0 )-    | i + 1 < x  = Just (V3 (i + 1)      0       0 )+    | k + 1 < z  = Just (V3 (i + 1)      j       k )+    | j + 1 < y  = Just (V3      0  (j + 1)      k )+    | i + 1 < x  = Just (V3      0       0  (k + 1))     | otherwise  = Nothing   {-# INLINE shapeStep #-} -  shapeStepBetween (V3 _ia ja ka) (V3 ib jb kb) (V3 i j k)-    | k < kb  = Just (V3      i       j  (k + 1))-    | j < jb  = Just (V3      i  (j + 1)     ka )-    | i < ib  = Just (V3 (i + 1)     ja      ka )+  shapeStepBetween (V3 ia ja _ka) (V3 ib jb kb) (V3 i j k)+    | k < kb  = Just (V3 (i + 1)      j       k )+    | j < jb  = Just (V3     ia  (j + 1)      k )+    | i < ib  = Just (V3     ia      ja  (k + 1))     | otherwise  = Nothing   {-# INLINE shapeStepBetween #-}  instance Shape V4 where   shapeStep (V4 x y z w) (V4 i j k l)-    | l + 1 < w  = Just (V4      i       j       k  (l + 1))-    | k + 1 < z  = Just (V4      i       j  (k + 1)      0 )-    | j + 1 < y  = Just (V4      i  (j + 1)      0       0 )-    | i + 1 < x  = Just (V4 (i + 1)      0       0       0 )+    | l + 1 < w  = Just (V4 (i + 1)      j       k       l )+    | k + 1 < z  = Just (V4      0  (j + 1)      k       l )+    | j + 1 < y  = Just (V4      0       0  (k + 1)      l )+    | i + 1 < x  = Just (V4      0       0       0  (l + 1))     | otherwise  = Nothing   {-# INLINE shapeStep #-} -  shapeStepBetween (V4 _ia ja ka la) (V4 ib jb kb lb) (V4 i j k l)-    | l < lb  = Just (V4      i       j       k  (l + 1))-    | k < kb  = Just (V4      i       j  (k + 1)     la )-    | j < jb  = Just (V4      i  (j + 1)     ka      la )-    | i < ib  = Just (V4 (i + 1)     ja      ka      la )+  shapeStepBetween (V4 ia ja ka _la) (V4 ib jb kb lb) (V4 i j k l)+    | l < lb  = Just (V4 (i + 1)      j       k       l )+    | k < kb  = Just (V4     ia  (j + 1)      k       l )+    | j < jb  = Just (V4     ia      ja  (k + 1)      l )+    | i < ib  = Just (V4     ia      ia      ka  (l + 1))     | otherwise  = Nothing   {-# INLINE shapeStepBetween #-}
src/Data/Dense/Mutable.hs view
@@ -107,7 +107,7 @@  -- | Lens onto the shape of the vector. The total size of the layout --   _must_ remain the same or an error is thrown.-mlayout :: (Shape l, Shape l') => Lens (MArray v l s a) (MArray v l' s a) (Layout l) (Layout l')+mlayout :: (Shape f, Shape f') => Lens (MArray v f s a) (MArray v f' s a) (Layout f) (Layout f') mlayout f (MArray l v) = f l <&> \l' ->   sizeMissmatch (F.product l) (F.product l')     ("mlayout: trying to replace shape " ++ showShape l ++ ", with " ++ showShape l')@@ -121,7 +121,7 @@ -- | Indexed lens over the underlying vector of an array. The index is --   the 'extent' of the array. You must __not__ change the length of --   the vector, otherwise an error will be thrown.-mvector :: (MVector v a, MVector w b) => IndexedLens (Layout l) (MArray v l s a) (MArray w l t b) (v s a) (w t b)+mvector :: (MVector v a, MVector w b) => IndexedLens (Layout f) (MArray v f s a) (MArray w f t b) (v s a) (w t b) mvector f (MArray l v) =   indexed f l v <&> \w ->   sizeMissmatch (GM.length v) (GM.length w)@@ -130,23 +130,23 @@ {-# INLINE mvector #-}  -- | New mutable array with shape @l@.-new :: (PrimMonad m, Shape l, MVector v a) => Layout l -> m (MArray v l (PrimState m) a)+new :: (PrimMonad m, Shape f, MVector v a) => Layout f -> m (MArray v f (PrimState m) a) new l = MArray l `liftM` GM.new (F.product l) {-# INLINE new #-}  -- | New mutable array with shape @l@ filled with element @a@.-replicate :: (PrimMonad m, Shape l, MVector v a) => Layout l -> a -> m (MArray v l (PrimState m) a)+replicate :: (PrimMonad m, Shape f, MVector v a) => Layout f -> a -> m (MArray v f (PrimState m) a) replicate l a = MArray l `liftM` GM.replicate (F.product l) a {-# INLINE replicate #-}  -- | New mutable array with shape @l@ filled with result of monadic --   action @a@.-replicateM :: (PrimMonad m, Shape l, MVector v a) => Layout l -> m a -> m (MArray v l (PrimState m) a)+replicateM :: (PrimMonad m, Shape f, MVector v a) => Layout f -> m a -> m (MArray v f (PrimState m) a) replicateM l a = MArray l `liftM` GM.replicateM (F.product l) a {-# INLINE replicateM #-}  -- | Clone a mutable array, making a new, separate mutable array.-clone :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> m (MArray v l (PrimState m) a)+clone :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> m (MArray v f (PrimState m) a) clone (MArray l v) = MArray l `liftM` GM.clone v {-# INLINE clone #-} @@ -154,130 +154,130 @@  -- | Clear the elements of a mutable array. This is usually a no-op for --   unboxed arrays.-clear :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> m ()+clear :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> m () clear (MArray _ v) = GM.clear v {-# INLINE clear #-}  -- | Read a mutable array at element @l@.-read :: (PrimMonad m, Shape l, MVector v a) => MArray v l (PrimState m) a -> l Int -> m a+read :: (PrimMonad m, Shape f, MVector v a) => MArray v f (PrimState m) a -> f Int -> m a read (MArray l v) s = boundsCheck l s $ GM.unsafeRead v (shapeToIndex l s) {-# INLINE read #-}  -- | Write a mutable array at element @l@.-write :: (PrimMonad m, Shape l, MVector v a) => MArray v l (PrimState m) a -> l Int -> a -> m ()+write :: (PrimMonad m, Shape f, MVector v a) => MArray v f (PrimState m) a -> f Int -> a -> m () write (MArray l v) s a = boundsCheck l s $ GM.unsafeWrite v (shapeToIndex l s) a {-# INLINE write #-}  -- | Modify a mutable array at element @l@ by applying a function.-modify :: (PrimMonad m, Shape l, MVector v a) => MArray v l (PrimState m) a -> l Int -> (a -> a) -> m ()+modify :: (PrimMonad m, Shape f, MVector v a) => MArray v f (PrimState m) a -> f Int -> (a -> a) -> m () modify (MArray l v) s f = boundsCheck l s $ GM.unsafeRead v i >>= GM.unsafeWrite v i . f   where i = shapeToIndex l s {-# INLINE modify #-}  -- | Swap two elements in a mutable array.-swap :: (PrimMonad m, Shape l, MVector v a) => MArray v l (PrimState m) a -> l Int -> l Int -> m ()+swap :: (PrimMonad m, Shape f, MVector v a) => MArray v f (PrimState m) a -> f Int -> f Int -> m () swap (MArray l v) i j = boundsCheck l i boundsCheck l j $ GM.unsafeSwap v (shapeToIndex l i) (shapeToIndex l j) {-# INLINE swap #-}  -- | Replace the element at the give position and return the old --   element.-exchange :: (PrimMonad m, Shape l, MVector v a) => MArray v l (PrimState m) a -> l Int -> a -> m a+exchange :: (PrimMonad m, Shape f, MVector v a) => MArray v f (PrimState m) a -> f Int -> a -> m a exchange (MArray l v) i a = boundsCheck l i $ GM.unsafeExchange v (shapeToIndex l i) a {-# INLINE exchange #-}  -- | Read a mutable array at element @i@ by indexing the internal --   vector.-linearRead :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> Int -> m a+linearRead :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> Int -> m a linearRead (MArray _ v) = GM.read v {-# INLINE linearRead #-}  -- | Write a mutable array at element @i@ by indexing the internal --   vector.-linearWrite :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> Int -> a -> m ()+linearWrite :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> Int -> a -> m () linearWrite (MArray _ v) = GM.write v {-# INLINE linearWrite #-}  -- | Swap two elements in a mutable array by indexing the internal --   vector.-linearSwap :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> Int -> Int -> m ()+linearSwap :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> Int -> Int -> m () linearSwap (MArray _ v) = GM.swap v {-# INLINE linearSwap #-}  -- | Modify a mutable array at element @i@ by applying a function.-linearModify :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> Int -> (a -> a) -> m ()+linearModify :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> Int -> (a -> a) -> m () linearModify (MArray _ v) i f = GM.read v i >>= GM.unsafeWrite v i . f {-# INLINE linearModify #-}  -- | Replace the element at the give position and return the old --   element.-linearExchange :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> Int -> a -> m a+linearExchange :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> Int -> a -> m a linearExchange (MArray _ v) i a = GM.exchange v i a {-# INLINE linearExchange #-}  -- Unsafe varients  -- | 'read' without bounds checking.-unsafeRead :: (PrimMonad m, Shape l, MVector v a) => MArray v l (PrimState m) a -> l Int -> m a+unsafeRead :: (PrimMonad m, Shape f, MVector v a) => MArray v f (PrimState m) a -> f Int -> m a unsafeRead (MArray l v) s = GM.unsafeRead v (shapeToIndex l s) {-# INLINE unsafeRead #-}  -- | 'write' without bounds checking.-unsafeWrite :: (PrimMonad m, Shape l, MVector v a) => MArray v l (PrimState m) a -> l Int -> a -> m ()+unsafeWrite :: (PrimMonad m, Shape f, MVector v a) => MArray v f (PrimState m) a -> f Int -> a -> m () unsafeWrite (MArray l v) s = GM.unsafeWrite v (shapeToIndex l s) {-# INLINE unsafeWrite #-}  -- | 'swap' without bounds checking.-unsafeSwap :: (PrimMonad m, Shape l, MVector v a) => MArray v l (PrimState m) a -> l Int -> l Int -> m ()+unsafeSwap :: (PrimMonad m, Shape f, MVector v a) => MArray v f (PrimState m) a -> f Int -> f Int -> m () unsafeSwap (MArray l v) s j = GM.unsafeSwap v (shapeToIndex l s) (shapeToIndex j s) {-# INLINE unsafeSwap #-}  -- | 'modify' without bounds checking.-unsafeModify :: (PrimMonad m, Shape l, MVector v a) => MArray v l (PrimState m) a -> l Int -> (a -> a) -> m ()+unsafeModify :: (PrimMonad m, Shape f, MVector v a) => MArray v f (PrimState m) a -> f Int -> (a -> a) -> m () unsafeModify (MArray l v) s f = GM.unsafeRead v i >>= GM.unsafeWrite v i . f   where i = shapeToIndex l s {-# INLINE unsafeModify #-}  -- | Replace the element at the give position and return the old --   element.-unsafeExchange :: (PrimMonad m, Shape l, MVector v a) => MArray v l (PrimState m) a -> l Int -> a -> m a+unsafeExchange :: (PrimMonad m, Shape f, MVector v a) => MArray v f (PrimState m) a -> f Int -> a -> m a unsafeExchange (MArray l v) i a = GM.unsafeExchange v (shapeToIndex l i) a {-# INLINE unsafeExchange #-}  -- | 'linearRead' without bounds checking.-unsafeLinearRead :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> Int -> m a+unsafeLinearRead :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> Int -> m a unsafeLinearRead (MArray _ v) = GM.unsafeRead v {-# INLINE unsafeLinearRead #-}  -- | 'linearWrite' without bounds checking.-unsafeLinearWrite :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> Int -> a -> m ()+unsafeLinearWrite :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> Int -> a -> m () unsafeLinearWrite (MArray _ v) = GM.unsafeWrite v {-# INLINE unsafeLinearWrite #-}  -- | 'linearSwap' without bounds checking.-unsafeLinearSwap :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> Int -> Int -> m ()+unsafeLinearSwap :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> Int -> Int -> m () unsafeLinearSwap (MArray _ v) = GM.unsafeSwap v {-# INLINE unsafeLinearSwap #-}  -- | 'linearModify' without bounds checking.-unsafeLinearModify :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> Int -> (a -> a) -> m ()+unsafeLinearModify :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> Int -> (a -> a) -> m () unsafeLinearModify (MArray _ v) i f = GM.unsafeRead v i >>= GM.unsafeWrite v i . f {-# INLINE unsafeLinearModify #-}  -- | Replace the element at the give position and return the old --   element.-unsafeLinearExchange :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> Int -> a -> m a+unsafeLinearExchange :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> Int -> a -> m a unsafeLinearExchange (MArray _ v) i a = GM.unsafeExchange v i a {-# INLINE unsafeLinearExchange #-}  -- Filling and copying -------------------------------------------------  -- | Set all elements in a mutable array to a constant value.-set :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> a -> m ()+set :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> a -> m () set (MArray _ v) = GM.set v {-# INLINE set #-}  -- | Copy all elements from one array into another.-copy :: (PrimMonad m, MVector v a) => MArray v l (PrimState m) a -> MArray v l (PrimState m) a -> m ()+copy :: (PrimMonad m, MVector v a) => MArray v f (PrimState m) a -> MArray v f (PrimState m) a -> m () copy (MArray _ v) (MArray _ u) = GM.copy v u {-# INLINE copy #-} @@ -286,7 +286,7 @@ -- Array v V1 a is essentially v a with a wrapper. Instance is provided -- for convience. -instance (MVector v a, l ~ V1) => MVector (MArray v l) a where+instance (MVector v a, f ~ V1) => MVector (MArray v f) a where   {-# INLINE basicLength #-}   {-# INLINE basicUnsafeSlice #-}   {-# INLINE basicOverlaps #-}
src/Data/Dense/TH.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP                   #-} {-# LANGUAGE DeriveFunctor         #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE LambdaCase            #-}@@ -60,6 +61,13 @@ import           Data.Dense.Index import           Data.Dense.Stencil +tupe :: [Exp] -> Exp+#if __GLASGOW_HASKELL__ <= 808+tupe = TupE+#else+tupe = TupE . map Just+#endif+ -- | QuasiQuoter for producing a dense arrays using a custom parser. --   Values are space separated, while also allowing infix expressions --   (like @5/7@). If you want to apply a function, it should be done in@@ -500,7 +508,7 @@   -- parenthesis / tuples   "(" -> do as           <- expression `sepBy` comma             Lex.Punc ")" <- Lex.lex-            pure $ TupE as+            pure $ tupe as   -- lists   "[" -> do as           <- expression `sepBy` comma             Lex.Punc "]" <- Lex.lex@@ -593,8 +601,8 @@   | otherwise = do       vN <- newName "v"       let idx i = AppE (AppE (VarE 'Vector.unsafeIndex) (VarE vN)) (intE i)-      let xs = TupE $ map idx [0..n-1]-      a   <- newName "a"+      let xs = tupe $ map idx [0..n-1]+      a <- newName "a"       let tup = iterate (\x -> AppT x (VarT a)) (TupleT n) !! n           typ = ForallT [PlainTV a] []                   (AppT (AppT ArrowT (AppT (AppT (ConT ''V.V) (intT n)) (VarT a))) tup)