Safe Haskell | None |
---|---|
Language | Haskell2010 |
Data.Array.XArray
Synopsis
- newtype XArray (sh :: [Maybe Nat]) a = XArray (Array (Rank sh) a)
- shape :: forall (sh :: [Maybe Nat]) a. StaticShX sh -> XArray sh a -> IShX sh
- fromVector :: forall (sh :: [Maybe Nat]) a. Storable a => IShX sh -> Vector a -> XArray sh a
- toVector :: forall a (sh :: [Maybe Nat]). Storable a => XArray sh a -> Vector a
- arrayStrides :: forall (sh :: [Maybe Nat]) a. XArray sh a -> [Int]
- scalar :: Storable a => a -> XArray ('[] :: [Maybe Nat]) a
- cast :: forall (sh1 :: [Maybe Nat]) (sh2 :: [Maybe Nat]) (sh' :: [Maybe Nat]) a. Rank sh1 ~ Rank sh2 => StaticShX sh1 -> IShX sh2 -> StaticShX sh' -> XArray (sh1 ++ sh') a -> XArray (sh2 ++ sh') a
- unScalar :: Storable a => XArray ('[] :: [Maybe Nat]) a -> a
- replicate :: forall (sh :: [Maybe Nat]) (sh' :: [Maybe Nat]) a. Storable a => IShX sh -> StaticShX sh' -> XArray sh' a -> XArray (sh ++ sh') a
- replicateScal :: forall (sh :: [Maybe Nat]) a. Storable a => IShX sh -> a -> XArray sh a
- generate :: forall a (sh :: [Maybe Nat]). Storable a => IShX sh -> (IIxX sh -> a) -> XArray sh a
- indexPartial :: forall a (sh :: [Maybe Nat]) (sh' :: [Maybe Nat]). Storable a => XArray (sh ++ sh') a -> IIxX sh -> XArray sh' a
- index :: forall (sh :: [Maybe Nat]) a. Storable a => XArray sh a -> IIxX sh -> a
- append :: forall (n :: Maybe Nat) (m :: Maybe Nat) (sh :: [Maybe Nat]) a. Storable a => StaticShX sh -> XArray (n ': sh) a -> XArray (m ': sh) a -> XArray (AddMaybe n m ': sh) a
- concat :: forall a (sh :: [Maybe Nat]). Storable a => StaticShX sh -> NonEmpty (XArray (('Nothing :: Maybe Nat) ': sh) a) -> XArray (('Nothing :: Maybe Nat) ': sh) a
- rerank :: forall (sh :: [Maybe Nat]) (sh1 :: [Maybe Nat]) (sh2 :: [Maybe Nat]) a b. (Storable a, Storable b) => StaticShX sh -> StaticShX sh1 -> StaticShX sh2 -> (XArray sh1 a -> XArray sh2 b) -> XArray (sh ++ sh1) a -> XArray (sh ++ sh2) b
- rerankTop :: forall (sh1 :: [Maybe Nat]) (sh2 :: [Maybe Nat]) (sh :: [Maybe Nat]) a b. (Storable a, Storable b) => StaticShX sh1 -> StaticShX sh2 -> StaticShX sh -> (XArray sh1 a -> XArray sh2 b) -> XArray (sh1 ++ sh) a -> XArray (sh2 ++ sh) b
- rerank2 :: forall (sh :: [Maybe Nat]) (sh1 :: [Maybe Nat]) (sh2 :: [Maybe Nat]) a b c. (Storable a, Storable b, Storable c) => StaticShX sh -> StaticShX sh1 -> StaticShX sh2 -> (XArray sh1 a -> XArray sh1 b -> XArray sh2 c) -> XArray (sh ++ sh1) a -> XArray (sh ++ sh1) b -> XArray (sh ++ sh2) c
- transpose :: forall (is :: [Natural]) (sh :: [Maybe Nat]) a. (IsPermutation is, Rank is <= Rank sh) => StaticShX sh -> Perm is -> XArray sh a -> XArray (PermutePrefix is sh) a
- transposeUntyped :: forall (n :: Nat) (sh :: [Maybe Nat]) a. SNat n -> StaticShX sh -> [Int] -> XArray (Replicate n ('Nothing :: Maybe Nat) ++ sh) a -> XArray (Replicate n ('Nothing :: Maybe Nat) ++ sh) a
- transpose2 :: forall (sh1 :: [Maybe Nat]) (sh2 :: [Maybe Nat]) a. StaticShX sh1 -> StaticShX sh2 -> XArray (sh1 ++ sh2) a -> XArray (sh2 ++ sh1) a
- sumFull :: forall a (sh :: [Maybe Nat]). (Storable a, NumElt a) => StaticShX sh -> XArray sh a -> a
- sumInner :: forall (sh :: [Maybe Nat]) (sh' :: [Maybe Nat]) a. (Storable a, NumElt a) => StaticShX sh -> StaticShX sh' -> XArray (sh ++ sh') a -> XArray sh a
- sumOuter :: forall (sh :: [Maybe Nat]) (sh' :: [Maybe Nat]) a. (Storable a, NumElt a) => StaticShX sh -> StaticShX sh' -> XArray (sh ++ sh') a -> XArray sh' a
- fromListOuter :: forall (n :: Maybe Nat) (sh :: [Maybe Nat]) a. Storable a => StaticShX (n ': sh) -> [XArray sh a] -> XArray (n ': sh) a
- toListOuter :: forall a (n :: Maybe Nat) (sh :: [Maybe Nat]). Storable a => XArray (n ': sh) a -> [XArray sh a]
- fromList1 :: forall a (n :: Maybe Nat). Storable a => StaticShX '[n] -> [a] -> XArray '[n] a
- toList1 :: forall a (n :: Maybe Nat). Storable a => XArray '[n] a -> [a]
- empty :: forall (sh :: [Maybe Nat]) a. Storable a => IShX sh -> XArray sh a
- slice :: forall (i :: Nat) (n :: Nat) (k :: Natural) (sh :: [Maybe Natural]) a. SNat i -> SNat n -> XArray ('Just ((i + n) + k) ': sh) a -> XArray ('Just n ': sh) a
- sliceU :: forall (sh :: [Maybe Nat]) a. Int -> Int -> XArray (('Nothing :: Maybe Nat) ': sh) a -> XArray (('Nothing :: Maybe Nat) ': sh) a
- rev1 :: forall (n :: Maybe Nat) (sh :: [Maybe Nat]) a. XArray (n ': sh) a -> XArray (n ': sh) a
- reshape :: forall (sh1 :: [Maybe Nat]) (sh2 :: [Maybe Nat]) a. Storable a => StaticShX sh1 -> IShX sh2 -> XArray sh1 a -> XArray sh2 a
- reshapePartial :: forall (sh1 :: [Maybe Nat]) (sh2 :: [Maybe Nat]) (sh' :: [Maybe Nat]) a. Storable a => StaticShX sh1 -> StaticShX sh' -> IShX sh2 -> XArray (sh1 ++ sh') a -> XArray (sh2 ++ sh') a
- iota :: forall a (n :: Nat). (Enum a, Storable a) => SNat n -> XArray '['Just n] a
Documentation
newtype XArray (sh :: [Maybe Nat]) a Source #
Instances
Generic (XArray sh a) Source # | |||||
Defined in Data.Array.XArray Associated Types
| |||||
(Show a, Unbox a) => Show (XArray sh a) Source # | |||||
NFData (XArray sh a) Source # | |||||
Defined in Data.Array.XArray | |||||
(Eq a, Storable a) => Eq (XArray sh a) Source # | |||||
(Ord a, Storable a) => Ord (XArray sh a) Source # | |||||
Defined in Data.Array.XArray | |||||
type Rep (XArray sh a) Source # | |||||
Defined in Data.Array.XArray |
fromVector :: forall (sh :: [Maybe Nat]) a. Storable a => IShX sh -> Vector a -> XArray sh a Source #
arrayStrides :: forall (sh :: [Maybe Nat]) a. XArray sh a -> [Int] Source #
This allows observing the strides in the underlying orthotope array. This can be useful for optimisation, but should be considered an implementation detail: strides may change in new versions of this library without notice.
cast :: forall (sh1 :: [Maybe Nat]) (sh2 :: [Maybe Nat]) (sh' :: [Maybe Nat]) a. Rank sh1 ~ Rank sh2 => StaticShX sh1 -> IShX sh2 -> StaticShX sh' -> XArray (sh1 ++ sh') a -> XArray (sh2 ++ sh') a Source #
Will throw if the array does not have the casted-to shape.
replicate :: forall (sh :: [Maybe Nat]) (sh' :: [Maybe Nat]) a. Storable a => IShX sh -> StaticShX sh' -> XArray sh' a -> XArray (sh ++ sh') a Source #
generate :: forall a (sh :: [Maybe Nat]). Storable a => IShX sh -> (IIxX sh -> a) -> XArray sh a Source #
indexPartial :: forall a (sh :: [Maybe Nat]) (sh' :: [Maybe Nat]). Storable a => XArray (sh ++ sh') a -> IIxX sh -> XArray sh' a Source #
append :: forall (n :: Maybe Nat) (m :: Maybe Nat) (sh :: [Maybe Nat]) a. Storable a => StaticShX sh -> XArray (n ': sh) a -> XArray (m ': sh) a -> XArray (AddMaybe n m ': sh) a Source #
concat :: forall a (sh :: [Maybe Nat]). Storable a => StaticShX sh -> NonEmpty (XArray (('Nothing :: Maybe Nat) ': sh) a) -> XArray (('Nothing :: Maybe Nat) ': sh) a Source #
All arrays must have the same shape, except possibly for the outermost dimension.
rerank :: forall (sh :: [Maybe Nat]) (sh1 :: [Maybe Nat]) (sh2 :: [Maybe Nat]) a b. (Storable a, Storable b) => StaticShX sh -> StaticShX sh1 -> StaticShX sh2 -> (XArray sh1 a -> XArray sh2 b) -> XArray (sh ++ sh1) a -> XArray (sh ++ sh2) b Source #
If the prefix of the shape of the input array (sh
) is empty (i.e.
contains a zero), then there is no way to deduce the full shape of the output
array (more precisely, the sh2
part): that could only come from calling
f
, and there are no subarrays to call f
on. orthotope
errors out in
this case; we choose to fill the shape with zeros wherever we cannot deduce
what it should be.
For example, if:
arr :: XArray '[Just 3, Just 0, Just 4, Just 2, Nothing] Int -- of shape [3, 0, 4, 2, 21] f :: XArray '[Just 2, Nothing] Int -> XArray '[Just 5, Nothing, Just 17] Float
then:
rerank _ _ _ f arr :: XArray '[Just 3, Just 0, Just 4, Just 5, Nothing, Just 17] Float
and this result will have shape [3, 0, 4, 5, 0, 17]
. Note the second 0
in this shape: we don't know if f
intended to return an array with shape 0
here (it probably didn't), but there is no better number to put here absent
a subarray of the input to pass to f
.
In this particular case the fact that sh
is empty was evident from the
type-level information, but the same situation occurs when sh
consists of
Nothing
s, and some of those happen to be zero at runtime.
rerankTop :: forall (sh1 :: [Maybe Nat]) (sh2 :: [Maybe Nat]) (sh :: [Maybe Nat]) a b. (Storable a, Storable b) => StaticShX sh1 -> StaticShX sh2 -> StaticShX sh -> (XArray sh1 a -> XArray sh2 b) -> XArray (sh1 ++ sh) a -> XArray (sh2 ++ sh) b Source #
rerank2 :: forall (sh :: [Maybe Nat]) (sh1 :: [Maybe Nat]) (sh2 :: [Maybe Nat]) a b c. (Storable a, Storable b, Storable c) => StaticShX sh -> StaticShX sh1 -> StaticShX sh2 -> (XArray sh1 a -> XArray sh1 b -> XArray sh2 c) -> XArray (sh ++ sh1) a -> XArray (sh ++ sh1) b -> XArray (sh ++ sh2) c Source #
The caveat about empty arrays at rerank
applies here too.
transpose :: forall (is :: [Natural]) (sh :: [Maybe Nat]) a. (IsPermutation is, Rank is <= Rank sh) => StaticShX sh -> Perm is -> XArray sh a -> XArray (PermutePrefix is sh) a Source #
The list argument gives indices into the original dimension list.
transposeUntyped :: forall (n :: Nat) (sh :: [Maybe Nat]) a. SNat n -> StaticShX sh -> [Int] -> XArray (Replicate n ('Nothing :: Maybe Nat) ++ sh) a -> XArray (Replicate n ('Nothing :: Maybe Nat) ++ sh) a Source #
The list argument gives indices into the original dimension list.
The permutation (the list) must have length <= n
. If it is longer, this
function throws.
transpose2 :: forall (sh1 :: [Maybe Nat]) (sh2 :: [Maybe Nat]) a. StaticShX sh1 -> StaticShX sh2 -> XArray (sh1 ++ sh2) a -> XArray (sh2 ++ sh1) a Source #
sumFull :: forall a (sh :: [Maybe Nat]). (Storable a, NumElt a) => StaticShX sh -> XArray sh a -> a Source #
sumInner :: forall (sh :: [Maybe Nat]) (sh' :: [Maybe Nat]) a. (Storable a, NumElt a) => StaticShX sh -> StaticShX sh' -> XArray (sh ++ sh') a -> XArray sh a Source #
sumOuter :: forall (sh :: [Maybe Nat]) (sh' :: [Maybe Nat]) a. (Storable a, NumElt a) => StaticShX sh -> StaticShX sh' -> XArray (sh ++ sh') a -> XArray sh' a Source #
fromListOuter :: forall (n :: Maybe Nat) (sh :: [Maybe Nat]) a. Storable a => StaticShX (n ': sh) -> [XArray sh a] -> XArray (n ': sh) a Source #
toListOuter :: forall a (n :: Maybe Nat) (sh :: [Maybe Nat]). Storable a => XArray (n ': sh) a -> [XArray sh a] Source #
fromList1 :: forall a (n :: Maybe Nat). Storable a => StaticShX '[n] -> [a] -> XArray '[n] a Source #
empty :: forall (sh :: [Maybe Nat]) a. Storable a => IShX sh -> XArray sh a Source #
Throws if the given shape is not, in fact, empty.
slice :: forall (i :: Nat) (n :: Nat) (k :: Natural) (sh :: [Maybe Natural]) a. SNat i -> SNat n -> XArray ('Just ((i + n) + k) ': sh) a -> XArray ('Just n ': sh) a Source #
sliceU :: forall (sh :: [Maybe Nat]) a. Int -> Int -> XArray (('Nothing :: Maybe Nat) ': sh) a -> XArray (('Nothing :: Maybe Nat) ': sh) a Source #
rev1 :: forall (n :: Maybe Nat) (sh :: [Maybe Nat]) a. XArray (n ': sh) a -> XArray (n ': sh) a Source #
reshape :: forall (sh1 :: [Maybe Nat]) (sh2 :: [Maybe Nat]) a. Storable a => StaticShX sh1 -> IShX sh2 -> XArray sh1 a -> XArray sh2 a Source #
Throws if the given array and the target shape do not have the same number of elements.