content: {-# LANGUAGE BangPatterns      #-}
  {-# LANGUAGE DefaultSignatures #-}
  {-# LANGUAGE FlexibleContexts  #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE TypeOperators     #-}
  {-# OPTIONS_HADDOCK hide #-}
  -- |
  -- Module      : Data.Array.Accelerate.Test.Similar
  -- Copyright   : [2009..2020] The Accelerate Team
  -- License     : BSD3
  --
  -- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
  -- Stability   : experimental
  -- Portability : non-portable (GHC extensions)
  --
  
  module Data.Array.Accelerate.Test.Similar
    where
  
  import Data.Array.Accelerate.Data.Complex
  import Data.Array.Accelerate.Sugar.Array
  import Data.Array.Accelerate.Sugar.Elt
  import Data.Array.Accelerate.Sugar.Shape
  import Data.Array.Accelerate.Type
  
  import Hedgehog
  import Hedgehog.Internal.Source                           ( HasCallStack, withFrozenCallStack )
  
  import Prelude                                            hiding ( (!!) )
  
  
  -- | Fails the test if the two arguments are not equal, allowing for a small
  -- amount of floating point inaccuracy.
  --
  infix 4 ~~~
  (~~~) :: (MonadTest m, Similar a, Show a, HasCallStack) => a -> a -> m ()
  a ~~~ b = withFrozenCallStack $ Sim a === Sim b
  
  data Sim a = Sim a
  
  instance Similar a => Eq (Sim a) where
    Sim a == Sim b = a ~= b
  
  instance Show a => Show (Sim a) where
    show (Sim a) = show a
  
  
  -- | A class of things that support almost-equality, so that we can disregard
  -- small amounts of floating-point round-off error.
  --
  class Similar a where
    {-# INLINE (~=) #-}
    (~=) :: a -> a -> Bool
    default (~=) :: Eq a => a -> a -> Bool
    (~=) = (==)
  
  infix 4 ~=
  
  instance Similar ()
  instance Similar Z
  instance Similar All
  instance Similar Int
  instance Similar Int8
  instance Similar Int16
  instance Similar Int32
  instance Similar Int64
  instance Similar Word8
  instance Similar Word16
  instance Similar Word32
  instance Similar Word64
  instance Similar Char
  instance Similar Bool
  instance Similar CShort
  instance Similar CUShort
  instance Similar CInt
  instance Similar CUInt
  instance Similar CLong
  instance Similar CULong
  instance Similar CLLong
  instance Similar CULLong
  instance Similar CChar
  instance Similar CSChar
  instance Similar CUChar
  
  instance                   Similar (Any Z)
  instance (Eq sh, Eq sz) => Similar (sh:.sz)
  instance (Eq sh)        => Similar (Any (sh:.Int))
  
  instance Similar Half    where (~=) = absRelTol 0.05    0.5
  instance Similar Float   where (~=) = absRelTol 0.00005 0.005
  instance Similar Double  where (~=) = absRelTol 0.00005 0.005
  instance Similar CFloat  where (~=) = absRelTol 0.00005 0.005
  instance Similar CDouble where (~=) = absRelTol 0.00005 0.005
  
  instance (Similar a, Similar b) => Similar (a, b) where
    (x1, x2) ~= (y1, y2) = x1 ~= y1 && x2 ~= y2
  
  instance (Similar a, Similar b, Similar c) => Similar (a, b, c) where
    (x1, x2, x3) ~= (y1, y2, y3) = x1 ~= y1 && x2 ~= y2 && x3 ~= y3
  
  instance (Similar a, Similar b, Similar c, Similar d) => Similar (a, b, c, d) where
    (x1, x2, x3, x4) ~= (y1, y2, y3, y4) = x1 ~= y1 && x2 ~= y2 && x3 ~= y3 && x4 ~= y4
  
  instance (Similar a, Similar b, Similar c, Similar d, Similar e)
      => Similar (a, b, c, d, e) where
    (x1, x2, x3, x4, x5) ~= (y1, y2, y3, y4, y5) =
      x1 ~= y1 && x2 ~= y2 && x3 ~= y3 && x4 ~= y4 && x5 ~= y5
  
  instance (Similar a, Similar b, Similar c, Similar d, Similar e, Similar f)
      => Similar (a, b, c, d, e, f) where
    (x1, x2, x3, x4, x5, x6) ~= (y1, y2, y3, y4, y5, y6) =
      x1 ~= y1 && x2 ~= y2 && x3 ~= y3 && x4 ~= y4 && x5 ~= y5 && x6 ~= y6
  
  instance (Similar a, Similar b, Similar c, Similar d, Similar e, Similar f, Similar g)
      => Similar (a, b, c, d, e, f, g) where
    (x1, x2, x3, x4, x5, x6, x7) ~= (y1, y2, y3, y4, y5, y6, y7) =
      x1 ~= y1 && x2 ~= y2 && x3 ~= y3 && x4 ~= y4 && x5 ~= y5 && x6 ~= y6 && x7 ~= y7
  
  instance (Similar a, Similar b, Similar c, Similar d, Similar e, Similar f, Similar g, Similar h)
      => Similar (a, b, c, d, e, f, g, h) where
    (x1, x2, x3, x4, x5, x6, x7, x8) ~= (y1, y2, y3, y4, y5, y6, y7, y8) =
      x1 ~= y1 && x2 ~= y2 && x3 ~= y3 && x4 ~= y4 && x5 ~= y5 && x6 ~= y6 && x7 ~= y7 && x8 ~= y8
  
  instance (Similar a, Similar b, Similar c, Similar d, Similar e, Similar f, Similar g, Similar h, Similar i)
      => Similar (a, b, c, d, e, f, g, h, i) where
    (x1, x2, x3, x4, x5, x6, x7, x8, x9) ~= (y1, y2, y3, y4, y5, y6, y7, y8, y9) =
      x1 ~= y1 && x2 ~= y2 && x3 ~= y3 && x4 ~= y4 && x5 ~= y5 && x6 ~= y6 && x7 ~= y7 && x8 ~= y8 && x9 ~= y9
  
  instance (Similar a, Similar b, Similar c, Similar d, Similar e, Similar f, Similar g, Similar h, Similar i, Similar j)
      => Similar (a, b, c, d, e, f, g, h, i, j) where
    (x1, x2, x3, x4, x5, x6, x7, x8, x9, x10) ~= (y1, y2, y3, y4, y5, y6, y7, y8, y9, y10) =
      x1 ~= y1 && x2 ~= y2 && x3 ~= y3 && x4 ~= y4 && x5 ~= y5 && x6 ~= y6 && x7 ~= y7 && x8 ~= y8 && x9 ~= y9 && x10 ~= y10
  
  instance (Similar a, Similar b, Similar c, Similar d, Similar e, Similar f, Similar g, Similar h, Similar i, Similar j, Similar k)
      => Similar (a, b, c, d, e, f, g, h, i, j, k) where
    (x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11) ~= (y1, y2, y3, y4, y5, y6, y7, y8, y9, y10, y11) =
      x1 ~= y1 && x2 ~= y2 && x3 ~= y3 && x4 ~= y4 && x5 ~= y5 && x6 ~= y6 && x7 ~= y7 && x8 ~= y8 && x9 ~= y9 && x10 ~= y10 && x11 ~= y11
  
  instance (Similar a, Similar b, Similar c, Similar d, Similar e, Similar f, Similar g, Similar h, Similar i, Similar j, Similar k, Similar l)
      => Similar (a, b, c, d, e, f, g, h, i, j, k, l) where
    (x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12) ~= (y1, y2, y3, y4, y5, y6, y7, y8, y9, y10, y11, y12) =
      x1 ~= y1 && x2 ~= y2 && x3 ~= y3 && x4 ~= y4 && x5 ~= y5 && x6 ~= y6 && x7 ~= y7 && x8 ~= y8 && x9 ~= y9 && x10 ~= y10 && x11 ~= y11 && x12 ~= y12
  
  instance (Similar a, Similar b, Similar c, Similar d, Similar e, Similar f, Similar g, Similar h, Similar i, Similar j, Similar k, Similar l, Similar m)
      => Similar (a, b, c, d, e, f, g, h, i, j, k, l, m) where
    (x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13) ~= (y1, y2, y3, y4, y5, y6, y7, y8, y9, y10, y11, y12, y13) =
      x1 ~= y1 && x2 ~= y2 && x3 ~= y3 && x4 ~= y4 && x5 ~= y5 && x6 ~= y6 && x7 ~= y7 && x8 ~= y8 && x9 ~= y9 && x10 ~= y10 && x11 ~= y11 && x12 ~= y12 && x13 ~= y13
  
  instance (Similar a, Similar b, Similar c, Similar d, Similar e, Similar f, Similar g, Similar h, Similar i, Similar j, Similar k, Similar l, Similar m, Similar n)
      => Similar (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where
    (x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14) ~= (y1, y2, y3, y4, y5, y6, y7, y8, y9, y10, y11, y12, y13, y14) =
      x1 ~= y1 && x2 ~= y2 && x3 ~= y3 && x4 ~= y4 && x5 ~= y5 && x6 ~= y6 && x7 ~= y7 && x8 ~= y8 && x9 ~= y9 && x10 ~= y10 && x11 ~= y11 && x12 ~= y12 && x13 ~= y13 && x14 ~= y14
  
  instance (Similar a, Similar b, Similar c, Similar d, Similar e, Similar f, Similar g, Similar h, Similar i, Similar j, Similar k, Similar l, Similar m, Similar n, Similar o)
      => Similar (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where
    (x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15) ~= (y1, y2, y3, y4, y5, y6, y7, y8, y9, y10, y11, y12, y13, y14, y15) =
      x1 ~= y1 && x2 ~= y2 && x3 ~= y3 && x4 ~= y4 && x5 ~= y5 && x6 ~= y6 && x7 ~= y7 && x8 ~= y8 && x9 ~= y9 && x10 ~= y10 && x11 ~= y11 && x12 ~= y12 && x13 ~= y13 && x14 ~= y14 && x15 ~= y15
  
  instance (Similar a, Similar b, Similar c, Similar d, Similar e, Similar f, Similar g, Similar h, Similar i, Similar j, Similar k, Similar l, Similar m, Similar n, Similar o, Similar p)
      => Similar (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) where
    (x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16) ~= (y1, y2, y3, y4, y5, y6, y7, y8, y9, y10, y11, y12, y13, y14, y15, y16) =
      x1 ~= y1 && x2 ~= y2 && x3 ~= y3 && x4 ~= y4 && x5 ~= y5 && x6 ~= y6 && x7 ~= y7 && x8 ~= y8 && x9 ~= y9 && x10 ~= y10 && x11 ~= y11 && x12 ~= y12 && x13 ~= y13 && x14 ~= y14 && x15 ~= y15 && x16 ~= y16
  
  instance Similar e => Similar (Complex e) where
    (r1 :+ i1) ~= (r2 :+ i2) = r1 ~= r2 && i1 ~= i2
  
  instance Similar a => Similar [a] where
    []     ~= []     = True
    (x:xs) ~= (y:ys) = x ~= y && xs ~= ys
    _      ~= _      = False
  
  instance (Similar e, Eq sh, Shape sh, Elt e) => Similar (Array sh e) where
    a1 ~= a2 = shape a1 == shape a2 && go 0
      where
        n     = size (shape a1)
        go !i
          | i >= n              = True
          | a1 !! i ~= a2 !! i  = go (i+1)
          | otherwise           = False
  
  {-# INLINEABLE absRelTol #-}
  absRelTol :: RealFloat a => a -> a -> a -> a -> Bool
  absRelTol epsilonAbs epsilonRel u v
    |  isInfinite u
    && isInfinite v          = True
    |  isNaN u
    && isNaN v               = True
    | abs (u-v) < epsilonAbs = True
    | abs u > abs v          = abs ((u-v) / u) < epsilonRel
    | otherwise              = abs ((v-u) / v) < epsilonRel
  
  