{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module Data.Massiv.Array.Ops.Transform (
transpose,
transposeInner,
transposeOuter,
reverse,
reverse',
reverseM,
backpermuteM,
backpermute',
resizeM,
resize',
flatten,
extractM,
extract',
extractFromToM,
extractFromTo',
deleteRowsM,
deleteColumnsM,
deleteRegionM,
appendOuterM,
appendM,
append',
concatOuterM,
concatM,
concat',
stackSlicesM,
stackOuterSlicesM,
stackInnerSlicesM,
splitAtM,
splitAt',
splitExtractM,
replaceSlice,
replaceOuterSlice,
upsample,
downsample,
zoom,
zoomWithGrid,
transformM,
transform',
transform2M,
transform2',
) where
import Control.Monad as M (foldM_, forM_, unless)
import Control.Monad.ST
import Control.Scheduler (traverse_)
import Data.Bifunctor (bimap)
import Data.Foldable as F (foldl', foldrM, length, toList)
import qualified Data.List as L (uncons)
import Data.Massiv.Array.Delayed.Pull
import Data.Massiv.Array.Delayed.Push
import Data.Massiv.Array.Mutable
import Data.Massiv.Array.Ops.Construct
import Data.Massiv.Array.Ops.Map
import Data.Massiv.Core
import Data.Massiv.Core.Common
import Prelude as P hiding (
concat,
drop,
mapM_,
reverse,
splitAt,
take,
traverse,
)
extractM
:: forall r ix e m
. (MonadThrow m, Index ix, Source r e)
=> ix
-> Sz ix
-> Array r ix e
-> m (Array D ix e)
!ix
sIx !Sz ix
newSz !Array r ix e
arr
| forall ix. Index ix => Sz ix -> ix -> Bool
isSafeIndex Sz ix
sz1 ix
sIx Bool -> Bool -> Bool
&& forall ix. Index ix => Sz ix -> ix -> Bool
isSafeIndex Sz ix
eIx1 ix
sIx Bool -> Bool -> Bool
&& forall ix. Index ix => Sz ix -> ix -> Bool
isSafeIndex Sz ix
sz1 ix
eIx =
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall r e ix.
(Source r e, Index ix) =>
ix -> Sz ix -> Array r ix e -> Array D ix e
unsafeExtract ix
sIx Sz ix
newSz Array r ix e
arr
| Bool
otherwise = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ forall ix. Index ix => Sz ix -> ix -> Sz ix -> SizeException
SizeSubregionException (forall r ix e. Size r => Array r ix e -> Sz ix
size Array r ix e
arr) ix
sIx Sz ix
newSz
where
sz1 :: Sz ix
sz1 = forall ix. Index ix => ix -> Sz ix
Sz (forall ix. Index ix => (Int -> Int) -> ix -> ix
liftIndex (forall a. Num a => a -> a -> a
+ Int
1) (forall ix. Sz ix -> ix
unSz (forall r ix e. Size r => Array r ix e -> Sz ix
size Array r ix e
arr)))
eIx1 :: Sz ix
eIx1 = forall ix. Index ix => ix -> Sz ix
Sz (forall ix. Index ix => (Int -> Int) -> ix -> ix
liftIndex (forall a. Num a => a -> a -> a
+ Int
1) ix
eIx)
eIx :: ix
eIx = forall ix. Index ix => (Int -> Int -> Int) -> ix -> ix -> ix
liftIndex2 forall a. Num a => a -> a -> a
(+) ix
sIx forall a b. (a -> b) -> a -> b
$ forall ix. Sz ix -> ix
unSz Sz ix
newSz
{-# INLINE extractM #-}
extract'
:: forall r ix e
. (HasCallStack, Index ix, Source r e)
=> ix
-> Sz ix
-> Array r ix e
-> Array D ix e
ix
sIx Sz ix
newSz = forall a. HasCallStack => Either SomeException a -> a
throwEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r ix e (m :: * -> *).
(MonadThrow m, Index ix, Source r e) =>
ix -> Sz ix -> Array r ix e -> m (Array D ix e)
extractM ix
sIx Sz ix
newSz
{-# INLINE extract' #-}
extractFromToM
:: forall r ix e m
. (MonadThrow m, Index ix, Source r e)
=> ix
-> ix
-> Array r ix e
-> m (Array D ix e)
ix
sIx ix
eIx = forall r ix e (m :: * -> *).
(MonadThrow m, Index ix, Source r e) =>
ix -> Sz ix -> Array r ix e -> m (Array D ix e)
extractM ix
sIx (forall ix. Index ix => ix -> Sz ix
Sz (forall ix. Index ix => (Int -> Int -> Int) -> ix -> ix -> ix
liftIndex2 (-) ix
eIx ix
sIx))
{-# INLINE extractFromToM #-}
extractFromTo'
:: forall r ix e
. (HasCallStack, Index ix, Source r e)
=> ix
-> ix
-> Array r ix e
-> Array D ix e
ix
sIx ix
eIx = forall r ix e.
(HasCallStack, Index ix, Source r e) =>
ix -> Sz ix -> Array r ix e -> Array D ix e
extract' ix
sIx forall a b. (a -> b) -> a -> b
$ forall ix. Index ix => ix -> Sz ix
Sz (forall ix. Index ix => (Int -> Int -> Int) -> ix -> ix -> ix
liftIndex2 (-) ix
eIx ix
sIx)
{-# INLINE extractFromTo' #-}
resizeM
:: forall r ix ix' e m
. (MonadThrow m, Index ix', Index ix, Size r)
=> Sz ix'
-> Array r ix e
-> m (Array r ix' e)
resizeM :: forall r ix ix' e (m :: * -> *).
(MonadThrow m, Index ix', Index ix, Size r) =>
Sz ix' -> Array r ix e -> m (Array r ix' e)
resizeM Sz ix'
sz Array r ix e
arr = forall (m :: * -> *) ix ix'.
(MonadThrow m, Index ix, Index ix') =>
Sz ix -> Sz ix' -> m ()
guardNumberOfElements (forall r ix e. Size r => Array r ix e -> Sz ix
size Array r ix e
arr) Sz ix'
sz forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall r ix ix' e.
(Size r, Index ix, Index ix') =>
Sz ix' -> Array r ix e -> Array r ix' e
unsafeResize Sz ix'
sz Array r ix e
arr)
{-# INLINE resizeM #-}
resize'
:: forall r ix ix' e
. (HasCallStack, Index ix', Index ix, Size r)
=> Sz ix'
-> Array r ix e
-> Array r ix' e
resize' :: forall r ix ix' e.
(HasCallStack, Index ix', Index ix, Size r) =>
Sz ix' -> Array r ix e -> Array r ix' e
resize' Sz ix'
sz = forall a. HasCallStack => Either SomeException a -> a
throwEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r ix ix' e (m :: * -> *).
(MonadThrow m, Index ix', Index ix, Size r) =>
Sz ix' -> Array r ix e -> m (Array r ix' e)
resizeM Sz ix'
sz
{-# INLINE resize' #-}
flatten :: forall r ix e. (Index ix, Size r) => Array r ix e -> Vector r e
flatten :: forall r ix e. (Index ix, Size r) => Array r ix e -> Vector r e
flatten Array r ix e
arr = forall r ix ix' e.
(Size r, Index ix, Index ix') =>
Sz ix' -> Array r ix e -> Array r ix' e
unsafeResize (forall ix. ix -> Sz ix
SafeSz (forall ix. Index ix => Sz ix -> Int
totalElem (forall r ix e. Size r => Array r ix e -> Sz ix
size Array r ix e
arr))) Array r ix e
arr
{-# INLINE flatten #-}
transpose :: forall r e. Source r e => Matrix r e -> Matrix D e
transpose :: forall r e. Source r e => Matrix r e -> Matrix D e
transpose = forall r ix e.
(Index (Lower ix), Index ix, Source r e) =>
Array r ix e -> Array D ix e
transposeInner
{-# INLINE [1] transpose #-}
{-# RULES
"transpose . transpose" [~1] forall arr. transpose (transpose arr) = delay arr
"transposeInner . transposeInner" [~1] forall arr. transposeInner (transposeInner arr) = delay arr
"transposeOuter . transposeOuter" [~1] forall arr. transposeOuter (transposeOuter arr) = delay arr
#-}
transposeInner
:: forall r ix e
. (Index (Lower ix), Index ix, Source r e)
=> Array r ix e
-> Array D ix e
transposeInner :: forall r ix e.
(Index (Lower ix), Index ix, Source r e) =>
Array r ix e -> Array D ix e
transposeInner !Array r ix e
arr = forall r ix e.
Load r ix e =>
Comp -> Sz ix -> (ix -> e) -> Array r ix e
makeArray (forall r ix e. Strategy r => Array r ix e -> Comp
getComp Array r ix e
arr) Sz ix
newsz ix -> e
newVal
where
transInner :: ix -> ix
transInner !ix
ix =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. (HasCallStack, Exception e) => e -> a
throwImpossible forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ do
Int
n <- forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> m Int
getDimM ix
ix Dim
dix
Int
m <- forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> m Int
getDimM ix
ix (Dim
dix forall a. Num a => a -> a -> a
- Dim
1)
ix
ix' <- forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> Int -> m ix
setDimM ix
ix Dim
dix Int
m
forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> Int -> m ix
setDimM ix
ix' (Dim
dix forall a. Num a => a -> a -> a
- Dim
1) Int
n
{-# INLINE transInner #-}
newVal :: ix -> e
newVal = forall r e ix. (Source r e, Index ix) => Array r ix e -> ix -> e
unsafeIndex Array r ix e
arr forall b c a. (b -> c) -> (a -> b) -> a -> c
. ix -> ix
transInner
{-# INLINE newVal #-}
!newsz :: Sz ix
newsz = forall ix. Index ix => ix -> Sz ix
Sz (ix -> ix
transInner (forall ix. Sz ix -> ix
unSz (forall r ix e. Size r => Array r ix e -> Sz ix
size Array r ix e
arr)))
!dix :: Dim
dix = forall ix (proxy :: * -> *). Index ix => proxy ix -> Dim
dimensions Sz ix
newsz
{-# INLINE [1] transposeInner #-}
transposeOuter
:: forall r ix e
. (Index (Lower ix), Index ix, Source r e)
=> Array r ix e
-> Array D ix e
transposeOuter :: forall r ix e.
(Index (Lower ix), Index ix, Source r e) =>
Array r ix e -> Array D ix e
transposeOuter !Array r ix e
arr = forall r ix e.
Load r ix e =>
Comp -> Sz ix -> (ix -> e) -> Array r ix e
makeArray (forall r ix e. Strategy r => Array r ix e -> Comp
getComp Array r ix e
arr) Sz ix
newsz ix -> e
newVal
where
transOuter :: c -> c
transOuter !c
ix =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. (HasCallStack, Exception e) => e -> a
throwImpossible forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ do
Int
n <- forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> m Int
getDimM c
ix Dim
1
Int
m <- forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> m Int
getDimM c
ix Dim
2
c
ix' <- forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> Int -> m ix
setDimM c
ix Dim
1 Int
m
forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> Int -> m ix
setDimM c
ix' Dim
2 Int
n
{-# INLINE transOuter #-}
newVal :: ix -> e
newVal = forall r e ix. (Source r e, Index ix) => Array r ix e -> ix -> e
unsafeIndex Array r ix e
arr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {c}. Index c => c -> c
transOuter
{-# INLINE newVal #-}
!newsz :: Sz ix
newsz = forall ix. Index ix => ix -> Sz ix
Sz (forall {c}. Index c => c -> c
transOuter (forall ix. Sz ix -> ix
unSz (forall r ix e. Size r => Array r ix e -> Sz ix
size Array r ix e
arr)))
{-# INLINE [1] transposeOuter #-}
reverse
:: forall n r ix e
. (IsIndexDimension ix n, Index ix, Source r e)
=> Dimension n
-> Array r ix e
-> Array D ix e
reverse :: forall (n :: Natural) r ix e.
(IsIndexDimension ix n, Index ix, Source r e) =>
Dimension n -> Array r ix e -> Array D ix e
reverse Dimension n
dim = forall r ix e.
(HasCallStack, Index ix, Source r e) =>
Dim -> Array r ix e -> Array D ix e
reverse' (forall (n :: Natural). KnownNat n => Dimension n -> Dim
fromDimension Dimension n
dim)
{-# INLINE reverse #-}
reverseM
:: forall r ix e m
. (MonadThrow m, Index ix, Source r e)
=> Dim
-> Array r ix e
-> m (Array D ix e)
reverseM :: forall r ix e (m :: * -> *).
(MonadThrow m, Index ix, Source r e) =>
Dim -> Array r ix e -> m (Array D ix e)
reverseM Dim
dim Array r ix e
arr = do
let sz :: Sz ix
sz = forall r ix e. Size r => Array r ix e -> Sz ix
size Array r ix e
arr
Int
k <- forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> m Int
getDimM (forall ix. Sz ix -> ix
unSz Sz ix
sz) Dim
dim
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall r ix e.
Load r ix e =>
Comp -> Sz ix -> (ix -> e) -> Array r ix e
makeArray (forall r ix e. Strategy r => Array r ix e -> Comp
getComp Array r ix e
arr) Sz ix
sz forall a b. (a -> b) -> a -> b
$ \ix
ix ->
forall r e ix. (Source r e, Index ix) => Array r ix e -> ix -> e
unsafeIndex Array r ix e
arr (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall ix.
(HasCallStack, Index ix) =>
ix -> Dim -> (Int -> Int) -> (Int, ix)
modifyDim' ix
ix Dim
dim (\Int
i -> Int
k forall a. Num a => a -> a -> a
- Int
i forall a. Num a => a -> a -> a
- Int
1))
{-# INLINE reverseM #-}
reverse'
:: forall r ix e
. (HasCallStack, Index ix, Source r e)
=> Dim
-> Array r ix e
-> Array D ix e
reverse' :: forall r ix e.
(HasCallStack, Index ix, Source r e) =>
Dim -> Array r ix e -> Array D ix e
reverse' Dim
dim = forall a. HasCallStack => Either SomeException a -> a
throwEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r ix e (m :: * -> *).
(MonadThrow m, Index ix, Source r e) =>
Dim -> Array r ix e -> m (Array D ix e)
reverseM Dim
dim
{-# INLINE reverse' #-}
backpermuteM
:: forall r ix e r' ix' m
. (Manifest r e, Index ix, Source r' e, Index ix', MonadUnliftIO m, PrimMonad m, MonadThrow m)
=> Sz ix
-> (ix -> ix')
-> Array r' ix' e
-> m (Array r ix e)
backpermuteM :: forall r ix e r' ix' (m :: * -> *).
(Manifest r e, Index ix, Source r' e, Index ix', MonadUnliftIO m,
PrimMonad m, MonadThrow m) =>
Sz ix -> (ix -> ix') -> Array r' ix' e -> m (Array r ix e)
backpermuteM Sz ix
sz ix -> ix'
ixF !Array r' ix' e
arr = forall r ix e (m :: * -> *).
(MonadUnliftIO m, Manifest r e, Index ix) =>
Comp -> Sz ix -> (ix -> m e) -> m (Array r ix e)
generateArray (forall r ix e. Strategy r => Array r ix e -> Comp
getComp Array r' ix' e
arr) Sz ix
sz (forall ix r e (m :: * -> *).
(Index ix, Source r e, MonadThrow m) =>
Array r ix e -> ix -> m e
evaluateM Array r' ix' e
arr forall b c a. (b -> c) -> (a -> b) -> a -> c
. ix -> ix'
ixF)
{-# INLINE backpermuteM #-}
backpermute'
:: forall r ix ix' e
. (HasCallStack, Source r e, Index ix, Index ix')
=> Sz ix'
-> (ix' -> ix)
-> Array r ix e
-> Array D ix' e
backpermute' :: forall r ix ix' e.
(HasCallStack, Source r e, Index ix, Index ix') =>
Sz ix' -> (ix' -> ix) -> Array r ix e -> Array D ix' e
backpermute' Sz ix'
sz ix' -> ix
ixF !Array r ix e
arr = forall r ix e.
Load r ix e =>
Comp -> Sz ix -> (ix -> e) -> Array r ix e
makeArray (forall r ix e. Strategy r => Array r ix e -> Comp
getComp Array r ix e
arr) Sz ix'
sz (forall ix r e.
(HasCallStack, Index ix, Source r e) =>
Array r ix e -> ix -> e
evaluate' Array r ix e
arr forall b c a. (b -> c) -> (a -> b) -> a -> c
. ix' -> ix
ixF)
{-# INLINE backpermute' #-}
appendM
:: forall r1 r2 ix e m
. (MonadThrow m, Index ix, Source r1 e, Source r2 e)
=> Dim
-> Array r1 ix e
-> Array r2 ix e
-> m (Array DL ix e)
appendM :: forall r1 r2 ix e (m :: * -> *).
(MonadThrow m, Index ix, Source r1 e, Source r2 e) =>
Dim -> Array r1 ix e -> Array r2 ix e -> m (Array DL ix e)
appendM Dim
n !Array r1 ix e
arr1 !Array r2 ix e
arr2 = do
let !sz1 :: Sz ix
sz1 = forall r ix e. Size r => Array r ix e -> Sz ix
size Array r1 ix e
arr1
!sz2 :: Sz ix
sz2 = forall r ix e. Size r => Array r ix e -> Sz ix
size Array r2 ix e
arr2
(Sz Int
k1, Sz (Lower ix)
szl1) <- forall (m :: * -> *) ix.
(MonadThrow m, Index ix) =>
Sz ix -> Dim -> m (Sz Int, Sz (Lower ix))
pullOutSzM Sz ix
sz1 Dim
n
(Sz Int
k2, Sz (Lower ix)
szl2) <- forall (m :: * -> *) ix.
(MonadThrow m, Index ix) =>
Sz ix -> Dim -> m (Sz Int, Sz (Lower ix))
pullOutSzM Sz ix
sz2 Dim
n
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Sz (Lower ix)
szl1 forall a. Eq a => a -> a -> Bool
== Sz (Lower ix)
szl2) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ forall ix. Index ix => Sz ix -> Sz ix -> SizeException
SizeMismatchException Sz ix
sz1 Sz ix
sz2
let !k1' :: Int
k1' = forall ix. Sz ix -> ix
unSz Sz Int
k1
Sz ix
newSz <- forall (m :: * -> *) ix.
(MonadThrow m, Index ix) =>
Sz (Lower ix) -> Dim -> Sz Int -> m (Sz ix)
insertSzM Sz (Lower ix)
szl1 Dim
n (forall ix. ix -> Sz ix
SafeSz (Int
k1' forall a. Num a => a -> a -> a
+ forall ix. Sz ix -> ix
unSz Sz Int
k2))
let load :: Loader e
load :: Loader e
load Scheduler s ()
scheduler !Int
startAt Int -> e -> ST s ()
dlWrite Int -> Sz Int -> e -> ST s ()
_dlSet = do
forall s (m :: * -> *) a.
MonadPrimBase s m =>
Scheduler s a -> m a -> m ()
scheduleWork Scheduler s ()
scheduler forall a b. (a -> b) -> a -> b
$
forall ix (f :: * -> *) a.
(Index ix, Applicative f) =>
ix -> ix -> ix -> (Int -> Int -> Bool) -> (ix -> f a) -> f ()
iterA_ forall ix. Index ix => ix
zeroIndex (forall ix. Sz ix -> ix
unSz Sz ix
sz1) (forall ix. Index ix => Int -> ix
pureIndex Int
1) forall a. Ord a => a -> a -> Bool
(<) forall a b. (a -> b) -> a -> b
$ \ix
ix ->
Int -> e -> ST s ()
dlWrite (Int
startAt forall a. Num a => a -> a -> a
+ forall ix. Index ix => Sz ix -> ix -> Int
toLinearIndex Sz ix
newSz ix
ix) (forall r e ix. (Source r e, Index ix) => Array r ix e -> ix -> e
unsafeIndex Array r1 ix e
arr1 ix
ix)
forall s (m :: * -> *) a.
MonadPrimBase s m =>
Scheduler s a -> m a -> m ()
scheduleWork Scheduler s ()
scheduler forall a b. (a -> b) -> a -> b
$
forall ix (f :: * -> *) a.
(Index ix, Applicative f) =>
ix -> ix -> ix -> (Int -> Int -> Bool) -> (ix -> f a) -> f ()
iterA_ forall ix. Index ix => ix
zeroIndex (forall ix. Sz ix -> ix
unSz Sz ix
sz2) (forall ix. Index ix => Int -> ix
pureIndex Int
1) forall a. Ord a => a -> a -> Bool
(<) forall a b. (a -> b) -> a -> b
$ \ix
ix ->
let i :: Int
i = forall ix. (HasCallStack, Index ix) => ix -> Dim -> Int
getDim' ix
ix Dim
n
ix' :: ix
ix' = forall ix. (HasCallStack, Index ix) => ix -> Dim -> Int -> ix
setDim' ix
ix Dim
n (Int
i forall a. Num a => a -> a -> a
+ Int
k1')
in Int -> e -> ST s ()
dlWrite (Int
startAt forall a. Num a => a -> a -> a
+ forall ix. Index ix => Sz ix -> ix -> Int
toLinearIndex Sz ix
newSz ix
ix') (forall r e ix. (Source r e, Index ix) => Array r ix e -> ix -> e
unsafeIndex Array r2 ix e
arr2 ix
ix)
{-# INLINE load #-}
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
DLArray
{ dlComp :: Comp
dlComp = forall r ix e. Strategy r => Array r ix e -> Comp
getComp Array r1 ix e
arr1 forall a. Semigroup a => a -> a -> a
<> forall r ix e. Strategy r => Array r ix e -> Comp
getComp Array r2 ix e
arr2
, dlSize :: Sz ix
dlSize = Sz ix
newSz
, dlLoad :: Loader e
dlLoad = Loader e
load
}
{-# INLINE appendM #-}
append'
:: forall r1 r2 ix e
. (HasCallStack, Index ix, Source r1 e, Source r2 e)
=> Dim
-> Array r1 ix e
-> Array r2 ix e
-> Array DL ix e
append' :: forall r1 r2 ix e.
(HasCallStack, Index ix, Source r1 e, Source r2 e) =>
Dim -> Array r1 ix e -> Array r2 ix e -> Array DL ix e
append' Dim
dim Array r1 ix e
arr1 Array r2 ix e
arr2 = forall a. HasCallStack => Either SomeException a -> a
throwEither forall a b. (a -> b) -> a -> b
$ forall r1 r2 ix e (m :: * -> *).
(MonadThrow m, Index ix, Source r1 e, Source r2 e) =>
Dim -> Array r1 ix e -> Array r2 ix e -> m (Array DL ix e)
appendM Dim
dim Array r1 ix e
arr1 Array r2 ix e
arr2
{-# INLINE append' #-}
concat'
:: forall f r ix e
. (HasCallStack, Foldable f, Index ix, Source r e)
=> Dim
-> f (Array r ix e)
-> Array DL ix e
concat' :: forall (f :: * -> *) r ix e.
(HasCallStack, Foldable f, Index ix, Source r e) =>
Dim -> f (Array r ix e) -> Array DL ix e
concat' Dim
n = forall a. HasCallStack => Either SomeException a -> a
throwEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r ix e (f :: * -> *) (m :: * -> *).
(MonadThrow m, Foldable f, Index ix, Source r e) =>
Dim -> f (Array r ix e) -> m (Array DL ix e)
concatM Dim
n
{-# INLINE concat' #-}
concatM
:: forall r ix e f m
. (MonadThrow m, Foldable f, Index ix, Source r e)
=> Dim
-> f (Array r ix e)
-> m (Array DL ix e)
concatM :: forall r ix e (f :: * -> *) (m :: * -> *).
(MonadThrow m, Foldable f, Index ix, Source r e) =>
Dim -> f (Array r ix e) -> m (Array DL ix e)
concatM Dim
n f (Array r ix e)
arrsF =
case forall a. [a] -> Maybe (a, [a])
L.uncons (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList f (Array r ix e)
arrsF) of
Maybe (Array r ix e, [Array r ix e])
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall r ix e. Load r ix e => Array r ix e
empty
Just (Array r ix e
a, [Array r ix e]
arrs) -> do
let sz :: ix
sz = forall ix. Sz ix -> ix
unSz (forall r ix e. Size r => Array r ix e -> Sz ix
size Array r ix e
a)
szs :: [ix]
szs = forall ix. Sz ix -> ix
unSz forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r ix e. Size r => Array r ix e -> Sz ix
size forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Array r ix e]
arrs
(Int
k, Lower ix
szl) <- forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> m (Int, Lower ix)
pullOutDimM ix
sz Dim
n
([Int]
ks, [Lower ix]
szls) <-
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
F.foldrM (\ !ix
csz ([Int]
ks, [Lower ix]
szls) -> forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall a. a -> [a] -> [a]
: [Int]
ks) (forall a. a -> [a] -> [a]
: [Lower ix]
szls) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> m (Int, Lower ix)
pullOutDimM ix
csz Dim
n) ([], []) [ix]
szs
forall (f :: * -> *) (t :: * -> *) a.
(Applicative f, Foldable t) =>
(a -> f ()) -> t a -> f ()
traverse_
(\(ix
sz', Lower ix
_) -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (forall ix. Index ix => Sz ix -> Sz ix -> SizeException
SizeMismatchException (forall ix. ix -> Sz ix
SafeSz ix
sz) (forall ix. ix -> Sz ix
SafeSz ix
sz')))
(forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((forall a. Eq a => a -> a -> Bool
== Lower ix
szl) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
P.zip [ix]
szs [Lower ix]
szls)
let kTotal :: Sz Int
kTotal = forall ix. ix -> Sz ix
SafeSz forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' forall a. Num a => a -> a -> a
(+) Int
k [Int]
ks
Sz ix
newSz <- forall (m :: * -> *) ix.
(MonadThrow m, Index ix) =>
Sz (Lower ix) -> Dim -> Sz Int -> m (Sz ix)
insertSzM (forall ix. ix -> Sz ix
SafeSz Lower ix
szl) Dim
n Sz Int
kTotal
let load :: Loader e
load :: Loader e
load Scheduler s ()
scheduler Int
startAt Int -> e -> ST s ()
dlWrite Int -> Sz Int -> e -> ST s ()
_dlSet =
let arrayLoader :: Int -> (Int, Array r ix e) -> ST s Int
arrayLoader !Int
kAcc (!Int
kCur, Array r ix e
arr) = do
forall s (m :: * -> *) a.
MonadPrimBase s m =>
Scheduler s a -> m a -> m ()
scheduleWork Scheduler s ()
scheduler forall a b. (a -> b) -> a -> b
$
forall r a ix (m :: * -> *) b.
(Source r a, Index ix, Monad m) =>
Array r ix a -> (ix -> a -> m b) -> m ()
iforM_ Array r ix e
arr forall a b. (a -> b) -> a -> b
$ \ix
ix e
e -> do
Int
i <- forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> m Int
getDimM ix
ix Dim
n
ix
ix' <- forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> Int -> m ix
setDimM ix
ix Dim
n (Int
i forall a. Num a => a -> a -> a
+ Int
kAcc)
Int -> e -> ST s ()
dlWrite (Int
startAt forall a. Num a => a -> a -> a
+ forall ix. Index ix => Sz ix -> ix -> Int
toLinearIndex Sz ix
newSz ix
ix') e
e
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! Int
kAcc forall a. Num a => a -> a -> a
+ Int
kCur
{-# INLINE arrayLoader #-}
in forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
M.foldM_ Int -> (Int, Array r ix e) -> ST s Int
arrayLoader Int
0 forall a b. (a -> b) -> a -> b
$ (Int
k, Array r ix e
a) forall a. a -> [a] -> [a]
: forall a b. [a] -> [b] -> [(a, b)]
P.zip [Int]
ks [Array r ix e]
arrs
{-# INLINE load #-}
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
DLArray{dlComp :: Comp
dlComp = forall r ix e. Strategy r => Array r ix e -> Comp
getComp Array r ix e
a forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall r ix e. Strategy r => Array r ix e -> Comp
getComp [Array r ix e]
arrs, dlSize :: Sz ix
dlSize = Sz ix
newSz, dlLoad :: Loader e
dlLoad = Loader e
load}
{-# INLINE concatM #-}
stackSlicesM
:: forall r ix e f m
. (Foldable f, MonadThrow m, Index (Lower ix), Source r e, Index ix)
=> Dim
-> f (Array r (Lower ix) e)
-> m (Array DL ix e)
stackSlicesM :: forall r ix e (f :: * -> *) (m :: * -> *).
(Foldable f, MonadThrow m, Index (Lower ix), Source r e,
Index ix) =>
Dim -> f (Array r (Lower ix) e) -> m (Array DL ix e)
stackSlicesM Dim
dim !f (Array r (Lower ix) e)
arrsF = do
case forall a. [a] -> Maybe (a, [a])
L.uncons (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList f (Array r (Lower ix) e)
arrsF) of
Maybe (Array r (Lower ix) e, [Array r (Lower ix) e])
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall r ix e. Load r ix e => Array r ix e
empty
Just (Array r (Lower ix) e
a, [Array r (Lower ix) e]
arrs) -> do
let sz :: Sz (Lower ix)
sz = forall r ix e. Size r => Array r ix e -> Sz ix
size Array r (Lower ix) e
a
len :: Sz Int
len = forall ix. ix -> Sz ix
SafeSz (forall (t :: * -> *) a. Foldable t => t a -> Int
F.length f (Array r (Lower ix) e)
arrsF)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
M.forM_ f (Array r (Lower ix) e)
arrsF forall a b. (a -> b) -> a -> b
$ \Array r (Lower ix) e
arr ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Sz (Lower ix)
sz forall a. Eq a => a -> a -> Bool
== forall r ix e. Size r => Array r ix e -> Sz ix
size Array r (Lower ix) e
arr) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (forall ix. Index ix => Sz ix -> Sz ix -> SizeException
SizeMismatchException Sz (Lower ix)
sz (forall r ix e. Size r => Array r ix e -> Sz ix
size Array r (Lower ix) e
arr))
Sz ix
newSz <- forall (m :: * -> *) ix.
(MonadThrow m, Index ix) =>
Sz (Lower ix) -> Dim -> Sz Int -> m (Sz ix)
insertSzM Sz (Lower ix)
sz Dim
dim Sz Int
len
let load :: Loader e
load :: Loader e
load Scheduler s ()
scheduler Int
startAt Int -> e -> ST s ()
dlWrite Int -> Sz Int -> e -> ST s ()
_dlSet =
let loadIndex :: Int -> Lower ix -> e -> ST s ()
loadIndex Int
k Lower ix
ix = Int -> e -> ST s ()
dlWrite (forall ix. Index ix => Sz ix -> ix -> Int
toLinearIndex Sz ix
newSz (forall ix. (HasCallStack, Index ix) => Lower ix -> Dim -> Int -> ix
insertDim' Lower ix
ix Dim
dim Int
k) forall a. Num a => a -> a -> a
+ Int
startAt)
arrayLoader :: Int -> Array r (Lower ix) e -> ST s Int
arrayLoader !Int
k Array r (Lower ix) e
arr = (Int
k forall a. Num a => a -> a -> a
+ Int
1) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) a.
MonadPrimBase s m =>
Scheduler s a -> m a -> m ()
scheduleWork Scheduler s ()
scheduler (forall ix r a (m :: * -> *) b.
(Index ix, Source r a, Monad m) =>
(ix -> a -> m b) -> Array r ix a -> m ()
imapM_ (Int -> Lower ix -> e -> ST s ()
loadIndex Int
k) Array r (Lower ix) e
arr)
{-# INLINE arrayLoader #-}
in forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
M.foldM_ Int -> Array r (Lower ix) e -> ST s Int
arrayLoader Int
0 f (Array r (Lower ix) e)
arrsF
{-# INLINE load #-}
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
DLArray{dlComp :: Comp
dlComp = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall r ix e. Strategy r => Array r ix e -> Comp
getComp [Array r (Lower ix) e]
arrs, dlSize :: Sz ix
dlSize = Sz ix
newSz, dlLoad :: Loader e
dlLoad = Loader e
load}
{-# INLINE stackSlicesM #-}
stackOuterSlicesM
:: forall r ix e f m
. (Foldable f, MonadThrow m, Index (Lower ix), Source r e, Index ix)
=> f (Array r (Lower ix) e)
-> m (Array DL ix e)
stackOuterSlicesM :: forall r ix e (f :: * -> *) (m :: * -> *).
(Foldable f, MonadThrow m, Index (Lower ix), Source r e,
Index ix) =>
f (Array r (Lower ix) e) -> m (Array DL ix e)
stackOuterSlicesM = forall r ix e (f :: * -> *) (m :: * -> *).
(Foldable f, MonadThrow m, Index (Lower ix), Source r e,
Index ix) =>
Dim -> f (Array r (Lower ix) e) -> m (Array DL ix e)
stackSlicesM (forall ix (proxy :: * -> *). Index ix => proxy ix -> Dim
dimensions (forall {k} (t :: k). Proxy t
Proxy :: Proxy ix))
{-# INLINE stackOuterSlicesM #-}
stackInnerSlicesM
:: forall r ix e f m
. (Foldable f, MonadThrow m, Index (Lower ix), Source r e, Index ix)
=> f (Array r (Lower ix) e)
-> m (Array DL ix e)
stackInnerSlicesM :: forall r ix e (f :: * -> *) (m :: * -> *).
(Foldable f, MonadThrow m, Index (Lower ix), Source r e,
Index ix) =>
f (Array r (Lower ix) e) -> m (Array DL ix e)
stackInnerSlicesM = forall r ix e (f :: * -> *) (m :: * -> *).
(Foldable f, MonadThrow m, Index (Lower ix), Source r e,
Index ix) =>
Dim -> f (Array r (Lower ix) e) -> m (Array DL ix e)
stackSlicesM Dim
1
{-# INLINE stackInnerSlicesM #-}
splitAtM
:: forall r ix e m
. (MonadThrow m, Index ix, Source r e)
=> Dim
-> Int
-> Array r ix e
-> m (Array D ix e, Array D ix e)
splitAtM :: forall r ix e (m :: * -> *).
(MonadThrow m, Index ix, Source r e) =>
Dim -> Int -> Array r ix e -> m (Array D ix e, Array D ix e)
splitAtM Dim
dim Int
i Array r ix e
arr = do
let Sz ix
sz = forall r ix e. Size r => Array r ix e -> Sz ix
size Array r ix e
arr
ix
eIx <- forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> Int -> m ix
setDimM ix
sz Dim
dim Int
i
ix
sIx <- forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> Int -> m ix
setDimM forall ix. Index ix => ix
zeroIndex Dim
dim Int
i
Array D ix e
arr1 <- forall r ix e (m :: * -> *).
(MonadThrow m, Index ix, Source r e) =>
ix -> ix -> Array r ix e -> m (Array D ix e)
extractFromToM forall ix. Index ix => ix
zeroIndex ix
eIx Array r ix e
arr
Array D ix e
arr2 <- forall r ix e (m :: * -> *).
(MonadThrow m, Index ix, Source r e) =>
ix -> ix -> Array r ix e -> m (Array D ix e)
extractFromToM ix
sIx ix
sz Array r ix e
arr
forall (m :: * -> *) a. Monad m => a -> m a
return (Array D ix e
arr1, Array D ix e
arr2)
{-# INLINE splitAtM #-}
splitAt'
:: forall r ix e
. (HasCallStack, Index ix, Source r e)
=> Dim
-> Int
-> Array r ix e
-> (Array D ix e, Array D ix e)
splitAt' :: forall r ix e.
(HasCallStack, Index ix, Source r e) =>
Dim -> Int -> Array r ix e -> (Array D ix e, Array D ix e)
splitAt' Dim
dim Int
i = forall a. HasCallStack => Either SomeException a -> a
throwEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r ix e (m :: * -> *).
(MonadThrow m, Index ix, Source r e) =>
Dim -> Int -> Array r ix e -> m (Array D ix e, Array D ix e)
splitAtM Dim
dim Int
i
{-# INLINE splitAt' #-}
splitExtractM
:: forall r ix e m
. (MonadThrow m, Index ix, Source r e)
=> Dim
-> Ix1
-> Sz Ix1
-> Array r ix e
-> m (Array D ix e, Array D ix e, Array D ix e)
Dim
dim Int
startIx1 (Sz Int
extractSzIx1) Array r ix e
arr = do
let Sz ix
szIx = forall r ix e. Size r => Array r ix e -> Sz ix
size Array r ix e
arr
ix
midStartIx <- forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> Int -> m ix
setDimM forall ix. Index ix => ix
zeroIndex Dim
dim Int
startIx1
ix
midExtractSzIx <- forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> Int -> m ix
setDimM ix
szIx Dim
dim Int
extractSzIx1
Array D ix e
midArr <- forall r ix e (m :: * -> *).
(MonadThrow m, Index ix, Source r e) =>
ix -> Sz ix -> Array r ix e -> m (Array D ix e)
extractM ix
midStartIx (forall ix. Index ix => ix -> Sz ix
Sz ix
midExtractSzIx) Array r ix e
arr
ix
leftArrSzIx <- forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> Int -> m ix
setDimM ix
szIx Dim
dim Int
startIx1
Array D ix e
leftArr <- forall r ix e (m :: * -> *).
(MonadThrow m, Index ix, Source r e) =>
ix -> Sz ix -> Array r ix e -> m (Array D ix e)
extractM forall ix. Index ix => ix
zeroIndex (forall ix. Index ix => ix -> Sz ix
Sz ix
leftArrSzIx) Array r ix e
arr
ix
rightArrStartIx <- forall ix (m :: * -> *).
(Index ix, MonadThrow m) =>
ix -> Dim -> Int -> m ix
setDimM forall ix. Index ix => ix
zeroIndex Dim
dim (Int
startIx1 forall a. Num a => a -> a -> a
+ Int
extractSzIx1)
Array D ix e
rightArr <- forall r ix e (m :: * -> *).
(MonadThrow m, Index ix, Source r e) =>
ix -> ix -> Array r ix e -> m (Array D ix e)
extractFromToM ix
rightArrStartIx ix
szIx Array r ix e
arr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Array D ix e
leftArr, Array D ix e
midArr, Array D ix e
rightArr)
{-# INLINE splitExtractM #-}
replaceSlice
:: forall r r' ix e m
. (MonadThrow m, Source r e, Source r' e, Index ix, Index (Lower ix))
=> Dim
-> Ix1
-> Array r' (Lower ix) e
-> Array r ix e
-> m (Array DL ix e)
replaceSlice :: forall r r' ix e (m :: * -> *).
(MonadThrow m, Source r e, Source r' e, Index ix,
Index (Lower ix)) =>
Dim
-> Int
-> Array r' (Lower ix) e
-> Array r ix e
-> m (Array DL ix e)
replaceSlice Dim
dim Int
i Array r' (Lower ix) e
sl Array r ix e
arr = do
(Array D ix e
l, Array D ix e
m, Array D ix e
r) <- forall r ix e (m :: * -> *).
(MonadThrow m, Index ix, Source r e) =>
Dim
-> Int
-> Sz Int
-> Array r ix e
-> m (Array D ix e, Array D ix e, Array D ix e)
splitExtractM Dim
dim Int
i (forall ix. ix -> Sz ix
SafeSz Int
1) Array r ix e
arr
Array r' ix e
m' <- forall r ix ix' e (m :: * -> *).
(MonadThrow m, Index ix', Index ix, Size r) =>
Sz ix' -> Array r ix e -> m (Array r ix' e)
resizeM (forall r ix e. Size r => Array r ix e -> Sz ix
size Array D ix e
m) Array r' (Lower ix) e
sl
forall r ix e (f :: * -> *) (m :: * -> *).
(MonadThrow m, Foldable f, Index ix, Source r e) =>
Dim -> f (Array r ix e) -> m (Array DL ix e)
concatM Dim
dim [Array D ix e
l, forall ix r e.
(Index ix, Source r e) =>
Array r ix e -> Array D ix e
delay Array r' ix e
m', Array D ix e
r]
{-# INLINE replaceSlice #-}
replaceOuterSlice
:: forall r ix e m
. (MonadThrow m, Index ix, Source r e, Load r (Lower ix) e)
=> Ix1
-> Array r (Lower ix) e
-> Array r ix e
-> m (Array DL ix e)
replaceOuterSlice :: forall r ix e (m :: * -> *).
(MonadThrow m, Index ix, Source r e, Load r (Lower ix) e) =>
Int -> Array r (Lower ix) e -> Array r ix e -> m (Array DL ix e)
replaceOuterSlice Int
i Array r (Lower ix) e
sl Array r ix e
arr = forall r r' ix e (m :: * -> *).
(MonadThrow m, Source r e, Source r' e, Index ix,
Index (Lower ix)) =>
Dim
-> Int
-> Array r' (Lower ix) e
-> Array r ix e
-> m (Array DL ix e)
replaceSlice (forall ix (proxy :: * -> *). Index ix => proxy ix -> Dim
dimensions (forall r ix e. Size r => Array r ix e -> Sz ix
size Array r ix e
arr)) Int
i Array r (Lower ix) e
sl Array r ix e
arr
{-# INLINE replaceOuterSlice #-}
deleteRegionM
:: forall r ix e m
. (MonadThrow m, Index ix, Source r e)
=> Dim
-> Ix1
-> Sz Ix1
-> Array r ix e
-> m (Array DL ix e)
deleteRegionM :: forall r ix e (m :: * -> *).
(MonadThrow m, Index ix, Source r e) =>
Dim -> Int -> Sz Int -> Array r ix e -> m (Array DL ix e)
deleteRegionM Dim
dim Int
ix Sz Int
sz Array r ix e
arr = do
(Array D ix e
leftArr, Array D ix e
_, Array D ix e
rightArr) <- forall r ix e (m :: * -> *).
(MonadThrow m, Index ix, Source r e) =>
Dim
-> Int
-> Sz Int
-> Array r ix e
-> m (Array D ix e, Array D ix e, Array D ix e)
splitExtractM Dim
dim Int
ix Sz Int
sz Array r ix e
arr
forall r1 r2 ix e (m :: * -> *).
(MonadThrow m, Index ix, Source r1 e, Source r2 e) =>
Dim -> Array r1 ix e -> Array r2 ix e -> m (Array DL ix e)
appendM Dim
dim Array D ix e
leftArr Array D ix e
rightArr
{-# INLINE deleteRegionM #-}
deleteRowsM
:: forall r ix e m
. (MonadThrow m, Index ix, Index (Lower ix), Source r e)
=> Ix1
-> Sz Ix1
-> Array r ix e
-> m (Array DL ix e)
deleteRowsM :: forall r ix e (m :: * -> *).
(MonadThrow m, Index ix, Index (Lower ix), Source r e) =>
Int -> Sz Int -> Array r ix e -> m (Array DL ix e)
deleteRowsM = forall r ix e (m :: * -> *).
(MonadThrow m, Index ix, Source r e) =>
Dim -> Int -> Sz Int -> Array r ix e -> m (Array DL ix e)
deleteRegionM Dim
2
{-# INLINE deleteRowsM #-}
deleteColumnsM
:: forall r ix e m
. (MonadThrow m, Index ix, Source r e)
=> Ix1
-> Sz Ix1
-> Array r ix e
-> m (Array DL ix e)
deleteColumnsM :: forall r ix e (m :: * -> *).
(MonadThrow m, Index ix, Source r e) =>
Int -> Sz Int -> Array r ix e -> m (Array DL ix e)
deleteColumnsM = forall r ix e (m :: * -> *).
(MonadThrow m, Index ix, Source r e) =>
Dim -> Int -> Sz Int -> Array r ix e -> m (Array DL ix e)
deleteRegionM Dim
1
{-# INLINE deleteColumnsM #-}
downsample
:: forall r ix e
. (Source r e, Load r ix e)
=> Stride ix
-> Array r ix e
-> Array DL ix e
downsample :: forall r ix e.
(Source r e, Load r ix e) =>
Stride ix -> Array r ix e -> Array DL ix e
downsample Stride ix
stride Array r ix e
arr =
DLArray{dlComp :: Comp
dlComp = forall r ix e. Strategy r => Array r ix e -> Comp
getComp Array r ix e
arr, dlSize :: Sz ix
dlSize = Sz ix
resultSize, dlLoad :: Loader e
dlLoad = Loader e
load}
where
resultSize :: Sz ix
resultSize = forall ix. Index ix => Stride ix -> Sz ix -> Sz ix
strideSize Stride ix
stride (forall r ix e. Size r => Array r ix e -> Sz ix
size Array r ix e
arr)
strideIx :: ix
strideIx = forall ix. Stride ix -> ix
unStride Stride ix
stride
unsafeLinearWriteWithStride :: Int -> e
unsafeLinearWriteWithStride =
forall r e ix. (Source r e, Index ix) => Array r ix e -> ix -> e
unsafeIndex Array r ix e
arr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ix. Index ix => (Int -> Int -> Int) -> ix -> ix -> ix
liftIndex2 forall a. Num a => a -> a -> a
(*) ix
strideIx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ix. Index ix => Sz ix -> Int -> ix
fromLinearIndex Sz ix
resultSize
{-# INLINE unsafeLinearWriteWithStride #-}
load :: Loader e
load :: Loader e
load Scheduler s ()
scheduler Int
startAt Int -> e -> ST s ()
dlWrite Int -> Sz Int -> e -> ST s ()
_ =
forall s (m :: * -> *) b c.
MonadPrimBase s m =>
Scheduler s ()
-> Int -> Int -> (Int -> m b) -> (Int -> b -> m c) -> m ()
splitLinearlyWithStartAtM_
Scheduler s ()
scheduler
Int
startAt
(forall ix. Index ix => Sz ix -> Int
totalElem Sz ix
resultSize)
(forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> e
unsafeLinearWriteWithStride)
Int -> e -> ST s ()
dlWrite
{-# INLINE load #-}
{-# INLINE downsample #-}
upsample
:: forall r ix e
. Load r ix e
=> e
-> Stride ix
-> Array r ix e
-> Array DL ix e
upsample :: forall r ix e.
Load r ix e =>
e -> Stride ix -> Array r ix e -> Array DL ix e
upsample !e
fillWith Stride ix
safeStride Array r ix e
arr =
DLArray
{ dlComp :: Comp
dlComp = forall r ix e. Strategy r => Array r ix e -> Comp
getComp Array r ix e
arr
, dlSize :: Sz ix
dlSize = Sz ix
newsz
, dlLoad :: Loader e
dlLoad = Loader e
load
}
where
load :: Loader e
load :: Loader e
load Scheduler s ()
scheduler Int
startAt Int -> e -> ST s ()
uWrite Int -> Sz Int -> e -> ST s ()
uSet = do
Int -> Sz Int -> e -> ST s ()
uSet Int
startAt (forall ix. Index ix => Sz ix -> Sz Int
toLinearSz Sz ix
newsz) e
fillWith
forall r ix e s.
Load r ix e =>
Scheduler s () -> Array r ix e -> (Int -> e -> ST s ()) -> ST s ()
iterArrayLinearST_ Scheduler s ()
scheduler Array r ix e
arr (\Int
i -> Int -> e -> ST s ()
uWrite (Int -> Int
adjustLinearStride (Int
i forall a. Num a => a -> a -> a
+ Int
startAt)))
{-# INLINE load #-}
adjustLinearStride :: Int -> Int
adjustLinearStride = forall ix. Index ix => Sz ix -> ix -> Int
toLinearIndex Sz ix
newsz forall b c a. (b -> c) -> (a -> b) -> a -> c
. ix -> ix
timesStride forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ix. Index ix => Sz ix -> Int -> ix
fromLinearIndex Sz ix
sz
{-# INLINE adjustLinearStride #-}
timesStride :: ix -> ix
timesStride !ix
ix = forall ix. Index ix => (Int -> Int -> Int) -> ix -> ix -> ix
liftIndex2 forall a. Num a => a -> a -> a
(*) ix
stride ix
ix
{-# INLINE timesStride #-}
!stride :: ix
stride = forall ix. Stride ix -> ix
unStride Stride ix
safeStride
~Sz ix
sz = forall r ix e. Shape r ix => Array r ix e -> Sz ix
outerSize Array r ix e
arr
!newsz :: Sz ix
newsz = forall ix. ix -> Sz ix
SafeSz (ix -> ix
timesStride forall a b. (a -> b) -> a -> b
$ forall ix. Sz ix -> ix
unSz Sz ix
sz)
{-# INLINE upsample #-}
transformM
:: forall r ix e r' ix' e' a m
. (Manifest r e, Index ix, Source r' e', Index ix', MonadUnliftIO m, PrimMonad m, MonadThrow m)
=> (Sz ix' -> m (Sz ix, a))
-> (a -> (ix' -> m e') -> ix -> m e)
-> Array r' ix' e'
-> m (Array r ix e)
transformM :: forall r ix e r' ix' e' a (m :: * -> *).
(Manifest r e, Index ix, Source r' e', Index ix', MonadUnliftIO m,
PrimMonad m, MonadThrow m) =>
(Sz ix' -> m (Sz ix, a))
-> (a -> (ix' -> m e') -> ix -> m e)
-> Array r' ix' e'
-> m (Array r ix e)
transformM Sz ix' -> m (Sz ix, a)
getSzM a -> (ix' -> m e') -> ix -> m e
getM Array r' ix' e'
arr = do
(Sz ix
sz, a
a) <- Sz ix' -> m (Sz ix, a)
getSzM (forall r ix e. Size r => Array r ix e -> Sz ix
size Array r' ix' e'
arr)
forall r ix e (m :: * -> *).
(MonadUnliftIO m, Manifest r e, Index ix) =>
Comp -> Sz ix -> (ix -> m e) -> m (Array r ix e)
generateArray (forall r ix e. Strategy r => Array r ix e -> Comp
getComp Array r' ix' e'
arr) Sz ix
sz (a -> (ix' -> m e') -> ix -> m e
getM a
a (forall ix r e (m :: * -> *).
(Index ix, Source r e, MonadThrow m) =>
Array r ix e -> ix -> m e
evaluateM Array r' ix' e'
arr))
{-# INLINE transformM #-}
transform'
:: forall ix e r' ix' e' a
. (HasCallStack, Source r' e', Index ix', Index ix)
=> (Sz ix' -> (Sz ix, a))
-> (a -> (ix' -> e') -> ix -> e)
-> Array r' ix' e'
-> Array D ix e
transform' :: forall ix e r' ix' e' a.
(HasCallStack, Source r' e', Index ix', Index ix) =>
(Sz ix' -> (Sz ix, a))
-> (a -> (ix' -> e') -> ix -> e) -> Array r' ix' e' -> Array D ix e
transform' Sz ix' -> (Sz ix, a)
getSz a -> (ix' -> e') -> ix -> e
get Array r' ix' e'
arr = forall r ix e.
Load r ix e =>
Comp -> Sz ix -> (ix -> e) -> Array r ix e
makeArray (forall r ix e. Strategy r => Array r ix e -> Comp
getComp Array r' ix' e'
arr) Sz ix
sz (a -> (ix' -> e') -> ix -> e
get a
a (forall ix r e.
(HasCallStack, Index ix, Source r e) =>
Array r ix e -> ix -> e
evaluate' Array r' ix' e'
arr))
where
(Sz ix
sz, a
a) = Sz ix' -> (Sz ix, a)
getSz (forall r ix e. Size r => Array r ix e -> Sz ix
size Array r' ix' e'
arr)
{-# INLINE transform' #-}
transform2M
:: ( Manifest r e
, Index ix
, Source r1 e1
, Source r2 e2
, Index ix1
, Index ix2
, MonadUnliftIO m
, PrimMonad m
, MonadThrow m
)
=> (Sz ix1 -> Sz ix2 -> m (Sz ix, a))
-> (a -> (ix1 -> m e1) -> (ix2 -> m e2) -> ix -> m e)
-> Array r1 ix1 e1
-> Array r2 ix2 e2
-> m (Array r ix e)
transform2M :: forall r e ix r1 e1 r2 e2 ix1 ix2 (m :: * -> *) a.
(Manifest r e, Index ix, Source r1 e1, Source r2 e2, Index ix1,
Index ix2, MonadUnliftIO m, PrimMonad m, MonadThrow m) =>
(Sz ix1 -> Sz ix2 -> m (Sz ix, a))
-> (a -> (ix1 -> m e1) -> (ix2 -> m e2) -> ix -> m e)
-> Array r1 ix1 e1
-> Array r2 ix2 e2
-> m (Array r ix e)
transform2M Sz ix1 -> Sz ix2 -> m (Sz ix, a)
getSzM a -> (ix1 -> m e1) -> (ix2 -> m e2) -> ix -> m e
getM Array r1 ix1 e1
arr1 Array r2 ix2 e2
arr2 = do
(Sz ix
sz, a
a) <- Sz ix1 -> Sz ix2 -> m (Sz ix, a)
getSzM (forall r ix e. Size r => Array r ix e -> Sz ix
size Array r1 ix1 e1
arr1) (forall r ix e. Size r => Array r ix e -> Sz ix
size Array r2 ix2 e2
arr2)
forall r ix e (m :: * -> *).
(MonadUnliftIO m, Manifest r e, Index ix) =>
Comp -> Sz ix -> (ix -> m e) -> m (Array r ix e)
generateArray (forall r ix e. Strategy r => Array r ix e -> Comp
getComp Array r1 ix1 e1
arr1 forall a. Semigroup a => a -> a -> a
<> forall r ix e. Strategy r => Array r ix e -> Comp
getComp Array r2 ix2 e2
arr2) Sz ix
sz (a -> (ix1 -> m e1) -> (ix2 -> m e2) -> ix -> m e
getM a
a (forall ix r e (m :: * -> *).
(Index ix, Source r e, MonadThrow m) =>
Array r ix e -> ix -> m e
evaluateM Array r1 ix1 e1
arr1) (forall ix r e (m :: * -> *).
(Index ix, Source r e, MonadThrow m) =>
Array r ix e -> ix -> m e
evaluateM Array r2 ix2 e2
arr2))
{-# INLINE transform2M #-}
transform2'
:: (HasCallStack, Source r1 e1, Source r2 e2, Index ix, Index ix1, Index ix2)
=> (Sz ix1 -> Sz ix2 -> (Sz ix, a))
-> (a -> (ix1 -> e1) -> (ix2 -> e2) -> ix -> e)
-> Array r1 ix1 e1
-> Array r2 ix2 e2
-> Array D ix e
transform2' :: forall r1 e1 r2 e2 ix ix1 ix2 a e.
(HasCallStack, Source r1 e1, Source r2 e2, Index ix, Index ix1,
Index ix2) =>
(Sz ix1 -> Sz ix2 -> (Sz ix, a))
-> (a -> (ix1 -> e1) -> (ix2 -> e2) -> ix -> e)
-> Array r1 ix1 e1
-> Array r2 ix2 e2
-> Array D ix e
transform2' Sz ix1 -> Sz ix2 -> (Sz ix, a)
getSz a -> (ix1 -> e1) -> (ix2 -> e2) -> ix -> e
get Array r1 ix1 e1
arr1 Array r2 ix2 e2
arr2 =
forall r ix e.
Load r ix e =>
Comp -> Sz ix -> (ix -> e) -> Array r ix e
makeArray (forall r ix e. Strategy r => Array r ix e -> Comp
getComp Array r1 ix1 e1
arr1 forall a. Semigroup a => a -> a -> a
<> forall r ix e. Strategy r => Array r ix e -> Comp
getComp Array r2 ix2 e2
arr2) Sz ix
sz (a -> (ix1 -> e1) -> (ix2 -> e2) -> ix -> e
get a
a (forall ix r e.
(HasCallStack, Index ix, Source r e) =>
Array r ix e -> ix -> e
evaluate' Array r1 ix1 e1
arr1) (forall ix r e.
(HasCallStack, Index ix, Source r e) =>
Array r ix e -> ix -> e
evaluate' Array r2 ix2 e2
arr2))
where
(Sz ix
sz, a
a) = Sz ix1 -> Sz ix2 -> (Sz ix, a)
getSz (forall r ix e. Size r => Array r ix e -> Sz ix
size Array r1 ix1 e1
arr1) (forall r ix e. Size r => Array r ix e -> Sz ix
size Array r2 ix2 e2
arr2)
{-# INLINE transform2' #-}
zoomWithGrid
:: forall r ix e
. (Index ix, Source r e)
=> e
-> Stride ix
-> Array r ix e
-> Array DL ix e
zoomWithGrid :: forall r ix e.
(Index ix, Source r e) =>
e -> Stride ix -> Array r ix e -> Array DL ix e
zoomWithGrid e
gridVal (Stride ix
zoomFactor) Array r ix e
arr = forall ix e.
Index ix =>
Comp
-> Sz ix
-> Maybe e
-> (forall s.
Scheduler s () -> Int -> (Int -> e -> ST s ()) -> ST s ())
-> Array DL ix e
unsafeMakeLoadArray Comp
Seq Sz ix
newSz (forall a. a -> Maybe a
Just e
gridVal) forall s. Scheduler s () -> Int -> (Int -> e -> ST s ()) -> ST s ()
load
where
!kx :: ix
kx = forall ix. Index ix => (Int -> Int) -> ix -> ix
liftIndex (forall a. Num a => a -> a -> a
+ Int
1) ix
zoomFactor
!lastNewIx :: ix
lastNewIx = forall ix. Index ix => (Int -> Int -> Int) -> ix -> ix -> ix
liftIndex2 forall a. Num a => a -> a -> a
(*) ix
kx forall a b. (a -> b) -> a -> b
$ forall ix. Sz ix -> ix
unSz (forall r ix e. Size r => Array r ix e -> Sz ix
size Array r ix e
arr)
!newSz :: Sz ix
newSz = forall ix. Index ix => ix -> Sz ix
Sz (forall ix. Index ix => (Int -> Int) -> ix -> ix
liftIndex (forall a. Num a => a -> a -> a
+ Int
1) ix
lastNewIx)
load :: forall s. Scheduler s () -> Ix1 -> (Ix1 -> e -> ST s ()) -> ST s ()
load :: forall s. Scheduler s () -> Int -> (Int -> e -> ST s ()) -> ST s ()
load Scheduler s ()
scheduler Int
_ Int -> e -> ST s ()
writeElement =
forall ix r e s (m :: * -> *) a.
(Index ix, Source r e, MonadPrimBase s m) =>
Scheduler s () -> Array r ix e -> (ix -> e -> m a) -> m ()
iforSchedulerM_ Scheduler s ()
scheduler Array r ix e
arr forall a b. (a -> b) -> a -> b
$ \ !ix
ix !e
e ->
let !kix :: ix
kix = forall ix. Index ix => (Int -> Int -> Int) -> ix -> ix -> ix
liftIndex2 forall a. Num a => a -> a -> a
(*) ix
ix ix
kx
in forall r a ix (m :: * -> *) b.
(Source r a, Index ix, Monad m) =>
(a -> m b) -> Array r ix a -> m ()
mapM_ (\ !ix
ix' -> Int -> e -> ST s ()
writeElement (forall ix. Index ix => Sz ix -> ix -> Int
toLinearIndex Sz ix
newSz ix
ix') e
e) forall a b. (a -> b) -> a -> b
$
forall ix. Index ix => Comp -> ix -> ix -> Array D ix ix
range Comp
Seq (forall ix. Index ix => (Int -> Int) -> ix -> ix
liftIndex (forall a. Num a => a -> a -> a
+ Int
1) ix
kix) (forall ix. Index ix => (Int -> Int -> Int) -> ix -> ix -> ix
liftIndex2 forall a. Num a => a -> a -> a
(+) ix
kix ix
kx)
{-# INLINE load #-}
{-# INLINE zoomWithGrid #-}
zoom
:: forall r ix e
. (Index ix, Source r e)
=> Stride ix
-> Array r ix e
-> Array DL ix e
zoom :: forall r ix e.
(Index ix, Source r e) =>
Stride ix -> Array r ix e -> Array DL ix e
zoom (Stride ix
zoomFactor) Array r ix e
arr = forall ix e.
Index ix =>
Comp
-> Sz ix
-> Maybe e
-> (forall s.
Scheduler s () -> Int -> (Int -> e -> ST s ()) -> ST s ())
-> Array DL ix e
unsafeMakeLoadArray Comp
Seq Sz ix
newSz forall a. Maybe a
Nothing forall s. Scheduler s () -> Int -> (Int -> e -> ST s ()) -> ST s ()
load
where
!lastNewIx :: ix
lastNewIx = forall ix. Index ix => (Int -> Int -> Int) -> ix -> ix -> ix
liftIndex2 forall a. Num a => a -> a -> a
(*) ix
zoomFactor forall a b. (a -> b) -> a -> b
$ forall ix. Sz ix -> ix
unSz (forall r ix e. Size r => Array r ix e -> Sz ix
size Array r ix e
arr)
!newSz :: Sz ix
newSz = forall ix. Index ix => ix -> Sz ix
Sz ix
lastNewIx
load :: forall s. Scheduler s () -> Ix1 -> (Ix1 -> e -> ST s ()) -> ST s ()
load :: forall s. Scheduler s () -> Int -> (Int -> e -> ST s ()) -> ST s ()
load Scheduler s ()
scheduler Int
_ Int -> e -> ST s ()
writeElement =
forall ix r e s (m :: * -> *) a.
(Index ix, Source r e, MonadPrimBase s m) =>
Scheduler s () -> Array r ix e -> (ix -> e -> m a) -> m ()
iforSchedulerM_ Scheduler s ()
scheduler Array r ix e
arr forall a b. (a -> b) -> a -> b
$ \ !ix
ix !e
e ->
let !kix :: ix
kix = forall ix. Index ix => (Int -> Int -> Int) -> ix -> ix -> ix
liftIndex2 forall a. Num a => a -> a -> a
(*) ix
ix ix
zoomFactor
in forall r a ix (m :: * -> *) b.
(Source r a, Index ix, Monad m) =>
(a -> m b) -> Array r ix a -> m ()
mapM_ (\ !ix
ix' -> Int -> e -> ST s ()
writeElement (forall ix. Index ix => Sz ix -> ix -> Int
toLinearIndex Sz ix
newSz ix
ix') e
e) forall a b. (a -> b) -> a -> b
$
forall ix. Index ix => Comp -> ix -> ix -> Array D ix ix
range Comp
Seq ix
kix (forall ix. Index ix => (Int -> Int -> Int) -> ix -> ix -> ix
liftIndex2 forall a. Num a => a -> a -> a
(+) ix
kix ix
zoomFactor)
{-# INLINE load #-}
{-# INLINE zoom #-}