module QCInterval where

import Interval
import Test.QuickCheck

{-
-- Take one

data UnaryOpRef = UOR {
    uorOp  :: Ivl -> Ivl,
    uorRef :: Double -> Double
}

prop_PointToPoint :: UnaryOpRef -> Double -> Bool
prop_PointToPoint (UOR {uorOp = o, uorRef = r}) x =
    o (x +/- 0) == r x +/- 0

uors = [UOR negate negate, UOR abs abs, UOR recip recip]

main = mapM quickCheck (map prop_PointToPoint uors)
-}


-- Take two: ensure intervals are valid for the operator in question.

data UnaryOpRef = UOR {
    uorOp  :: Ivl -> Ivl,
    uorVI  :: Ivl -> Bool,
    uorRef :: Double -> Double
}

uors = [ UOR negate (const True)    negate
       , UOR abs    (const True)    abs
       , UOR signum (const True)    signum
       , UOR recip  (not . inIvl 0) recip]


tabulateLog10 :: Testable prop => Double -> prop -> Property 
tabulateLog10 x = label (showLog10 x) -- tabulate "Log10" [showLog10 x]
    where 
        showLog10 x | x == 0    = "-Inf"
                    | otherwise = show (round (logBase 10 (abs x)))


-- A point interval is mapped to a point interval
prop_PointToPoint :: UnaryOpRef -> Double -> Property
prop_PointToPoint (UOR {uorOp = o, uorVI = vi, uorRef = r}) x =
    tabulateLog10 x $ vi i ==> o i == (r x +/- 0)
    where
        i = x +/- 0

instance Arbitrary Ivl where
   arbitrary = do
       x <- arbitrary
       -- e <- abs <$> arbitrary
       -- e <- getNonNegative <$> arbitrary
       NonNegative e <- arbitrary
       return (x +/- e)


chooseIvl :: Ivl -> Gen Double
chooseIvl i = choose (lBound i, uBound i)


-- Applying the underlying operator to an element in the interval
-- yields a value within the interval resulting from applying the
-- inerval operator on the interval.
prop_InInterval :: UnaryOpRef -> Ivl -> Property
prop_InInterval (UOR {uorOp = o, uorVI = vi, uorRef = r}) i =
    vi i ==> forAll (chooseIvl i) $
                \x -> r x `inIvl` o i

{-
-- Take 3: Binary operators

data BinaryOpRef = BOR {
    borOp  :: Ivl -> Ivl -> Ivl,
    borVIs :: Ivl -> Ivl -> Bool,
    borRef :: Double -> Double -> Double
}

bors = [ BOR (+) (const (const True))    (+)
       , BOR (-) (const (const True))    (-)
       , BOR (*) (const (const True))    (*)
       , BOR (/) (const (not . inIvl 0)) (/)]


-- Point intervals are mapped to a point interval
prop_PointPointToPoint :: BinaryOpRef -> Double -> Double -> Property
prop_PointPointToPoint (BOR {borOp = o, borVIs = vis, borRef = r}) x y =
    tabulateLog10 x $ tabulateLog10 y $ vis i j ==> i `o` j == (x `r` y +/- 0)
    where
        i = x +/- 0
        j = y +/- 0

prop_InInterval2 :: BinaryOpRef -> Ivl -> Ivl -> Property
prop_InInterval2 (BOR {borOp = o, borVIs = vis, borRef = r}) i j =
    vis i j ==> forAll (chooseIvl i) $ \x -> 
                forAll (chooseIvl j) $ \y -> 
                (x `r` y) `inIvl` (i `o` j)
-}


main = do
   putStrLn "Testing prop_PointToPoint:"
   mapM (quickCheckWith (stdArgs {maxSuccess = 100, maxSize = 1000}))
                        (map prop_PointToPoint uors)
   putStrLn ""

   putStrLn "Testing prop_InInterval:"
   mapM (quickCheckWith (stdArgs {maxSuccess = 100, maxSize = 1000}))
                        (map prop_InInterval uors)
   putStrLn ""

{-
   putStrLn "Testing prop_PointPointToPoint:"
   mapM (quickCheckWith (stdArgs {maxSuccess = 100, maxSize = 1000}))
                        (map prop_PointPointToPoint bors)
   putStrLn ""

   putStrLn "Testing prop_InInterval2:"
   mapM (quickCheckWith (stdArgs {maxSuccess = 100, maxSize = 1000}))
                        (map prop_InInterval2 bors)
   putStrLn ""
-}