Copyright | (c) Alexey Kuleshevich 2018-2022 |
---|---|
License | BSD3 |
Maintainer | Alexey Kuleshevich <lehins@yandex.ru> |
Stability | experimental |
Portability | non-portable |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
Synopsis
- sizeOfMArray :: (Manifest r e, Index ix) => MArray s r ix e -> Sz ix
- msize :: (Manifest r e, Index ix) => MArray s r ix e -> Sz ix
- resizeMArrayM :: (Manifest r e, Index ix', Index ix, MonadThrow m) => Sz ix' -> MArray s r ix e -> m (MArray s r ix' e)
- flattenMArray :: (Manifest r e, Index ix) => MArray s r ix e -> MVector s r e
- outerSliceMArrayM :: forall r ix e m s. (MonadThrow m, Index (Lower ix), Index ix, Manifest r e) => MArray s r ix e -> Ix1 -> m (MArray s r (Lower ix) e)
- outerSlicesMArray :: forall r ix e s. (Index (Lower ix), Index ix, Manifest r e) => Comp -> MArray s r ix e -> Vector D (MArray s r (Lower ix) e)
- read :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> m (Maybe e)
- readM :: (Manifest r e, Index ix, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -> ix -> m e
- write :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> e -> m Bool
- write_ :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> e -> m ()
- writeM :: (Manifest r e, Index ix, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -> ix -> e -> m ()
- modify :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (e -> m e) -> ix -> m (Maybe e)
- modify_ :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (e -> m e) -> ix -> m ()
- modifyM :: (Manifest r e, Index ix, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -> (e -> m e) -> ix -> m e
- modifyM_ :: (Manifest r e, Index ix, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -> (e -> m e) -> ix -> m ()
- swap :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> ix -> m (Maybe (e, e))
- swap_ :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> ix -> m ()
- swapM :: (Manifest r e, Index ix, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -> ix -> ix -> m (e, e)
- swapM_ :: (Manifest r e, Index ix, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -> ix -> ix -> m ()
- zipSwapM_ :: forall r1 r2 ix e m s. (MonadPrim s m, Manifest r2 e, Manifest r1 e, Index ix) => ix -> MArray s r1 ix e -> MArray s r2 ix e -> m ()
- thaw :: forall r ix e m. (Manifest r e, Index ix, MonadIO m) => Array r ix e -> m (MArray RealWorld r ix e)
- thawS :: forall r ix e m. (Manifest r e, Index ix, PrimMonad m) => Array r ix e -> m (MArray (PrimState m) r ix e)
- freeze :: forall r ix e m. (Manifest r e, Index ix, MonadIO m) => Comp -> MArray RealWorld r ix e -> m (Array r ix e)
- freezeS :: forall r ix e m. (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> m (Array r ix e)
- newMArray :: (Manifest r e, Index ix, PrimMonad m) => Sz ix -> e -> m (MArray (PrimState m) r ix e)
- newMArray' :: forall r ix e m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -> m (MArray (PrimState m) r ix e)
- makeMArray :: forall r ix e m. (MonadUnliftIO m, Manifest r e, Index ix) => Comp -> Sz ix -> (ix -> m e) -> m (MArray RealWorld r ix e)
- makeMArrayLinear :: forall r ix e m. (MonadUnliftIO m, Manifest r e, Index ix) => Comp -> Sz ix -> (Int -> m e) -> m (MArray RealWorld r ix e)
- makeMArrayS :: forall r ix e m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -> (ix -> m e) -> m (MArray (PrimState m) r ix e)
- makeMArrayLinearS :: forall r ix e m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -> (Int -> m e) -> m (MArray (PrimState m) r ix e)
- createArray_ :: forall r ix e a m. (Manifest r e, Index ix, MonadUnliftIO m) => Comp -> Sz ix -> (Scheduler RealWorld () -> MArray RealWorld r ix e -> m a) -> m (Array r ix e)
- createArray :: forall r ix e a m b. (Manifest r e, Index ix, MonadUnliftIO m) => Comp -> Sz ix -> (Scheduler RealWorld a -> MArray RealWorld r ix e -> m b) -> m ([a], Array r ix e)
- createArrayS_ :: forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -> (MArray (PrimState m) r ix e -> m a) -> m (Array r ix e)
- createArrayS :: forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -> (MArray (PrimState m) r ix e -> m a) -> m (a, Array r ix e)
- createArrayST_ :: forall r ix e a. (Manifest r e, Index ix) => Sz ix -> (forall s. MArray s r ix e -> ST s a) -> Array r ix e
- createArrayST :: forall r ix e a. (Manifest r e, Index ix) => Sz ix -> (forall s. MArray s r ix e -> ST s a) -> (a, Array r ix e)
- generateArray :: forall r ix e m. (MonadUnliftIO m, Manifest r e, Index ix) => Comp -> Sz ix -> (ix -> m e) -> m (Array r ix e)
- generateArrayLinear :: forall r ix e m. (MonadUnliftIO m, Manifest r e, Index ix) => Comp -> Sz ix -> (Ix1 -> m e) -> m (Array r ix e)
- generateArrayS :: forall r ix e m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -> (ix -> m e) -> m (Array r ix e)
- generateArrayLinearS :: forall r ix e m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -> (Int -> m e) -> m (Array r ix e)
- generateSplitSeedArray :: forall r ix e g it. (Iterator it, Manifest r e, Index ix) => it -> g -> (forall s. g -> ST s (g, g)) -> Comp -> Sz ix -> (forall s. Ix1 -> ix -> g -> ST s (e, g)) -> (g, [g], Array r ix e)
- generateArrayWS :: forall r ix e s m. (Manifest r e, Index ix, MonadUnliftIO m, PrimMonad m) => WorkerStates s -> Sz ix -> (ix -> s -> m e) -> m (Array r ix e)
- generateArrayLinearWS :: forall r ix e s m. (Manifest r e, Index ix, MonadUnliftIO m, PrimMonad m) => WorkerStates s -> Sz ix -> (Int -> s -> m e) -> m (Array r ix e)
- unfoldrPrimM_ :: forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -> (a -> m (e, a)) -> a -> m (Array r ix e)
- iunfoldrPrimM_ :: forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -> (a -> ix -> m (e, a)) -> a -> m (Array r ix e)
- unfoldrPrimM :: forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -> (a -> m (e, a)) -> a -> m (a, Array r ix e)
- iunfoldrPrimM :: forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -> (a -> ix -> m (e, a)) -> a -> m (a, Array r ix e)
- unfoldlPrimM_ :: forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -> (a -> m (a, e)) -> a -> m (Array r ix e)
- iunfoldlPrimM_ :: forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -> (a -> ix -> m (a, e)) -> a -> m (Array r ix e)
- unfoldlPrimM :: forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -> (a -> m (a, e)) -> a -> m (a, Array r ix e)
- iunfoldlPrimM :: forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -> (a -> ix -> m (a, e)) -> a -> m (a, Array r ix e)
- forPrimM :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (e -> m e) -> m ()
- forPrimM_ :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (e -> m ()) -> m ()
- iforPrimM :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (ix -> e -> m e) -> m ()
- iforPrimM_ :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (ix -> e -> m ()) -> m ()
- iforLinearPrimM :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (Int -> e -> m e) -> m ()
- iforLinearPrimM_ :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (Int -> e -> m ()) -> m ()
- for2PrimM_ :: forall r1 r2 e1 e2 ix m. (PrimMonad m, Index ix, Manifest r1 e1, Manifest r2 e2) => MArray (PrimState m) r1 ix e1 -> MArray (PrimState m) r2 ix e2 -> (e1 -> e2 -> m ()) -> m ()
- ifor2PrimM_ :: forall r1 r2 e1 e2 ix m. (PrimMonad m, Index ix, Manifest r1 e1, Manifest r2 e2) => MArray (PrimState m) r1 ix e1 -> MArray (PrimState m) r2 ix e2 -> (ix -> e1 -> e2 -> m ()) -> m ()
- withMArray :: (Manifest r e, Index ix, MonadUnliftIO m) => Array r ix e -> (Scheduler RealWorld a -> MArray RealWorld r ix e -> m b) -> m ([a], Array r ix e)
- withMArray_ :: (Manifest r e, Index ix, MonadUnliftIO m) => Array r ix e -> (Scheduler RealWorld () -> MArray RealWorld r ix e -> m a) -> m (Array r ix e)
- withLoadMArray_ :: forall r ix e r' m b. (Load r' ix e, Manifest r e, MonadUnliftIO m) => Array r' ix e -> (Scheduler RealWorld () -> MArray RealWorld r ix e -> m b) -> m (Array r ix e)
- withMArrayS :: (Manifest r e, Index ix, PrimMonad m) => Array r ix e -> (MArray (PrimState m) r ix e -> m a) -> m (a, Array r ix e)
- withLoadMArrayS :: forall r ix e r' m a. (Load r' ix e, Manifest r e, PrimMonad m) => Array r' ix e -> (MArray (PrimState m) r ix e -> m a) -> m (a, Array r ix e)
- withMArrayS_ :: (Manifest r e, Index ix, PrimMonad m) => Array r ix e -> (MArray (PrimState m) r ix e -> m a) -> m (Array r ix e)
- withLoadMArrayS_ :: forall r ix e r' m a. (Load r' ix e, Manifest r e, PrimMonad m) => Array r' ix e -> (MArray (PrimState m) r ix e -> m a) -> m (Array r ix e)
- withMArrayST :: (Manifest r e, Index ix) => Array r ix e -> (forall s. MArray s r ix e -> ST s a) -> (a, Array r ix e)
- withLoadMArrayST :: forall r ix e r' a. (Load r' ix e, Manifest r e) => Array r' ix e -> (forall s. MArray s r ix e -> ST s a) -> (a, Array r ix e)
- withMArrayST_ :: (Manifest r e, Index ix) => Array r ix e -> (forall s. MArray s r ix e -> ST s a) -> Array r ix e
- withLoadMArrayST_ :: forall r ix e r' a. (Load r' ix e, Manifest r e) => Array r' ix e -> (forall s. MArray s r ix e -> ST s a) -> Array r ix e
- initialize :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> m ()
- initializeNew :: (Manifest r e, Index ix, PrimMonad m) => Maybe e -> Sz ix -> m (MArray (PrimState m) r ix e)
- class Source r e => Manifest r e
- data family MArray s r ix e :: Type
- data RealWorld
- computeInto :: (Load r' ix' e, Manifest r e, Index ix, MonadIO m) => MArray RealWorld r ix e -> Array r' ix' e -> m ()
- loadArray :: forall r ix e r' m. (Load r' ix e, Manifest r e, MonadIO m) => Array r' ix e -> m (MArray RealWorld r ix e)
- loadArrayS :: forall r ix e r' m. (Load r' ix e, Manifest r e, PrimMonad m) => Array r' ix e -> m (MArray (PrimState m) r ix e)
Size
sizeOfMArray :: (Manifest r e, Index ix) => MArray s r ix e -> Sz ix Source #
O(1) - Get the size of a mutable array.
Since: 1.0.0
resizeMArrayM :: (Manifest r e, Index ix', Index ix, MonadThrow m) => Sz ix' -> MArray s r ix e -> m (MArray s r ix' e) Source #
O(1) - Change the size of a mutable array. Throws
SizeElementsMismatchException
if total number of elements does not match
the supplied array.
Since: 1.0.0
flattenMArray :: (Manifest r e, Index ix) => MArray s r ix e -> MVector s r e Source #
O(1) - Change a mutable array to a mutable vector.
Since: 1.0.0
outerSliceMArrayM :: forall r ix e m s. (MonadThrow m, Index (Lower ix), Index ix, Manifest r e) => MArray s r ix e -> Ix1 -> m (MArray s r (Lower ix) e) Source #
O(1) - Slice a mutable array from the outside, while reducing its
dimensionality by one. Same as !?>
operator, but for
mutable arrays.
Since: 1.0.0
outerSlicesMArray :: forall r ix e s. (Index (Lower ix), Index ix, Manifest r e) => Comp -> MArray s r ix e -> Vector D (MArray s r (Lower ix) e) Source #
O(1) - Take all outer slices of a mutable array and construct a delayed
vector out of them. In other words it applies outerSliceMArrayM
to each
outer index. Same as outerSlices
function, but for
mutable arrays.
Examples
>>>
import Data.Massiv.Array as A
>>>
arr <- resizeM (Sz2 4 7) $ makeArrayR P Seq (Sz1 28) (+10)
>>>
arr
Array P Seq (Sz (4 :. 7)) [ [ 10, 11, 12, 13, 14, 15, 16 ] , [ 17, 18, 19, 20, 21, 22, 23 ] , [ 24, 25, 26, 27, 28, 29, 30 ] , [ 31, 32, 33, 34, 35, 36, 37 ] ]
Here we can see we can get individual rows from a mutable matrix
>>>
marr <- thawS arr
>>>
import Control.Monad ((<=<))
>>>
mapIO_ (print <=< freezeS) $ outerSlicesMArray Seq marr
Array P Seq (Sz1 7) [ 10, 11, 12, 13, 14, 15, 16 ] Array P Seq (Sz1 7) [ 17, 18, 19, 20, 21, 22, 23 ] Array P Seq (Sz1 7) [ 24, 25, 26, 27, 28, 29, 30 ] Array P Seq (Sz1 7) [ 31, 32, 33, 34, 35, 36, 37 ]
For the sake of example what if our goal was to mutate array in such a way that rows from the top half were swapped with the bottom half:
>>>
(top, bottom) <- splitAtM 1 2 $ outerSlicesMArray Seq marr
>>>
mapIO_ (print <=< freezeS) top
Array P Seq (Sz1 7) [ 10, 11, 12, 13, 14, 15, 16 ] Array P Seq (Sz1 7) [ 17, 18, 19, 20, 21, 22, 23 ]>>>
mapIO_ (print <=< freezeS) bottom
Array P Seq (Sz1 7) [ 24, 25, 26, 27, 28, 29, 30 ] Array P Seq (Sz1 7) [ 31, 32, 33, 34, 35, 36, 37 ]>>>
szipWithM_ (zipSwapM_ 0) top bottom
>>>
freezeS marr
Array P Seq (Sz (4 :. 7)) [ [ 24, 25, 26, 27, 28, 29, 30 ] , [ 31, 32, 33, 34, 35, 36, 37 ] , [ 10, 11, 12, 13, 14, 15, 16 ] , [ 17, 18, 19, 20, 21, 22, 23 ] ]
Since: 1.0.0
Element-wise mutation
read :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> m (Maybe e) Source #
O(1) - Lookup an element in the mutable array. Returns Nothing
when index is out of bounds.
Since: 0.1.0
readM :: (Manifest r e, Index ix, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -> ix -> m e Source #
O(1) - Same as read
, but throws IndexOutOfBoundsException
on an invalid index.
Since: 0.4.0
write :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> e -> m Bool Source #
O(1) - Write an element into the cell of a mutable array. Returns False
when index is out
of bounds.
Since: 0.1.0
write_ :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> e -> m () Source #
O(1) - Write an element into the cell of a mutable array. Same as write
function
in case of an out of bounds index it is noop, but unlike write
, there is no
information is returned about was the writing of element successful or not. In other
words, just like writeM
, but doesn't throw an exception.
Since: 0.4.4
writeM :: (Manifest r e, Index ix, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -> ix -> e -> m () Source #
O(1) - Same as write
, but throws IndexOutOfBoundsException
on an invalid index.
Since: 0.4.0
:: (Manifest r e, Index ix, PrimMonad m) | |
=> MArray (PrimState m) r ix e | Array to mutate. |
-> (e -> m e) | Monadic action that modifies the element |
-> ix | Index at which to perform modification. |
-> m (Maybe e) |
O(1) - Modify an element in the cell of a mutable array with a supplied action. Returns the previous value, if index was not out of bounds.
Since: 0.1.0
:: (Manifest r e, Index ix, PrimMonad m, MonadThrow m) | |
=> MArray (PrimState m) r ix e | Array to mutate. |
-> (e -> m e) | Monadic action that modifies the element |
-> ix | Index at which to perform modification. |
-> m e |
O(1) - Modify an element in the cell of a mutable array with a supplied
action. Throws an IndexOutOfBoundsException
exception for invalid index and returns
the previous value otherwise.
Since: 0.4.0
:: (Manifest r e, Index ix, PrimMonad m, MonadThrow m) | |
=> MArray (PrimState m) r ix e | Array to mutate. |
-> (e -> m e) | Monadic action that modifies the element |
-> ix | Index at which to perform modification. |
-> m () |
O(1) - Same as modifyM
, but discard the returned element
Examples
>>>
:set -XTypeApplications
>>>
import Control.Monad.ST
>>>
import Data.Massiv.Array
>>>
runST $ newMArray' @P @Ix1 @Int (Sz1 3) >>= (\ma -> modifyM_ ma (pure . (+10)) 1 >> freezeS ma)
Array P Seq (Sz1 3) [ 0, 10, 0 ]
Since: 0.4.0
swap :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> ix -> m (Maybe (e, e)) Source #
swap_ :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> ix -> m () Source #
:: (Manifest r e, Index ix, PrimMonad m, MonadThrow m) | |
=> MArray (PrimState m) r ix e | |
-> ix | Index for the first element, which will be returned as the first element in the tuple. |
-> ix | Index for the second element, which will be returned as the second element in the tuple. |
-> m (e, e) |
O(1) - Swap two elements in a mutable array under the supplied indices. Throws an
IndexOutOfBoundsException
when either one of the indices is out of bounds and
elements under those indices otherwise.
Since: 0.4.0
swapM_ :: (Manifest r e, Index ix, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -> ix -> ix -> m () Source #
O(1) - Same as swapM
, but discard the returned elements
Since: 0.4.0
zipSwapM_ :: forall r1 r2 ix e m s. (MonadPrim s m, Manifest r2 e, Manifest r1 e, Index ix) => ix -> MArray s r1 ix e -> MArray s r2 ix e -> m () Source #
Swap elements in the intersection of two mutable arrays starting at the initial index.
Since: 1.0.0
Operations on MArray
Immutable conversion
thaw :: forall r ix e m. (Manifest r e, Index ix, MonadIO m) => Array r ix e -> m (MArray RealWorld r ix e) Source #
O(n) - Make a mutable copy of a pure array. Keep in mind that both freeze
and thaw
trigger a
copy of the full array.
Example
>>>
import Data.Massiv.Array
>>>
:set -XTypeApplications
>>>
arr <- fromListsM @U @Ix2 @Double Par [[12,21],[13,31]]
>>>
marr <- thaw arr
>>>
modify marr (pure . (+ 10)) (1 :. 0)
Just 13.0>>>
freeze Par marr
Array U Par (Sz (2 :. 2)) [ [ 12.0, 21.0 ] , [ 23.0, 31.0 ] ]
Since: 0.1.0
thawS :: forall r ix e m. (Manifest r e, Index ix, PrimMonad m) => Array r ix e -> m (MArray (PrimState m) r ix e) Source #
Same as thaw
, but restrict computation to sequential only.
Example
>>>
import Data.Massiv.Array
>>>
:set -XOverloadedLists
>>>
thawS @P @Ix1 @Double [1..10]
>>>
marr <- thawS @P @Ix1 @Double [1..10]
>>>
writeM marr 5 100
>>>
freezeS marr
Array P Seq (Sz1 10) [ 1.0, 2.0, 3.0, 4.0, 5.0, 100.0, 7.0, 8.0, 9.0, 10.0 ]
Since: 0.3.0
freeze :: forall r ix e m. (Manifest r e, Index ix, MonadIO m) => Comp -> MArray RealWorld r ix e -> m (Array r ix e) Source #
O(n) - Yield an immutable copy of the mutable array. Note that mutable representations have to be the same.
Example
>>>
import Data.Massiv.Array
>>>
marr <- newMArray @P (Sz2 2 6) (0 :: Int)
>>>
forM_ (range Seq 0 (Ix2 1 4)) $ \ix -> write marr ix 9
>>>
freeze Seq marr
Array P Seq (Sz (2 :. 6)) [ [ 9, 9, 9, 9, 0, 0 ] , [ 0, 0, 0, 0, 0, 0 ] ]
Since: 0.1.0
freezeS :: forall r ix e m. (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> m (Array r ix e) Source #
Create mutable
newMArray :: (Manifest r e, Index ix, PrimMonad m) => Sz ix -> e -> m (MArray (PrimState m) r ix e) Source #
Create new mutable array while initializing all elements to the specified value.
Since: 0.6.0
newMArray' :: forall r ix e m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -> m (MArray (PrimState m) r ix e) Source #
O(n) - Initialize a new mutable array. All elements will be set to some default value. For
boxed arrays it will be a thunk with Uninitialized
exception, while for others it will be
simply zeros.
Examples
>>>
import Data.Massiv.Array
>>>
marr <- newMArray' (Sz2 2 6) :: IO (MArray RealWorld P Ix2 Int)
>>>
freeze Seq marr
Array P Seq (Sz (2 :. 6)) [ [ 0, 0, 0, 0, 0, 0 ] , [ 0, 0, 0, 0, 0, 0 ] ]
Or using TypeApplications
:
>>>
:set -XTypeApplications
>>>
newMArray' @P @Ix2 @Int (Sz2 2 6) >>= freezeS
Array P Seq (Sz (2 :. 6)) [ [ 0, 0, 0, 0, 0, 0 ] , [ 0, 0, 0, 0, 0, 0 ] ]>>>
newMArray' @B @_ @Int (Sz2 2 6) >>= freezeS
*** Exception: Uninitialized
Since: 0.6.0
makeMArray :: forall r ix e m. (MonadUnliftIO m, Manifest r e, Index ix) => Comp -> Sz ix -> (ix -> m e) -> m (MArray RealWorld r ix e) Source #
Just like makeMArrayS
, but also accepts computation strategy and runs in IO
.
Since: 0.3.0
makeMArrayLinear :: forall r ix e m. (MonadUnliftIO m, Manifest r e, Index ix) => Comp -> Sz ix -> (Int -> m e) -> m (MArray RealWorld r ix e) Source #
Just like makeMArrayLinearS
, but also accepts computation strategy and runs in IO
.
Since: 0.3.0
:: forall r ix e m. (Manifest r e, Index ix, PrimMonad m) | |
=> Sz ix | Size of the create array |
-> (ix -> m e) | Element generating action |
-> m (MArray (PrimState m) r ix e) |
Create a mutable array using an index aware generating action.
Since: 0.3.0
makeMArrayLinearS :: forall r ix e m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -> (Int -> m e) -> m (MArray (PrimState m) r ix e) Source #
Same as makeMArrayS
, but index supplied to the action is row-major linear index.
Since: 0.3.0
Create pure
:: forall r ix e a m. (Manifest r e, Index ix, MonadUnliftIO m) | |
=> Comp | Computation strategy to use after |
-> Sz ix | Size of the newly created array |
-> (Scheduler RealWorld () -> MArray RealWorld r ix e -> m a) | An action that should fill all elements of the brand new mutable array |
-> m (Array r ix e) |
Create a new array by supplying an action that will fill the new blank mutable array. Use
createArray
if you'd like to keep the result of the filling function.
Examples
>>>
:set -XTypeApplications
>>>
import Data.Massiv.Array
>>>
createArray_ @P @_ @Int Seq (Sz1 2) (\ s marr -> scheduleWork s (writeM marr 0 10) >> scheduleWork s (writeM marr 1 11))
Array P Seq (Sz1 2) [ 10, 11 ]
Since: 0.3.0
:: forall r ix e a m b. (Manifest r e, Index ix, MonadUnliftIO m) | |
=> Comp | Computation strategy to use after |
-> Sz ix | Size of the newly created array |
-> (Scheduler RealWorld a -> MArray RealWorld r ix e -> m b) | An action that should fill all elements of the brand new mutable array |
-> m ([a], Array r ix e) |
Just like createArray_
, but together with Array
it returns results of scheduled filling
actions.
Since: 0.3.0
:: forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) | |
=> Sz ix | Size of the newly created array |
-> (MArray (PrimState m) r ix e -> m a) | An action that should fill all elements of the brand new mutable array |
-> m (Array r ix e) |
Create a new array by supplying an action that will fill the new blank mutable array. Use
createArrayS
if you'd like to keep the result of the filling function.
Examples
>>>
:set -XTypeApplications
>>>
import Data.Massiv.Array
>>>
createArrayS_ @P @_ @Int (Sz1 2) (\ marr -> write marr 0 10 >> write marr 1 12)
Array P Seq (Sz1 2) [ 10, 12 ]
Since: 0.3.0
:: forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) | |
=> Sz ix | Size of the newly created array |
-> (MArray (PrimState m) r ix e -> m a) | An action that should fill all elements of the brand new mutable array |
-> m (a, Array r ix e) |
Just like createArray_
, but together with Array
it returns the result of the filling action.
Since: 0.3.0
createArrayST_ :: forall r ix e a. (Manifest r e, Index ix) => Sz ix -> (forall s. MArray s r ix e -> ST s a) -> Array r ix e Source #
Just like createArrayS_
, but restricted to ST
.
Since: 0.3.0
createArrayST :: forall r ix e a. (Manifest r e, Index ix) => Sz ix -> (forall s. MArray s r ix e -> ST s a) -> (a, Array r ix e) Source #
Just like createArrayS
, but restricted to ST
.
Since: 0.2.6
Generate
generateArray :: forall r ix e m. (MonadUnliftIO m, Manifest r e, Index ix) => Comp -> Sz ix -> (ix -> m e) -> m (Array r ix e) Source #
Just like generateArrayS
, except this generator will respect the supplied computation
strategy, and for that reason it is restricted to IO
.
Since: 0.2.6
generateArrayLinear :: forall r ix e m. (MonadUnliftIO m, Manifest r e, Index ix) => Comp -> Sz ix -> (Ix1 -> m e) -> m (Array r ix e) Source #
Just like generateArray
, except generating action will receive a row-major linear
index.
Since: 0.3.0
:: forall r ix e m. (Manifest r e, Index ix, PrimMonad m) | |
=> Sz ix | Size of the array |
-> (ix -> m e) | Element producing action |
-> m (Array r ix e) |
Sequentially generate a pure array. Much like makeArray
creates a pure array this
function will use Manifest
interface to generate a pure Array
in the end, except that
computation strategy is set to Seq
. Element producing function no longer has to be pure
but is a stateful action, becuase it is restricted to PrimMonad
thus allows for sharing
the state between computation of each element.
Examples
>>>
import Data.Massiv.Array
>>>
import Data.IORef
>>>
ref <- newIORef (0 :: Int)
>>>
generateArrayS (Sz1 6) (\ i -> modifyIORef' ref (+i) >> print i >> pure i) :: IO (Array U Ix1 Int)
0 1 2 3 4 5 Array U Seq (Sz1 6) [ 0, 1, 2, 3, 4, 5 ]>>>
readIORef ref
15
Since: 0.2.6
:: forall r ix e m. (Manifest r e, Index ix, PrimMonad m) | |
=> Sz ix | Resulting size of the array |
-> (Int -> m e) | Element producing generator |
-> m (Array r ix e) |
Same as generateArray
but with action that accepts row-major linear index.
Since: 0.3.0
generateSplitSeedArray Source #
:: forall r ix e g it. (Iterator it, Manifest r e, Index ix) | |
=> it | Iterator |
-> g | Initial seed |
-> (forall s. g -> ST s (g, g)) | An ST action that can split a seed into two independent seeds. It will be called the same number of times as the number of jobs that will get scheduled during parallelization. Eg. only once for the sequential case. |
-> Comp | Computation strategy. |
-> Sz ix | Resulting size of the array. |
-> (forall s. Ix1 -> ix -> g -> ST s (e, g)) | An ST action that produces a value and the next seed. It takes both versions of the index, in linear and in multi-dimensional forms, as well as the current seeding value. Returns the element for the array cell together with the new seed that will be used for the next element generation |
-> (g, [g], Array r ix e) | Returned values are:
|
Similar to makeSplitSeedArray
, except it will produce a
Manifest array and will return back the last unused seed together with all
final seeds produced by each scheduled job. This function can be thought of
as an unfolding done in parallel while iterating in a customizable manner.
Since: 1.0.2
Stateful worker threads
generateArrayWS :: forall r ix e s m. (Manifest r e, Index ix, MonadUnliftIO m, PrimMonad m) => WorkerStates s -> Sz ix -> (ix -> s -> m e) -> m (Array r ix e) Source #
Use per worker thread state while generating elements of the array. Very useful for things that are not thread safe.
Since: 0.3.4
generateArrayLinearWS :: forall r ix e s m. (Manifest r e, Index ix, MonadUnliftIO m, PrimMonad m) => WorkerStates s -> Sz ix -> (Int -> s -> m e) -> m (Array r ix e) Source #
Same as generateArrayWS
, but use linear indexing instead.
Since: 0.3.4
Unfold
:: forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) | |
=> Sz ix | Size of the desired array |
-> (a -> m (e, a)) | Unfolding action |
-> a | Initial accumulator |
-> m (Array r ix e) |
Sequentially unfold an array from the left.
Examples
Create an array with Fibonacci numbers while performing an IO
action at each iteration.
>>>
import Data.Massiv.Array
>>>
unfoldrPrimM_ (Sz1 10) (\(f0, f1) -> (f0, (f1, f0 + f1)) <$ print f1) (0, 1) :: IO (Array P Ix1 Int)
1 1 2 3 5 8 13 21 34 55 Array P Seq (Sz1 10) [ 0, 1, 1, 2, 3, 5, 8, 13, 21, 34 ]
Since: 0.3.0
:: forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) | |
=> Sz ix | Size of the desired array |
-> (a -> ix -> m (e, a)) | Unfolding action |
-> a | Initial accumulator |
-> m (Array r ix e) |
Same as unfoldrPrimM_
but do the unfolding with index aware function.
Since: 0.3.0
:: forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) | |
=> Sz ix | Size of the desired array |
-> (a -> m (e, a)) | Unfolding action |
-> a | Initial accumulator |
-> m (a, Array r ix e) |
Just like iunfoldrPrimM
, but do the unfolding with index aware function.
Since: 0.3.0
:: forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) | |
=> Sz ix | Size of the desired array |
-> (a -> ix -> m (e, a)) | Unfolding action |
-> a | Initial accumulator |
-> m (a, Array r ix e) |
Just like iunfoldrPrimM_
, but also returns the final value of the accumulator.
Since: 0.3.0
:: forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) | |
=> Sz ix | Size of the desired array |
-> (a -> m (a, e)) | Unfolding action |
-> a | Initial accumulator |
-> m (Array r ix e) |
Sequentially unfold an array from the left.
Examples
Create an array with Fibonacci numbers starting at the end while performing and IO
action on
the accumulator for each element of the array.
>>>
import Data.Massiv.Array
>>>
unfoldlPrimM_ (Sz1 10) (\a@(f0, f1) -> let fn = f0 + f1 in print a >> return ((f1, fn), f0)) (0, 1) :: IO (Array P Ix1 Int)
(0,1) (1,1) (1,2) (2,3) (3,5) (5,8) (8,13) (13,21) (21,34) (34,55) Array P Seq (Sz1 10) [ 34, 21, 13, 8, 5, 3, 2, 1, 1, 0 ]
Since: 0.3.0
:: forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) | |
=> Sz ix | Size of the desired array |
-> (a -> ix -> m (a, e)) | Unfolding action |
-> a | Initial accumulator |
-> m (Array r ix e) |
Same as unfoldlPrimM_
but do the unfolding with index aware function.
Since: 0.3.0
:: forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) | |
=> Sz ix | Size of the desired array |
-> (a -> m (a, e)) | Unfolding action |
-> a | Initial accumulator |
-> m (a, Array r ix e) |
Just like iunfoldlPrimM
, but do the unfolding with index aware function.
Since: 0.3.0
:: forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) | |
=> Sz ix | Size of the desired array |
-> (a -> ix -> m (a, e)) | Unfolding action |
-> a | Initial accumulator |
-> m (a, Array r ix e) |
Just like iunfoldlPrimM_
, but also returns the final value of the accumulator.
Since: 0.3.0
Mapping
forPrimM :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (e -> m e) -> m () Source #
Sequentially loop over a mutable array while modifying each element with an action.
Since: 0.4.0
forPrimM_ :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (e -> m ()) -> m () Source #
Sequentially loop over a mutable array while reading each element and applying an action to it. There is no mutation to the array, unless the action itself modifies it.
Since: 0.4.0
iforPrimM :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (ix -> e -> m e) -> m () Source #
Sequentially loop over a mutable array while modifying each element with an index aware action.
Since: 0.4.0
iforPrimM_ :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (ix -> e -> m ()) -> m () Source #
Sequentially loop over a mutable array while reading each element and applying an index aware action to it. There is no mutation to the array, unless the action itself modifies it.
Since: 0.4.0
iforLinearPrimM :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (Int -> e -> m e) -> m () Source #
Sequentially loop over a mutable array while modifying each element with an index aware action.
Since: 0.4.0
iforLinearPrimM_ :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (Int -> e -> m ()) -> m () Source #
Sequentially loop over a mutable array while reading each element and applying a linear index aware action to it. There is no mutation to the array, unless the action itself modifies it.
Since: 0.4.0
for2PrimM_ :: forall r1 r2 e1 e2 ix m. (PrimMonad m, Index ix, Manifest r1 e1, Manifest r2 e2) => MArray (PrimState m) r1 ix e1 -> MArray (PrimState m) r2 ix e2 -> (e1 -> e2 -> m ()) -> m () Source #
Sequentially loop over the intersection of two mutable arrays while reading elements from both and applying an action to it. There is no mutation to the actual arrays, unless the action itself modifies either one of them.
Since: 1.0.0
ifor2PrimM_ :: forall r1 r2 e1 e2 ix m. (PrimMonad m, Index ix, Manifest r1 e1, Manifest r2 e2) => MArray (PrimState m) r1 ix e1 -> MArray (PrimState m) r2 ix e2 -> (ix -> e1 -> e2 -> m ()) -> m () Source #
Same as for2PrimM_
, but with index aware action.
Since: 1.0.0
Modify
withMArray :: (Manifest r e, Index ix, MonadUnliftIO m) => Array r ix e -> (Scheduler RealWorld a -> MArray RealWorld r ix e -> m b) -> m ([a], Array r ix e) Source #
Same as withMArray_
, but allows to keep artifacts of scheduled tasks.
Since: 0.5.0
withMArray_ :: (Manifest r e, Index ix, MonadUnliftIO m) => Array r ix e -> (Scheduler RealWorld () -> MArray RealWorld r ix e -> m a) -> m (Array r ix e) Source #
Create a copy of a pure array, mutate it in place and return its frozen version. The big
difference between withMArrayS
is that it's not only gonna respect the computation strategy
supplied to it while making a copy, but it will also pass extra argumens to the action that
suppose to modify the mutable copy of the source array. These two extra arguments are:
- Number of capabilities derived from the
Comp
utation strategy of the array. - An action that can be used to schedule arbitrary number of jobs that will be executed in parallel.
- And, of course, the mutable array itself.
Since: 0.5.0
withLoadMArray_ :: forall r ix e r' m b. (Load r' ix e, Manifest r e, MonadUnliftIO m) => Array r' ix e -> (Scheduler RealWorld () -> MArray RealWorld r ix e -> m b) -> m (Array r ix e) Source #
Same as withMArray_
, but the array supplied to this function can be any loadable
array. For that reason it will be faster if supplied array is delayed.
Since: 0.6.1
withMArrayS :: (Manifest r e, Index ix, PrimMonad m) => Array r ix e -> (MArray (PrimState m) r ix e -> m a) -> m (a, Array r ix e) Source #
withLoadMArrayS :: forall r ix e r' m a. (Load r' ix e, Manifest r e, PrimMonad m) => Array r' ix e -> (MArray (PrimState m) r ix e -> m a) -> m (a, Array r ix e) Source #
Same as withMArrayS
, but will work with any loadable array.
Since: 0.6.1
withMArrayS_ :: (Manifest r e, Index ix, PrimMonad m) => Array r ix e -> (MArray (PrimState m) r ix e -> m a) -> m (Array r ix e) Source #
Same as withMArrayS
, except it discards the value produced by the supplied action
Since: 0.5.0
withLoadMArrayS_ :: forall r ix e r' m a. (Load r' ix e, Manifest r e, PrimMonad m) => Array r' ix e -> (MArray (PrimState m) r ix e -> m a) -> m (Array r ix e) Source #
Same as withMArrayS_
, but will work with any loadable array.
Since: 0.6.1
withMArrayST :: (Manifest r e, Index ix) => Array r ix e -> (forall s. MArray s r ix e -> ST s a) -> (a, Array r ix e) Source #
Same as withMArrayS
but in ST
. This is not only pure, but also the safest way to do
mutation to the array.
Since: 0.5.0
withLoadMArrayST :: forall r ix e r' a. (Load r' ix e, Manifest r e) => Array r' ix e -> (forall s. MArray s r ix e -> ST s a) -> (a, Array r ix e) Source #
Same as withMArrayST
, but works with any loadable array.
Since: 0.6.1
withMArrayST_ :: (Manifest r e, Index ix) => Array r ix e -> (forall s. MArray s r ix e -> ST s a) -> Array r ix e Source #
Same as withMArrayS
but in ST
. This is not only pure, but also the safest way to do
mutation to the array.
Since: 0.5.0
withLoadMArrayST_ :: forall r ix e r' a. (Load r' ix e, Manifest r e) => Array r' ix e -> (forall s. MArray s r ix e -> ST s a) -> Array r ix e Source #
Same as withMArrayST_
, but works with any loadable array.
Since: 0.6.1
Initialize
initialize :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> m () Source #
Initialize mutable array to some default value.
Since: 0.3.0
initializeNew :: (Manifest r e, Index ix, PrimMonad m) => Maybe e -> Sz ix -> m (MArray (PrimState m) r ix e) Source #
Create new mutable array while initializing all elements to some default value.
Since: 0.3.0
Computation
class Source r e => Manifest r e Source #
Manifest arrays are backed by actual memory and values are looked up versus
computed as it is with delayed arrays. Because manifest arrays are located in
memory their contents can be mutated once thawed into MArray
. The process
of changed a mutable MArray
back into an immutable Array
is called
freezing.
unsafeLinearIndexM, sizeOfMArray, unsafeResizeMArray, unsafeLinearSliceMArray, unsafeThaw, unsafeFreeze, unsafeNew, unsafeLinearRead, unsafeLinearWrite, initialize
Instances
data family MArray s r ix e :: Type Source #
Mutable version of a Manifest
Array
. The extra type argument s
is for
the state token used by IO
and ST
.
Since: 0.1.0
Instances
NFData ix => NFData (MArray s P ix e) Source # | |
Defined in Data.Massiv.Array.Manifest.Primitive | |
NFData ix => NFData (MArray s S ix e) Source # | |
Defined in Data.Massiv.Array.Manifest.Storable | |
NFData ix => NFData (MArray s U ix e) Source # | |
Defined in Data.Massiv.Array.Manifest.Unboxed | |
newtype MArray s B ix e Source # | |
data MArray s BL ix e Source # | |
Defined in Data.Massiv.Array.Manifest.Boxed | |
newtype MArray s BN ix e Source # | |
data MArray s P ix e Source # | |
Defined in Data.Massiv.Array.Manifest.Primitive | |
data MArray s S ix e Source # | |
Defined in Data.Massiv.Array.Manifest.Storable | |
data MArray s U ix e Source # | |
RealWorld
is deeply magical. It is primitive, but it is not
unlifted (hence ptrArg
). We never manipulate values of type
RealWorld
; it's only used in the type system, to parameterise State#
.
Instances
Prim a => Storable (PVar a RealWorld) | |
Defined in Data.Primitive.PVar.Internal sizeOf :: PVar a RealWorld -> Int # alignment :: PVar a RealWorld -> Int # peekElemOff :: Ptr (PVar a RealWorld) -> Int -> IO (PVar a RealWorld) # pokeElemOff :: Ptr (PVar a RealWorld) -> Int -> PVar a RealWorld -> IO () # peekByteOff :: Ptr b -> Int -> IO (PVar a RealWorld) # pokeByteOff :: Ptr b -> Int -> PVar a RealWorld -> IO () # peek :: Ptr (PVar a RealWorld) -> IO (PVar a RealWorld) # poke :: Ptr (PVar a RealWorld) -> PVar a RealWorld -> IO () # |
:: (Load r' ix' e, Manifest r e, Index ix, MonadIO m) | |
=> MArray RealWorld r ix e | Target Array |
-> Array r' ix' e | Array to load |
-> m () |
Compute an Array while loading the results into the supplied mutable target array. Number of
elements for arrays must agree, otherwise SizeElementsMismatchException
exception is thrown.
Since: 0.1.3