{-|
    Module      :  Data.Number.ER.Real.Base.Tests.Generate
    Description :  (testing) generating base real numbers
    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
    according to different distributions. 
-}
module Data.Number.ER.Real.Base.Tests.Generate where

import qualified Data.Number.ER.Real.Base as B
import Data.Number.ER.BasicTypes

import Test.QuickCheck

newtype BGran20 b = BGran20 b deriving Show
newtype BGran100 b = BGran100 b deriving Show
newtype BGran1000 b = BGran1000 b deriving Show

instance (B.ERRealBase b) => Arbitrary (BGran20 b)
    where
    arbitrary =
        do
        gran <- choose (8,20)
        (f1,f2,f3) <- arbitrary
        pow <- choose (-10,10)
        return $ BGran20 $ constructB gran (f1,f2,f3) pow
    coarbitrary _ =
        error "ER.Real.Base: Tests: coarbitrary not implemented"

constructB ::
    (B.ERRealBase b) =>
    Granularity ->
    (Double, Double, Double) ->
    Int ->
    b
constructB gran (f1,f2,f3) pow =
    (b1/b2) ^^ pow + b3 
    where
    [b1,b2,b3] = map cvt [f1,f2,f3]
    cvt f = B.setGranularity gran $ B.fromDouble f

instance (B.ERRealBase b) => Arbitrary (BGran100 b)
    where
    arbitrary = 
        sized arbitrarySized
        where
        arbitrarySized n 
            | n <= 28 =
                do
                (BGran20 b) <- arbitrary
                return (BGran100 b)
            | otherwise =
                do
                gran <- choose (30,100)
                (f1,f2,f3) <- arbitrary
                pow <- choose (-100,100)
                return $ BGran100 $ constructB gran (f1,f2,f3) pow
    coarbitrary _ =
        error "ER.Real.Base: Tests: coarbitrary not implemented"

instance (B.ERRealBase b) => Arbitrary (BGran1000 b)
    where
    arbitrary = 
        sized arbitrarySized
        where
        arbitrarySized n 
            | n <= 28 =
                do
                (BGran20 b) <- arbitrary
                return (BGran1000 b)
            | n <= 68 =
                do
                (BGran100 b) <- arbitrary
                return (BGran1000 b)
            | otherwise =
                do
                gran <- choose (400,1000)
                (f1,f2,f3) <- arbitrary
                pow <- choose (-10000,10000)
                return $ BGran1000 $ constructB gran (f1,f2,f3) pow
    coarbitrary _ =
        error "ER.Real.Base: Tests: coarbitrary not implemented"