{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE FunctionalDependencies #-}
{-|
    Module      :  Data.Number.ER.RnToRm.UnitDom.Approx
    Description :  class abstracting function enclosures on @[-1,1]^n@
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

    Maintainer  :  mik@konecny.aow.cz
    Stability   :  experimental
    Portability :  portable

    Approximation of continuous real functions 
    defined on the unit rectangle domain of a certain dimension.
    
    To be imported qualified, usually with the synonym UFA.    
-}
module Data.Number.ER.RnToRm.UnitDom.Approx
(
    ERUnitFnApprox(..)
)
where

import Data.Number.ER.RnToRm.Approx
import qualified Data.Number.ER.Real.DomainBox as DBox
import Data.Number.ER.Real.DomainBox (VariableID(..), DomainBox, DomainIntBox)
import Data.Number.ER.BasicTypes

import qualified Data.Map as Map

{-|
    This class extends 'ERFnApprox' by:
    
    * assuming that the domain of the function enclosures is always @[-1,1]^n@ for some @n@;
    
    * allowing the construction of basic function enclosures
      where the domain has to be known.
-}

class (ERFnApprox box varid domra ranra fa) => 
    ERUnitFnApprox box varid domra ranra fa
    | fa -> box varid domra ranra
    where
    {-| 
        A function enclosure with no information about the function's values.
    -}
    bottomApprox :: fa
    {-|
        Construct a constant enclosure for a tuple of functions.
    -}
    const :: [ranra] -> fa
    {-| 
        Construct the exact enclosure of an affine function on @[-1,1]^n@. 
    -} 
    affine :: 
        [ranra] {-^ values at 0 -} ->
        Map.Map varid ([ranra]) {-^ ascents of each base vector -} -> 
        fa
    {-| 
        Find close upper and lower bounds of the volume of the entire enclosure.
        A negative volume means that the enclosure is certainly inconsistent.
        
        Explicitly specify the variables to identify the dimension of the domain.
    -}    
    volume :: [varid] -> fa -> ranra
    {-|
        Intersect two enclosures and measure the global improvement as one number.
        
        (Use 'RA.intersectMeasureImprovement' defined in module "Data.Number.ER.Real.Approx" 
         to measure the improvement using a function enclosure.) 
        
        Explicitly specify the variables to identify the dimension of the domain.
    -}        
    intersectMeasureImprovement ::
        EffortIndex -> 
        [varid] ->
        fa -> 
        fa -> 
        (fa, ranra)
            {-^ enclosure intersection and measurement of improvement analogous to the one 
                returned by the pointwise 'RA.intersectMeasureImprovement' -}
    {-| 
        Safely integrate a @[-1,1]^n -> R^m@ function enclosure
        with some initial condition (origin and function at origin).
    -}    
    integrate :: 
        EffortIndex {-^ how hard to try -} ->
        fa {-^ function to integrate -} ->
        varid {-^ @x@ = variable to integrate by -} ->
        domra {-^ origin in terms of @x@; this has to be exact! -} ->
        fa {-^ values at origin -} ->
        fa