repa-array-4.2.3.1: Bulk array representations and operators.

Safe HaskellNone
LanguageHaskell98

Data.Repa.Array.Generic

Contents

Description

Generic array API.

A Repa array is a wrapper around an underlying container structure that holds the array elements.

In the type (Array l a), the l specifies the Layout of data, which includes the type of the underlying container, as well as how the elements should be arranged in that container. The a specifies the element type.

The operators provided by this module do not depend on any particular array representation.

Synopsis

Array Access

class Layout l => Bulk l a where Source #

Class of array representations that we can read elements from in a random-access manner.

Minimal complete definition

layout, index

Associated Types

data Array l a Source #

An Array supplies an element of type a to each position in the index space associated with layout l.

Methods

layout :: Array l a -> l Source #

O(1). Get the layout of an array.

index :: Array l a -> Index l -> a Source #

O(1). Get an element from an array. If the provided index is outside the extent of the array then the result depends on the layout.

Instances

Bulk L Int Source #

Linear arrays.

Associated Types

data Array L Int :: * Source #

Methods

layout :: Array L Int -> L Source #

index :: Array L Int -> Index L -> Int Source #

Bulk B a Source #

Boxed arrays.

Associated Types

data Array B a :: * Source #

Methods

layout :: Array B a -> B Source #

index :: Array B a -> Index B -> a Source #

Storable a => Bulk F a Source #

Foreign arrays.

Associated Types

data Array F a :: * Source #

Methods

layout :: Array F a -> F Source #

index :: Array F a -> Index F -> a Source #

Unbox a => Bulk U a Source #

Unboxed arrays.

Associated Types

data Array U a :: * Source #

Methods

layout :: Array U a -> U Source #

index :: Array U a -> Index U -> a Source #

(BulkI l a, Windowable l a) => Bulk N (Array l a) Source #

Nested arrays.

Associated Types

data Array N (Array l a) :: * Source #

Methods

layout :: Array N (Array l a) -> N Source #

index :: Array N (Array l a) -> Index N -> Array l a Source #

Bulk l a => Bulk (W l) a Source #

Windowed arrays.

Associated Types

data Array (W l) a :: * Source #

Methods

layout :: Array (W l) a -> W l Source #

index :: Array (W l) a -> Index (W l) -> a Source #

(Layout (RW sh), (~) * (Index (RW sh)) sh) => Bulk (RW sh) sh Source #

Row-wise arrays.

Associated Types

data Array (RW sh) sh :: * Source #

Methods

layout :: Array (RW sh) sh -> RW sh Source #

index :: Array (RW sh) sh -> Index (RW sh) -> sh Source #

Layout l => Bulk (D l) a Source #

Delayed arrays.

Associated Types

data Array (D l) a :: * Source #

Methods

layout :: Array (D l) a -> D l Source #

index :: Array (D l) a -> Index (D l) -> a Source #

(Layout l1, Layout l2, (~) * (Index l1) (Index l2)) => Bulk (D2 l1 l2) a Source #

Delayed arrays.

Associated Types

data Array (D2 l1 l2) a :: * Source #

Methods

layout :: Array (D2 l1 l2) a -> D2 l1 l2 Source #

index :: Array (D2 l1 l2) a -> Index (D2 l1 l2) -> a Source #

((~) * (Index r) Int, Layout l, Bulk r a) => Bulk (E r l) a Source #

Dense arrays.

Associated Types

data Array (E r l) a :: * Source #

Methods

layout :: Array (E r l) a -> E r l Source #

index :: Array (E r l) a -> Index (E r l) -> a Source #

(Bulk l1 a, Bulk l2 b, (~) * (Index l1) (Index l2)) => Bulk (T2 l1 l2) (a, b) Source #

Tupled arrays.

Associated Types

data Array (T2 l1 l2) (a, b) :: * Source #

Methods

layout :: Array (T2 l1 l2) (a, b) -> T2 l1 l2 Source #

index :: Array (T2 l1 l2) (a, b) -> Index (T2 l1 l2) -> (a, b) Source #

type BulkI l a = (Bulk l a, Index l ~ Int) Source #

Constraint synonym that requires an integer index space.

(!) :: Bulk l a => Array l a -> Index l -> a Source #

O(1). Alias for index.

length :: Bulk l a => Array l a -> Int Source #

O(1). Get the number of elements in an array.

first :: BulkI l a => Array l a -> Maybe a Source #

O(1). Take the first element of an array, if there is one.

last :: BulkI l a => Array l a -> Maybe a Source #

Array Computation

class (Bulk l1 a, Target l2 a) => Load l1 l2 a Source #

Compute all elements defined by a delayed array and write them to a manifest target representation.

The instances of this class require that the source array has a delayed representation. If you want to use a pre-existing manifest array as the source then delay it first.

Minimal complete definition

loadS, loadP

Instances

(Layout l1, Target l2 a) => Load (D l1) l2 a Source # 

Methods

loadS :: Array (D l1) a -> Buffer l2 a -> IO () Source #

loadP :: Gang -> Array (D l1) a -> Buffer l2 a -> IO () Source #

(Layout lSrc1, Layout lSrc2, Target lDst a, (~) * (Index lSrc1) (Index lSrc2)) => Load (D2 lSrc1 lSrc2) lDst a Source # 

Methods

loadS :: Array (D2 lSrc1 lSrc2) a -> Buffer lDst a -> IO () Source #

loadP :: Gang -> Array (D2 lSrc1 lSrc2) a -> Buffer lDst a -> IO () Source #

class Layout l => Target l a Source #

Class of manifest array representations that can be constructed in a random-access manner.

Instances

Target B a Source #

Boxed buffers.

Storable a => Target F a Source #

Foreign buffers

Unbox a => Target U a Source #

Unboxed buffers.

(Bulk l a, Target l a, (~) * (Index l) Int) => Target N (Array l a) Source # 

Associated Types

data Buffer N (Array l a) :: * Source #

(Layout l, (~) * (Index r) Int, Target r a) => Target (E r l) a Source #

Dense buffers.

Associated Types

data Buffer (E r l) a :: * Source #

Methods

unsafeNewBuffer :: E r l -> IO (Buffer (E r l) a) Source #

unsafeReadBuffer :: Buffer (E r l) a -> Int -> IO a Source #

unsafeWriteBuffer :: Buffer (E r l) a -> Int -> a -> IO () Source #

unsafeGrowBuffer :: Buffer (E r l) a -> Int -> IO (Buffer (E r l) a) Source #

unsafeSliceBuffer :: Int -> Int -> Buffer (E r l) a -> IO (Buffer (E r l) a) Source #

unsafeFreezeBuffer :: Buffer (E r l) a -> IO (Array (E r l) a) Source #

unsafeThawBuffer :: Array (E r l) a -> IO (Buffer (E r l) a) Source #

touchBuffer :: Buffer (E r l) a -> IO () Source #

bufferLayout :: Buffer (E r l) a -> E r l Source #

(Target l1 a, Target l2 b, (~) * (Index l1) (Index l2)) => Target (T2 l1 l2) (a, b) Source #

Tupled buffers.

Associated Types

data Buffer (T2 l1 l2) (a, b) :: * Source #

Methods

unsafeNewBuffer :: T2 l1 l2 -> IO (Buffer (T2 l1 l2) (a, b)) Source #

unsafeReadBuffer :: Buffer (T2 l1 l2) (a, b) -> Int -> IO (a, b) Source #

unsafeWriteBuffer :: Buffer (T2 l1 l2) (a, b) -> Int -> (a, b) -> IO () Source #

unsafeGrowBuffer :: Buffer (T2 l1 l2) (a, b) -> Int -> IO (Buffer (T2 l1 l2) (a, b)) Source #

unsafeSliceBuffer :: Int -> Int -> Buffer (T2 l1 l2) (a, b) -> IO (Buffer (T2 l1 l2) (a, b)) Source #

unsafeFreezeBuffer :: Buffer (T2 l1 l2) (a, b) -> IO (Array (T2 l1 l2) (a, b)) Source #

unsafeThawBuffer :: Array (T2 l1 l2) (a, b) -> IO (Buffer (T2 l1 l2) (a, b)) Source #

touchBuffer :: Buffer (T2 l1 l2) (a, b) -> IO () Source #

bufferLayout :: Buffer (T2 l1 l2) (a, b) -> T2 l1 l2 Source #

type TargetI l a = (Target l a, Index l ~ Int) Source #

Constraint synonym that requires an integer index space.

computeS :: (Load lSrc lDst a, Index lSrc ~ Index lDst) => Name lDst -> Array lSrc a -> Array lDst a Source #

Sequential computation of delayed array elements.

Elements of the source array are computed sequentially and written to a new array of the specified layout.

computeIntoS :: Load lSrc lDst a => lDst -> Array lSrc a -> Maybe (Array lDst a) Source #

Like computeS but use the provided desination layout.

The size of the destination layout must match the size of the source array, else Nothing.

Operators

Construction

empty :: TargetI l a => Name l -> Array l a Source #

O(1). An empty array of the given layout.

singleton :: TargetI l a => Name l -> a -> Array l a Source #

O(1). Create a new empty array containing a single element.

generateMaybeS :: TargetI l a => Name l -> Int -> (Int -> Maybe a) -> Maybe (Array l a) Source #

Generate an array of the given length by applying a function to every index, sequentially. If any element returns Nothing, then Nothing for the whole array.

mapMaybeS :: (BulkI lSrc a, TargetI lDst b) => Name lDst -> (a -> Maybe b) -> Array lSrc a -> Maybe (Array lDst b) Source #

Apply a function to every element of an array, if any application returns Nothing, then Nothing for the whole result.

generateEitherS :: TargetI l a => Name l -> Int -> (Int -> Either err a) -> Either err (Array l a) Source #

Generate an array of the given length by applying a function to every index, sequentially. If any element returns Left, then Left for the whole array.

mapEitherS :: (BulkI lSrc a, TargetI lDst b) => Name lDst -> (a -> Either err b) -> Array lSrc a -> Either err (Array lDst b) Source #

Apply a function to every element of an array, if any application returns Left, then Left for the whole result.

Conversion

fromList :: TargetI l a => Name l -> [a] -> Array l a Source #

O(length src). Construct a linear array from a list of elements.

fromListInto :: Target l a => l -> [a] -> Maybe (Array l a) Source #

O(length src). Construct an array from a list of elements, and give it the provided layout.

The length of the provided shape must match the length of the list, else Nothing.

toList :: Bulk l a => Array l a -> [a] Source #

Convert an array to a list.

convert :: Convert l1 a1 l2 a2 => Name l2 -> Array l1 a1 -> Array l2 a2 Source #

O(1). Constant time conversion of one array representation to another.

copy :: (Bulk l1 a, Target l2 a, Index l1 ~ Index l2) => Name l2 -> Array l1 a -> Array l2 a Source #

O(n). Linear time copy of one array representation to another.

This function must be used instead of convert when the bit-wise layout of the two array representations are different.

Replicating

replicates :: (BulkI lSrc (Int, a), TargetI lDst a) => Name lDst -> Array lSrc (Int, a) -> Array lDst a Source #

Segmented replicate.

Mapping

mapS Source #

Arguments

:: (Bulk lSrc a, Target lDst b, Index lSrc ~ Index lDst) 
=> Name lDst

Name of destination layout.

-> (a -> b)

Worker function.

-> Array lSrc a

Source array.

-> Array lDst b 

Like map, but immediately computeS the result.

map2S Source #

Arguments

:: (Bulk lSrc1 a, Bulk lSrc2 b, Target lDst c, Index lSrc1 ~ Index lDst, Index lSrc2 ~ Index lDst) 
=> Name lDst

Name of destination layout.

-> (a -> b -> c)

Worker function.

-> Array lSrc1 a

Source array.

-> Array lSrc2 b

Source array

-> Maybe (Array lDst c) 

Like map2, but immediately computeS the result.

Merging

merge Source #

Arguments

:: (Ord k, BulkI l1 (k, a), BulkI l2 (k, b), TargetI lDst (k, c)) 
=> Name lDst

Name of destination layout.

-> (k -> a -> b -> c)

Combine two values with the same key.

-> (k -> a -> c)

Handle a left value without a right value.

-> (k -> b -> c)

Handle a right value without a left value.

-> Array l1 (k, a)

Array of keys and left values.

-> Array l2 (k, b)

Array of keys and right values.

-> Array lDst (k, c)

Array of keys and results.

Merge two sorted key-value streams.

mergeMaybe Source #

Arguments

:: (Ord k, BulkI l1 (k, a), BulkI l2 (k, b), TargetI lDst (k, c)) 
=> Name lDst 
-> (k -> a -> b -> Maybe c)

Combine two values with the same key.

-> (k -> a -> Maybe c)

Handle a left value without a right value.

-> (k -> b -> Maybe c)

Handle a right value without a left value.

-> Array l1 (k, a)

Array of keys and left values.

-> Array l2 (k, b)

Array of keys and right values.

-> Array lDst (k, c)

Array of keys and results.

Like merge, but only produce the elements where the worker functions return Just.

Splitting

compact :: (BulkI lSrc a, TargetI lDst b) => Name lDst -> (s -> a -> (s, Maybe b)) -> s -> Array lSrc a -> Array lDst b Source #

Combination of fold and filter.

We walk over the stream front to back, maintaining an accumulator. At each point we can chose to emit an element (or not).

compactIn :: (BulkI lSrc a, TargetI lDst a) => Name lDst -> (a -> a -> (a, Maybe a)) -> Array lSrc a -> Array lDst a Source #

Like compact but use the first value of the stream as the initial state, and add the final state to the end of the output.

Processing

process Source #

Arguments

:: (BulkI lSrc a, BulkI lDst b, Bulk lDst (Array lDst b), TargetI lDst b, TargetI lDst (Array lDst b)) 
=> Name lDst

Name of destination layout.

-> (s -> a -> (s, Array lDst b))

Worker function.

-> s

Initial state.

-> Array lSrc a

Input array.

-> (s, Array lDst b)

Result state and array.

Apply a generic stream process to an array.

Unfolding

unfolds Source #

Arguments

:: (BulkI lSrc a, TargetI lDst b) 
=> Name lDst

Name of destination layout.

-> (a -> s -> StepUnfold s b)

Worker function.

-> s

Initial state.

-> Array lSrc a

Input array.

-> (s, Array lDst b)

Result state and array.

Apply a generic stream process to an array.

data StepUnfold s a :: * -> * -> * #

Instances

(Show s, Show a) => Show (StepUnfold s a) 

Methods

showsPrec :: Int -> StepUnfold s a -> ShowS #

show :: StepUnfold s a -> String #

showList :: [StepUnfold s a] -> ShowS #

Filtering

filter :: (BulkI lSrc a, TargetI lDst a) => Name lDst -> (a -> Bool) -> Array lSrc a -> Array lDst a Source #

Keep the elements of an array that match the given predicate.

Inserting

insert Source #

Arguments

:: (BulkI lSrc a, TargetI lDst a) 
=> Name lDst

Name of destination layout.

-> (Int -> Maybe a)

Produce an element for this index.

-> Array lSrc a

Array of source elements.

-> Array lDst a 

Insert elements produced by the given function in to an array.

Searching

findIndex :: BulkI l a => (a -> Bool) -> Array l a -> Maybe Int Source #

O(len src) Yield Just the index of the first element matching the predicate or Nothing if no such element exists.

Sloshing

Sloshing operators copy array elements into a different arrangement, but do not create new element values.

concat Source #

Arguments

:: ConcatDict lOut lIn tIn lDst a 
=> Name lDst

Layout for destination.

-> Array lOut (Array lIn a)

Arrays to concatenate.

-> Array lDst a 

O(len result) Concatenate nested arrays.

> import Data.Repa.Array.Material
> let arrs = fromList B [fromList U [1, 2, 3], fromList U [5, 6, 7 :: Int]]
> toList $ concat U arrs
[1,2,3,5,6,7]

concatWith Source #

Arguments

:: (ConcatDict lOut lIn tIn lDst a, BulkI lSep a) 
=> Name lDst

Result representation.

-> Array lSep a

Separator array.

-> Array lOut (Array lIn a)

Arrays to concatenate.

-> Array lDst a 

O(len result) Concatenate the elements of some nested vector, inserting a copy of the provided separator array between each element.

> import Data.Repa.Array.Material
> let sep  = fromList U [0, 0, 0]
> let arrs = fromList B [fromList U [1, 2, 3], fromList U [5, 6, 7 :: Int]]
> toList $ concatWith U sep arrs
[1,2,3,0,0,0,5,6,7,0,0,0]

unlines Source #

Arguments

:: ConcatDict lOut lIn tIn lDst Char 
=> Name lDst

Result representation.

-> Array lOut (Array lIn Char)

Arrays to concatenate.

-> Array lDst Char 

O(len result). Perform a concatWith, adding a newline character to the end of each inner array.

intercalate Source #

Arguments

:: (ConcatDict lOut lIn tIn lDst a, BulkI lSep a) 
=> Name lDst

Result representation.

-> Array lSep a

Separator array.

-> Array lOut (Array lIn a)

Arrays to concatenate.

-> Array lDst a 

O(len result) Insert a copy of the separator array between the elements of the second and concatenate the result.

> import Data.Repa.Array.Material
> let sep  = fromList U [0, 0, 0]
> let arrs = fromList B [fromList U [1, 2, 3], fromList U [5, 6, 7 :: Int]]
> toList $ intercalate U sep arrs
[1,2,3,0,0,0,5,6,7]

type ConcatDict lOut lIn tIn lDst a = (BulkI lOut (Array lIn a), BulkI lIn a, TargetI lDst a) Source #

Dictionaries needed to perform a concatenation.

Grouping

groups Source #

Arguments

:: (GroupsDict lElt lGrp tGrp lLen tLen n, Eq n) 
=> Name lGrp

Layout for group names.

-> Name lLen

Layout gor group lengths.

-> Array lElt n

Input elements.

-> (Array (T2 lGrp lLen) (n, Int), Maybe (n, Int)) 

From a stream of values which has consecutive runs of idential values, produce a stream of the lengths of these runs.

> import Data.Repa.Array.Material
> import Data.Repa.Nice
> nice $ groups U U (fromList U "waaabllle")
([(w,1),(a,3),(b,1),(l,3)],Just (e,1))

groupsWith Source #

Arguments

:: GroupsDict lElt lGrp tGrp lLen tLen n 
=> Name lGrp

Layout for group names.

-> Name lLen

Layout for group lengths.

-> (n -> n -> Bool)

Comparison function.

-> Maybe (n, Int)

Starting element and count.

-> Array lElt n

Input elements.

-> (Array (T2 lGrp lLen) (n, Int), Maybe (n, Int)) 

Like groups, but use the given function to determine whether two consecutive elements should be in the same group. Also take an initial starting group and count.

> import Data.Repa.Array.Material
> import Data.Repa.Nice
> nice $ groupsWith U U (==) (Just (w, 5)) (fromList U "waaabllle")
([(w,6),(a,3),(b,1),(l,3)],Just (e,1))

type GroupsDict lElt lGrp tGrp lLen tLen n = (Bulk lElt n, Target lGrp n, Target lLen Int, Index lGrp ~ Index lLen) Source #

Dictionaries need to perform a grouping.

Folding

Complete fold

foldl :: (Bulk l b, Index l ~ Int) => (a -> b -> a) -> a -> Array l b -> a Source #

Left fold of all elements in an array, sequentially.

sum :: (BulkI l a, Num a) => Array l a -> a Source #

Yield the sum of the elements of an array.

product :: (BulkI l a, Num a) => Array l a -> a Source #

Yield the product of the elements of an array.

mean :: (BulkI l a, Fractional a) => Array l a -> a Source #

Yield the mean value of the elements of an array.

std :: (BulkI l a, Floating a) => Array l a -> a Source #

Yield the standard deviation of the elements of an array

correlate :: (BulkI l1 a, BulkI l2 a, Floating a) => Array l1 a -> Array l2 a -> a Source #

Compute the Pearson correlation of two arrays.

If the arrays differ in length then only the common prefix is correlated.

Segmented fold

folds Source #

Arguments

:: FoldsDict lSeg lElt lGrp tGrp lRes tRes n a b 
=> Name lGrp

Layout for group names.

-> Name lRes

Layout for fold results.

-> (a -> b -> b)

Worker function.

-> b

Initial state when folding segments.

-> Array lSeg (n, Int)

Segment names and lengths.

-> Array lElt a

Elements.

-> (Array (T2 lGrp lRes) (n, b), Folds Int Int n a b) 

Segmented fold over vectors of segment lengths and input values.

  • The total lengths of all segments need not match the length of the input elements vector. The returned Folds state can be inspected to determine whether all segments were completely folded, or the vector of segment lengths or elements was too short relative to the other.
> import Data.Repa.Array.Material
> import Data.Repa.Nice
> let segs  = fromList B [("red", 3), ("green", 5)]
> let vals  = fromList U [0..100 :: Int]
> nice $ fst $ folds B U (+) 0 segs vals
[("red",3),("green",25)]

foldsWith Source #

Arguments

:: FoldsDict lSeg lElt lGrp tGrp lRes tRes n a b 
=> Name lGrp

Layout for group names.

-> Name lRes

Layout for fold results.

-> (a -> b -> b)

Worker function.

-> b

Initial state when folding segments.

-> Maybe (n, Int, b)

Name, length and initial state for first segment.

-> Array lSeg (n, Int)

Segment names and lengths.

-> Array lElt a

Elements.

-> (Array (T2 lGrp lRes) (n, b), Folds Int Int n a b) 

Like folds, but take an initial state for the first segment.

> import Data.Repa.Array.Material
> import Data.Repa.Nice
> let state = Just ("white", 4, 100)
> let segs  = fromList B [("red", 3), ("green", 5)]
> let vals  = fromList U [0..100 :: Int]
> nice $ fst $ foldsWith B U (+) 0  state segs vals
[("white",106),("red",15),("green",45)]

data Folds sLens sVals n a b :: * -> * -> * -> * -> * -> * #

Return state of a folds operation.

Constructors

Folds 

Fields

Instances

(Show sLens, Show sVals, Show n, Show b) => Show (Folds sLens sVals n a b) 

Methods

showsPrec :: Int -> Folds sLens sVals n a b -> ShowS #

show :: Folds sLens sVals n a b -> String #

showList :: [Folds sLens sVals n a b] -> ShowS #

type FoldsDict lSeg lElt lGrp tGrp lRes tRes n a b = (Bulk lSeg (n, Int), Bulk lElt a, Target lGrp n, Target lRes b, Index lGrp ~ Index lRes) Source #

Dictionaries need to perform a segmented fold.