{-# LANGUAGE BangPatterns
, CPP
, FlexibleContexts
, FlexibleInstances
, GADTs
, MultiParamTypeClasses
, TypeFamilies
, TupleSections
, ScopedTypeVariables #-}
module Vision.Image.Filter.Internal (
Filterable (..), Filter (..)
, BoxFilter, BoxFilter1, SeparableFilter, SeparableFilter1
, KernelAnchor (..)
, Kernel (..)
, SeparableKernel (..), SeparatelyFiltrable (..)
, FilterFold (..), FilterFold1 (..)
, BorderInterpolate (..)
, kernelAnchor, borderInterpolate
, Morphological, dilate, erode
, Blur, blur, gaussianBlur
, Derivative, DerivativeType (..), scharr, sobel
, Mean, mean
) where
#if __GLASGOW_HASKELL__ < 710
import Data.Word
#endif
import Data.List
import Data.Ratio
import Foreign.Storable (Storable)
import qualified Data.Vector.Storable as V
import Vision.Image.Class (MaskedImage (..), Image (..), FromFunction (..), (!))
import Vision.Image.Type (Manifest, Delayed)
import Vision.Primitive (Z (..), (:.) (..), DIM1, Point, Size, ix1, ix2)
class Filterable src res f where
apply :: f -> src -> res
data Filter src kernel init fold acc res = Filter {
forall src kernel init fold acc res.
Filter src kernel init fold acc res -> Size
fKernelSize :: !Size
, forall src kernel init fold acc res.
Filter src kernel init fold acc res -> KernelAnchor
fKernelCenter :: !KernelAnchor
, forall src kernel init fold acc res.
Filter src kernel init fold acc res -> kernel
fKernel :: !kernel
, forall src kernel init fold acc res.
Filter src kernel init fold acc res -> Size -> src -> init
fInit :: !(Point -> src -> init)
, forall src kernel init fold acc res.
Filter src kernel init fold acc res -> fold
fFold :: !fold
, forall src kernel init fold acc res.
Filter src kernel init fold acc res
-> Size -> src -> init -> acc -> res
fPost :: !(Point -> src -> init -> acc -> res)
, forall src kernel init fold acc res.
Filter src kernel init fold acc res -> BorderInterpolate src
fInterpol :: !(BorderInterpolate src)
}
type BoxFilter src init acc res = Filter src (Kernel src init acc) init
(FilterFold acc) acc res
type BoxFilter1 src init res = Filter src (Kernel src init src) init
FilterFold1 src res
type SeparableFilter src init acc res = Filter src
(SeparableKernel src init acc)
init (FilterFold acc) acc res
type SeparableFilter1 src init res = Filter src
(SeparableKernel src init src)
init FilterFold1 src res
data KernelAnchor = KernelAnchor !Point | KernelAnchorCenter
newtype Kernel src init acc = Kernel (init -> Point -> src -> acc -> acc)
data SeparableKernel src init acc = SeparableKernel {
forall src init acc.
SeparableKernel src init acc -> init -> DIM1 -> src -> acc -> acc
skVertical :: !(init -> DIM1 -> src -> acc -> acc)
, forall src init acc.
SeparableKernel src init acc -> init -> DIM1 -> acc -> acc -> acc
skHorizontal :: !(init -> DIM1 -> acc -> acc -> acc)
}
class ( Image (SeparableFilterAccumulator src res acc)
, ImagePixel (SeparableFilterAccumulator src res acc) ~ acc
, FromFunction (SeparableFilterAccumulator src res acc)
, FromFunctionPixel (SeparableFilterAccumulator src res acc) ~ acc)
=> SeparatelyFiltrable src res acc where
type SeparableFilterAccumulator src res acc
instance Storable acc => SeparatelyFiltrable src (Manifest p) acc where
type SeparableFilterAccumulator src (Manifest p) acc = Manifest acc
instance Storable acc => SeparatelyFiltrable src (Delayed p) acc where
type SeparableFilterAccumulator src (Delayed p) acc = Delayed acc
data FilterFold acc = FilterFold (Point -> acc)
data FilterFold1 = FilterFold1
data BorderInterpolate a =
BorderReplicate
| BorderReflect
| BorderWrap
| BorderConstant !a
instance (Image src, FromFunction res, src_pix ~ ImagePixel src
, res_pix ~ FromFunctionPixel res)
=> Filterable src res (BoxFilter src_pix init acc res_pix) where
apply :: BoxFilter src_pix init acc res_pix -> src -> res
apply !(Filter Size
ksize KernelAnchor
anchor (Kernel init -> Size -> src_pix -> acc -> acc
kernel) Size -> src_pix -> init
initF FilterFold acc
fold Size -> src_pix -> init -> acc -> res_pix
post BorderInterpolate src_pix
interpol) !src
img =
let !(FilterFold Size -> acc
fAcc) = FilterFold acc
fold
in forall i.
FromFunction i =>
Size -> (Size -> FromFunctionPixel i) -> i
fromFunction Size
size forall a b. (a -> b) -> a -> b
$ \(!pt :: Size
pt@(Z
Z :. Int
iy :. Int
ix)) ->
let pix :: ImagePixel src
pix = src
img forall i. Image i => i -> Size -> ImagePixel i
! Size
pt
!ini :: init
ini = Size -> src_pix -> init
initF Size
pt ImagePixel src
pix
!acc :: acc
acc = Size -> acc
fAcc Size
pt
!iy0 :: Int
iy0 = Int
iy forall a. Num a => a -> a -> a
- Int
kcy
!ix0 :: Int
ix0 = Int
ix forall a. Num a => a -> a -> a
- Int
kcx
!safe :: Bool
safe = Int
iy0 forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
iy0 forall a. Num a => a -> a -> a
+ Int
kh forall a. Ord a => a -> a -> Bool
<= Int
ih
Bool -> Bool -> Bool
&& Int
ix0 forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
ix0 forall a. Num a => a -> a -> a
+ Int
kw forall a. Ord a => a -> a -> Bool
<= Int
iw
in Size -> src_pix -> init -> acc -> res_pix
post Size
pt ImagePixel src
pix init
ini forall a b. (a -> b) -> a -> b
$!
if Bool
safe then init -> Int -> Int -> Int -> acc -> acc
goColumnSafe init
ini (Int
iy0 forall a. Num a => a -> a -> a
* Int
iw) Int
ix0 Int
0 acc
acc
else init -> Int -> Int -> Int -> acc -> acc
goColumn init
ini Int
iy0 Int
ix0 Int
0 acc
acc
where
!size :: Size
size@(Z
Z :. Int
ih :. Int
iw) = forall i. MaskedImage i => i -> Size
shape src
img
!(Z
Z :. Int
kh :. Int
kw) = Size
ksize
!(Z
Z :. Int
kcy :. Int
kcx) = KernelAnchor -> Size -> Size
kernelAnchor KernelAnchor
anchor Size
ksize
goColumn :: init -> Int -> Int -> Int -> acc -> acc
goColumn !init
ini !Int
iy !Int
ix !Int
ky !acc
acc
| Int
ky forall a. Ord a => a -> a -> Bool
< Int
kh = case forall a. BorderInterpolate a -> Int -> Int -> Either Int a
borderInterpolate BorderInterpolate src_pix
interpol Int
ih Int
iy of
Left Int
iy' -> init -> Int -> Int -> Int -> Int -> Int -> Int -> acc -> acc
goLine init
ini Int
iy (Int
iy' forall a. Num a => a -> a -> a
* Int
iw) Int
ix Int
ix Int
ky Int
0 acc
acc
Right src_pix
val -> init -> Int -> Int -> Int -> Int -> src_pix -> acc -> acc
goLineConst init
ini Int
iy Int
ix Int
ky Int
0 src_pix
val acc
acc
| Bool
otherwise = acc
acc
goColumnSafe :: init -> Int -> Int -> Int -> acc -> acc
goColumnSafe !init
ini !Int
linearIY !Int
ix !Int
ky !acc
acc
| Int
ky forall a. Ord a => a -> a -> Bool
< Int
kh = init -> Int -> Int -> Int -> Int -> Int -> acc -> acc
goLineSafe init
ini Int
linearIY Int
ix Int
ix Int
ky Int
0 acc
acc
| Bool
otherwise = acc
acc
goLine :: init -> Int -> Int -> Int -> Int -> Int -> Int -> acc -> acc
goLine !init
ini !Int
iy !Int
linearIY !Int
ix0 !Int
ix !Int
ky !Int
kx !acc
acc
| Int
kx forall a. Ord a => a -> a -> Bool
< Int
kw =
let !val :: ImagePixel src
val = case forall a. BorderInterpolate a -> Int -> Int -> Either Int a
borderInterpolate BorderInterpolate src_pix
interpol Int
iw Int
ix of
Left Int
ix' -> src
img forall i. Image i => i -> Int -> ImagePixel i
`linearIndex` (Int
linearIY forall a. Num a => a -> a -> a
+ Int
ix')
Right src_pix
val' -> src_pix
val'
!acc' :: acc
acc' = init -> Size -> src_pix -> acc -> acc
kernel init
ini (Int -> Int -> Size
ix2 Int
ky Int
kx) ImagePixel src
val acc
acc
in init -> Int -> Int -> Int -> Int -> Int -> Int -> acc -> acc
goLine init
ini Int
iy Int
linearIY Int
ix0 (Int
ix forall a. Num a => a -> a -> a
+ Int
1) Int
ky (Int
kx forall a. Num a => a -> a -> a
+ Int
1) acc
acc'
| Bool
otherwise = init -> Int -> Int -> Int -> acc -> acc
goColumn init
ini (Int
iy forall a. Num a => a -> a -> a
+ Int
1) Int
ix0 (Int
ky forall a. Num a => a -> a -> a
+ Int
1) acc
acc
goLineSafe :: init -> Int -> Int -> Int -> Int -> Int -> acc -> acc
goLineSafe !init
ini !Int
linearIY !Int
ix0 !Int
ix !Int
ky !Int
kx !acc
acc
| Int
kx forall a. Ord a => a -> a -> Bool
< Int
kw =
let !val :: ImagePixel src
val = src
img forall i. Image i => i -> Int -> ImagePixel i
`linearIndex` (Int
linearIY forall a. Num a => a -> a -> a
+ Int
ix)
!acc' :: acc
acc' = init -> Size -> src_pix -> acc -> acc
kernel init
ini (Int -> Int -> Size
ix2 Int
ky Int
kx) ImagePixel src
val acc
acc
in init -> Int -> Int -> Int -> Int -> Int -> acc -> acc
goLineSafe init
ini Int
linearIY Int
ix0 (Int
ix forall a. Num a => a -> a -> a
+ Int
1) Int
ky (Int
kx forall a. Num a => a -> a -> a
+ Int
1) acc
acc'
| Bool
otherwise = init -> Int -> Int -> Int -> acc -> acc
goColumnSafe init
ini (Int
linearIY forall a. Num a => a -> a -> a
+ Int
iw) Int
ix0 (Int
ky forall a. Num a => a -> a -> a
+ Int
1) acc
acc
goLineConst :: init -> Int -> Int -> Int -> Int -> src_pix -> acc -> acc
goLineConst !init
ini !Int
iy !Int
ix !Int
ky !Int
kx !src_pix
val !acc
acc
| Int
kx forall a. Ord a => a -> a -> Bool
< Int
kw = let !acc' :: acc
acc' = init -> Size -> src_pix -> acc -> acc
kernel init
ini (Int -> Int -> Size
ix2 Int
ky Int
kx) src_pix
val acc
acc
in init -> Int -> Int -> Int -> Int -> src_pix -> acc -> acc
goLineConst init
ini Int
iy Int
ix Int
ky (Int
kx forall a. Num a => a -> a -> a
+ Int
1) src_pix
val acc
acc'
| Bool
otherwise = init -> Int -> Int -> Int -> acc -> acc
goColumn init
ini (Int
iy forall a. Num a => a -> a -> a
+ Int
1) Int
ix (Int
ky forall a. Num a => a -> a -> a
+ Int
1) acc
acc
{-# INLINE apply #-}
instance (Image src, FromFunction res, src_pix ~ ImagePixel src
, res_pix ~ FromFunctionPixel res)
=> Filterable src res (BoxFilter1 src_pix init res_pix) where
apply :: BoxFilter1 src_pix init res_pix -> src -> res
apply !(Filter Size
ksize KernelAnchor
anchor (Kernel init -> Size -> src_pix -> src_pix -> src_pix
kernel) Size -> src_pix -> init
initF FilterFold1
_ Size -> src_pix -> init -> src_pix -> res_pix
post BorderInterpolate src_pix
interpol) !src
img
| Int
kh forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
kw forall a. Eq a => a -> a -> Bool
== Int
0 =
forall a. HasCallStack => [Char] -> a
error [Char]
"Using FilterFold1 with an empty kernel."
| Bool
otherwise =
forall i.
FromFunction i =>
Size -> (Size -> FromFunctionPixel i) -> i
fromFunction Size
size forall a b. (a -> b) -> a -> b
$ \(!pt :: Size
pt@(Z
Z :. Int
iy :. Int
ix)) ->
let pix :: ImagePixel src
pix = src
img forall i. Image i => i -> Size -> ImagePixel i
! Size
pt
!ini :: init
ini = Size -> src_pix -> init
initF Size
pt ImagePixel src
pix
!iy0 :: Int
iy0 = Int
iy forall a. Num a => a -> a -> a
- Int
kcy
!ix0 :: Int
ix0 = Int
ix forall a. Num a => a -> a -> a
- Int
kcx
!safe :: Bool
safe = Int
iy0 forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
iy0 forall a. Num a => a -> a -> a
+ Int
kh forall a. Ord a => a -> a -> Bool
<= Int
ih
Bool -> Bool -> Bool
&& Int
ix0 forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
ix0 forall a. Num a => a -> a -> a
+ Int
kw forall a. Ord a => a -> a -> Bool
<= Int
iw
in Size -> src_pix -> init -> src_pix -> res_pix
post Size
pt ImagePixel src
pix init
ini forall a b. (a -> b) -> a -> b
$! if Bool
safe then init -> Int -> Int -> src_pix
goColumn1Safe init
ini Int
iy0 Int
ix0
else init -> Int -> Int -> src_pix
goColumn1 init
ini Int
iy0 Int
ix0
where
!size :: Size
size@(Z
Z :. Int
ih :. Int
iw) = forall i. MaskedImage i => i -> Size
shape src
img
!(Z
Z :. Int
kh :. Int
kw) = Size
ksize
!(Z
Z :. Int
kcy :. Int
kcx) = KernelAnchor -> Size -> Size
kernelAnchor KernelAnchor
anchor Size
ksize
goColumn1 :: init -> Int -> Int -> src_pix
goColumn1 !init
ini !Int
iy !Int
ix =
case forall a. BorderInterpolate a -> Int -> Int -> Either Int a
borderInterpolate BorderInterpolate src_pix
interpol Int
ih Int
iy of
Left Int
iy' ->
let !linearIY :: Int
linearIY = Int
iy' forall a. Num a => a -> a -> a
* Int
iw
!acc :: ImagePixel src
acc = Int -> Int -> ImagePixel src
safeIndex Int
linearIY Int
ix
in init
-> Int -> Int -> Int -> Int -> Int -> Int -> src_pix -> src_pix
goLine init
ini Int
iy Int
linearIY Int
ix (Int
ix forall a. Num a => a -> a -> a
+ Int
1) Int
0 Int
1 ImagePixel src
acc
Right src_pix
val -> init -> Int -> Int -> Int -> Int -> src_pix -> src_pix -> src_pix
goLineConst init
ini Int
iy Int
ix Int
0 Int
1 src_pix
val src_pix
val
goColumn1Safe :: init -> Int -> Int -> src_pix
goColumn1Safe !init
ini !Int
iy !Int
ix =
let !linearIY :: Int
linearIY = Int
iy forall a. Num a => a -> a -> a
* Int
iw
!acc :: ImagePixel src
acc = src
img forall i. Image i => i -> Int -> ImagePixel i
`linearIndex` (Int
linearIY forall a. Num a => a -> a -> a
+ Int
ix)
in init -> Int -> Int -> Int -> Int -> Int -> src_pix -> src_pix
goLineSafe init
ini Int
linearIY Int
ix (Int
ix forall a. Num a => a -> a -> a
+ Int
1) Int
0 Int
1 ImagePixel src
acc
goColumn :: init -> Int -> Int -> Int -> src_pix -> src_pix
goColumn !init
ini !Int
iy !Int
ix !Int
ky !src_pix
acc
| Int
ky forall a. Ord a => a -> a -> Bool
< Int
kh = case forall a. BorderInterpolate a -> Int -> Int -> Either Int a
borderInterpolate BorderInterpolate src_pix
interpol Int
ih Int
iy of
Left Int
iy' -> init
-> Int -> Int -> Int -> Int -> Int -> Int -> src_pix -> src_pix
goLine init
ini Int
iy (Int
iy' forall a. Num a => a -> a -> a
* Int
iw) Int
ix Int
ix Int
ky Int
0 src_pix
acc
Right src_pix
val -> init -> Int -> Int -> Int -> Int -> src_pix -> src_pix -> src_pix
goLineConst init
ini Int
iy Int
ix Int
ky Int
0 src_pix
val src_pix
acc
| Bool
otherwise = src_pix
acc
goColumnSafe :: init -> Int -> Int -> Int -> src_pix -> src_pix
goColumnSafe !init
ini !Int
linearIY !Int
ix !Int
ky !src_pix
acc
| Int
ky forall a. Ord a => a -> a -> Bool
< Int
kh = init -> Int -> Int -> Int -> Int -> Int -> src_pix -> src_pix
goLineSafe init
ini Int
linearIY Int
ix Int
ix Int
ky Int
0 src_pix
acc
| Bool
otherwise = src_pix
acc
goLine :: init
-> Int -> Int -> Int -> Int -> Int -> Int -> src_pix -> src_pix
goLine !init
ini !Int
iy !Int
linearIY !Int
ix0 !Int
ix !Int
ky !Int
kx !src_pix
acc
| Int
kx forall a. Ord a => a -> a -> Bool
< Int
kw =
let !val :: ImagePixel src
val = Int -> Int -> ImagePixel src
safeIndex Int
linearIY Int
ix
!acc' :: src_pix
acc' = init -> Size -> src_pix -> src_pix -> src_pix
kernel init
ini (Int -> Int -> Size
ix2 Int
ky Int
kx) ImagePixel src
val src_pix
acc
in init
-> Int -> Int -> Int -> Int -> Int -> Int -> src_pix -> src_pix
goLine init
ini Int
iy Int
linearIY Int
ix0 (Int
ix forall a. Num a => a -> a -> a
+ Int
1) Int
ky (Int
kx forall a. Num a => a -> a -> a
+ Int
1) src_pix
acc'
| Bool
otherwise = init -> Int -> Int -> Int -> src_pix -> src_pix
goColumn init
ini (Int
iy forall a. Num a => a -> a -> a
+ Int
1) Int
ix0 (Int
ky forall a. Num a => a -> a -> a
+ Int
1) src_pix
acc
goLineSafe :: init -> Int -> Int -> Int -> Int -> Int -> src_pix -> src_pix
goLineSafe !init
ini !Int
linearIY !Int
ix0 !Int
ix !Int
ky !Int
kx !src_pix
acc
| Int
kx forall a. Ord a => a -> a -> Bool
< Int
kw =
let !val :: ImagePixel src
val = src
img forall i. Image i => i -> Int -> ImagePixel i
`linearIndex` (Int
linearIY forall a. Num a => a -> a -> a
+ Int
ix)
!acc' :: src_pix
acc' = init -> Size -> src_pix -> src_pix -> src_pix
kernel init
ini (Int -> Int -> Size
ix2 Int
ky Int
kx) ImagePixel src
val src_pix
acc
in init -> Int -> Int -> Int -> Int -> Int -> src_pix -> src_pix
goLineSafe init
ini Int
linearIY Int
ix0 (Int
ix forall a. Num a => a -> a -> a
+ Int
1) Int
ky (Int
kx forall a. Num a => a -> a -> a
+ Int
1) src_pix
acc'
| Bool
otherwise = init -> Int -> Int -> Int -> src_pix -> src_pix
goColumnSafe init
ini (Int
linearIY forall a. Num a => a -> a -> a
+ Int
iw) Int
ix0 (Int
ky forall a. Num a => a -> a -> a
+ Int
1) src_pix
acc
goLineConst :: init -> Int -> Int -> Int -> Int -> src_pix -> src_pix -> src_pix
goLineConst !init
ini !Int
iy !Int
ix !Int
ky !Int
kx !src_pix
val !src_pix
acc
| Int
kx forall a. Ord a => a -> a -> Bool
< Int
kw = let !acc' :: src_pix
acc' = init -> Size -> src_pix -> src_pix -> src_pix
kernel init
ini (Int -> Int -> Size
ix2 Int
ky Int
kx) src_pix
val src_pix
acc
in init -> Int -> Int -> Int -> Int -> src_pix -> src_pix -> src_pix
goLineConst init
ini Int
iy Int
ix Int
ky (Int
kx forall a. Num a => a -> a -> a
+ Int
1) src_pix
val src_pix
acc'
| Bool
otherwise = init -> Int -> Int -> Int -> src_pix -> src_pix
goColumn init
ini (Int
iy forall a. Num a => a -> a -> a
+ Int
1) Int
ix (Int
ky forall a. Num a => a -> a -> a
+ Int
1) src_pix
acc
safeIndex :: Int -> Int -> ImagePixel src
safeIndex !Int
linearIY !Int
ix =
case forall a. BorderInterpolate a -> Int -> Int -> Either Int a
borderInterpolate BorderInterpolate src_pix
interpol Int
iw Int
ix of
Left Int
ix' -> src
img forall i. Image i => i -> Int -> ImagePixel i
`linearIndex` (Int
linearIY forall a. Num a => a -> a -> a
+ Int
ix')
Right src_pix
val -> src_pix
val
{-# INLINE apply #-}
instance ( Image src, FromFunction res
, src_pix ~ ImagePixel src
, res_pix ~ FromFunctionPixel res
, SeparatelyFiltrable src res acc)
=> Filterable src res (SeparableFilter src_pix init acc res_pix)
where
apply :: SeparableFilter src_pix init acc res_pix -> src -> res
apply !SeparableFilter src_pix init acc res_pix
f !src
img =
forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$! (Image src, FromFunction res) =>
src
-> SeparableFilter
(ImagePixel src) init acc (FromFunctionPixel res)
-> (res, SeparableFilterAccumulator src res acc)
wrapper src
img SeparableFilter src_pix init acc res_pix
f
where
wrapper :: (Image src, FromFunction res)
=> src
-> SeparableFilter (ImagePixel src) init acc (FromFunctionPixel res)
-> (res, SeparableFilterAccumulator src res acc)
wrapper :: (Image src, FromFunction res) =>
src
-> SeparableFilter
(ImagePixel src) init acc (FromFunctionPixel res)
-> (res, SeparableFilterAccumulator src res acc)
wrapper !src
src !(Filter Size
ksize KernelAnchor
anchor SeparableKernel (ImagePixel src) init acc
kernel Size -> ImagePixel src -> init
initF FilterFold acc
fold Size -> ImagePixel src -> init -> acc -> FromFunctionPixel res
post BorderInterpolate (ImagePixel src)
interpol) =
(res
res, SeparableFilterAccumulator src res acc
tmp)
where
!size :: Size
size@(Z
Z :. Int
ih :. Int
iw) = forall i. MaskedImage i => i -> Size
shape src
src
!(Z
Z :. Int
kh :. Int
kw) = Size
ksize
!(Z
Z :. Int
kcy :. Int
kcx) = KernelAnchor -> Size -> Size
kernelAnchor KernelAnchor
anchor Size
ksize
!(SeparableKernel init -> DIM1 -> ImagePixel src -> acc -> acc
vert init -> DIM1 -> acc -> acc -> acc
horiz) = SeparableKernel (ImagePixel src) init acc
kernel
!(FilterFold Size -> acc
fAcc) = FilterFold acc
fold
!tmp :: SeparableFilterAccumulator src res acc
tmp = forall i.
FromFunction i =>
Size -> (Size -> FromFunctionPixel i) -> i
fromFunction Size
size forall a b. (a -> b) -> a -> b
$ \(!pt :: Size
pt@(Z
Z :. Int
iy :. Int
ix)) ->
let pix :: ImagePixel src
pix = src
src forall i. Image i => i -> Size -> ImagePixel i
! Size
pt
!ini :: init
ini = Size -> ImagePixel src -> init
initF Size
pt ImagePixel src
pix
!acc0 :: acc
acc0 = Size -> acc
fAcc Size
pt
!iy0 :: Int
iy0 = Int
iy forall a. Num a => a -> a -> a
- Int
kcy
in if Int
iy0 forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
iy0 forall a. Num a => a -> a -> a
+ Int
kh forall a. Ord a => a -> a -> Bool
<= Int
ih
then init -> Int -> Int -> Int -> acc -> acc
goColumnSafe init
ini Int
iy0 Int
ix Int
0 acc
acc0
else init -> Int -> Int -> Int -> acc -> acc
goColumn init
ini Int
iy0 Int
ix Int
0 acc
acc0
!res :: res
res = forall i.
FromFunction i =>
Size -> (Size -> FromFunctionPixel i) -> i
fromFunction Size
size forall a b. (a -> b) -> a -> b
$ \(!pt :: Size
pt@(Z
Z :. Int
iy :. Int
ix)) ->
let pix :: ImagePixel src
pix = src
src forall i. Image i => i -> Size -> ImagePixel i
! Size
pt
!ini :: init
ini = Size -> ImagePixel src -> init
initF Size
pt ImagePixel src
pix
!acc0 :: acc
acc0 = Size -> acc
fAcc Size
pt
!ix0 :: Int
ix0 = Int
ix forall a. Num a => a -> a -> a
- Int
kcx
in Size -> ImagePixel src -> init -> acc -> FromFunctionPixel res
post Size
pt ImagePixel src
pix init
ini forall a b. (a -> b) -> a -> b
$!
if Int
ix0 forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
ix0 forall a. Num a => a -> a -> a
+ Int
kw forall a. Ord a => a -> a -> Bool
<= Int
iw
then init -> Int -> Int -> Int -> acc -> acc
goLineSafe init
ini (Int
iy forall a. Num a => a -> a -> a
* Int
iw) Int
ix0 Int
0 acc
acc0
else init -> acc -> Int -> Int -> Int -> acc -> acc
goLine init
ini acc
acc0 (Int
iy forall a. Num a => a -> a -> a
* Int
iw) Int
ix0 Int
0
acc
acc0
goColumn :: init -> Int -> Int -> Int -> acc -> acc
goColumn !init
ini !Int
iy !Int
ix !Int
ky !acc
acc
| Int
ky forall a. Ord a => a -> a -> Bool
< Int
kh =
let !val :: ImagePixel src
val = case forall a. BorderInterpolate a -> Int -> Int -> Either Int a
borderInterpolate BorderInterpolate (ImagePixel src)
interpol Int
ih Int
iy of
Left Int
iy' -> src
src forall i. Image i => i -> Size -> ImagePixel i
! Int -> Int -> Size
ix2 Int
iy' Int
ix
Right src_pix
val' -> src_pix
val'
!acc' :: acc
acc' = init -> DIM1 -> ImagePixel src -> acc -> acc
vert init
ini (Int -> DIM1
ix1 Int
ky) ImagePixel src
val acc
acc
in init -> Int -> Int -> Int -> acc -> acc
goColumn init
ini (Int
iy forall a. Num a => a -> a -> a
+ Int
1) Int
ix (Int
ky forall a. Num a => a -> a -> a
+ Int
1) acc
acc'
| Bool
otherwise = acc
acc
goColumnSafe :: init -> Int -> Int -> Int -> acc -> acc
goColumnSafe !init
ini !Int
iy !Int
ix !Int
ky !acc
acc
| Int
ky forall a. Ord a => a -> a -> Bool
< Int
kh =
let !val :: ImagePixel src
val = src
src forall i. Image i => i -> Size -> ImagePixel i
! Int -> Int -> Size
ix2 Int
iy Int
ix
!acc' :: acc
acc' = init -> DIM1 -> ImagePixel src -> acc -> acc
vert init
ini (Int -> DIM1
ix1 Int
ky) ImagePixel src
val acc
acc
in init -> Int -> Int -> Int -> acc -> acc
goColumnSafe init
ini (Int
iy forall a. Num a => a -> a -> a
+ Int
1) Int
ix (Int
ky forall a. Num a => a -> a -> a
+ Int
1) acc
acc'
| Bool
otherwise = acc
acc
goLine :: init -> acc -> Int -> Int -> Int -> acc -> acc
goLine !init
ini !acc
acc0 !Int
linearIY !Int
ix !Int
kx !acc
acc
| Int
kx forall a. Ord a => a -> a -> Bool
< Int
kw =
let !val :: ImagePixel (SeparableFilterAccumulator src res acc)
val =
case forall a. BorderInterpolate a -> Int -> Int -> Either Int a
borderInterpolate BorderInterpolate (ImagePixel src)
interpol Int
iw Int
ix of
Left Int
ix' -> SeparableFilterAccumulator src res acc
tmp forall i. Image i => i -> Int -> ImagePixel i
`linearIndex` (Int
linearIY forall a. Num a => a -> a -> a
+ Int
ix')
Right src_pix
val' -> init -> acc -> src_pix -> acc
constCol init
ini acc
acc0 src_pix
val'
!acc' :: acc
acc' = init -> DIM1 -> acc -> acc -> acc
horiz init
ini (Int -> DIM1
ix1 Int
kx) ImagePixel (SeparableFilterAccumulator src res acc)
val acc
acc
in init -> acc -> Int -> Int -> Int -> acc -> acc
goLine init
ini acc
acc0 Int
linearIY (Int
ix forall a. Num a => a -> a -> a
+ Int
1) (Int
kx forall a. Num a => a -> a -> a
+ Int
1) acc
acc'
| Bool
otherwise = acc
acc
goLineSafe :: init -> Int -> Int -> Int -> acc -> acc
goLineSafe !init
ini !Int
linearIY !Int
ix !Int
kx !acc
acc
| Int
kx forall a. Ord a => a -> a -> Bool
< Int
kw =
let !val :: ImagePixel (SeparableFilterAccumulator src res acc)
val = SeparableFilterAccumulator src res acc
tmp forall i. Image i => i -> Int -> ImagePixel i
`linearIndex` (Int
linearIY forall a. Num a => a -> a -> a
+ Int
ix)
!acc' :: acc
acc' = init -> DIM1 -> acc -> acc -> acc
horiz init
ini (Int -> DIM1
ix1 Int
kx) ImagePixel (SeparableFilterAccumulator src res acc)
val acc
acc
in init -> Int -> Int -> Int -> acc -> acc
goLineSafe init
ini Int
linearIY (Int
ix forall a. Num a => a -> a -> a
+ Int
1) (Int
kx forall a. Num a => a -> a -> a
+ Int
1) acc
acc'
| Bool
otherwise = acc
acc
constCol :: init -> acc -> src_pix -> acc
constCol !init
ini !acc
acc0 !src_pix
constVal =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\acc
acc Int
ky -> init -> DIM1 -> ImagePixel src -> acc -> acc
vert init
ini (Int -> DIM1
ix1 Int
ky) src_pix
constVal acc
acc) acc
acc0
[Int
0..Int
khforall a. Num a => a -> a -> a
-Int
1]
{-# INLINE wrapper #-}
{-# INLINE apply #-}
instance ( Image src, FromFunction res
, src_pix ~ ImagePixel src
, res_pix ~ FromFunctionPixel res
, SeparatelyFiltrable src res src_pix)
=> Filterable src res (SeparableFilter1 src_pix init res_pix)
where
apply :: SeparableFilter1 src_pix init res_pix -> src -> res
apply !SeparableFilter1 src_pix init res_pix
f !src
img =
forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$! forall acc.
(Image src, FromFunction res, acc ~ ImagePixel src,
FromFunction (SeparableFilterAccumulator src res acc),
FromFunctionPixel (SeparableFilterAccumulator src res acc) ~ acc,
Image (SeparableFilterAccumulator src res acc),
ImagePixel (SeparableFilterAccumulator src res acc) ~ acc) =>
src
-> SeparableFilter1 (ImagePixel src) init (FromFunctionPixel res)
-> (res, SeparableFilterAccumulator src res acc)
wrapper src
img SeparableFilter1 src_pix init res_pix
f
where
wrapper :: (Image src, FromFunction res, acc ~ ImagePixel src
, FromFunction (SeparableFilterAccumulator src res acc)
, FromFunctionPixel (SeparableFilterAccumulator src res acc) ~ acc
, Image (SeparableFilterAccumulator src res acc)
, ImagePixel (SeparableFilterAccumulator src res acc) ~ acc)
=> src
-> SeparableFilter1 (ImagePixel src) init (FromFunctionPixel res)
-> (res, SeparableFilterAccumulator src res acc)
wrapper :: forall acc.
(Image src, FromFunction res, acc ~ ImagePixel src,
FromFunction (SeparableFilterAccumulator src res acc),
FromFunctionPixel (SeparableFilterAccumulator src res acc) ~ acc,
Image (SeparableFilterAccumulator src res acc),
ImagePixel (SeparableFilterAccumulator src res acc) ~ acc) =>
src
-> SeparableFilter1 (ImagePixel src) init (FromFunctionPixel res)
-> (res, SeparableFilterAccumulator src res acc)
wrapper !src
src !(Filter Size
ksize KernelAnchor
anchor SeparableKernel (ImagePixel src) init (ImagePixel src)
kernel Size -> ImagePixel src -> init
initF FilterFold1
_ Size
-> ImagePixel src
-> init
-> ImagePixel src
-> FromFunctionPixel res
post BorderInterpolate (ImagePixel src)
interpol)
| Int
kh forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
kw forall a. Eq a => a -> a -> Bool
== Int
0 =
forall a. HasCallStack => [Char] -> a
error [Char]
"Using FilterFold1 with an empty kernel."
| Bool
otherwise =
(res
res, SeparableFilterAccumulator src res src_pix
tmp)
where
!size :: Size
size@(Z
Z :. Int
ih :. Int
iw) = forall i. MaskedImage i => i -> Size
shape src
src
!(Z
Z :. Int
kh :. Int
kw) = Size
ksize
!(Z
Z :. Int
kcy :. Int
kcx) = KernelAnchor -> Size -> Size
kernelAnchor KernelAnchor
anchor Size
ksize
!(SeparableKernel init -> DIM1 -> ImagePixel src -> ImagePixel src -> ImagePixel src
vert init -> DIM1 -> ImagePixel src -> ImagePixel src -> ImagePixel src
horiz) = SeparableKernel (ImagePixel src) init (ImagePixel src)
kernel
!tmp :: SeparableFilterAccumulator src res src_pix
tmp = forall i.
FromFunction i =>
Size -> (Size -> FromFunctionPixel i) -> i
fromFunction Size
size forall a b. (a -> b) -> a -> b
$ \(!pt :: Size
pt@(Z
Z :. Int
iy :. Int
ix)) ->
let pix :: ImagePixel src
pix = src
src forall i. Image i => i -> Size -> ImagePixel i
! Size
pt
!ini :: init
ini = Size -> ImagePixel src -> init
initF Size
pt ImagePixel src
pix
!iy0 :: Int
iy0 = Int
iy forall a. Num a => a -> a -> a
- Int
kcy
in if Int
iy0 forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
iy0 forall a. Num a => a -> a -> a
+ Int
kh forall a. Ord a => a -> a -> Bool
<= Int
ih
then init -> Int -> Int -> src_pix
goColumn1Safe init
ini Int
iy0 Int
ix
else init -> Int -> Int -> src_pix
goColumn1 init
ini Int
iy0 Int
ix
!res :: res
res = forall i.
FromFunction i =>
Size -> (Size -> FromFunctionPixel i) -> i
fromFunction Size
size forall a b. (a -> b) -> a -> b
$ \(!pt :: Size
pt@(Z
Z :. Int
iy :. Int
ix)) ->
let pix :: ImagePixel src
pix = src
src forall i. Image i => i -> Size -> ImagePixel i
! Size
pt
!ini :: init
ini = Size -> ImagePixel src -> init
initF Size
pt ImagePixel src
pix
!ix0 :: Int
ix0 = Int
ix forall a. Num a => a -> a -> a
- Int
kcx
in Size
-> ImagePixel src
-> init
-> ImagePixel src
-> FromFunctionPixel res
post Size
pt ImagePixel src
pix init
ini forall a b. (a -> b) -> a -> b
$!
if Int
ix0 forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
ix0 forall a. Num a => a -> a -> a
+ Int
kw forall a. Ord a => a -> a -> Bool
<= Int
iw
then init -> Int -> Int -> src_pix
goLine1Safe init
ini (Int
iy forall a. Num a => a -> a -> a
* Int
iw) Int
ix0
else init -> Int -> Int -> src_pix
goLine1 init
ini (Int
iy forall a. Num a => a -> a -> a
* Int
iw) Int
ix0
goColumn1 :: init -> Int -> Int -> src_pix
goColumn1 !init
ini !Int
iy !Int
ix =
case forall a. BorderInterpolate a -> Int -> Int -> Either Int a
borderInterpolate BorderInterpolate (ImagePixel src)
interpol Int
ih Int
iy of
Left Int
iy' ->
let !acc :: ImagePixel src
acc = src
src forall i. Image i => i -> Size -> ImagePixel i
! Int -> Int -> Size
ix2 Int
iy' Int
ix
in init -> Int -> Int -> Int -> src_pix -> src_pix
goColumn init
ini (Int
iy forall a. Num a => a -> a -> a
+ Int
1) Int
ix Int
1 ImagePixel src
acc
Right src_pix
val ->
init -> Int -> Int -> Int -> src_pix -> src_pix
goColumn init
ini (Int
iy forall a. Num a => a -> a -> a
+ Int
1) Int
ix Int
1 src_pix
val
goColumn1Safe :: init -> Int -> Int -> src_pix
goColumn1Safe !init
ini !Int
iy !Int
ix =
let !linearIY :: Int
linearIY = Int
iy forall a. Num a => a -> a -> a
* Int
iw
!acc :: ImagePixel src
acc = src
src forall i. Image i => i -> Int -> ImagePixel i
`linearIndex` (Int
linearIY forall a. Num a => a -> a -> a
+ Int
ix)
in init -> Int -> Int -> Int -> src_pix -> src_pix
goColumnSafe init
ini (Int
linearIY forall a. Num a => a -> a -> a
+ Int
iw) Int
ix Int
1 ImagePixel src
acc
goColumn :: init -> Int -> Int -> Int -> src_pix -> src_pix
goColumn !init
ini !Int
iy !Int
ix !Int
ky !src_pix
acc
| Int
ky forall a. Ord a => a -> a -> Bool
< Int
kh =
let !val :: ImagePixel src
val = case forall a. BorderInterpolate a -> Int -> Int -> Either Int a
borderInterpolate BorderInterpolate (ImagePixel src)
interpol Int
ih Int
iy of
Left Int
iy' -> src
src forall i. Image i => i -> Size -> ImagePixel i
! Int -> Int -> Size
ix2 Int
iy' Int
ix
Right src_pix
val' -> src_pix
val'
!acc' :: ImagePixel src
acc' = init -> DIM1 -> ImagePixel src -> ImagePixel src -> ImagePixel src
vert init
ini (Int -> DIM1
ix1 Int
ky) ImagePixel src
val src_pix
acc
in init -> Int -> Int -> Int -> src_pix -> src_pix
goColumn init
ini (Int
iy forall a. Num a => a -> a -> a
+ Int
1) Int
ix (Int
ky forall a. Num a => a -> a -> a
+ Int
1) ImagePixel src
acc'
| Bool
otherwise = src_pix
acc
goColumnSafe :: init -> Int -> Int -> Int -> src_pix -> src_pix
goColumnSafe !init
ini !Int
linearIY !Int
ix !Int
ky !src_pix
acc
| Int
ky forall a. Ord a => a -> a -> Bool
< Int
kh =
let !val :: ImagePixel src
val = src
src forall i. Image i => i -> Int -> ImagePixel i
`linearIndex` (Int
linearIY forall a. Num a => a -> a -> a
+ Int
ix)
!acc' :: ImagePixel src
acc' = init -> DIM1 -> ImagePixel src -> ImagePixel src -> ImagePixel src
vert init
ini (Int -> DIM1
ix1 Int
ky) ImagePixel src
val src_pix
acc
in init -> Int -> Int -> Int -> src_pix -> src_pix
goColumnSafe init
ini (Int
linearIY forall a. Num a => a -> a -> a
+ Int
iw) Int
ix (Int
ky forall a. Num a => a -> a -> a
+ Int
1) ImagePixel src
acc'
| Bool
otherwise = src_pix
acc
goLine1 :: init -> Int -> Int -> src_pix
goLine1 !init
ini !Int
linearIY !Int
ix =
let !acc :: ImagePixel (SeparableFilterAccumulator src res src_pix)
acc =
case forall a. BorderInterpolate a -> Int -> Int -> Either Int a
borderInterpolate BorderInterpolate (ImagePixel src)
interpol Int
iw Int
ix of
Left Int
ix' -> SeparableFilterAccumulator src res src_pix
tmp forall i. Image i => i -> Int -> ImagePixel i
`linearIndex` (Int
linearIY forall a. Num a => a -> a -> a
+ Int
ix')
Right src_pix
val -> init -> src_pix -> src_pix
columnConst init
ini src_pix
val
in init -> Int -> Int -> Int -> src_pix -> src_pix
goLine init
ini Int
linearIY (Int
ix forall a. Num a => a -> a -> a
+ Int
1) Int
1 ImagePixel (SeparableFilterAccumulator src res src_pix)
acc
goLine1Safe :: init -> Int -> Int -> src_pix
goLine1Safe !init
ini !Int
linearIY !Int
ix =
let !linearIX :: Int
linearIX = Int
linearIY forall a. Num a => a -> a -> a
+ Int
ix
!acc :: ImagePixel (SeparableFilterAccumulator src res src_pix)
acc = SeparableFilterAccumulator src res src_pix
tmp forall i. Image i => i -> Int -> ImagePixel i
`linearIndex` Int
linearIX
in init -> Int -> Int -> src_pix -> src_pix
goLineSafe init
ini (Int
linearIX forall a. Num a => a -> a -> a
+ Int
1) Int
1 ImagePixel (SeparableFilterAccumulator src res src_pix)
acc
goLine :: init -> Int -> Int -> Int -> src_pix -> src_pix
goLine !init
ini !Int
linearIY !Int
ix !Int
kx !src_pix
acc
| Int
kx forall a. Ord a => a -> a -> Bool
< Int
kw =
let !val :: ImagePixel (SeparableFilterAccumulator src res src_pix)
val =
case forall a. BorderInterpolate a -> Int -> Int -> Either Int a
borderInterpolate BorderInterpolate (ImagePixel src)
interpol Int
iw Int
ix of
Left Int
ix' -> SeparableFilterAccumulator src res src_pix
tmp forall i. Image i => i -> Int -> ImagePixel i
`linearIndex` (Int
linearIY forall a. Num a => a -> a -> a
+ Int
ix')
Right src_pix
val' -> init -> src_pix -> src_pix
columnConst init
ini src_pix
val'
!acc' :: ImagePixel src
acc' = init -> DIM1 -> ImagePixel src -> ImagePixel src -> ImagePixel src
horiz init
ini (Int -> DIM1
ix1 Int
kx) ImagePixel (SeparableFilterAccumulator src res src_pix)
val src_pix
acc
in init -> Int -> Int -> Int -> src_pix -> src_pix
goLine init
ini Int
linearIY (Int
ix forall a. Num a => a -> a -> a
+ Int
1) (Int
kx forall a. Num a => a -> a -> a
+ Int
1) ImagePixel src
acc'
| Bool
otherwise = src_pix
acc
goLineSafe :: init -> Int -> Int -> src_pix -> src_pix
goLineSafe !init
ini !Int
linearIX !Int
kx !src_pix
acc
| Int
kx forall a. Ord a => a -> a -> Bool
< Int
kw =
let !val :: ImagePixel (SeparableFilterAccumulator src res src_pix)
val = SeparableFilterAccumulator src res src_pix
tmp forall i. Image i => i -> Int -> ImagePixel i
`linearIndex` Int
linearIX
!acc' :: ImagePixel src
acc' = init -> DIM1 -> ImagePixel src -> ImagePixel src -> ImagePixel src
horiz init
ini (Int -> DIM1
ix1 Int
kx) ImagePixel (SeparableFilterAccumulator src res src_pix)
val src_pix
acc
in init -> Int -> Int -> src_pix -> src_pix
goLineSafe init
ini (Int
linearIX forall a. Num a => a -> a -> a
+ Int
1) (Int
kx forall a. Num a => a -> a -> a
+ Int
1) ImagePixel src
acc'
| Bool
otherwise = src_pix
acc
columnConst :: init -> src_pix -> src_pix
columnConst !init
ini !src_pix
constVal = init -> Int -> src_pix -> src_pix -> src_pix
goColumnConst init
ini Int
1 src_pix
constVal src_pix
constVal
goColumnConst :: init -> Int -> src_pix -> src_pix -> src_pix
goColumnConst !init
ini !Int
ky !src_pix
constVal !src_pix
acc
| Int
ky forall a. Ord a => a -> a -> Bool
< Int
kh = init -> Int -> src_pix -> src_pix -> src_pix
goColumnConst init
ini (Int
ky forall a. Num a => a -> a -> a
+ Int
1) src_pix
constVal
(init -> DIM1 -> ImagePixel src -> ImagePixel src -> ImagePixel src
vert init
ini (Int -> DIM1
ix1 Int
ky) src_pix
acc src_pix
constVal)
| Bool
otherwise = src_pix
acc
{-# INLINE wrapper #-}
{-# INLINE apply #-}
kernelAnchor :: KernelAnchor -> Size -> Point
kernelAnchor :: KernelAnchor -> Size -> Size
kernelAnchor (KernelAnchor Size
ix) Size
_ = Size
ix
kernelAnchor (KernelAnchor
KernelAnchorCenter) (Z
Z :. Int
kh :. Int
kw) = Int -> Int -> Size
ix2 (forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ (Int
kh forall a. Num a => a -> a -> a
- Int
1) forall a. Integral a => a -> a -> Ratio a
% Int
2)
(forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ (Int
kw forall a. Num a => a -> a -> a
- Int
1) forall a. Integral a => a -> a -> Ratio a
% Int
2)
borderInterpolate :: BorderInterpolate a
-> Int
-> Int
-> Either Int a
borderInterpolate :: forall a. BorderInterpolate a -> Int -> Int -> Either Int a
borderInterpolate !BorderInterpolate a
interpol !Int
len !Int
ix
| forall a. Integral a => a -> Word
word Int
ix forall a. Ord a => a -> a -> Bool
< forall a. Integral a => a -> Word
word Int
len = forall a b. a -> Either a b
Left Int
ix
| Bool
otherwise =
case BorderInterpolate a
interpol of
BorderInterpolate a
BorderReplicate | Int
ix forall a. Ord a => a -> a -> Bool
< Int
0 -> forall a b. a -> Either a b
Left Int
0
| Bool
otherwise -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$! Int
len forall a. Num a => a -> a -> a
- Int
1
BorderInterpolate a
BorderReflect -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$! Int -> Int
goReflect Int
ix
BorderInterpolate a
BorderWrap -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$! Int
ix forall a. Integral a => a -> a -> a
`mod` Int
len
BorderConstant a
i -> forall a b. b -> Either a b
Right a
i
where
goReflect :: Int -> Int
goReflect !Int
ix' | Int
ix' forall a. Ord a => a -> a -> Bool
< Int
0 = Int -> Int
goReflect (-Int
ix' forall a. Num a => a -> a -> a
- Int
1)
| Int
ix' forall a. Ord a => a -> a -> Bool
>= Int
len = Int -> Int
goReflect ((Int
len forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
- (Int
ix' forall a. Num a => a -> a -> a
- Int
len))
| Bool
otherwise = Int
ix'
{-# INLINE borderInterpolate #-}
type Morphological pix = SeparableFilter1 pix () pix
dilate :: Ord pix => Int -> Morphological pix
dilate :: forall pix. Ord pix => Int -> Morphological pix
dilate Int
radius =
forall src kernel init fold acc res.
Size
-> KernelAnchor
-> kernel
-> (Size -> src -> init)
-> fold
-> (Size -> src -> init -> acc -> res)
-> BorderInterpolate src
-> Filter src kernel init fold acc res
Filter (Int -> Int -> Size
ix2 Int
size Int
size) KernelAnchor
KernelAnchorCenter (forall src init acc.
(init -> DIM1 -> src -> acc -> acc)
-> (init -> DIM1 -> acc -> acc -> acc)
-> SeparableKernel src init acc
SeparableKernel forall {a} {p} {p}. Ord a => p -> p -> a -> a -> a
kernel forall {a} {p} {p}. Ord a => p -> p -> a -> a -> a
kernel)
(\Size
_ pix
_ -> ()) FilterFold1
FilterFold1 (\Size
_ pix
_ ()
_ !pix
acc -> pix
acc) forall a. BorderInterpolate a
BorderReplicate
where
!size :: Int
size = Int
radius forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
+ Int
1
kernel :: p -> p -> a -> a -> a
kernel p
_ p
_ = forall a. Ord a => a -> a -> a
max
{-# INLINE dilate #-}
erode :: Ord pix => Int -> Morphological pix
erode :: forall pix. Ord pix => Int -> Morphological pix
erode Int
radius =
forall src kernel init fold acc res.
Size
-> KernelAnchor
-> kernel
-> (Size -> src -> init)
-> fold
-> (Size -> src -> init -> acc -> res)
-> BorderInterpolate src
-> Filter src kernel init fold acc res
Filter (Int -> Int -> Size
ix2 Int
size Int
size) KernelAnchor
KernelAnchorCenter (forall src init acc.
(init -> DIM1 -> src -> acc -> acc)
-> (init -> DIM1 -> acc -> acc -> acc)
-> SeparableKernel src init acc
SeparableKernel forall {a} {p} {p}. Ord a => p -> p -> a -> a -> a
kernel forall {a} {p} {p}. Ord a => p -> p -> a -> a -> a
kernel)
(\Size
_ pix
_ -> ()) FilterFold1
FilterFold1 (\Size
_ pix
_ ()
_ !pix
acc -> pix
acc) forall a. BorderInterpolate a
BorderReplicate
where
!size :: Int
size = Int
radius forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
+ Int
1
kernel :: p -> p -> a -> a -> a
kernel p
_ p
_ = forall a. Ord a => a -> a -> a
min
{-# INLINE erode #-}
type Blur src acc res = SeparableFilter src () acc res
blur :: (Integral src, Integral acc, Num res)
=> Int
-> Blur src acc res
blur :: forall src acc res.
(Integral src, Integral acc, Num res) =>
Int -> Blur src acc res
blur Int
radius =
forall src kernel init fold acc res.
Size
-> KernelAnchor
-> kernel
-> (Size -> src -> init)
-> fold
-> (Size -> src -> init -> acc -> res)
-> BorderInterpolate src
-> Filter src kernel init fold acc res
Filter (Int -> Int -> Size
ix2 Int
size Int
size) KernelAnchor
KernelAnchorCenter (forall src init acc.
(init -> DIM1 -> src -> acc -> acc)
-> (init -> DIM1 -> acc -> acc -> acc)
-> SeparableKernel src init acc
SeparableKernel forall {a} {a} {p} {p}.
(Integral a, Num a) =>
p -> p -> a -> a -> a
vert forall {a} {p} {p}. Num a => p -> p -> a -> a -> a
horiz)
(\Size
_ src
_ -> ()) (forall acc. (Size -> acc) -> FilterFold acc
FilterFold (forall a b. a -> b -> a
const acc
0)) Size -> src -> () -> acc -> res
post forall a. BorderInterpolate a
BorderReplicate
where
!size :: Int
size = Int
radius forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
+ Int
1
!nPixs :: acc
nPixs = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
square Int
size
vert :: p -> p -> a -> a -> a
vert p
_ p
_ !a
val !a
acc = a
acc forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
val
horiz :: p -> p -> a -> a -> a
horiz p
_ p
_ !a
acc' !a
acc = a
acc forall a. Num a => a -> a -> a
+ a
acc'
post :: Size -> src -> () -> acc -> res
post Size
_ src
_ ()
_ !acc
acc = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ acc
acc forall a. Integral a => a -> a -> a
`div` acc
nPixs
{-# INLINE blur #-}
gaussianBlur :: (Integral src, Floating acc, RealFrac acc, Storable acc
, Integral res)
=> Int
-> Maybe acc
-> Blur src acc res
gaussianBlur :: forall src acc res.
(Integral src, Floating acc, RealFrac acc, Storable acc,
Integral res) =>
Int -> Maybe acc -> Blur src acc res
gaussianBlur !Int
radius !Maybe acc
mSig =
forall src kernel init fold acc res.
Size
-> KernelAnchor
-> kernel
-> (Size -> src -> init)
-> fold
-> (Size -> src -> init -> acc -> res)
-> BorderInterpolate src
-> Filter src kernel init fold acc res
Filter (Int -> Int -> Size
ix2 Int
size Int
size) KernelAnchor
KernelAnchorCenter (forall src init acc.
(init -> DIM1 -> src -> acc -> acc)
-> (init -> DIM1 -> acc -> acc -> acc)
-> SeparableKernel src init acc
SeparableKernel () -> DIM1 -> src -> acc -> acc
vert () -> DIM1 -> acc -> acc -> acc
horiz)
(\Size
_ src
_ -> ()) (forall acc. (Size -> acc) -> FilterFold acc
FilterFold (forall a b. a -> b -> a
const acc
0)) (\Size
_ src
_ ()
_ !acc
acc -> forall a b. (RealFrac a, Integral b) => a -> b
round acc
acc)
forall a. BorderInterpolate a
BorderReplicate
where
!size :: Int
size = Int
radius forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
+ Int
1
!sig :: acc
sig = case Maybe acc
mSig of Just acc
s -> acc
s
Maybe acc
Nothing -> (acc
0.5 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
radius) forall a. Fractional a => a -> a -> a
/ acc
3
vert :: () -> DIM1 -> src -> acc -> acc
vert ()
_ !(Z
Z :. Int
y) !src
val !acc
acc = let !coeff :: acc
coeff = Vector acc
kernelVec forall a. Storable a => Vector a -> Int -> a
V.! Int
y
in acc
acc forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral src
val forall a. Num a => a -> a -> a
* acc
coeff
horiz :: () -> DIM1 -> acc -> acc -> acc
horiz ()
_ !(Z
Z :. Int
x) !acc
val !acc
acc = let !coeff :: acc
coeff = Vector acc
kernelVec forall a. Storable a => Vector a -> Int -> a
V.! Int
x
in acc
acc forall a. Num a => a -> a -> a
+ acc
val forall a. Num a => a -> a -> a
* acc
coeff
!kernelVec :: Vector acc
kernelVec =
let !unormalized :: Vector acc
unormalized = forall a. Storable a => Int -> (Int -> a) -> Vector a
V.generate Int
size forall a b. (a -> b) -> a -> b
$ \Int
x ->
acc -> acc
gaussian forall a b. (a -> b) -> a -> b
$! forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$! forall a. Num a => a -> a
abs forall a b. (a -> b) -> a -> b
$! Int
x forall a. Num a => a -> a -> a
- Int
radius
!kernelSum :: acc
kernelSum = forall a. (Storable a, Num a) => Vector a -> a
V.sum Vector acc
unormalized
in forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
V.map (forall a. Fractional a => a -> a -> a
/ acc
kernelSum) Vector acc
unormalized
gaussian :: acc -> acc
gaussian !acc
x = acc
invSigSqrt2Pi forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
exp (acc
inv2xSig2 forall a. Num a => a -> a -> a
* forall a. Num a => a -> a
square acc
x)
!invSigSqrt2Pi :: acc
invSigSqrt2Pi = acc
1 forall a. Fractional a => a -> a -> a
/ (acc
sig forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sqrt (acc
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi))
!inv2xSig2 :: acc
inv2xSig2 = -acc
1 forall a. Fractional a => a -> a -> a
/ (acc
2 forall a. Num a => a -> a -> a
* forall a. Num a => a -> a
square acc
sig)
{-# INLINE gaussianBlur #-}
type Derivative src res = SeparableFilter src () res res
data DerivativeType = DerivativeX | DerivativeY
scharr :: (Integral src, Integral res)
=> DerivativeType -> Derivative src res
scharr :: forall src res.
(Integral src, Integral res) =>
DerivativeType -> Derivative src res
scharr DerivativeType
der =
let !kernel :: SeparableKernel src () res
kernel =
case DerivativeType
der of
DerivativeType
DerivativeX -> forall src init acc.
(init -> DIM1 -> src -> acc -> acc)
-> (init -> DIM1 -> acc -> acc -> acc)
-> SeparableKernel src init acc
SeparableKernel forall {a} {a} {a} {p}.
(Integral a, Num a, Num a, Eq a) =>
p -> (Z :. a) -> a -> a -> a
kernel1 forall {a} {a} {a} {p}.
(Integral a, Num a, Num a, Eq a) =>
p -> (Z :. a) -> a -> a -> a
kernel2
DerivativeType
DerivativeY -> forall src init acc.
(init -> DIM1 -> src -> acc -> acc)
-> (init -> DIM1 -> acc -> acc -> acc)
-> SeparableKernel src init acc
SeparableKernel forall {a} {a} {a} {p}.
(Integral a, Num a, Num a, Eq a) =>
p -> (Z :. a) -> a -> a -> a
kernel2 forall {a} {a} {a} {p}.
(Integral a, Num a, Num a, Eq a) =>
p -> (Z :. a) -> a -> a -> a
kernel1
in forall src kernel init fold acc res.
Size
-> KernelAnchor
-> kernel
-> (Size -> src -> init)
-> fold
-> (Size -> src -> init -> acc -> res)
-> BorderInterpolate src
-> Filter src kernel init fold acc res
Filter (Int -> Int -> Size
ix2 Int
3 Int
3) KernelAnchor
KernelAnchorCenter SeparableKernel src () res
kernel (\Size
_ src
_ -> ())
(forall acc. (Size -> acc) -> FilterFold acc
FilterFold (forall a b. a -> b -> a
const res
0)) (\Size
_ src
_ ()
_ !res
acc -> res
acc) forall a. BorderInterpolate a
BorderReplicate
where
kernel1 :: p -> (Z :. a) -> a -> a -> a
kernel1 p
_ !(Z
Z :. a
1) !a
val !a
acc = a
acc forall a. Num a => a -> a -> a
+ a
10 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral a
val
kernel1 p
_ !(Z
Z :. a
_) !a
val !a
acc = a
acc forall a. Num a => a -> a -> a
+ a
3 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral a
val
kernel2 :: p -> (Z :. a) -> a -> a -> a
kernel2 p
_ !(Z
Z :. a
0) !a
val !a
acc = a
acc forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral a
val
kernel2 p
_ !(Z
Z :. a
1) !a
_ !a
acc = a
acc
kernel2 p
_ !(Z
Z :. ~a
2) !a
val !a
acc = a
acc forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
val
{-# INLINE scharr #-}
sobel :: (Integral src, Integral res, Storable res)
=> Int
-> DerivativeType
-> Derivative src res
sobel :: forall src res.
(Integral src, Integral res, Storable res) =>
Int -> DerivativeType -> Derivative src res
sobel Int
radius DerivativeType
der =
forall src kernel init fold acc res.
Size
-> KernelAnchor
-> kernel
-> (Size -> src -> init)
-> fold
-> (Size -> src -> init -> acc -> res)
-> BorderInterpolate src
-> Filter src kernel init fold acc res
Filter (Int -> Int -> Size
ix2 Int
size Int
size) KernelAnchor
KernelAnchorCenter (forall src init acc.
(init -> DIM1 -> src -> acc -> acc)
-> (init -> DIM1 -> acc -> acc -> acc)
-> SeparableKernel src init acc
SeparableKernel () -> DIM1 -> src -> res -> res
vert () -> DIM1 -> res -> res -> res
horiz)
(\Size
_ src
_ -> ()) (forall acc. (Size -> acc) -> FilterFold acc
FilterFold (forall a b. a -> b -> a
const res
0)) (\Size
_ src
_ ()
_ !res
acc -> res
acc)
forall a. BorderInterpolate a
BorderReplicate
where
!size :: Int
size = Int
radius forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
+ Int
1
vert :: () -> DIM1 -> src -> res -> res
vert ()
_ !(Z
Z :. Int
x) !src
val !res
acc = let !coeff :: res
coeff = Vector res
vec1 forall a. Storable a => Vector a -> Int -> a
V.! Int
x
in res
acc forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral src
val forall a. Num a => a -> a -> a
* res
coeff
horiz :: () -> DIM1 -> res -> res -> res
horiz ()
_ !(Z
Z :. Int
x) !res
val !res
acc = let !coeff :: res
coeff = Vector res
vec2 forall a. Storable a => Vector a -> Int -> a
V.! Int
x
in res
acc forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral res
val forall a. Num a => a -> a -> a
* res
coeff
!radius' :: res
radius' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
radius
(!Vector res
vec1, !Vector res
vec2) = case DerivativeType
der of DerivativeType
DerivativeX -> (Vector res
vec1', Vector res
vec2')
DerivativeType
DerivativeY -> (Vector res
vec2', Vector res
vec1')
!vec1' :: Vector res
vec1' = let pows :: [res]
pows = [ res
2forall a b. (Num a, Integral b) => a -> b -> a
^res
i | res
i <- [res
0..res
radius'] ]
in forall a. Storable a => [a] -> Vector a
V.fromList forall a b. (a -> b) -> a -> b
$ [res]
pows forall a. [a] -> [a] -> [a]
++ (forall a. [a] -> [a]
tail (forall a. [a] -> [a]
reverse [res]
pows))
!vec2' :: Vector res
vec2' = forall a. Storable a => [a] -> Vector a
V.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Num a => a -> a
negate [res
1..res
radius'] forall a. [a] -> [a] -> [a]
++ [res
0] forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
reverse [res
1..res
radius']
{-# INLINE sobel #-}
type Mean src acc res = SeparableFilter src () acc res
mean :: (Integral src, Integral acc, Fractional res)
=> Size -> SeparableFilter src () acc res
mean :: forall src acc res.
(Integral src, Integral acc, Fractional res) =>
Size -> SeparableFilter src () acc res
mean size :: Size
size@(Z
Z :. Int
h :. Int
w) =
forall src kernel init fold acc res.
Size
-> KernelAnchor
-> kernel
-> (Size -> src -> init)
-> fold
-> (Size -> src -> init -> acc -> res)
-> BorderInterpolate src
-> Filter src kernel init fold acc res
Filter Size
size KernelAnchor
KernelAnchorCenter (forall src init acc.
(init -> DIM1 -> src -> acc -> acc)
-> (init -> DIM1 -> acc -> acc -> acc)
-> SeparableKernel src init acc
SeparableKernel forall {a} {a} {p} {p}.
(Integral a, Num a) =>
p -> p -> a -> a -> a
vert forall {a} {p} {p}. Num a => p -> p -> a -> a -> a
horiz) (\Size
_ src
_ -> ())
(forall acc. (Size -> acc) -> FilterFold acc
FilterFold (forall a b. a -> b -> a
const acc
0)) Size -> src -> () -> acc -> res
post forall a. BorderInterpolate a
BorderReplicate
where
vert :: p -> p -> a -> a -> a
vert p
_ p
_ !a
val !a
acc = a
acc forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
val
horiz :: p -> p -> a -> a -> a
horiz p
_ p
_ !a
acc' !a
acc = a
acc forall a. Num a => a -> a -> a
+ a
acc'
!nPixsFactor :: res
nPixsFactor = res
1 forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$! Int
h forall a. Num a => a -> a -> a
* Int
w)
post :: Size -> src -> () -> acc -> res
post Size
_ src
_ ()
_ !acc
acc = forall a b. (Integral a, Num b) => a -> b
fromIntegral acc
acc forall a. Num a => a -> a -> a
* res
nPixsFactor
{-# INLINE mean #-}
square :: Num a => a -> a
square :: forall a. Num a => a -> a
square a
a = a
a forall a. Num a => a -> a -> a
* a
a
word :: Integral a => a -> Word
word :: forall a. Integral a => a -> Word
word = forall a b. (Integral a, Num b) => a -> b
fromIntegral