{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE TypeOperators     #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
-- Module:      : Data.Array.Accelerate.Examples.Internal.Similar
-- Copyright    : [2014] Trevor L. McDonell
-- License      : BSD3
--
-- Maintainer   : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>
-- Stability    : experimental
-- Portability  : non-portable (GHC extensions)
--

module Data.Array.Accelerate.Examples.Internal.Similar (

  Similar(..)

) where

import Data.Array.Accelerate                            ( Z(..), (:.)(..), Array, Shape, arrayShape, toList )
import Data.Complex
import Data.Int
import Data.Word
import Foreign.C.Types
import Linear.V1
import Linear.V2
import Linear.V3
import Linear.V4
import Prelude                                          as P


-- 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 a => Similar [a] where
  []     ~= []          = True
  (x:xs) ~= (y:ys)      = x ~= y && xs ~= ys
  _      ~= _           = False

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 (V1 a) where
  V1 x ~= V1 y = x ~= y

instance Similar a => Similar (V2 a) where
  V2 x1 x2 ~= V2 y1 y2 = x1 ~= y1 && x2 ~= y2

instance Similar a => Similar (V3 a) where
  V3 x1 x2 x3 ~= V3 y1 y2 y3 = x1 ~= y1 && x2 ~= y2 && x3 ~= y3

instance Similar a => Similar (V4 a) where
  V4 x1 x2 x3 x4 ~= V4 y1 y2 y3 y4 = x1 ~= y1 && x2 ~= y2 && x3 ~= y3 && x4 ~= y4

instance Similar Z
instance (Eq sh, Eq sz) => Similar (sh:.sz)

instance Similar Int
instance Similar Int8
instance Similar Int16
instance Similar Int32
instance Similar Int64
instance Similar Word
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 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 e => Similar (Complex e) where
  (r1 :+ i1) ~= (r2 :+ i2) = r1 ~= r2 && i1 ~= i2


-- {-# INLINE relTol #-}
-- relTol :: (Fractional a, Ord a) => a -> a -> a -> Bool
-- relTol epsilon x y = abs ((x-y) / (x+y+epsilon)) < epsilon

{-# 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

instance (Similar e, Eq sh, Shape sh) => Similar (Array sh e) where
  a1 ~= a2      =  arrayShape a1 == arrayShape a2
                && toList a1     ~= toList a2