oalg-base-1.1.4.0: Algebraic structures on oriented entities and limits as a tool kit to solve algebraic problems.
Copyright(c) Erich Gut
LicenseBSD3
Maintainerzerich.gut@gmail.com
Safe HaskellSafe-Inferred
LanguageHaskell2010

OAlg.Data.Statement.Definition

Description

Statements on properties which can be validated via validateStoch. They serve to implement automatic testing (see OAlg.Control.Validate).

Examples Deterministic

Validation of the valid and invalid statement

>>> getOmega >>= validateStoch SValid 10
Valid
>>> getOmega >>= validateStoch SInvalid 5
Invalid

As no stochastic was used to evaluate the two examples, the result is Valid and Invalid respectively!

Examples Stochastic

Validation of a Forall and Exist statement

>>> getOmega >>= validateStoch (Forall (xIntB 0 10) (\i -> (0 <= i && i <= 10):?>Params["i":=show i]-- )) 100
ProbablyValid
>>> getOmega >>= validateStoch (Exist (xIntB 0 10) (\i -> (11 <= i):?>Params["i":=show i])) 100
ProbablyInvalid

The valuation of these two examples uses the given Omega and Wide of 100 to pick randomly 100 samples of the given random variable xIntB 0 10 and applies these samples to the given test function. The result is ProbablyValid and ProbablyInvalid respectively!

Synopsis

Statement

data Statement where Source #

statement on properties..

Constructors

SInvalid :: Statement

the invalid statement.

SValid :: Statement

the valid statement.

(:?>) :: Bool -> Message -> Statement infix 4

checking a boolean.

Catch :: Exception e => Statement -> (e -> Statement) -> Statement

catching an exception.

Not :: Statement -> Statement

not

(:&&) :: Statement -> Statement -> Statement infixr 3

and

And :: [Statement] -> Statement

and

(:||) :: Statement -> Statement -> Statement infixr 2

or

Or :: [Statement] -> Statement

or

(:=>) :: Statement -> Statement -> Statement infixr 1

implication

Impl :: [Statement] -> Statement -> Statement

implication

(:<=>:) :: Label -> Statement -> Statement infixr 0

efinitional equivalence

(:<=>) :: Statement -> Statement -> Statement infixr 1

equivalence

Eqvl :: [Statement] -> Statement

equivalence

Forall :: X x -> (x -> Statement) -> Statement

the for all constructor

Exist :: X x -> (x -> Statement) -> Statement

the exist constructor.

(.==.) :: Eq a => a -> a -> Statement infix 4 Source #

checking for equality.

(./=.) :: Eq a => a -> a -> Statement infix 4 Source #

checking for inequality.

(|~>) :: Statement -> Statement -> Statement infixr 1 Source #

implication without resulting in denied premises for a false premises. This is useful for switch cases.

data Label Source #

a labels.

Constructors

Label String 
Prp String 

Instances

Instances details
Show Label Source # 
Instance details

Defined in OAlg.Data.Statement.Definition

Methods

showsPrec :: Int -> Label -> ShowS #

show :: Label -> String #

showList :: [Label] -> ShowS #

Verbose Label Source # 
Instance details

Defined in OAlg.Data.Statement.Definition

data Message Source #

a message.

Constructors

MInvalid

used for relations where no further information is desired or possible to give (see relRelation as an example).

Message String

a message

Params [Parameter]

a list of parameters

Instances

Instances details
Show Message Source # 
Instance details

Defined in OAlg.Data.Statement.Definition

Verbose Message Source # 
Instance details

Defined in OAlg.Data.Statement.Definition

type Variable = String Source #

type of variables.

data Parameter where Source #

showing the involved parameters of a statement.

Constructors

(:=) :: Variable -> String -> Parameter 

Instances

Instances details
Show Parameter Source # 
Instance details

Defined in OAlg.Data.Statement.Definition

Verbose Parameter Source # 
Instance details

Defined in OAlg.Data.Statement.Definition

Validating

Stochastic

validateStoch :: Statement -> Wide -> Omega -> IO Valid Source #

validates the statement according to a given Wide and Omega. For deterministic statements better use validateDet and for non deterministic or to get more information validate.

type Wide = Int Source #

the wide for a Forall and Exist resolution.

value :: Statement -> Wide -> Omega -> IO V Source #

evaluates the value of a statement according a given Wide and Omega.

Note

  1. The only reason to valuate a statement in the IO monad is to be able to catch exceptions. Other interactions with the real world during the valuation are not performed.
  2. During the evaluation process the given wide and omega will not be changed and as such all same random variables will produce exactly the same samples. This restricts the stochastic, but it is necessary for the sound behavior of the validation of statements.

data V Source #

the value of a statement resulting from its validation. Forall and Exist are resolved by finite samples.

Instances

Instances details
Show V Source # 
Instance details

Defined in OAlg.Data.Statement.Definition

Methods

showsPrec :: Int -> V -> ShowS #

show :: V -> String #

showList :: [V] -> ShowS #

Verbose V Source # 
Instance details

Defined in OAlg.Data.Statement.Definition

Methods

vshow :: Verbosity -> V -> String Source #

valDeterministic :: V -> Bool Source #

determines whether the value is deterministic, i.e. dose not contain a VForall or VExist constructor.

valT :: V -> T Source #

validating a value v.

type T = HNFValue Valid Source #

the truth type of a value v.

data Valid Source #

weak form of classical boolean values arising from stochastically performed valuation of Statements.

Definition Let a, b be in Valid, then we define:

  1. not a = toEnum (fromEnum Valid - fromEnum a).
  2. a || b = max a b.
  3. a && b = min a b.
  4. a ~> b = not a || b.

Note min and max are implemented lazy as Valid is bounded. This is important that ~> behaves as desired, i.e. for a ~> b and a = Invalid then b has not to be evaluated, because the maximum is already reached..

Instances

Instances details
Bounded Valid Source # 
Instance details

Defined in OAlg.Data.Statement.Definition

Enum Valid Source # 
Instance details

Defined in OAlg.Data.Statement.Definition

Show Valid Source # 
Instance details

Defined in OAlg.Data.Statement.Definition

Methods

showsPrec :: Int -> Valid -> ShowS #

show :: Valid -> String #

showList :: [Valid] -> ShowS #

NFData Valid Source # 
Instance details

Defined in OAlg.Data.Statement.Definition

Methods

rnf :: Valid -> () #

Eq Valid Source # 
Instance details

Defined in OAlg.Data.Statement.Definition

Methods

(==) :: Valid -> Valid -> Bool #

(/=) :: Valid -> Valid -> Bool #

Ord Valid Source # 
Instance details

Defined in OAlg.Data.Statement.Definition

Methods

compare :: Valid -> Valid -> Ordering #

(<) :: Valid -> Valid -> Bool #

(<=) :: Valid -> Valid -> Bool #

(>) :: Valid -> Valid -> Bool #

(>=) :: Valid -> Valid -> Bool #

max :: Valid -> Valid -> Valid #

min :: Valid -> Valid -> Valid #

Boolean Valid Source # 
Instance details

Defined in OAlg.Data.Statement.Definition

Validable Valid Source # 
Instance details

Defined in OAlg.Data.Validable

Projectible Bool Valid Source # 
Instance details

Defined in OAlg.Data.Statement.Definition

Methods

prj :: Valid -> Bool Source #

showV :: Indent -> V -> String Source #

pretty showing a value with the given indentation.

indent0 :: String -> Indent Source #

the initial indentation given by a indentation string.

showVStatement :: Wide -> Statement -> IO () Source #

pretty showing the value of a statement according to the given Wide and randomly given Omega.

Deterministic

validateDet :: Statement -> Bool Source #

validation for deterministic statements.

Definition A statement s is called deterministic if and only if it dose not depend on the stochastic nor on the state of the machine.

Examples

>>> validateDet SValid
True
>>> validateDet (Forall xBool (\_ -> SValid))
*** Exception: NonDeterministic
>>> validateDet (SValid || Exist xInt (\i -> (i==0):?>MInvalid))
True

Reducing Values

tests :: V -> [(Int, SPath)] Source #

the list of all relevant tests - i.e 'VDedEqvl l _ where l = Label _ - together with the number of tests.

type SPath = [String] Source #

path of strings.

cntTests :: V -> Int Source #

number of tests.

rdcTrue :: V -> Maybe V Source #

reduces true valus to its relevant part.

cntTestsRdcTrue :: V -> Int Source #

number of tests for true values. Note Before counting the tests they will be first reduced to there relevant part (see rdcTrue).

rdcFalse :: V -> Maybe V Source #

reduces false valus to its relevant part.

cntTestsRdcFalse :: V -> Int Source #

number of tests for false values. Note Before counting the tests they will be first reduced to there relevant part (see rdcFalse).

rdcDndPrms :: V -> Maybe V Source #

reduces ture values - having implications with no conclusions, i.e. denied premises - to its relevant part.

cntTestsRdcDndPrms :: V -> Int Source #

number of tests for values containing denied premises. Note Before counting the tests they will be first reduced to there relevant part (see rdcDndPrms).

rdcFailed :: V -> Maybe V Source #

reduces failed values to its relevant part.

cntTestsRdcFailed :: V -> Int Source #

number of tests for failed values. Note Before counting the tests they will be first reduced to there relevant part (see rdcFailed).

X

xValue :: Statement -> X (Wide, Omega) -> X (IO V) Source #

random variable of valuation values according to the randomly given Wide and Omega.

xWO :: Wide -> Wide -> X (Wide, Omega) Source #

xWO l h is the random variable over wide and omgea, where the wide is bounded between l and h.

xValid :: X Valid Source #

uniformly distributed random variable of Valid.

Exception