Copyright | (c) Alexey Kuleshevich 2018-2019 |
---|---|
License | BSD3 |
Maintainer | Alexey Kuleshevich <lehins@yandex.ru> |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
Synopsis
- data Stencil ix e a
- data Value e
- makeStencil :: (Index ix, Default e) => Sz ix -> ix -> ((ix -> Value e) -> Value a) -> Stencil ix e a
- makeStencilDef :: Index ix => e -> Sz ix -> ix -> ((ix -> Value e) -> Value a) -> Stencil ix e a
- mapStencil :: (Source r ix e, Manifest r ix e) => Border e -> Stencil ix e a -> Array r ix e -> Array DW ix a
- dimapStencil :: (c -> d) -> (a -> b) -> Stencil ix d a -> Stencil ix c b
- lmapStencil :: (c -> d) -> Stencil ix d a -> Stencil ix c a
- rmapStencil :: (a -> b) -> Stencil ix e a -> Stencil ix e b
- makeConvolutionStencil :: (Index ix, Num e) => Sz ix -> ix -> ((ix -> Value e -> Value e -> Value e) -> Value e -> Value e) -> Stencil ix e e
- makeConvolutionStencilFromKernel :: (Manifest r ix e, Num e) => Array r ix e -> Stencil ix e e
- makeCorrelationStencil :: (Index ix, Num e) => Sz ix -> ix -> ((ix -> Value e -> Value e -> Value e) -> Value e -> Value e) -> Stencil ix e e
- makeCorrelationStencilFromKernel :: (Manifest r ix e, Num e) => Array r ix e -> Stencil ix e e
- class Default a where
- def :: a
Stencil
Stencil is abstract description of how to handle elements in the neighborhood of every array
cell in order to compute a value for the cells in the new array. Use makeStencil
and
makeConvolutionStencil
in order to create a stencil.
Instances
This is a simple wrapper for value of an array cell. It is used in order to improve safety of
Stencil
mapping. Using various class instances, such as Num
and Functor
for example, make
it possible to manipulate the value, without having direct access to it.
Instances
Functor Value Source # | |
Applicative Value Source # | |
Bounded e => Bounded (Value e) Source # | |
Floating e => Floating (Value e) Source # | |
Fractional e => Fractional (Value e) Source # | |
Num e => Num (Value e) Source # | |
Show e => Show (Value e) Source # | |
Semigroup a => Semigroup (Value a) Source # | Since: 0.1.5 |
Monoid a => Monoid (Value a) Source # | Since: 0.1.5 |
:: (Index ix, Default e) | |
=> Sz ix | Size of the stencil |
-> ix | Center of the stencil |
-> ((ix -> Value e) -> Value a) | Stencil function that receives a "get" function as it's argument that can retrieve values of cells in the source array with respect to the center of the stencil. Stencil function must return a value that will be assigned to the cell in the result array. Offset supplied to the "get" function cannot go outside the boundaries of the stencil, otherwise an error will be raised during stencil creation. |
-> Stencil ix e a |
Construct a stencil from a function, which describes how to calculate the value at a point while having access to neighboring elements with a function that accepts idices relative to the center of stencil. Trying to index outside the stencil box will result in a runtime error upon stencil creation.
Example
Below is an example of creating a Stencil
, which, when mapped over a
2-dimensional array, will compute an average of all elements in a 3x3 square
for each element in that array. Note: Make sure to add INLINE
pragma,
otherwise performance will be terrible.
average3x3Stencil :: (Default a, Fractional a) => Stencil Ix2 a a average3x3Stencil = makeStencil (Sz (3 :. 3)) (1 :. 1) $ \ get -> ( get (-1 :. -1) + get (-1 :. 0) + get (-1 :. 1) + get ( 0 :. -1) + get ( 0 :. 0) + get ( 0 :. 1) + get ( 1 :. -1) + get ( 1 :. 0) + get ( 1 :. 1) ) / 9 {-# INLINE average3x3Stencil #-}
Since: 0.1.0
:: Index ix | |
=> e | |
-> Sz ix | Size of the stencil |
-> ix | Center of the stencil |
-> ((ix -> Value e) -> Value a) | Stencil function. |
-> Stencil ix e a |
Same as makeStencil
, but with ability to specify default value for stencil validation.
Since: 0.2.3
:: (Source r ix e, Manifest r ix e) | |
=> Border e | Border resolution technique |
-> Stencil ix e a | Stencil to map over the array |
-> Array r ix e | Source array |
-> Array DW ix a |
Map a constructed stencil over an array. Resulting array must be compute
d in order to be
useful.
Since: 0.1.0
Profunctor
dimapStencil :: (c -> d) -> (a -> b) -> Stencil ix d a -> Stencil ix c b Source #
A Profunctor dimap. Same caviat applies as in lmapStencil
Since: 0.2.3
lmapStencil :: (c -> d) -> Stencil ix d a -> Stencil ix c a Source #
A contravariant map of a second type parameter. In other words map a function over each element of the array, that the stencil will be applied to.
Note: This map can be very inefficient, since for stencils larger than 1 element in size, the supllied function will be repeatedly applied to the same element. It is better to simply map that function over the source array instead.
Since: 0.2.3
rmapStencil :: (a -> b) -> Stencil ix e a -> Stencil ix e b Source #
A covariant map over the right most type argument. In other words a usual Functor fmap
:
fmap == rmapStencil
Since: 0.2.3
Convolution
makeConvolutionStencil :: (Index ix, Num e) => Sz ix -> ix -> ((ix -> Value e -> Value e -> Value e) -> Value e -> Value e) -> Stencil ix e e Source #
Create a convolution stencil by specifying border resolution technique and an accumulator function.
Examples
Here is how to create a 2D horizontal Sobel Stencil:
sobelX :: Num e => Stencil Ix2 e e sobelX = makeConvolutionStencil (Sz2 3 3) (1 :. 1) $ \f -> f (-1 :. -1) (-1) . f (-1 :. 1) 1 . f ( 0 :. -1) (-2) . f ( 0 :. 1) 2 . f ( 1 :. -1) (-1) . f ( 1 :. 1) 1 {-# INLINE sobelX #-}
Since: 0.1.0
makeConvolutionStencilFromKernel :: (Manifest r ix e, Num e) => Array r ix e -> Stencil ix e e Source #
Make a stencil out of a Kernel Array. This Stencil
will be slower than if
makeConvolutionStencil
is used, but sometimes we just really don't know the
kernel at compile time.
Since: 0.1.0
makeCorrelationStencil :: (Index ix, Num e) => Sz ix -> ix -> ((ix -> Value e -> Value e -> Value e) -> Value e -> Value e) -> Stencil ix e e Source #
Make a cross-correlation stencil
Since: 0.1.5
makeCorrelationStencilFromKernel :: (Manifest r ix e, Num e) => Array r ix e -> Stencil ix e e Source #
Make a cross-correlation stencil out of a
Kernel Array. This Stencil
will be slower than if makeCorrelationStencil
is used, but
sometimes we just really don't know the kernel at compile time.
Since: 0.1.5
Re-export
A class for types with a default value.
Nothing