ox-arrays-0.1.0.0: An efficient CPU-based multidimensional array (tensor) library
Safe HaskellNone
LanguageHaskell2010

Data.Array.XArray

Synopsis

Documentation

newtype XArray (sh :: [Maybe Nat]) a Source #

Constructors

XArray (Array (Rank sh) a) 

Instances

Instances details
Generic (XArray sh a) Source # 
Instance details

Defined in Data.Array.XArray

Associated Types

type Rep (XArray sh a) 
Instance details

Defined in Data.Array.XArray

type Rep (XArray sh a) = D1 ('MetaData "XArray" "Data.Array.XArray" "ox-arrays-0.1.0.0-G9rS3ky7ORtC6G06Mvzq1I" 'True) (C1 ('MetaCons "XArray" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Array (Rank sh) a))))

Methods

from :: XArray sh a -> Rep (XArray sh a) x #

to :: Rep (XArray sh a) x -> XArray sh a #

(Show a, Unbox a) => Show (XArray sh a) Source # 
Instance details

Defined in Data.Array.XArray

Methods

showsPrec :: Int -> XArray sh a -> ShowS #

show :: XArray sh a -> String #

showList :: [XArray sh a] -> ShowS #

NFData (XArray sh a) Source # 
Instance details

Defined in Data.Array.XArray

Methods

rnf :: XArray sh a -> () #

(Eq a, Storable a) => Eq (XArray sh a) Source # 
Instance details

Defined in Data.Array.XArray

Methods

(==) :: XArray sh a -> XArray sh a -> Bool #

(/=) :: XArray sh a -> XArray sh a -> Bool #

(Ord a, Storable a) => Ord (XArray sh a) Source # 
Instance details

Defined in Data.Array.XArray

Methods

compare :: XArray sh a -> XArray sh a -> Ordering #

(<) :: XArray sh a -> XArray sh a -> Bool #

(<=) :: XArray sh a -> XArray sh a -> Bool #

(>) :: XArray sh a -> XArray sh a -> Bool #

(>=) :: XArray sh a -> XArray sh a -> Bool #

max :: XArray sh a -> XArray sh a -> XArray sh a #

min :: XArray sh a -> XArray sh a -> XArray sh a #

type Rep (XArray sh a) Source # 
Instance details

Defined in Data.Array.XArray

type Rep (XArray sh a) = D1 ('MetaData "XArray" "Data.Array.XArray" "ox-arrays-0.1.0.0-G9rS3ky7ORtC6G06Mvzq1I" 'True) (C1 ('MetaCons "XArray" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Array (Rank sh) a))))

shape :: forall (sh :: [Maybe Nat]) a. StaticShX sh -> XArray sh a -> IShX sh Source #

fromVector :: forall (sh :: [Maybe Nat]) a. Storable a => IShX sh -> Vector a -> XArray sh a Source #

toVector :: forall a (sh :: [Maybe Nat]). Storable a => XArray sh a -> Vector 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.

scalar :: Storable a => a -> XArray ('[] :: [Maybe Nat]) a Source #

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.

unScalar :: Storable a => XArray ('[] :: [Maybe Nat]) a -> a Source #

replicate :: forall (sh :: [Maybe Nat]) (sh' :: [Maybe Nat]) a. Storable a => IShX sh -> StaticShX sh' -> XArray sh' a -> XArray (sh ++ sh') a Source #

replicateScal :: forall (sh :: [Maybe Nat]) a. Storable a => IShX sh -> a -> XArray 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 #

index :: forall (sh :: [Maybe Nat]) a. Storable a => XArray sh a -> IIxX 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 Nothings, 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 #

toList1 :: forall a (n :: Maybe Nat). Storable a => XArray '[n] a -> [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.

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 Source #

Throws if the given array and the target shape do not have the same number of elements.

iota :: forall a (n :: Nat). (Enum a, Storable a) => SNat n -> XArray '['Just n] a Source #