{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- |
-- Module      : Data.Massiv.Array.Stencil.Internal
-- Copyright   : (c) Alexey Kuleshevich 2018-2019
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
-- Stability   : experimental
-- Portability : non-portable
--
module Data.Massiv.Array.Stencil.Internal
  ( Stencil(..)
  , Value(..)
  , dimapStencil
  , lmapStencil
  , rmapStencil
  , validateStencil
  ) where

import Control.Applicative
import Control.DeepSeq
import Data.Massiv.Array.Delayed.Pull
import Data.Massiv.Core.Common

-- | 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 `Data.Array.makeStencil` and
-- `Data.Array.makeConvolutionStencil` in order to create a stencil.
data Stencil ix e a = Stencil
  { Stencil ix e a -> Sz ix
stencilSize   :: !(Sz ix)
  , Stencil ix e a -> ix
stencilCenter :: !ix
  , Stencil ix e a -> (ix -> Value e) -> ix -> Value a
stencilFunc   :: (ix -> Value e) -> ix -> Value a
  }


instance Index ix => NFData (Stencil ix e a) where
  rnf :: Stencil ix e a -> ()
rnf (Stencil Sz ix
sz ix
ix (ix -> Value e) -> ix -> Value a
f) = Sz ix
sz Sz ix -> ix -> ix
forall a b. NFData a => a -> b -> b
`deepseq` ix
ix ix
-> ((ix -> Value e) -> ix -> Value a)
-> (ix -> Value e)
-> ix
-> Value a
forall a b. NFData a => a -> b -> b
`deepseq` (ix -> Value e) -> ix -> Value a
f ((ix -> Value e) -> ix -> Value a) -> () -> ()
`seq` ()

-- | 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.
newtype Value e = Value
  { Value e -> e
unValue :: e
  } deriving (Value e
Value e -> Value e -> Bounded (Value e)
forall a. a -> a -> Bounded a
forall e. Bounded e => Value e
maxBound :: Value e
$cmaxBound :: forall e. Bounded e => Value e
minBound :: Value e
$cminBound :: forall e. Bounded e => Value e
Bounded)

instance Functor Value where
  fmap :: (a -> b) -> Value a -> Value b
fmap a -> b
f (Value a
e) = b -> Value b
forall e. e -> Value e
Value (a -> b
f a
e)
  {-# INLINE fmap #-}

instance Applicative Value where
  pure :: a -> Value a
pure = a -> Value a
forall e. e -> Value e
Value
  {-# INLINE pure #-}
  <*> :: Value (a -> b) -> Value a -> Value b
(<*>) (Value a -> b
f) (Value a
e) = b -> Value b
forall e. e -> Value e
Value (a -> b
f a
e)
  {-# INLINE (<*>) #-}

-- | @since 0.1.5
instance Semigroup a => Semigroup (Value a) where
  Value a
a <> :: Value a -> Value a -> Value a
<> Value a
b = a -> Value a
forall e. e -> Value e
Value (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b)
  {-# INLINE (<>) #-}

-- | @since 0.1.5
instance Monoid a => Monoid (Value a) where
  mempty :: Value a
mempty = a -> Value a
forall e. e -> Value e
Value a
forall a. Monoid a => a
mempty
  {-# INLINE mempty #-}
  Value a
a mappend :: Value a -> Value a -> Value a
`mappend` Value a
b = a -> Value a
forall e. e -> Value e
Value (a
a a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
b)
  {-# INLINE mappend #-}

instance Num e => Num (Value e) where
  + :: Value e -> Value e -> Value e
(+) = (e -> e -> e) -> Value e -> Value e -> Value e
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 e -> e -> e
forall a. Num a => a -> a -> a
(+)
  {-# INLINE (+) #-}
  * :: Value e -> Value e -> Value e
(*) = (e -> e -> e) -> Value e -> Value e -> Value e
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 e -> e -> e
forall a. Num a => a -> a -> a
(*)
  {-# INLINE (*) #-}
  negate :: Value e -> Value e
negate = (e -> e) -> Value e -> Value e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> e
forall a. Num a => a -> a
negate
  {-# INLINE negate #-}
  abs :: Value e -> Value e
abs = (e -> e) -> Value e -> Value e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> e
forall a. Num a => a -> a
abs
  {-# INLINE abs #-}
  signum :: Value e -> Value e
signum = (e -> e) -> Value e -> Value e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> e
forall a. Num a => a -> a
signum
  {-# INLINE signum #-}
  fromInteger :: Integer -> Value e
fromInteger = e -> Value e
forall e. e -> Value e
Value (e -> Value e) -> (Integer -> e) -> Integer -> Value e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> e
forall a. Num a => Integer -> a
fromInteger
  {-# INLINE fromInteger #-}

instance Fractional e => Fractional (Value e) where
  / :: Value e -> Value e -> Value e
(/) = (e -> e -> e) -> Value e -> Value e -> Value e
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 e -> e -> e
forall a. Fractional a => a -> a -> a
(/)
  {-# INLINE (/) #-}
  recip :: Value e -> Value e
recip = (e -> e) -> Value e -> Value e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> e
forall a. Fractional a => a -> a
recip
  {-# INLINE recip #-}
  fromRational :: Rational -> Value e
fromRational = e -> Value e
forall (f :: * -> *) a. Applicative f => a -> f a
pure (e -> Value e) -> (Rational -> e) -> Rational -> Value e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> e
forall a. Fractional a => Rational -> a
fromRational
  {-# INLINE fromRational #-}

instance Floating e => Floating (Value e) where
  pi :: Value e
pi = e -> Value e
forall (f :: * -> *) a. Applicative f => a -> f a
pure e
forall a. Floating a => a
pi
  {-# INLINE pi #-}
  exp :: Value e -> Value e
exp = (e -> e) -> Value e -> Value e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> e
forall a. Floating a => a -> a
exp
  {-# INLINE exp #-}
  log :: Value e -> Value e
log = (e -> e) -> Value e -> Value e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> e
forall a. Floating a => a -> a
log
  {-# INLINE log #-}
  sqrt :: Value e -> Value e
sqrt = (e -> e) -> Value e -> Value e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> e
forall a. Floating a => a -> a
sqrt
  {-# INLINE sqrt #-}
  ** :: Value e -> Value e -> Value e
(**) = (e -> e -> e) -> Value e -> Value e -> Value e
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 e -> e -> e
forall a. Floating a => a -> a -> a
(**)
  {-# INLINE (**) #-}
  logBase :: Value e -> Value e -> Value e
logBase = (e -> e -> e) -> Value e -> Value e -> Value e
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 e -> e -> e
forall a. Floating a => a -> a -> a
logBase
  {-# INLINE logBase #-}
  sin :: Value e -> Value e
sin = (e -> e) -> Value e -> Value e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> e
forall a. Floating a => a -> a
sin
  {-# INLINE sin #-}
  cos :: Value e -> Value e
cos = (e -> e) -> Value e -> Value e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> e
forall a. Floating a => a -> a
cos
  {-# INLINE cos #-}
  tan :: Value e -> Value e
tan = (e -> e) -> Value e -> Value e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> e
forall a. Floating a => a -> a
tan
  {-# INLINE tan #-}
  asin :: Value e -> Value e
asin = (e -> e) -> Value e -> Value e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> e
forall a. Floating a => a -> a
asin
  {-# INLINE asin #-}
  acos :: Value e -> Value e
acos = (e -> e) -> Value e -> Value e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> e
forall a. Floating a => a -> a
acos
  {-# INLINE acos #-}
  atan :: Value e -> Value e
atan = (e -> e) -> Value e -> Value e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> e
forall a. Floating a => a -> a
atan
  {-# INLINE atan #-}
  sinh :: Value e -> Value e
sinh = (e -> e) -> Value e -> Value e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> e
forall a. Floating a => a -> a
sinh
  {-# INLINE sinh #-}
  cosh :: Value e -> Value e
cosh = (e -> e) -> Value e -> Value e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> e
forall a. Floating a => a -> a
cosh
  {-# INLINE cosh #-}
  tanh :: Value e -> Value e
tanh = (e -> e) -> Value e -> Value e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> e
forall a. Floating a => a -> a
tanh
  {-# INLINE tanh #-}
  asinh :: Value e -> Value e
asinh = (e -> e) -> Value e -> Value e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> e
forall a. Floating a => a -> a
asinh
  {-# INLINE asinh #-}
  acosh :: Value e -> Value e
acosh = (e -> e) -> Value e -> Value e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> e
forall a. Floating a => a -> a
acosh
  {-# INLINE acosh #-}
  atanh :: Value e -> Value e
atanh = (e -> e) -> Value e -> Value e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> e
forall a. Floating a => a -> a
atanh
  {-# INLINE atanh #-}




instance Functor (Stencil ix e) where
  fmap :: (a -> b) -> Stencil ix e a -> Stencil ix e b
fmap = (a -> b) -> Stencil ix e a -> Stencil ix e b
forall a b ix e. (a -> b) -> Stencil ix e a -> Stencil ix e b
rmapStencil
  {-# INLINE fmap #-}


-- Profunctor

-- | A Profunctor dimap. Same caviat applies as in `lmapStencil`
--
-- @since 0.2.3
dimapStencil :: (c -> d) -> (a -> b) -> Stencil ix d a -> Stencil ix c b
dimapStencil :: (c -> d) -> (a -> b) -> Stencil ix d a -> Stencil ix c b
dimapStencil c -> d
f a -> b
g stencil :: Stencil ix d a
stencil@Stencil {stencilFunc :: forall ix e a. Stencil ix e a -> (ix -> Value e) -> ix -> Value a
stencilFunc = (ix -> Value d) -> ix -> Value a
sf} = Stencil ix d a
stencil {stencilFunc :: (ix -> Value c) -> ix -> Value b
stencilFunc = (ix -> Value c) -> ix -> Value b
sf'}
  where
    sf' :: (ix -> Value c) -> ix -> Value b
sf' ix -> Value c
s = b -> Value b
forall e. e -> Value e
Value (b -> Value b) -> (ix -> b) -> ix -> Value b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
g (a -> b) -> (ix -> a) -> ix -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value a -> a
forall e. Value e -> e
unValue (Value a -> a) -> (ix -> Value a) -> ix -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ix -> Value d) -> ix -> Value a
sf (d -> Value d
forall e. e -> Value e
Value (d -> Value d) -> (ix -> d) -> ix -> Value d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> d
f (c -> d) -> (ix -> c) -> ix -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value c -> c
forall e. Value e -> e
unValue (Value c -> c) -> (ix -> Value c) -> ix -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ix -> Value c
s)
    {-# INLINE sf' #-}
{-# INLINE dimapStencil #-}

-- | 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
lmapStencil :: (c -> d) -> Stencil ix d a -> Stencil ix c a
lmapStencil :: (c -> d) -> Stencil ix d a -> Stencil ix c a
lmapStencil c -> d
f stencil :: Stencil ix d a
stencil@Stencil {stencilFunc :: forall ix e a. Stencil ix e a -> (ix -> Value e) -> ix -> Value a
stencilFunc = (ix -> Value d) -> ix -> Value a
sf} = Stencil ix d a
stencil {stencilFunc :: (ix -> Value c) -> ix -> Value a
stencilFunc = (ix -> Value c) -> ix -> Value a
sf'}
  where
    sf' :: (ix -> Value c) -> ix -> Value a
sf' ix -> Value c
s = (ix -> Value d) -> ix -> Value a
sf (d -> Value d
forall e. e -> Value e
Value (d -> Value d) -> (ix -> d) -> ix -> Value d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> d
f (c -> d) -> (ix -> c) -> ix -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value c -> c
forall e. Value e -> e
unValue (Value c -> c) -> (ix -> Value c) -> ix -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ix -> Value c
s)
    {-# INLINE sf' #-}
{-# INLINE lmapStencil #-}

-- | A covariant map over the right most type argument. In other words a usual Functor `fmap`:
--
-- > fmap == rmapStencil
--
-- @since 0.2.3
rmapStencil :: (a -> b) -> Stencil ix e a -> Stencil ix e b
rmapStencil :: (a -> b) -> Stencil ix e a -> Stencil ix e b
rmapStencil a -> b
f stencil :: Stencil ix e a
stencil@Stencil {stencilFunc :: forall ix e a. Stencil ix e a -> (ix -> Value e) -> ix -> Value a
stencilFunc = (ix -> Value e) -> ix -> Value a
sf} = Stencil ix e a
stencil {stencilFunc :: (ix -> Value e) -> ix -> Value b
stencilFunc = (ix -> Value e) -> ix -> Value b
sf'}
  where
    sf' :: (ix -> Value e) -> ix -> Value b
sf' ix -> Value e
s = b -> Value b
forall e. e -> Value e
Value (b -> Value b) -> (ix -> b) -> ix -> Value b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f (a -> b) -> (ix -> a) -> ix -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value a -> a
forall e. Value e -> e
unValue (Value a -> a) -> (ix -> Value a) -> ix -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ix -> Value e) -> ix -> Value a
sf ix -> Value e
s
    {-# INLINE sf' #-}
{-# INLINE rmapStencil #-}



-- TODO: Figure out interchange law (u <*> pure y = pure ($ y) <*> u) and issue
-- with discarding size and center. Best idea so far is to increase stencil size to
-- the maximum one and shift the center of the other stencil so that they both match
-- up. This approach would also remove requirement to validate the result
-- Stencil - both stencils are trusted, increasing the size will not affect the
-- safety.
instance Index ix => Applicative (Stencil ix e) where
  pure :: a -> Stencil ix e a
pure a
a = Sz ix -> ix -> ((ix -> Value e) -> ix -> Value a) -> Stencil ix e a
forall ix e a.
Sz ix -> ix -> ((ix -> Value e) -> ix -> Value a) -> Stencil ix e a
Stencil Sz ix
forall ix. Index ix => Sz ix
oneSz ix
forall ix. Index ix => ix
zeroIndex ((ix -> Value a) -> (ix -> Value e) -> ix -> Value a
forall a b. a -> b -> a
const (Value a -> ix -> Value a
forall a b. a -> b -> a
const (a -> Value a
forall e. e -> Value e
Value a
a)))
  {-# INLINE pure #-}
  <*> :: Stencil ix e (a -> b) -> Stencil ix e a -> Stencil ix e b
(<*>) (Stencil (SafeSz ix
sSz1) ix
sC1 (ix -> Value e) -> ix -> Value (a -> b)
f1) (Stencil (SafeSz ix
sSz2) ix
sC2 (ix -> Value e) -> ix -> Value a
f2) = Sz ix -> ix -> ((ix -> Value e) -> ix -> Value b) -> Stencil ix e b
forall ix e a.
Sz ix -> ix -> ((ix -> Value e) -> ix -> Value a) -> Stencil ix e a
Stencil Sz ix
newSz ix
maxCenter (ix -> Value e) -> ix -> Value b
stF
    where
      stF :: (ix -> Value e) -> ix -> Value b
stF ix -> Value e
gV !ix
ix = b -> Value b
forall e. e -> Value e
Value (Value (a -> b) -> a -> b
forall e. Value e -> e
unValue ((ix -> Value e) -> ix -> Value (a -> b)
f1 ix -> Value e
gV ix
ix) (Value a -> a
forall e. Value e -> e
unValue ((ix -> Value e) -> ix -> Value a
f2 ix -> Value e
gV ix
ix)))
      {-# INLINE stF #-}
      !newSz :: Sz ix
newSz =
        ix -> Sz ix
forall ix. Index ix => ix -> Sz ix
Sz
          ((Int -> Int -> Int) -> ix -> ix -> ix
forall ix. Index ix => (Int -> Int -> Int) -> ix -> ix -> ix
liftIndex2
             Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)
             ix
maxCenter
             ((Int -> Int -> Int) -> ix -> ix -> ix
forall ix. Index ix => (Int -> Int -> Int) -> ix -> ix -> ix
liftIndex2 Int -> Int -> Int
forall a. Ord a => a -> a -> a
max ((Int -> Int -> Int) -> ix -> ix -> ix
forall ix. Index ix => (Int -> Int -> Int) -> ix -> ix -> ix
liftIndex2 (-) ix
sSz1 ix
sC1) ((Int -> Int -> Int) -> ix -> ix -> ix
forall ix. Index ix => (Int -> Int -> Int) -> ix -> ix -> ix
liftIndex2 (-) ix
sSz2 ix
sC2)))
      !maxCenter :: ix
maxCenter = (Int -> Int -> Int) -> ix -> ix -> ix
forall ix. Index ix => (Int -> Int -> Int) -> ix -> ix -> ix
liftIndex2 Int -> Int -> Int
forall a. Ord a => a -> a -> a
max ix
sC1 ix
sC2
  {-# INLINE (<*>) #-}

instance (Index ix, Num a) => Num (Stencil ix e a) where
  + :: Stencil ix e a -> Stencil ix e a -> Stencil ix e a
(+) = (a -> a -> a) -> Stencil ix e a -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(+)
  {-# INLINE (+) #-}
  (-) = (a -> a -> a) -> Stencil ix e a -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-)
  {-# INLINE (-) #-}
  * :: Stencil ix e a -> Stencil ix e a -> Stencil ix e a
(*) = (a -> a -> a) -> Stencil ix e a -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(*)
  {-# INLINE (*) #-}
  negate :: Stencil ix e a -> Stencil ix e a
negate = (a -> a) -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
negate
  {-# INLINE negate #-}
  abs :: Stencil ix e a -> Stencil ix e a
abs = (a -> a) -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
abs
  {-# INLINE abs #-}
  signum :: Stencil ix e a -> Stencil ix e a
signum = (a -> a) -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
signum
  {-# INLINE signum #-}
  fromInteger :: Integer -> Stencil ix e a
fromInteger = a -> Stencil ix e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Stencil ix e a)
-> (Integer -> a) -> Integer -> Stencil ix e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger
  {-# INLINE fromInteger #-}

instance (Index ix, Fractional a) => Fractional (Stencil ix e a) where
  / :: Stencil ix e a -> Stencil ix e a -> Stencil ix e a
(/) = (a -> a -> a) -> Stencil ix e a -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Fractional a => a -> a -> a
(/)
  {-# INLINE (/) #-}
  recip :: Stencil ix e a -> Stencil ix e a
recip = (a -> a) -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Fractional a => a -> a
recip
  {-# INLINE recip #-}
  fromRational :: Rational -> Stencil ix e a
fromRational = a -> Stencil ix e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Stencil ix e a)
-> (Rational -> a) -> Rational -> Stencil ix e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
fromRational
  {-# INLINE fromRational #-}

instance (Index ix, Floating a) => Floating (Stencil ix e a) where
  pi :: Stencil ix e a
pi = a -> Stencil ix e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Floating a => a
pi
  {-# INLINE pi #-}
  exp :: Stencil ix e a -> Stencil ix e a
exp = (a -> a) -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
exp
  {-# INLINE exp #-}
  log :: Stencil ix e a -> Stencil ix e a
log = (a -> a) -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
log
  {-# INLINE log #-}
  sqrt :: Stencil ix e a -> Stencil ix e a
sqrt = (a -> a) -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
sqrt
  {-# INLINE sqrt #-}
  ** :: Stencil ix e a -> Stencil ix e a -> Stencil ix e a
(**) = (a -> a -> a) -> Stencil ix e a -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Floating a => a -> a -> a
(**)
  {-# INLINE (**) #-}
  logBase :: Stencil ix e a -> Stencil ix e a -> Stencil ix e a
logBase = (a -> a -> a) -> Stencil ix e a -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Floating a => a -> a -> a
logBase
  {-# INLINE logBase #-}
  sin :: Stencil ix e a -> Stencil ix e a
sin = (a -> a) -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
sin
  {-# INLINE sin #-}
  cos :: Stencil ix e a -> Stencil ix e a
cos = (a -> a) -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
cos
  {-# INLINE cos #-}
  tan :: Stencil ix e a -> Stencil ix e a
tan = (a -> a) -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
tan
  {-# INLINE tan #-}
  asin :: Stencil ix e a -> Stencil ix e a
asin = (a -> a) -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
asin
  {-# INLINE asin #-}
  acos :: Stencil ix e a -> Stencil ix e a
acos = (a -> a) -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
acos
  {-# INLINE acos #-}
  atan :: Stencil ix e a -> Stencil ix e a
atan = (a -> a) -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
atan
  {-# INLINE atan #-}
  sinh :: Stencil ix e a -> Stencil ix e a
sinh = (a -> a) -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
sinh
  {-# INLINE sinh #-}
  cosh :: Stencil ix e a -> Stencil ix e a
cosh = (a -> a) -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
cosh
  {-# INLINE cosh #-}
  tanh :: Stencil ix e a -> Stencil ix e a
tanh = (a -> a) -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
tanh
  {-# INLINE tanh #-}
  asinh :: Stencil ix e a -> Stencil ix e a
asinh = (a -> a) -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
asinh
  {-# INLINE asinh #-}
  acosh :: Stencil ix e a -> Stencil ix e a
acosh = (a -> a) -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
acosh
  {-# INLINE acosh #-}
  atanh :: Stencil ix e a -> Stencil ix e a
atanh = (a -> a) -> Stencil ix e a -> Stencil ix e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
atanh
  {-# INLINE atanh #-}


safeStencilIndex :: Index ix => Array D ix e -> ix -> e
safeStencilIndex :: Array D ix e -> ix -> e
safeStencilIndex DArray {..} ix
ix
  | Sz ix -> ix -> Bool
forall ix. Index ix => Sz ix -> ix -> Bool
isSafeIndex Sz ix
dSize ix
ix = ix -> e
dIndex ix
ix
  | Bool
otherwise = IndexException -> e
forall a e. Exception e => e -> a
throw (IndexException -> e) -> IndexException -> e
forall a b. (a -> b) -> a -> b
$ Sz ix -> ix -> IndexException
forall ix. Index ix => Sz ix -> ix -> IndexException
IndexOutOfBoundsException Sz ix
dSize ix
ix


-- | Make sure constructed stencil doesn't index outside the allowed stencil size boundary.
validateStencil
  :: Index ix
  => e -> Stencil ix e a -> Stencil ix e a
validateStencil :: e -> Stencil ix e a -> Stencil ix e a
validateStencil e
d s :: Stencil ix e a
s@(Stencil Sz ix
sSz ix
sCenter (ix -> Value e) -> ix -> Value a
stencil)
  | Sz ix -> ix -> Bool
forall ix. Index ix => Sz ix -> ix -> Bool
isSafeIndex Sz ix
sSz ix
sCenter =
    let valArr :: Array D ix e
valArr = Comp -> Sz ix -> (ix -> e) -> Array D ix e
forall ix e. Comp -> Sz ix -> (ix -> e) -> Array D ix e
DArray Comp
Seq Sz ix
sSz (e -> ix -> e
forall a b. a -> b -> a
const e
d)
     in (ix -> Value e) -> ix -> Value a
stencil (e -> Value e
forall e. e -> Value e
Value (e -> Value e) -> (ix -> e) -> ix -> Value e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array D ix e -> ix -> e
forall ix e. Index ix => Array D ix e -> ix -> e
safeStencilIndex Array D ix e
valArr) ix
sCenter Value a -> Stencil ix e a -> Stencil ix e a
`seq` Stencil ix e a
s
  | Bool
otherwise = IndexException -> Stencil ix e a
forall a e. Exception e => e -> a
throw (IndexException -> Stencil ix e a)
-> IndexException -> Stencil ix e a
forall a b. (a -> b) -> a -> b
$ Sz ix -> ix -> IndexException
forall ix. Index ix => Sz ix -> ix -> IndexException
IndexOutOfBoundsException Sz ix
sSz ix
sCenter
{-# INLINE validateStencil #-}