{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-|
    Module      :  Data.Number.ER.RnToRm.UnitDom.Base.Tests.Generate
    Description :  (testing) generating basic functions for testing
    Copyright   :  (c) 2007-2008 Michal Konecny
    License     :  BSD3

    Maintainer  :  mik@konecny.aow.cz
    Stability   :  experimental
    Portability :  portable
    
    A collection of basic functions to pick from when testing.
-}
module Data.Number.ER.RnToRm.UnitDom.Base.Tests.Generate
(
    FBSize10(..), 
    FBSize10Small(..), 
    FBSize10Degree3(..), 
    FBEnclThinSize10(..), 
    FBEnclThinSize10Small(..),
    FBEnclThinSize10Degree3(..), 
    FBEnclParalSize10(..), 
    FBEnclParalSize10Small(..),
    FBEnclParalSize10Degree3(..), 
    FBEnclThickSize10(..), 
    FBEnclThickSize10Small(..),
    FBEnclThickSize10Degree3(..),
    Deg20Size20(..),
    Deg10Size10(..),
    Deg5Size10(..),
    polynomials1200ishSize10,
    polynomials1200ishSize10Small,
    polynomials1200ishSize10Degree3,
    makeThinEncl,
    makeThickEncl,
    makeParalEncl
)
where

import qualified Data.Number.ER.RnToRm.UnitDom.Base as UFB
import Data.Number.ER.RnToRm.UnitDom.Base ((+^),(-^),(*^))

import qualified Data.Number.ER.BasicTypes.DomainBox as DBox

import Data.Number.ER.BasicTypes.Tests.Generate

import qualified Data.Map as Map

import Test.QuickCheck

{---------------------}
{----- Generation of maximum size and degree limits -----}
{---------------------}

data Deg20Size20 = Deg20Size20 Int Int deriving (Show)
data Deg10Size10 = Deg10Size10 Int Int deriving (Show)
data Deg5Size10 = Deg5Size10 Int Int deriving (Show)

instance (Arbitrary Deg20Size20)
    where
    arbitrary =
        do
        maxDegree <- choose (2,20)
        maxSize <- choose (10,20)
        return $ Deg20Size20 maxDegree maxSize
    coarbitrary (Deg20Size20 maxDegree maxSize) =
        error "ERChebPoly: Generate: Arbitrary: coarbitrary not implemented for Deg20Size20"

instance (Arbitrary Deg10Size10)
    where
    arbitrary =
        do
        maxDegree <- choose (1,10)
        maxSize <- choose (5,10)
        return $ Deg10Size10 maxDegree maxSize
    coarbitrary (Deg10Size10 maxDegree maxSize) =
        error "ERChebPoly: Generate: Arbitrary: coarbitrary not implemented for Deg10Size10"

instance (Arbitrary Deg5Size10)
    where
    arbitrary =
        do
        maxDegree <- choose (1,5)
        maxSize <- choose (5,10)
        return $ Deg5Size10 maxDegree maxSize
    coarbitrary (Deg5Size10 maxDegree maxSize) =
        error "ERChebPoly: Generate: Arbitrary: coarbitrary not implemented for Deg5Size10"

{---------------------}
{----- Types for different function enclosure generation distributions ----}
{---------------------}

type E fb = (fb,fb)

newtype FBEnclThinSize10 fb = FBEnclThinSize10 ((Int, Int), E fb) deriving (Show)
newtype FBEnclThinSize10Small fb = FBEnclThinSize10Small (Int, E fb) deriving (Show)
newtype FBEnclThinSize10Degree3 fb = FBEnclThinSize10Degree3 (Int, E fb) deriving (Show)

instance (UFB.ERUnitFnBase boxb boxra varid b ra fb) => (Arbitrary (FBEnclThinSize10 fb)) 
    where
    arbitrary =
        do
        (FBSize10 (fbId, fb)) <- arbitrary
        return $ FBEnclThinSize10 (fbId, makeThinEncl fb)
    coarbitrary (FBEnclThinSize10 p) =
        error "ER.RnToRm.UnitDom.Base.Tests.Generate: coarbitrary not implemented"

instance (UFB.ERUnitFnBase boxb boxra varid b ra fb) => (Arbitrary (FBEnclThinSize10Small fb)) 
    where
    arbitrary =
        do
        (FBSize10Small (fbId, fb)) <- arbitrary
        return $ FBEnclThinSize10Small (fbId, makeThinEncl fb)
    coarbitrary (FBEnclThinSize10Small p) =
        error "ER.RnToRm.UnitDom.Base.Tests.Generate: coarbitrary not implemented"

instance (UFB.ERUnitFnBase boxb boxra varid b ra fb) => (Arbitrary (FBEnclThinSize10Degree3 fb)) 
    where
    arbitrary =
        do
        (FBSize10Degree3 (fbId, fb)) <- arbitrary
        return $ FBEnclThinSize10Degree3 (fbId, makeThinEncl fb)
    coarbitrary (FBEnclThinSize10Degree3 p) =
        error "ER.RnToRm.UnitDom.Base.Tests.Generate: coarbitrary not implemented"

makeThinEncl fb = (UFB.neg fb, fb)

newtype FBEnclParalSize10 fb = FBEnclParalSize10 (((Int, Int), SmallRatio), E fb) deriving (Show)
newtype FBEnclParalSize10Small fb = FBEnclParalSize10Small ((Int, SmallRatio), E fb) deriving (Show)
newtype FBEnclParalSize10Degree3 fb = FBEnclParalSize10Degree3 ((Int, SmallRatio), E fb) deriving (Show)

instance (UFB.ERUnitFnBase boxb boxra varid b ra fb) => (Arbitrary (FBEnclParalSize10 fb)) 
    where
    arbitrary =
        do
        (FBSize10 (fbId, fb)) <- arbitrary
        rat <- arbitrary
        return $ FBEnclParalSize10 ((fbId, rat), makeParalEncl fb rat)
    coarbitrary (FBEnclParalSize10 p) =
        error "ER.RnToRm.UnitDom.Base.Tests.Generate: coarbitrary not implemented"

instance (UFB.ERUnitFnBase boxb boxra varid b ra fb) => (Arbitrary (FBEnclParalSize10Small fb)) 
    where
    arbitrary =
        do
        (FBSize10Small (fbId, fb)) <- arbitrary
        rat <- arbitrary
        return $ FBEnclParalSize10Small ((fbId, rat), makeParalEncl fb rat)
    coarbitrary (FBEnclParalSize10Small p) =
        error "ER.RnToRm.UnitDom.Base.Tests.Generate: coarbitrary not implemented"

instance (UFB.ERUnitFnBase boxb boxra varid b ra fb) => (Arbitrary (FBEnclParalSize10Degree3 fb)) 
    where
    arbitrary =
        do
        (FBSize10Degree3 (fbId, fb)) <- arbitrary
        rat <- arbitrary
        return $ FBEnclParalSize10Degree3 ((fbId, rat), makeParalEncl fb rat)
    coarbitrary (FBEnclParalSize10Degree3 p) =
        error "ER.RnToRm.UnitDom.Base.Tests.Generate: coarbitrary not implemented"

makeParalEncl fb (SmallRatio num denom) =
--    unsafePrintReturn
--    (
--        "makeThinEncl: result = "
--    )
    (fbNeg, fb +^ cFB)
    where
    fbNeg = UFB.neg fb
    cFB = UFB.const cB
    cB = abs $ numB / (1000 * denomB)
    numB = fromInteger $ toInteger num
    denomB = fromInteger $ toInteger denom

newtype FBEnclThickSize10 fb = FBEnclThickSize10 (((Int, Int), (Int, Int)), E fb) deriving (Show)
newtype FBEnclThickSize10Small fb = FBEnclThickSize10Small ((Int, Int), E fb) deriving (Show)
newtype FBEnclThickSize10Degree3 fb = FBEnclThickSize10Degree3 ((Int, Int), E fb) deriving (Show)

instance (UFB.ERUnitFnBase boxb boxra varid b ra fb) => (Arbitrary (FBEnclThickSize10 fb)) 
    where
    arbitrary =
        do
        (FBSize10 (fbId1, fb1)) <- arbitrary
        (FBSize10 (fbId2, fb2)) <- arbitrary
        return $ FBEnclThickSize10 ((fbId1, fbId2), makeThickEncl 5 10 fb1 fb2)
    coarbitrary (FBEnclThickSize10 p) =
        error "ER.RnToRm.UnitDom.Base.Tests.Generate: coarbitrary not implemented"

instance (UFB.ERUnitFnBase boxb boxra varid b ra fb) => (Arbitrary (FBEnclThickSize10Small fb)) 
    where
    arbitrary =
        do
        (FBSize10Small (fbId1, fb1)) <- arbitrary
        (FBSize10Small (fbId2, fb2)) <- arbitrary
        return $ FBEnclThickSize10Small ((fbId1, fbId2), makeThickEncl 5 10 fb1 fb2)
    coarbitrary (FBEnclThickSize10Small p) =
        error "ER.RnToRm.UnitDom.Base.Tests.Generate: coarbitrary not implemented"

instance (UFB.ERUnitFnBase boxb boxra varid b ra fb) => (Arbitrary (FBEnclThickSize10Degree3 fb)) 
    where
    arbitrary =
        do
        (FBSize10Degree3 (fbId1, fb1)) <- arbitrary
        (FBSize10Degree3 (fbId2, fb2)) <- arbitrary
        return $ FBEnclThickSize10Degree3 ((fbId1, fbId2), makeThickEncl 5 10 fb1 fb2)
    coarbitrary (FBEnclThickSize10Degree3 p) =
        error "ER.RnToRm.UnitDom.Base.Tests.Generate: coarbitrary not implemented"

makeThickEncl maxDegree maxSize p1 p2 =
    (pMax q1Neg q2Neg, pMax q1 q2)
    where
    q1Neg = UFB.neg q1
    q2Neg = UFB.neg q2
    q1 = p1 +^ p2Mp1ScaledDown
    q2 = p1 -^ p2Mp1ScaledDown
    p2Mp1ScaledDown =
        UFB.scaleUp (10/sizeB) p2Mp1
        where
        sizeB = max (abs upperB) (abs lowerB)
        (lowerB, upperB) = UFB.bounds 10 p2Mp1
        p2Mp1 = p2 -^ p1
    pMax = UFB.maxUp maxDegree maxSize
    

{---------------------}
{----- Types for different function generation distributions ----}
{---------------------}

newtype FBSize10 fb = FBSize10 ((Int, Int), fb) deriving (Show)
newtype FBSize10Small fb = FBSize10Small (Int, fb) deriving (Show)
newtype FBSize10Degree3 fb = FBSize10Degree3 (Int, fb) deriving (Show)

instance (UFB.ERUnitFnBase boxb boxra varid b ra fb) => (Arbitrary (FBSize10 fb)) 
    where
    arbitrary =
        sized arbitrarySized
        where
        arbitrarySized n 
            | n <= 28 =
                elements $ map FBSize10 $ 
                    zip (map (\n -> (0,n)) [0..]) $ 
                        polynomials1200ishSize10Small $ UFB.const 0
            | otherwise =
                elements $ map FBSize10 $ 
                    zip (map (\n -> (1,n)) [0..]) $ 
                        polynomials1200ishSize10 $ UFB.const 0
    coarbitrary (FBSize10 p) =
        error "ER.RnToRm.UnitDom.Base.Tests.Generate: coarbitrary not implemented"

instance (UFB.ERUnitFnBase boxb boxra varid b ra fb) => (Arbitrary (FBSize10Degree3 fb)) 
    where
    arbitrary =
        sized arbitrarySized
        where
        arbitrarySized n = 
            elements $ map FBSize10Degree3 $ 
                zip [0..] $ 
                    polynomials1200ishSize10Degree3 $ UFB.const 0
    coarbitrary (FBSize10Degree3 p) =
        error "ER.RnToRm.UnitDom.Base.Tests.Generate: coarbitrary not implemented"

instance (UFB.ERUnitFnBase boxb boxra varid b ra fb) => (Arbitrary (FBSize10Small fb)) 
    where
    arbitrary =
        sized arbitrarySized
        where
        arbitrarySized n = 
            elements $ map FBSize10Small $ 
                zip [0..] $ 
                    polynomials1200ishSize10Small $ UFB.const 0
    coarbitrary (FBSize10Small p) =
        error "ER.RnToRm.UnitDom.Base.Tests.Generate: coarbitrary not implemented"

polynomials1200ishSize10 sample =
    polynomials1200ish sample $ UFB.reduceSizeUp 10
    
polynomials1200ishSize10Small sample =
    polynomials1200ishSmall sample $ UFB.reduceSizeUp 10
    
polynomials1200ishSize10Degree3 sample =
    polynomials1200ish sample $ UFB.reduceSizeUp 10 . UFB.reduceDegreeUp 3
    
polynomials1200ishSmallSize10Degree3 sample =
    polynomials1200ishSmall sample $ UFB.reduceSizeUp 10 . UFB.reduceDegreeUp 3
    
polynomials1200ish sample rdc =
    polynomials1200ishBoth False sample rdc

polynomials1200ishSmall sample rdc =
    polynomials1200ishBoth True sample rdc
    

{------------------}
{--------   A diverse collection of polynomials to pick from:    ----------}
{------------------}

polynomials1200ishBoth ::
    (UFB.ERUnitFnBase boxb boxra varid b ra fb) => 
    Bool -> fb -> (fb -> fb) -> [fb]
polynomials1200ishBoth isSmall sample rdc 
    | isSmall = 
        concat $ map (powers2 rdc) $
        concat $ map addConsts5 $
        concat $ map multConsts5 $
        concat $ map addConsts2 $
        polyBase12
    | otherwise = 
        concat $ map (powers4 rdc) $
        concat $ map addConsts5 $
        concat $ map multConsts5 $
        polyBase12
    where
    _ = [x0,one,sample] -- help type inference
    [x0,x1,x2,x3,x4] = map makeVar $ DBox.getNVars 5
        where
        makeVar i = UFB.affine 0 (Map.singleton i 1)
    [mone, one, two, three, seven, thousand, million, tiny, huge] = 
        map UFB.const [-1,1,2,3,7,1000,1000000,10^^(-200),10^^200]
    polyBase12 =
            [
             x0
            ,
             x0 +^ x1
            ,
             x0 -^ x1
            ,
             (two *^ x0) +^ x1
            ,
             (two *^ x0) -^ x1
            ,
             (seven *^ x0) +^ x1
            ,
             (seven *^ x0) -^ x1
            ,
             (tiny *^ x0) +^ x1
            ,
             (tiny *^ x0) -^ x1
            ,
             x0 -^ x1 *^ x2
            ,
             x0 *^ x1 +^ x2 *^ x3 +^ x4
            ,
             x0 -^ x1 +^ x2 -^ x3 +^ x4
            ]
    powersAll rdc p =
        powersAux [p, rdc $ p *^ p]
        where
        powersAux (pNHalfM1 : pNHalf : rest) = 
            pNHalfM1 : (powersAux $ (pNHalf : rest) ++ [pNM1, pN])
            where
            pNM1 = rdc $ pNHalf *^ pNHalfM1
            pN = rdc $ pNHalf *^ pNHalf
    
    powersForExps rdc p exponents =
        map pw exponents
        where
        pw n = pws !! (n - 1)
        pws = powersAll rdc p
    
    powers4 rdc p =
        powersForExps rdc p [1,2,3,4]
        
    powers2 rdc p =
        powersForExps rdc p [1,2]
        
    addConsts5 p =
        [p, p +^ mone, p +^ three, p +^ seven, p +^ thousand]
    
    multConsts5 p =
        [p, p *^ mone, p *^ two, p *^ three, p *^ seven]
    
    addConsts2 p =
        [p, p +^ mone]