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

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

    A class  abstracting function arithmetic with directed rounding.
    It is used to describe a boundary for an approximation
    to a real function on the interval [-1,1]^n.
    
    To be imported qualified, usually with the synonym UFB.
-}
module Data.Number.ER.RnToRm.UnitDom.Base where

import Prelude hiding (min, max, recip)

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.Number.ER.Real.Base as B
import qualified Data.Number.ER.Real.Approx as RA

import qualified Data.Map as Map

import Data.Typeable

class 
    (B.ERRealBase b, RA.ERIntApprox ra, Fractional ufb, Ord ufb,
     DomainBox boxb varid b, DomainIntBox boxra varid ra) => 
    ERUnitFnBase boxb boxra varid b ra ufb
    | ufb -> boxb boxra varid b ra
    where
    {-| 
        Check internal consistency of the function and report problem if any.
    -}
    check :: 
        String {-^ indentification of caller location for easier debugging -} -> 
        ufb -> ufb
    getGranularity :: ufb -> Granularity
    setMinGranularity :: Granularity -> ufb -> ufb
    setGranularity :: Granularity -> ufb -> ufb
    {-| Construct a constant function. -}
    const :: b -> ufb
    {-| Construct an affine function. -}
    affine :: 
        b {-^ value at 0 -} ->
        Map.Map varid b {-^ ascent of each base vector -} -> 
        ufb
    {-| 
        Multiply a function by a scalar, 
        rounding downwards and upwards. 
    -} 
    scale :: b -> ufb -> (ufb, ufb) 
    {-| 
        Multiply a function by an approximation of a scalar, 
        rounding downwards and upwards. 
    -} 
    scaleApprox :: ra -> ufb -> (ufb, ufb) 
    {-| 
        Multiply a function by an approximation of a scalar, 
        rounding downwards. 
    -} 
    scaleApproxDown :: ra -> ufb -> ufb
    scaleApproxDown ratio = fst . scaleApprox ratio  
    {-| 
        Multiply a function by an approximation of a scalar, 
        rounding upwards. 
    -} 
    scaleApproxUp :: ra -> ufb -> ufb
    scaleApproxUp ratio = snd . scaleApprox ratio  
    {-| 
        Get the degree of this particular function.
        
        If the function is a polynomial, this function should
        return its degree. 
    -}
    getDegree :: ufb -> Int
    {-| 
        Decrease the degree of function approximation, 
        rounding pointwise downwards and upwards.
    -}
    reduceDegree :: Int -> ufb -> (ufb, ufb)
    {-| 
        Decrease the degree of function approximation, rounding pointwise downwards.
    -}
    reduceDegreeDown :: Int -> ufb -> ufb
    reduceDegreeDown maxDegr = fst . reduceDegree maxDegr
    {-| 
        Decrease the degree of function approximation, rounding pointwise upwards.
    -}
    reduceDegreeUp :: Int -> ufb -> ufb
    reduceDegreeUp maxDegr = snd . reduceDegree maxDegr
    {-| 
        Approximate the integral of p (with 0 at 0) from below and from above.
    -}
    integrate :: 
        varid {-^ variable to integrate by -} -> 
        ufb {-^ p(x) -} -> 
        (ufb, ufb)
    {-| Approximate the integral of p (with 0 at 0) from below. -}
    integrateDown :: 
        varid {-^ variable to integrate by -} -> 
        ufb {-^ p(x) -} -> 
        ufb
    integrateDown x = fst . integrate x
    {-| Approximate the integral of p (with 0 at 0) from above. -}
    integrateUp :: 
        varid {-^ variable to integrate by -} -> 
        ufb {-^ p(x) -} -> 
        ufb
    integrateUp x = snd . integrate x
    {-| 
        Measure the volume between a function 
        and the zero hyperplane on the domain @[-1,1]^n@.
    -}
    volumeAboveZero :: 
        [varid] {-^ axes to include in the measuring domain -} -> 
        ufb -> (b,b)
    {-|
        Find an upper bound of the function over @[-1,1]^n@.
    -}
    upperBound :: EffortIndex -> ufb -> b
    {-|
        Find a lower bound of the function over @[-1,1]^n@.
    -}
    lowerBound :: EffortIndex -> ufb -> b
    lowerBound ix f = negate $ upperBound ix (negate f)
    {-| 
        Approximate the function max(0,p(x)) from below and from above.
    -}
    nonneg ::
        Int {-^ max degree for result -} -> 
        ufb {-^ p(x) -} -> 
        (ufb, ufb)
    {-| 
        Approximate the function 1/p(x) from below and from above.
    -}
    recip :: 
        Int {-^ max degree for result -} ->
        EffortIndex -> 
        ufb {-^ p(x) -} -> 
        (ufb, ufb)
    {-| 
        Approximate the function 1/p(x) from below.
    -}
    recipDown :: Int -> EffortIndex -> ufb -> ufb
    recipDown maxDegr ix a = fst $ recip maxDegr ix a
    {-| 
        Approximate the function 1/p(x) from above.
    -}
    recipUp :: Int -> EffortIndex -> ufb -> ufb
    recipUp maxDegr ix a = snd $ recip maxDegr ix a
    {-|
        Approximate the function max(p_1(x),p_2(x)) from below and from above.
    -}
    max :: 
        Int {-^ max degree for result -} -> 
        ufb {-^ p_1(x) -} -> 
        ufb {-^ p_2(x) -} -> 
        (ufb, ufb)
    {-|
        Approximate the function max(p_1(x),p_2(x)) from below.
    -}
    maxDown :: 
        Int {-^ max degree for result -} -> 
        ufb {-^ p_1(x) -} -> 
        ufb {-^ p_2(x) -} -> 
        ufb
    maxDown maxDegr a b = fst $ max maxDegr a b
    {-|
        Approximate the function max(p_1(x),p_2(x)) from above.
    -}
    maxUp :: 
        Int {-^ max degree for result -} -> 
        ufb {-^ p_1(x) -} -> 
        ufb {-^ p_2(x) -} -> 
        ufb
    maxUp maxDegr a b = snd $ max maxDegr a b
    {-|
        Approximate the function min(p_1(x),p_2(x)) from below and from above.
    -}
    min :: 
        Int {-^ max degree for result -} -> 
        ufb {-^ p_1(x) -} -> 
        ufb {-^ p_2(x) -} -> 
        (ufb, ufb)
    min maxDegr p1 p2 = -- default implementation using symmetry with ufbMax
        (negate hi, negate lo)
        where
        (lo, hi) = max maxDegr (negate p1) (negate p2)
    {-|
        Approximate the function min(p_1(x),p_2(x)) from below.
    -}
    minDown :: 
        Int {-^ max degree for result -} -> 
        ufb {-^ p_1(x) -} -> 
        ufb {-^ p_2(x) -} -> 
        ufb
    minDown maxDegr a b = fst $ min maxDegr a b
    {-|
        Approximate the function min(p_1(x),p_2(x)) from above.
    -}
    minUp :: 
        Int {-^ max degree for result -} -> 
        ufb {-^ p_1(x) -} -> 
        ufb {-^ p_2(x) -} -> 
        ufb
    minUp maxDegr a b = snd $ min maxDegr a b
    {-|
        Approximate @sqrt(p(x))@ from below and from above.
    -}
    sqrt :: 
        Int {-^ max degree for result -} -> 
        EffortIndex {-^ how hard to try when approximating exp as a polynomial -} -> 
        ufb {-^ p(x) -} -> 
        (ufb, ufb)
    {-|
        Approximate @exp(p(x))@ from below and from above.
    -}
    exp :: 
        Int {-^ max degree for result -} -> 
        EffortIndex {-^ how hard to try when approximating exp as a polynomial -} -> 
        ufb {-^ p(x) -} -> 
        (ufb, ufb)
    {-| 
        Approximate @log(p(x))@ from below and from above.
    -}
    log :: 
        Int {-^ max degree for result -} -> 
        EffortIndex {-^ how hard to try when approximating log as a polynomial -} -> 
        ufb {-^ p(x) -} -> 
        (ufb, ufb)
    {-| 
        Approximate @sin(p(x))@ from below and from above.
    -}
    sin :: 
        Int {-^ max degree for result -} -> 
        EffortIndex {-^ how hard to try when approximating sin as a polynomial -} -> 
        ufb {-^ p(x) -} -> 
        (ufb, ufb)
    {-|
        Approximate @cos(p(x))@ from below and from above.
    -}
    cos :: 
        Int {-^ max degree for result -} -> 
        EffortIndex {-^ how hard to try when approximating cos as a polynomial -} -> 
        ufb {-^ p(x) -} -> 
        (ufb, ufb)
    {-| 
        Evaluate at a point, rounding upwards and downwards.
    -}
    eval :: boxb -> ufb -> (b, b)
    {-| 
        Evaluate at a point, rounding downwards.
    -}
    evalDown :: boxb -> ufb -> b
    evalDown pt = fst . eval pt
    {-| 
        Evaluate at a point, rounding downwards.
    -}
    evalUp :: boxb -> ufb -> b
    evalUp pt = snd . eval pt
    {-|
        Safely evaluate at a point using a real number approximation
        for both the point and the result.
    -}
    evalApprox :: boxra -> ufb -> ra
    {-|
        Partially evaluate at a lower-dimensional point 
        given using a real number approximation.
        Approximate the resulting function from below and from above.
    -}
    partialEvalApprox :: boxra -> ufb -> (ufb, ufb)
    {-|
        Partially evaluate at a lower-dimensional point 
        given using a real number approximation.
        Approximate the resulting function from below.
    -}
    partialEvalApproxDown :: boxra -> ufb -> ufb
    partialEvalApproxDown substitutions = fst . partialEvalApprox substitutions
    {-|
        Partially evaluate at a lower-dimensional point 
        given using a real number approximation.
        Approximate the resulting function from above.
    -}
    partialEvalApproxUp :: boxra -> ufb -> ufb
    partialEvalApproxUp substitutions = snd . partialEvalApprox substitutions
    {-| 
        Compose two functions, rounding upwards and downwards
        provided each @f_v@ ranges within the domain @[-1,1]@. 
    -} 
    compose ::
        Int {-^ max degree for result -} -> 
        ufb {-^ function @f@ -} -> 
        Map.Map varid ufb 
         {-^ variables to substitute and for each variable @v@, 
             function @f_v@ to substitute for @v@ 
             that maps @[-1,1]@ into @[-1,1]@  -} ->
        (ufb, ufb) {-^ upper and lower bounds of @f[v |-> f_v]@ -}
    {-| 
        Compose two functions, rounding downwards
        provided each @f_v@ ranges within the domain @[-1,1]@. 
    -} 
    composeDown ::
        Int {-^ max degree for result -} -> 
        ufb {-^ function @f1@ -} -> 
        Map.Map varid ufb 
         {-^ variables to substitute and for each variable @v@, 
             function @f_v@ to substitute for @v@ 
             that maps @[-1,1]@ into @[-1,1]@  -} ->
        ufb {-^ a lower bound of @f1.f2@ -}
    composeDown maxDegr f = fst . compose maxDegr f  
    {-| 
        Compose two functions, rounding upwards
        provided each @f_v@ ranges within the domain @[-1,1]@. 
    -} 
    composeUp ::
        Int {-^ max degree for result -} -> 
        ufb {-^ function @f1@ -} -> 
        Map.Map varid ufb 
         {-^ variables to substitute and for each variable @v@, 
             function @f_v@ to substitute for @v@ 
             that maps @[-1,1]@ into @[-1,1]@  -} ->
        ufb {-^ an upper bound of @f1.f2@ -}
    composeUp maxDegr f = snd . compose maxDegr f 
    {-|
        Convert from the interval type to the base type.
        (The types are determined by the given example function.)
    -}
    raEndpoints :: 
        ufb {-^ this parameter is not used except for type checking -} -> 
        ra -> 
        (b,b)
    {-|
        Convert from the base type to the interval type. 
        (The types are determined by the given example function.)
    -}
    raFromEndpoints :: 
        ufb {-^ this parameter is not used except for type checking -} -> 
        (b,b) ->
        ra