-- SPDX-License-Identifier: MPL-2.0

{- | Finite CPU images with row-major spatial axes and interleaved channels
(last axis). Spatial rank is 1–8, channel count 1–16, and total storage at most
262,144 samples. Dimensions are positive; empty images are explicit errors.
The immutable constructor owns storage. Intensities have no implicit range;
color-space and histogram functions state their stricter range contracts.
-}
module HMath.Image.Core (
    Image,
    image,
    fromTensor,
    toTensor,
    imageShape,
    imageChannels,
    imageValues,
    pixel,
    channel,
    combineChannels,
    mapImage,
    zipImage,
    normalize,
    brightness,
    contrast,
    gamma,
    Boundary (..),
    coordinates,
    sample,
    build,
    at,
    spatialSize,
    finite,
    require,
    checked,
) where

import Data.Array (Array, elems, listArray, (!))
import HMath.Error
import qualified HMath.Tensor as T

{- | Opaque finite CPU image with row-major spatial axes and interleaved channels. Construct
with image; shape/channel/storage limits are checked.
-}
data Image = Image [Int] Int (Array Int Double) deriving (Image -> Image -> Bool
(Image -> Image -> Bool) -> (Image -> Image -> Bool) -> Eq Image
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Image -> Image -> Bool
== :: Image -> Image -> Bool
$c/= :: Image -> Image -> Bool
/= :: Image -> Image -> Bool
Eq, Int -> Image -> ShowS
[Image] -> ShowS
Image -> String
(Int -> Image -> ShowS)
-> (Image -> String) -> ([Image] -> ShowS) -> Show Image
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Image -> ShowS
showsPrec :: Int -> Image -> ShowS
$cshow :: Image -> String
show :: Image -> String
$cshowList :: [Image] -> ShowS
showList :: [Image] -> ShowS
Show)

-- | Test whether Double is neither NaN nor infinite.
finite :: Double -> Bool
finite :: Double -> Bool
finite Double
x = Bool -> Bool
not (Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
x Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
x)

{- | Given predicate then diagnostic, return Right () or image-prefixed Left
InvalidArgument.
-}
require :: Bool -> String -> Either MathError ()
require :: Bool -> String -> Either MathError ()
require Bool
p String
message = if Bool
p then () -> Either MathError ()
forall a b. b -> Either a b
Right () else MathError -> Either MathError ()
forall a b. a -> Either a b
Left (String -> MathError
InvalidArgument (String
"image: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
message))

{- | Return finite Double values unchanged, or Left NonFiniteResult when any sample is
non-finite.
-}
checked :: [Double] -> Either MathError [Double]
checked :: [Double] -> Either MathError [Double]
checked [Double]
values = if (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Double -> Bool
finite [Double]
values then [Double] -> Either MathError [Double]
forall a b. b -> Either a b
Right [Double]
values else MathError -> Either MathError [Double]
forall a b. a -> Either a b
Left MathError
NonFiniteResult

-- | Validate all dimensions before allocating boxed immutable array storage.
image :: [Int] -> Int -> [Double] -> Either MathError Image
image :: [Int] -> Int -> [Double] -> Either MathError Image
image [Int]
dims Int
channels [Double]
values = do
    Bool -> String -> Either MathError ()
require
        (Bool -> Bool
not ([Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
dims) Bool -> Bool -> Bool
&& [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
dims Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
8 Bool -> Bool -> Bool
&& (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) [Int]
dims Bool -> Bool -> Bool
&& Int
channels Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
channels Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
16)
        String
"invalid spatial/channel shape"
    let count :: Integer
count = [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ((Int -> Integer) -> [Int] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Integer
forall a. Integral a => a -> Integer
toInteger [Int]
dims) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
channels
    Bool -> String -> Either MathError ()
require
        (Integer
count Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
262144 Bool -> Bool -> Bool
&& Integer
count Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
values))
        String
"sample count mismatch or storage limit"
    _ <- [Double] -> Either MathError [Double]
checked [Double]
values
    Right (Image dims channels (listArray (0, length values - 1) values))

-- | Tensor shape must be spatial dimensions followed by a channel axis.
fromTensor :: T.Tensor Double -> Either MathError Image
fromTensor :: Tensor Double -> Either MathError Image
fromTensor Tensor Double
tensor = do
    let dims :: [Int]
dims = Tensor Double -> [Int]
forall a. Tensor a -> [Int]
T.tensorShape Tensor Double
tensor
    Bool -> String -> Either MathError ()
require ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
dims Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2) String
"tensor needs spatial and channel axes"
    [Int] -> Int -> [Double] -> Either MathError Image
image ([Int] -> [Int]
forall a. HasCallStack => [a] -> [a]
init [Int]
dims) ([Int] -> Int
forall a. HasCallStack => [a] -> a
last [Int]
dims) (Tensor Double -> [Double]
forall a. Tensor a -> [a]
T.tensorValues Tensor Double
tensor)

{- | Copy an image to Tensor Double with shape spatial dimensions followed by channel count.
Values remain row-major with interleaved channels; checked tensor size errors
propagate.
-}
toTensor :: Image -> Either MathError (T.Tensor Double)
toTensor :: Image -> Either MathError (Tensor Double)
toTensor Image
img = [Int] -> [Double] -> Either MathError (Tensor Double)
forall a. [Int] -> [a] -> Either MathError (Tensor a)
T.tensor (Image -> [Int]
imageShape Image
img [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Image -> Int
imageChannels Image
img]) (Image -> [Double]
imageValues Image
img)

-- | Return spatial dimensions only, excluding the last implicit channel axis.
imageShape :: Image -> [Int]
imageShape :: Image -> [Int]
imageShape (Image [Int]
dims Int
_ Array Int Double
_) = [Int]
dims

-- | Return channel count, between one and sixteen for validated images.
imageChannels :: Image -> Int
imageChannels :: Image -> Int
imageChannels (Image [Int]
_ Int
channels Array Int Double
_) = Int
channels

-- | Return flat row-major samples with channels interleaved at each spatial coordinate.
imageValues :: Image -> [Double]
imageValues :: Image -> [Double]
imageValues (Image [Int]
_ Int
_ Array Int Double
values) = Array Int Double -> [Double]
forall i e. Array i e -> [e]
elems Array Int Double
values

-- | Return number of spatial pixels (shape product), excluding channel multiplicity.
spatialSize :: Image -> Int
spatialSize :: Image -> Int
spatialSize = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ([Int] -> Int) -> (Image -> [Int]) -> Image -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image -> [Int]
imageShape

{- | Enumerate zero-based row-major coordinates of a dimension list. [] yields [[]];
zero/negative extents yield no coordinates. This helper performs no image validation.
-}
coordinates :: [Int] -> [[Int]]
coordinates :: [Int] -> [[Int]]
coordinates [] = [[]]
coordinates (Int
d : [Int]
ds) = [Int
i Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
is | Int
i <- [Int
0 .. Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1], [Int]
is <- [Int] -> [[Int]]
coordinates [Int]
ds]

-- Internal indexing kernel: callers must have checked rank/range and channel.

{- | Unchecked image access: given image,complete spatial coordinates,then channel, return
one sample. Checked callers must validate rank/ranges; invalid indices can raise an
array error.
-}
at :: Image -> [Int] -> Int -> Double
at :: Image -> [Int] -> Int -> Double
at (Image [Int]
dims Int
channels Array Int Double
values) [Int]
ix Int
c = Array Int Double
values Array Int Double -> Int -> Double
forall i e. Ix i => Array i e -> i -> e
! ((Int -> (Int, Int) -> Int) -> Int -> [(Int, Int)] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Int
acc (Int
i, Int
d) -> Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) Int
0 ([Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
ix [Int]
dims) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
channels Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c)

{- | Given image then complete spatial coordinates, return all channel values in order.
Invalid coordinate rank/range returns Left InvalidArgument.
-}
pixel :: Image -> [Int] -> Either MathError [Double]
pixel :: Image -> [Int] -> Either MathError [Double]
pixel Image
img [Int]
ix = do
    Bool -> String -> Either MathError ()
require
        ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Image -> [Int]
imageShape Image
img) Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Int -> Int -> Bool) -> [Int] -> [Int] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i Int
d -> Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
d) [Int]
ix (Image -> [Int]
imageShape Image
img)))
        String
"pixel index out of range"
    [Double] -> Either MathError [Double]
forall a b. b -> Either a b
Right [Image -> [Int] -> Int -> Double
at Image
img [Int]
ix Int
c | Int
c <- [Int
0 .. Image -> Int
imageChannels Image
img Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

{- | Given zero-based channel index then image, return a copied one-channel image of the
same spatial shape. Invalid channel index fails.
-}
channel :: Int -> Image -> Either MathError Image
channel :: Int -> Image -> Either MathError Image
channel Int
c Image
img = do
    Bool -> String -> Either MathError ()
require (Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Image -> Int
imageChannels Image
img) String
"channel index out of range"
    [Int] -> Int -> [Double] -> Either MathError Image
image (Image -> [Int]
imageShape Image
img) Int
1 [Image -> [Int] -> Int -> Double
at Image
img [Int]
ix Int
c | [Int]
ix <- [Int] -> [[Int]]
coordinates (Image -> [Int]
imageShape Image
img)]

{- | Concatenate channels of a nonempty same-spatial-shape image list in input order.
Require total channels\<=16; shape/count or checked storage limits fail.
-}
combineChannels :: [Image] -> Either MathError Image
combineChannels :: [Image] -> Either MathError Image
combineChannels [Image]
images = do
    Bool -> String -> Either MathError ()
require (Bool -> Bool
not ([Image] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Image]
images)) String
"no channels to combine"
    let dims :: [Int]
dims = Image -> [Int]
imageShape (([Image] -> Int -> Image
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) [Image]
images); count :: Int
count = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Image -> Int) -> [Image] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Image -> Int
imageChannels [Image]
images)
    Bool -> String -> Either MathError ()
require ((Image -> Bool) -> [Image] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (([Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== [Int]
dims) ([Int] -> Bool) -> (Image -> [Int]) -> Image -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image -> [Int]
imageShape) [Image]
images Bool -> Bool -> Bool
&& Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
16) String
"channel shapes/count mismatch"
    [Int] -> Int -> [Double] -> Either MathError Image
image
        [Int]
dims
        Int
count
        [Image -> [Int] -> Int -> Double
at Image
img [Int]
ix Int
c | [Int]
ix <- [Int] -> [[Int]]
coordinates [Int]
dims, Image
img <- [Image]
images, Int
c <- [Int
0 .. Image -> Int
imageChannels Image
img Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

-- | Output is validated, including arithmetic overflow inside the callback.
mapImage :: (Double -> Double) -> Image -> Either MathError Image
mapImage :: (Double -> Double) -> Image -> Either MathError Image
mapImage Double -> Double
f Image
img = [Int] -> Int -> [Double] -> Either MathError Image
image (Image -> [Int]
imageShape Image
img) (Image -> Int
imageChannels Image
img) ((Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Double
f (Image -> [Double]
imageValues Image
img))

{- | Given binary sample function then equally shaped/channel-count images, return a new
validated image. Mismatched shape/channels or non-finite output returns Left MathError.
-}
zipImage :: (Double -> Double -> Double) -> Image -> Image -> Either MathError Image
zipImage :: (Double -> Double -> Double)
-> Image -> Image -> Either MathError Image
zipImage Double -> Double -> Double
f Image
a Image
b = do
    Bool -> String -> Either MathError ()
require (Image -> [Int]
imageShape Image
a [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== Image -> [Int]
imageShape Image
b Bool -> Bool -> Bool
&& Image -> Int
imageChannels Image
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Image -> Int
imageChannels Image
b) String
"image shape mismatch"
    [Int] -> Int -> [Double] -> Either MathError Image
image (Image -> [Int]
imageShape Image
a) (Image -> Int
imageChannels Image
a) ((Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Double -> Double
f (Image -> [Double]
imageValues Image
a) (Image -> [Double]
imageValues Image
b))

-- | Global min/max scaling; a constant image maps to the requested lower bound.
normalize :: Double -> Double -> Image -> Either MathError Image
normalize :: Double -> Double -> Image -> Either MathError Image
normalize Double
lo Double
hi Image
img = do
    Bool -> String -> Either MathError ()
require (Double -> Bool
finite Double
lo Bool -> Bool -> Bool
&& Double -> Bool
finite Double
hi Bool -> Bool -> Bool
&& Double
lo Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
hi) String
"invalid normalization range"
    let values :: [Double]
values = Image -> [Double]
imageValues Image
img
        a :: Double
a = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
values
        b :: Double
b = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
values
        ratio :: Double -> Double
ratio Double
x = if Double -> Bool
finite (Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
a) then (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
a) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
a) else (Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
a Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
b Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
a Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)
    (Double -> Double) -> Image -> Either MathError Image
mapImage (\Double
x -> if Double
a Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
b then Double
lo else (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
ratio Double
x) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
lo Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
ratio Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
hi) Image
img

-- | Add a finite offset without implicit clipping.
brightness :: Double -> Image -> Either MathError Image
brightness :: Double -> Image -> Either MathError Image
brightness Double
offset Image
img = do Bool -> String -> Either MathError ()
require (Double -> Bool
finite Double
offset) String
"nonfinite brightness"; (Double -> Double) -> Image -> Either MathError Image
mapImage (Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
offset) Image
img

-- | Scale about a caller-defined pivot, without clipping.
contrast :: Double -> Double -> Image -> Either MathError Image
contrast :: Double -> Double -> Image -> Either MathError Image
contrast Double
factor Double
pivot Image
img = do
    Bool -> String -> Either MathError ()
require ((Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Double -> Bool
finite [Double
factor, Double
pivot] Bool -> Bool -> Bool
&& Double
factor Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0) String
"invalid contrast"
    (Double -> Double) -> Image -> Either MathError Image
mapImage (\Double
x -> Double
pivot Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
factor Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
pivot)) Image
img

-- | Positive gamma, nonnegative inputs; computes x^gamma without clipping.
gamma :: Double -> Image -> Either MathError Image
gamma :: Double -> Image -> Either MathError Image
gamma Double
power Image
img = do
    Bool -> String -> Either MathError ()
require
        (Double -> Bool
finite Double
power Bool -> Bool -> Bool
&& Double
power Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&& (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0) (Image -> [Double]
imageValues Image
img))
        String
"gamma needs positive exponent/nonnegative data"
    (Double -> Double) -> Image -> Either MathError Image
mapImage (Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
power) Image
img

{- | Image sampling policy: Constant fill,edge Clamp,half-sample symmetric Reflect,or
periodic Wrap.
-}
data Boundary = Constant Double | Clamp | Reflect | Wrap deriving (Boundary -> Boundary -> Bool
(Boundary -> Boundary -> Bool)
-> (Boundary -> Boundary -> Bool) -> Eq Boundary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Boundary -> Boundary -> Bool
== :: Boundary -> Boundary -> Bool
$c/= :: Boundary -> Boundary -> Bool
/= :: Boundary -> Boundary -> Bool
Eq, Int -> Boundary -> ShowS
[Boundary] -> ShowS
Boundary -> String
(Int -> Boundary -> ShowS)
-> (Boundary -> String) -> ([Boundary] -> ShowS) -> Show Boundary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Boundary -> ShowS
showsPrec :: Int -> Boundary -> ShowS
$cshow :: Boundary -> String
show :: Boundary -> String
$cshowList :: [Boundary] -> ShowS
showList :: [Boundary] -> ShowS
Show)

{- | Reflect is half-sample symmetric (... b a | a b c | c b ...).
Boundary rank/channel validation belongs to the checked filter/warp caller.
-}
sample :: Boundary -> Image -> [Int] -> Int -> Double
sample :: Boundary -> Image -> [Int] -> Int -> Double
sample Boundary
boundary Image
img [Int]
ix Int
c
    | ((Int, Int) -> Bool) -> [(Int, Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int, Int) -> Bool
forall {a}. (Ord a, Num a) => (a, a) -> Bool
inside ([Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
ix [Int]
dims) = Image -> [Int] -> Int -> Double
at Image
img [Int]
ix Int
c
    | Bool
otherwise = case Boundary
boundary of
        Constant Double
value -> Double
value
        Boundary
_ -> Image -> [Int] -> Int -> Double
at Image
img ((Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Int
forall {a}. Integral a => a -> a -> a
convert [Int]
ix [Int]
dims) Int
c
  where
    dims :: [Int]
dims = Image -> [Int]
imageShape Image
img
    inside :: (a, a) -> Bool
inside (a
i, a
d) = a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 Bool -> Bool -> Bool
&& a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
d
    convert :: a -> a -> a
convert a
i a
d = case Boundary
boundary of
        Boundary
Clamp -> a -> a -> a
forall a. Ord a => a -> a -> a
max a
0 (a -> a -> a
forall a. Ord a => a -> a -> a
min (a
d a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a
i)
        Boundary
Wrap -> a
i a -> a -> a
forall {a}. Integral a => a -> a -> a
`mod` a
d
        Boundary
Reflect -> let j :: a
j = a
i a -> a -> a
forall {a}. Integral a => a -> a -> a
`mod` (a
2 a -> a -> a
forall a. Num a => a -> a -> a
* a
d) in if a
j a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
d then a
j else a
2 a -> a -> a
forall a. Num a => a -> a -> a
* a
d a -> a -> a
forall a. Num a => a -> a -> a
- a
1 a -> a -> a
forall a. Num a => a -> a -> a
- a
j
        Constant Double
_ -> a
i

-- | Checked output allocation for internal coordinate-wise reference kernels.
build :: [Int] -> Int -> ([Int] -> Int -> Double) -> Either MathError Image
build :: [Int] -> Int -> ([Int] -> Int -> Double) -> Either MathError Image
build [Int]
dims Int
channels [Int] -> Int -> Double
f = do
    Bool -> String -> Either MathError ()
require
        ( Bool -> Bool
not ([Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
dims)
            Bool -> Bool -> Bool
&& [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
dims Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
8
            Bool -> Bool -> Bool
&& (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) [Int]
dims
            Bool -> Bool -> Bool
&& Int
channels Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1
            Bool -> Bool -> Bool
&& Int
channels Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
16
            Bool -> Bool -> Bool
&& [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ((Int -> Integer) -> [Int] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Integer
forall a. Integral a => a -> Integer
toInteger [Int]
dims) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
channels Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
262144
        )
        String
"output shape/storage limit"
    [Int] -> Int -> [Double] -> Either MathError Image
image [Int]
dims Int
channels [[Int] -> Int -> Double
f [Int]
ix Int
c | [Int]
ix <- [Int] -> [[Int]]
coordinates [Int]
dims, Int
c <- [Int
0 .. Int
channels Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]