Basic.hs

{-|
    Module      :  Control.ERNet.Blocks.Real.Basic
    Description :  basic processes for processing reals via intervals 
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

    Maintainer  :  mik@konecny.aow.cz
    Stability   :  experimental
    Portability :  portable
-}
module Control.ERNet.Blocks.Real.Basic
(
    rateRProcess,
    rateRsProcess
) 
where

import Control.ERNet.Foundations.Protocol
import Control.ERNet.Foundations.Protocol.StandardCombinators
import qualified Control.ERNet.Foundations.Channel as CH
import Control.ERNet.Foundations.Process

import Control.ERNet.Blocks.Basic

import Control.ERNet.Blocks.Real.Protocols
import qualified Data.Number.ER.Real.Approx as RA
import qualified Data.Number.ER.Real.Approx.Elementary as RAEL

import Data.Typeable

{-|
    A process passing on information about a real number, trying to improve the
    convergence rate in successive queries.
    
    Each query may refer to a previous query.  When it does,
    the query will not be answered until either:
    
    * the information about the number has improved by the desired amount since last time 
    
    * the number of queries made in response to this query has reached the given limit
-}
rateRProcess ::
    (CH.Channel sIn sOut sInAnyProt sOutAnyProt,
     RAEL.ERApproxElementary ra, Typeable ra) =>
    ERProcessName {-^ process identifier (string) -} ->
    Rational {-^ desired ratio of improvement -} ->
    Int {-^ maximum number of attempts to reach desired improvement -} ->
    ra {-^ sample approximation to aid typechecking -} ->
    ERProcess sInAnyProt sOutAnyProt
rateRProcess defName desiredImpr maxAttepts sampleRA = 
    rateProcess defName goodEnough maxAttepts chtpRC
    where
    chtpRC = chTChanges $ chTIx $ chtpRNoIx 
    chtpRNoIx = chTReal sampleRA
    
    goodEnough _ QAChangesAGivenUp = True
    goodEnough QAChangesAGivenUp _ = True
    goodEnough
        (QAChangesANew (QAIxA (QARealA prevRA))) 
        (QAChangesANew (QAIxA (QARealA newRA))) =
            case RA.compareReals (impr) (fromRational desiredImpr) of
                Just LT -> False 
                _ -> True
            where
            (_, impr) = RA.intersectMeasureImprovement 20 prevRA newRA
            _ = prevRA == sampleRA
         
{-|
    A process passing on information about a list of real numbers, trying to improve the
    convergence rate in successive queries.
    
    Each query may refer to a previous query.  When it does,
    the query will not be answered until either:
    
    * the information about the tuple has improved by the desired amount since last time 
    
    * the number of queries made in response to this query has reached the given limit
-}
rateRsProcess ::
    (CH.Channel sIn sOut sInAnyProt sOutAnyProt,
     RAEL.ERApproxElementary ra, Typeable ra) =>
    ERProcessName {-^ process identifier (string) -} ->
    Rational {-^ desired ratio of improvement -} ->
    Int {-^ maximum number of attempts to reach desired improvement -} ->
    ra {-^ sample approximation to aid typechecking -} ->
    ERProcess sInAnyProt sOutAnyProt
rateRsProcess defName desiredImpr maxAttepts sampleRA =
    rateProcess defName goodEnough maxAttepts chtpRsC
    where
    chtpRsC = chTChanges $ chTIx $ chTList chtpRNoIx 
    chtpRNoIx = chTReal sampleRA
    
--    Just (QAChangesANew (QAIxA (QAListASingle (QARealA sampleRA)))) = cast a
    goodEnough _ QAChangesAGivenUp = True
    goodEnough QAChangesAGivenUp _ = True
    goodEnough
        (QAChangesANew (QAIxA (QAListA prevAs))) 
        (QAChangesANew (QAIxA (QAListA newAs))) =
            case RA.compareReals (impr) (fromRational desiredImpr) of
                Just LT -> False 
                _ -> True
            where
            impr = foldl max 1 $ zipWith getImprAs prevAs newAs
            getImprAs (QARealA prevRA) (QARealA newRA) =
                snd $ RA.intersectMeasureImprovement 20 prevRA newRA
                where
                _ = prevRA == sampleRA