{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE DeriveDataTypeable #-}

-- | Test.TestApproximate uses Test.QuickCheck (Arbitrary) to test
-- that the confidences of Approximates generated by a given function
-- are accurate given a function which generates the real value being
-- approximated.
module Test.TestApproximate
       ( testApproximate
       , testApproximateWith
       , testApproximateResult
       , testApproximateWithResult
       , ApproxTestArgs(..), stdArgs
       , ApproxTestResult(..)
       ) where

import Test.QuickCheck (Arbitrary(..), Gen, generate, resize)
import Data.Approximate (Approximate(..))
import Data.Conduit (($$))
import Numeric.Log.Signed (SignedLog)
import Test.ProbabilityCheck.Internal (DistributionTestResult(..), DistributionTestValue(..), empiricalBernstienStopping, monadicToSource)

-- | Arguments for testApproximate
data ApproxTestArgs = ApproxTestArgs
                      { ataDelta   :: SignedLog Double -- ^ The allowable frequency that the test returns the incorrect result.
                      , ataEpsilon :: SignedLog Double -- ^ Largest value for which differences between the confidence and
                                                       -- actual accuracy should be considered the same.
                      }

-- | Result of a tested approximate.
newtype ApproxTestResult = ApproxTestResult {atrResult :: DistributionTestResult (SignedLog Double)}

-- | Default arguments of 5% false positive/negative and confendences
-- off by less than 1% are considered 'close enough'. These are fairly
-- libral defaults.
stdArgs :: ApproxTestArgs
stdArgs = ApproxTestArgs {ataDelta = 0.05, ataEpsilon = 0.01}

-- | Tests the confidence of an Approximate, and prints results to
-- stdout.
testApproximate :: (Arbitrary a, Ord b) => (a -> Approximate b) -> (a -> b) -> IO ()
testApproximate = testApproximateWith stdArgs

-- | Tests the confidence of an Approximate, with the given arguments,
-- and prints the results to stdout.
testApproximateWith :: (Arbitrary a, Ord b) => ApproxTestArgs -> (a -> Approximate b) -> (a -> b) -> IO ()
testApproximateWith args cApp cAct = testApproximateWithResult args cApp cAct >> return ()

-- | Tests the confidence of an Approximate, producing an
-- ApproxTestResult, and prints the results to stdout.
testApproximateResult :: (Arbitrary a, Ord b) => (a -> Approximate b) -> (a -> b) -> IO ApproxTestResult
testApproximateResult = testApproximateWithResult stdArgs

-- | Tests the confidence of an Approximate, with the given arguments,
-- producing an ApproximateTestResult, and prints the results to
-- stdout.
testApproximateWithResult :: (Arbitrary a, Ord b) => ApproxTestArgs -> (a -> Approximate b) -> (a -> b) -> IO ApproxTestResult
testApproximateWithResult args cApp cAct = do
  let delta = ataDelta args
      epsilon = ataEpsilon args
      sample = arbitrary
      value :: Gen (SignedLog Double)
      value = sample >>= sampleToValue
      sampleToValue a = let (Approximate conf lo _ hi) = cApp a
                            act = cAct a
                            diff = (if lo <= act && act <= hi then 1 else 0) - (realToFrac conf)
                        in return diff
  r <- (monadicToSource $ generate $ resize 1000 value) $$ empiricalBernstienStopping 2 delta epsilon
  case dtrValue r of
    TestZero -> print "Confidence is accurate."
    TestPositive -> print "Confidence is lower than actual accuracy."
    TestNegative -> print "Confidence is incorrectly high."
    TestInsufficientSample -> print "Unable to generate sufficient samples. This should not be possible."
  return $ ApproxTestResult r