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

Data.Array.Nested.Convert

Synopsis

Shape/index/list casting functions

To ranked

ixrFromIxS :: forall (sh :: [Nat]) i. IxS sh i -> IxR (Rank sh) i Source #

ixrFromIxX :: forall (sh :: [Maybe Nat]) i. IxX sh i -> IxR (Rank sh) i Source #

shrFromShS :: forall (sh :: [Nat]). ShS sh -> IShR (Rank sh) Source #

shrFromShX :: forall (sh :: [Maybe Nat]). IShX sh -> IShR (Rank sh) Source #

shrFromShX2 :: forall (n :: Natural). IShX (Replicate n ('Nothing :: Maybe Nat)) -> IShR n Source #

Convenience wrapper around shrFromShX that applies lemRankReplicate.

listrCast :: forall (n' :: Nat) (n :: Nat) i. SNat n' -> ListR n i -> ListR n' i Source #

Performs a runtime check that the lengths are identical.

ixrCast :: forall (n' :: Nat) (n :: Nat) i. SNat n' -> IxR n i -> IxR n' i Source #

Performs a runtime check that the lengths are identical.

shrCast :: forall (n' :: Nat) (n :: Nat) i. SNat n' -> ShR n i -> ShR n' i Source #

Performs a runtime check that the lengths are identical.

To shaped

ixsFromIxR :: forall (sh :: [Nat]) i. ShS sh -> IxR (Rank sh) i -> IxS sh i Source #

ixsFromIxR' :: forall (sh :: [Nat]) (n :: Nat) i. ShS sh -> IxR n i -> IxS sh i Source #

Performs a runtime check that n matches Rank sh. Equivalent to the following, but more efficient:

ixsFromIxR' sh idx = ixsFromIxR sh (ixrCast (shsRank sh) idx)

ixsFromIxX :: forall (sh :: [Nat]) i. ShS sh -> IxX (MapJust sh) i -> IxS sh i Source #

ixsFromIxX' :: forall (sh :: [Nat]) (sh' :: [Maybe Nat]) i. ShS sh -> IxX sh' i -> IxS sh i Source #

Performs a runtime check that Rank sh' match Rank sh. Equivalent to the following, but more efficient:

ixsFromIxX' sh idx = ixsFromIxX sh (ixxCast (shxFromShS sh) idx)

withShsFromShR :: forall (n :: Nat) r. IShR n -> (forall (sh :: [Nat]). Rank sh ~ n => ShS sh -> r) -> r Source #

Produce an existential ShS from an IShR.

shsFromShX :: forall (sh :: [Nat]) i. ShX (MapJust sh) i -> ShS sh Source #

withShsFromShX :: forall (sh' :: [Maybe Nat]) r. IShX sh' -> (forall (sh :: [Nat]). Rank sh ~ Rank sh' => ShS sh -> r) -> r Source #

Produce an existential ShS from an IShX. If you already know that sh' is MapJust of something, use shsFromShX instead.

shsFromSSX :: forall (sh :: [Nat]). StaticShX (MapJust sh) -> ShS sh Source #

ixsCast :: forall (sh' :: [Nat]) (sh :: [Nat]) i. ShS sh' -> IxS sh i -> IxS sh' i Source #

To mixed

ixxFromIxR :: forall (n :: Nat) i. IxR n i -> IxX (Replicate n ('Nothing :: Maybe Nat)) i Source #

ixxFromIxS :: forall (sh :: [Nat]) i. IxS sh i -> IxX (MapJust sh) i Source #

shxFromShR :: forall (n :: Nat) i. ShR n i -> ShX (Replicate n ('Nothing :: Maybe Nat)) i Source #

shxFromShS :: forall (sh :: [Nat]). ShS sh -> IShX (MapJust sh) Source #

ixxCast :: forall (sh' :: [Maybe Nat]) (sh :: [Maybe Nat]) i. StaticShX sh' -> IxX sh i -> IxX sh' i Source #

shxCast :: forall (sh' :: [Maybe Nat]) (sh :: [Maybe Nat]). StaticShX sh' -> IShX sh -> Maybe (IShX sh') Source #

shxCast' :: forall (sh' :: [Maybe Nat]) (sh :: [Maybe Nat]). StaticShX sh' -> IShX sh -> IShX sh' Source #

Partial version of shxCast.

Array conversions

convert :: (Elt a, Elt b) => Conversion a b -> a -> b Source #

data Conversion a b where Source #

The constructors that perform runtime shape checking are marked with a tick ('): ConvXS' and ConvXX'. For the other constructors, the types ensure that the shapes are already compatible. To convert between Ranked and Shaped, go via Mixed.

The guiding principle behind Conversion is that it should represent the array restructurings, or perhaps re-presentations, that do not change the underlying XArrays. This leads to the inclusion of some operations that do not look like simple conversions (casts) at first glance, like ConvZip.

Note: Haddock gleefully renames type variables in constructors so that they match the data type head as much as possible. See the source for a more readable presentation of this data type.

Constructors

ConvId :: forall a. Conversion a a 
ConvCmp :: forall b1 b a. Conversion b1 b -> Conversion a b1 -> Conversion a b 
ConvRX :: forall (n :: Nat) a1. Conversion (Ranked n a1) (Mixed (Replicate n ('Nothing :: Maybe Nat)) a1) 
ConvSX :: forall (sh :: [Nat]) a1. Conversion (Shaped sh a1) (Mixed (MapJust sh) a1) 
ConvXR :: forall a1 (sh :: [Maybe Nat]). Elt a1 => Conversion (Mixed sh a1) (Ranked (Rank sh) a1) 
ConvXS :: forall (sh :: [Nat]) a1. Conversion (Mixed (MapJust sh) a1) (Shaped sh a1) 
ConvXS' :: forall (sh :: [Maybe Nat]) (sh' :: [Nat]) a1. (Rank sh ~ Rank sh', Elt a1) => ShS sh' -> Conversion (Mixed sh a1) (Shaped sh' a1) 
ConvXX' :: forall (sh :: [Maybe Nat]) (sh' :: [Maybe Nat]) a1. (Rank sh ~ Rank sh', Elt a1) => StaticShX sh' -> Conversion (Mixed sh a1) (Mixed sh' a1) 
ConvRR :: forall a1 b1 (n :: Nat). Conversion a1 b1 -> Conversion (Ranked n a1) (Ranked n b1) 
ConvSS :: forall a1 b1 (sh :: [Nat]). Conversion a1 b1 -> Conversion (Shaped sh a1) (Shaped sh b1) 
ConvXX :: forall a1 b1 (sh :: [Maybe Nat]). Conversion a1 b1 -> Conversion (Mixed sh a1) (Mixed sh b1) 
ConvT2 :: forall a1 a' b1 b'. Conversion a1 a' -> Conversion b1 b' -> Conversion (a1, b1) (a', b') 
Conv0X :: forall a. Elt a => Conversion a (Mixed ('[] :: [Maybe Nat]) a) 
ConvX0 :: forall b. Conversion (Mixed ('[] :: [Maybe Nat]) b) b 
ConvNest :: forall a1 (sh :: [Maybe Nat]) (sh' :: [Maybe Nat]). Elt a1 => StaticShX sh -> Conversion (Mixed (sh ++ sh') a1) (Mixed sh (Mixed sh' a1)) 
ConvUnnest :: forall (sh :: [Maybe Nat]) (sh' :: [Maybe Nat]) a1. Conversion (Mixed sh (Mixed sh' a1)) (Mixed (sh ++ sh') a1) 
ConvZip :: forall a1 b1 (sh :: [Maybe Nat]). (Elt a1, Elt b1) => Conversion (Mixed sh a1, Mixed sh b1) (Mixed sh (a1, b1)) 
ConvUnzip :: forall a1 b1 (sh :: [Maybe Nat]). (Elt a1, Elt b1) => Conversion (Mixed sh (a1, b1)) (Mixed sh a1, Mixed sh b1) 

Instances

Instances details
Category Conversion Source # 
Instance details

Defined in Data.Array.Nested.Convert

Methods

id :: Conversion a a #

(.) :: Conversion b c -> Conversion a b -> Conversion a c #

Show (Conversion a b) Source # 
Instance details

Defined in Data.Array.Nested.Convert

Methods

showsPrec :: Int -> Conversion a b -> ShowS #

show :: Conversion a b -> String #

showList :: [Conversion a b] -> ShowS #

Special cases of array conversions

These functions can all be implemented using convert in some way, but some have fewer constraints.

rtoMixed :: forall (n :: Nat) a. Ranked n a -> Mixed (Replicate n ('Nothing :: Maybe Nat)) a Source #

rcastToMixed :: forall (sh :: [Maybe Nat]) (n :: Natural) a. (Rank sh ~ n, Elt a) => StaticShX sh -> Ranked n a -> Mixed sh a Source #

A more weakly-typed version of rtoMixed that does a runtime shape compatibility check.

rcastToShaped :: forall a (sh :: [Nat]). Elt a => Ranked (Rank sh) a -> ShS sh -> Shaped sh a Source #

stoMixed :: forall (sh :: [Nat]) a. Shaped sh a -> Mixed (MapJust sh) a Source #

scastToMixed :: forall (sh :: [Nat]) (sh' :: [Maybe Nat]) a. (Elt a, Rank sh ~ Rank sh') => StaticShX sh' -> Shaped sh a -> Mixed sh' a Source #

A more weakly-typed version of stoMixed that does a runtime shape compatibility check.

stoRanked :: forall a (sh :: [Nat]). Elt a => Shaped sh a -> Ranked (Rank sh) a Source #

mcast :: forall (sh1 :: [Maybe Nat]) (sh2 :: [Maybe Nat]) a. (Rank sh1 ~ Rank sh2, Elt a) => StaticShX sh2 -> Mixed sh1 a -> Mixed sh2 a Source #

mcastToShaped :: forall (sh :: [Maybe Nat]) (sh' :: [Nat]) a. (Elt a, Rank sh ~ Rank sh') => ShS sh' -> Mixed sh a -> Shaped sh' a Source #

mtoRanked :: forall (sh :: [Maybe Nat]) a. Elt a => Mixed sh a -> Ranked (Rank sh) a Source #