{-|
    Module      :  Data.Number.ER.RnToRm.UnitDom.BaseTests.Run
    Description :  (testing) running all function enclosure base tests in a batch
    Copyright   :  (c) 2007-2008 Michal Konecny
    License     :  BSD3

    Maintainer  :  mik@konecny.aow.cz
    Stability   :  experimental
    Portability :  portable
    
    Support for running all function enclosure base tests in a batch.
-}
module Data.Number.ER.RnToRm.UnitDom.Base.Tests.Run
where

import Data.Number.ER.Real.Approx.Tests.Reporting

import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Generate
import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Reduce
import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Bounds
import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Ring
import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Integration
import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Enclosure
import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Division
import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Compose
import Data.Number.ER.RnToRm.UnitDom.Base.Tests.Properties.Elementary

import qualified Data.Number.ER.RnToRm.UnitDom.Base as UFB
import qualified Data.Number.ER.Real.Approx as RA

import Data.Number.ER.Misc.Tests
import Data.Number.ER.Misc

import Test.QuickCheck
import Test.QuickCheck.Batch

import System.Directory
import qualified System.FilePath as FP
import Data.Time.Clock
import Data.Time.Calendar

runUFBTests :: 
    (UFB.ERUnitFnBaseElementary boxb boxra varid b ra fb, 
     UFB.ERUnitFnBaseIElementary boxb boxra varid b ra fb,
     RA.ERInnerOuterApprox ra,
     Ord ra, Show fb, Show boxra, Show varid) =>
    String -> fb -> IO () -> IO ()
runUFBTests title sample initialise =
    do
    (UTCTime (ModifiedJulianDay days) secs) <- getCurrentTime
    let folder = "tests-" ++ title ++ "-" ++ (show days) ++ "-" ++ (show $ floor $ toRational secs)
    createDirectory folder
--    erRunTests (title ++ " ufb tests") ufbTestOptions initialise (ufbTests sample folder)
    erRunTests (title ++ " ufb encl tests") ufbTestOptions initialise (ufbEnclTests (sample,sample) folder)

ufbTestOptions = 
    TestOptions
      { 
--        no_of_tests = 10
--        no_of_tests = 50
        no_of_tests = 200
--        no_of_tests = 500
      , 
        length_of_tests = 240 * 3600 -- ie 4h time limit
      ,
        debug_tests = False 
      }

ufbTests sample folder =
    [
        ("reduce term count", runR (prop_fbReduceTermCount_consistent sample) "reduceSize"),
        ("reduce degree", runR (prop_fbReduceDegree_consistent sample) "reduceDegree"),
        ("bounds of poly", runR (prop_fbBounds_consistent sample) "bounds"),
        ("max of two functions", runR (prop_fbMax_consistent sample) "max"),
        ("min of two functions", runR (prop_fbMin_consistent sample) "min"),
        ("add const to poly", runR (prop_fbAddConst_consistent sample) "addConst"),
        ("scale poly", runR (prop_fbScale_consistent sample) "scale"),
        ("add two polys", runR (prop_fbAdd_consistent sample) "add"),
        ("mult two polys", runR (prop_fbMult_consistent sample) "mult"),
        ("integrate + diff up", runR (prop_fbIntegrateDiffUp_consistent sample) "integrateDiffUp"),
        ("integrate + diff down", runR (prop_fbIntegrateDiffDown_consistent sample) "integrateDiffDown")
    ]
    where
    runR test filename opts =
        unsafeReport filepath "started" $
            do 
            run (test filepath) opts
        where
        filepath = addFolder filename
    addFolder name = FP.combine folder name

ufbEnclTests sampleE folder =
    [
        ("add thick encls", runR (prop_enclAdd_ThickEncls_consistent sampleE) "enclAdd_Thick"),
        ("add paral encls", runR (prop_enclAdd_ParalEncls_consistent sampleE) "enclAdd_Paral"),
        ("add thin encls", runR (prop_enclAdd_ThinEncls_consistent sampleE) "enclAdd_Thin"),
        ("scale thick encl", runR (prop_enclScale_ThickEncl_consistent sampleE) "enclScale_Thick"),
        ("scale paral encl", runR (prop_enclScale_ParalEncl_consistent sampleE) "enclScale_Paral"),
        ("scale thin encl", runR (prop_enclScale_ThinEncl_consistent sampleE) "enclScale_Thin"),
        ("mult thick encls", runR (prop_enclMult_ThickEncls_consistent sampleE) "enclMultiply_Thick"),
        ("mult paral encls", runR (prop_enclMult_ParalEncls_consistent sampleE) "enclMultiply_Paral"),
        ("mult thin encls", runR (prop_enclMult_ThinEncls_consistent sampleE) "enclMultiply_Thin"),
        ("recip thick encl", runR (prop_enclRecip_ThickEncl_consistent sampleE) "enclRecip_Thick"),
        ("recip paral encl", runR (prop_enclRecip_ParalEncl_consistent sampleE) "enclRecip_Paral"),
        ("recip thin encl", runR (prop_enclRecip_ThinEncl_consistent sampleE) "enclRecip_Thin"),
        ("compose thick encl", runR (prop_enclCompose_ThickEncl_consistent sampleE) "enclCompose_Thick"),
        ("compose paral encl", runR (prop_enclCompose_ParalEncl_consistent sampleE) "enclCompose_Paral"),
        ("compose thin encl", runR (prop_enclCompose_ThinEncl_consistent sampleE) "enclCompose_Thin"),
        ("sqrt thin encl", runR (prop_enclSqrt_ThinEncl_consistent sampleE) "enclSqrt_Thin"),
        ("sqrt paral encl", runR (prop_enclSqrt_ParalEncl_consistent sampleE) "enclSqrt_Paral"),
        ("sqrt thick encl", runR (prop_enclSqrt_ThickEncl_consistent sampleE) "enclSqrt_Thick"),
        ("exp thin encl", runR (prop_enclExp_ThinEncl_consistent sampleE) "enclExp_Thin"),
        ("exp paral encl", runR (prop_enclExp_ParalEncl_consistent sampleE) "enclExp_Paral"),
        ("exp thick encl", runR (prop_enclExp_ThickEncl_consistent sampleE) "enclExp_Thick"),
        ("sine thin encl", runR (prop_enclSine_ThinEncl_consistent sampleE) "enclSine_Thin"),
        ("sine paral encl", runR (prop_enclSine_ParalEncl_consistent sampleE) "enclSine_Paral"),
        ("sine thick encl", runR (prop_enclSine_ThickEncl_consistent sampleE) "enclSine_Thick"),
        ("cosine thin encl", runR (prop_enclCosine_ThinEncl_consistent sampleE) "enclCosine_Thin"),
        ("cosine paral encl", runR (prop_enclCosine_ParalEncl_consistent sampleE) "enclCosine_Paral"),
        ("cosine thick encl", runR (prop_enclCosine_ThickEncl_consistent sampleE) "enclCosine_Thick"),
        ("atan thin encl", runR (prop_enclAtan_ThinEncl_consistent sampleE) "enclAtan_Thin"),
        ("atan paral encl", runR (prop_enclAtan_ParalEncl_consistent sampleE) "enclAtan_Paral"),
        ("atan thick encl", runR (prop_enclAtan_ThickEncl_consistent sampleE) "enclAtan_Thick")
    ]
    where
    runR test filename opts =
        unsafeReport filepath "started" $
            do 
            result <- run (test filepath) opts
            produceSummary filepath
            return result 
        where
        filepath = FP.combine folder filename