{-|
    Module      :  Data.Number.ER.Real.Approx.Tests.Generate
    Description :  (testing) generating real approximations
    Copyright   :  (c) 2009 Michal Konecny
    License     :  BSD3

    Maintainer  :  mik@konecny.aow.cz
    Stability   :  experimental
    Portability :  portable
    
    Generic instances of 'Arbitrary' class for generating (almost) random instances. 
-}

module Data.Number.ER.Real.Approx.Tests.Generate where

import qualified Data.Number.ER.Real.Approx as RA
import Data.Number.ER.BasicTypes

import Test.QuickCheck

import qualified Data.List as List

newtype RAThin ira = RAThin ira deriving (Show)
newtype RAConsistent ira = RAConsistent ira deriving (Show)
newtype RADirected ira = RADirected ira deriving (Show)


instance (RA.ERIntApprox ira) => Arbitrary (RAThin ira)
    where
    arbitrary = 
        sized arbitrarySized
        where
        arbitrarySized n 
            | n < 28 =
                do
                gran <- choose (8,20)
                (f1,f2,f3) <- arbitrary
                isInfty <- choose (-inftyChance,inftyChance)
                pow <- choose (-10,10)
                return $ RAThin $ constructThinRA isInfty gran (f1,f2,f3) pow
            | n <= 68 =
                do
                gran <- choose (30,100)
                (f1,f2,f3) <- arbitrary
                isInfty <- choose (-inftyChance,inftyChance)
                pow <- choose (-100,100)
                return $ RAThin $ constructThinRA isInfty gran (f1,f2,f3) pow
            | otherwise =
                do
                gran <- choose (400,1000)
                (f1,f2,f3) <- arbitrary
                isInfty <- choose (-inftyChance,inftyChance)
                pow <- choose (-10000,10000)
                return $ RAThin $ constructThinRA isInfty gran (f1,f2,f3) pow
    coarbitrary _ =
        error "ER.Real.Approx: Tests: coarbitrary not implemented"

inftyChance = 15
                
constructThinRA ::
    (RA.ERIntApprox ra) =>
    Granularity ->
    Int ->
    (Double, Double, Double) ->
    Int ->
    ra
constructThinRA gran isInfty (f1,f2,f3) pow 
    | isInfty == inftyChance =
        RA.setGranularityOuter gran $ RA.plusInfinity
    | isInfty == - inftyChance =
        RA.setGranularityOuter gran $ negate $ RA.plusInfinity
    | isInfty == 0 =
        RA.setGranularityOuter gran 0
    | otherwise =
        fst $ RA.bounds $ -- ensure thinness
            (\ (Just a) -> a) $ List.find RA.isBounded results
    where
    results = [result1, result2, result3, result4, result5, 0]
    result1 = (b1/b2) ^^ pow + b3
    result2 = b1 * b2 + b3
    result3 = b1 ^^ pow - b2
    result4 = b1 - b2
    result5 = b1
    [b1,b2,b3] = map cvt [f1,f2,f3]
    cvt f = RA.setGranularityOuter gran $ RA.double2ra f

instance (RA.ERIntApprox ira) => Arbitrary (RAConsistent ira)
    where
    arbitrary = 
        sized arbitrarySized
        where
        arbitrarySized n 
            | n < 28 =
                do
                gran <- choose (8,20)
                (f11,f12,f13) <- arbitrary
                isInfty1 <- choose (-inftyChance,inftyChance)
                pow1 <- choose (-10,10)
                (f21,f22,f23) <- arbitrary
                isInfty2 <- choose (-inftyChance,inftyChance)
                pow2 <- choose (-10,10)
                let t1 = constructThinRA isInfty1 gran (f11,f12,f13) pow1
                let t2 = constructThinRA isInfty2 gran (f21,f22,f23) pow2
                return $ RAConsistent $ t1 RA.\/ t2
            | n <= 68 =
                do
                gran <- choose (30,100)
                (f11,f12,f13) <- arbitrary
                isInfty1 <- choose (-inftyChance,inftyChance)
                pow1 <- choose (-100,100)
                (f21,f22,f23) <- arbitrary
                isInfty2 <- choose (-inftyChance,inftyChance)
                pow2 <- choose (-100,100)
                let t1 = constructThinRA isInfty1 gran (f11,f12,f13) pow1
                let t2 = constructThinRA isInfty2 gran (f21,f22,f23) pow2
                return $ RAConsistent $ t1 RA.\/ t2
            | otherwise =
                do
                gran <- choose (400,1000)
                (f11,f12,f13) <- arbitrary
                isInfty1 <- choose (-inftyChance,inftyChance)
                pow1 <- choose (-10000,10000)
                (f21,f22,f23) <- arbitrary
                isInfty2 <- choose (-inftyChance,inftyChance)
                pow2 <- choose (-10000,10000)
                let t1 = constructThinRA isInfty1 gran (f11,f12,f13) pow1
                let t2 = constructThinRA isInfty2 gran (f21,f22,f23) pow2
                return $ RAConsistent $ t1 RA.\/ t2
    coarbitrary _ =
        error "ER.Real.Approx: Tests: coarbitrary not implemented"

instance (RA.ERIntApprox ira) => Arbitrary (RADirected ira)
    where
    arbitrary = 
        sized arbitrarySized
        where
        arbitrarySized n 
            | n < 28 =
                do
                gran <- choose (8,20)
                (f11,f12,f13) <- arbitrary
                isInfty1 <- choose (-inftyChance,inftyChance)
                pow1 <- choose (-10,10)
                (f21,f22,f23) <- arbitrary
                isInfty2 <- choose (-inftyChance,inftyChance)
                pow2 <- choose (-10,10)
                let t1 = constructThinRA isInfty1 gran (f11,f12,f13) pow1
                let t2 = constructThinRA isInfty2 gran (f21,f22,f23) pow2
                return $ RADirected $ RA.fromBounds (t1, t2)
            | n <= 68 =
                do
                gran <- choose (30,100)
                (f11,f12,f13) <- arbitrary
                isInfty1 <- choose (-inftyChance,inftyChance)
                pow1 <- choose (-100,100)
                (f21,f22,f23) <- arbitrary
                isInfty2 <- choose (-inftyChance,inftyChance)
                pow2 <- choose (-100,100)
                let t1 = constructThinRA isInfty1 gran (f11,f12,f13) pow1
                let t2 = constructThinRA isInfty2 gran (f21,f22,f23) pow2
                return $ RADirected $ RA.fromBounds (t1, t2)
            | otherwise =
                do
                gran <- choose (400,1000)
                (f11,f12,f13) <- arbitrary
                isInfty1 <- choose (-inftyChance,inftyChance)
                pow1 <- choose (-10000,10000)
                (f21,f22,f23) <- arbitrary
                isInfty2 <- choose (-inftyChance,inftyChance)
                pow2 <- choose (-10000,10000)
                let t1 = constructThinRA isInfty1 gran (f11,f12,f13) pow1
                let t2 = constructThinRA isInfty2 gran (f21,f22,f23) pow2
                return $ RADirected $ RA.fromBounds (t1, t2)
    coarbitrary _ =
        error "ER.Real.Approx: Tests: coarbitrary not implemented"