{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE FunctionalDependencies  #-}
{-|
    Module      :  Data.Number.ER.Real.DomainBox
    Description :  portions of many-dimensional domains   
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

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

    Abstractions of the 'Box' datatype, often used to represent
    sections of multi-dimensional function domains.
    
    To be imported qualified, usually with prefix DBox.
    
    VariableID(..) and DomainBox 
    are usually imported separately and not qualified.
-}
module Data.Number.ER.Real.DomainBox 
(
    VariableID(..),
    DomainBox(..),
    DomainIntBox(..)
)
where

import qualified Data.Number.ER.Real.Approx as RA

import Data.Number.ER.BasicTypes

import qualified Data.Set as Set
import qualified Data.Map as Map

import Prelude hiding (lookup)


{-| 
    A class abstracting a type of variable identifiers 
    for axes in function domains, polynomials etc.
-}
class (Ord varid) => VariableID varid
    where
    newVarID :: Set.Set varid -> varid
    defaultVar :: varid
    defaultVar = newVarID Set.empty
    showVar :: varid -> String

{-|
    A class abstracting a type of many-dimensional points or intervals.
-}
class (VariableID varid) => DomainBox box varid ira
    | box -> varid ira, varid ira -> box
    where
    noinfo :: box
    isNoinfo :: box -> Bool
    {-| constructor using 'defaultVar' -}
    unary :: ira -> box
    singleton :: varid -> ira -> box
    toList :: box -> [(varid, ira)]
    fromList :: [(varid, ira)] -> box
    toAscList :: box -> [(varid, ira)]
    fromAscList :: [(varid, ira)] -> box
    toMap :: box -> Map.Map varid ira
    fromMap :: Map.Map varid ira -> box
    insert :: varid -> ira -> box -> box
    insertWith :: (ira -> ira -> ira) -> varid -> ira -> box -> box
    delete :: varid -> box -> box
    member :: varid -> box -> Bool
    notMember :: varid -> box -> Bool
    union :: box -> box -> box
    unionWith :: (ira -> ira -> ira) -> box -> box -> box
    keys :: box -> [varid]
    elems :: box -> [ira]
    map :: (ira -> ira) -> box -> box
    fold :: (ira -> a -> a) -> a -> box -> a
    foldWithKey :: (varid -> ira -> a -> a) -> a -> box -> a
    zipWith :: (ira -> ira -> a) -> box -> box -> [(varid, a)] 
    intersectionWith :: (ira -> ira -> ira) -> box -> box -> box 
    findWithDefault :: ira -> varid -> box -> ira
    {-|
        Pick the extents of a single variable in a domain box.
        If there is no information for this variable, assume the
        variable ranges over the whole real line.
    -}
    lookup ::     
        String {-^ identification of caller location to use in error messages -} ->
        varid ->
        box ->
        ira
        
        
{-|
    A class abstracting a type of many-dimensional intervals.
-}
class (DomainBox box varid ira) => DomainIntBox box varid ira
    | box -> varid ira, varid ira -> box
    where
    {-|
        Check whether the two domains specify the same
        interval for each variable that they share.
    -}
    compatible ::
        box ->
        box ->
        Bool
    {-|
        Assuming that two domains are compatible, take the
        most information from both of the domains about the
        ranges of variables.
    -}
    unify ::
        String {-^ identification of caller location to use in error messages -} ->
        box ->
        box ->
        box
    {-|
        Find the variable with the largest interval
        and return it together with the default splitting point
        in its domain.
    -}
    bestSplit ::
        box ->
        (varid, ira)
    classifyPosition ::
        box {-^ domain @d1@ -} ->
        box {-^ domain @d2@ -} ->
        (Bool, Bool, Bool, Bool) 
            {-^ 
                Answers to these (mutually exclusive) questions:
                
                * is @d1@ outside and /not/ touching @d2@?
            
                * is @d1@ outside and touching @d2@?
            
                * is @d1@ intersecting and not inside @d2@?
            
                * is @d1@ inside @d2@?
            -}