{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Lattices.UnitIntervalStructures.Product(
    UIProduct(UIProduct),
    BoundedLattice(..),
    mkProductUnitInterval,
    fromProductUnitInterval
) where

import Lattices.ResiduatedLattice
import Lattices.UnitInterval

newtype UIProduct = UIProduct UnitInterval 
    deriving (UIProduct -> UIProduct -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UIProduct -> UIProduct -> Bool
$c/= :: UIProduct -> UIProduct -> Bool
== :: UIProduct -> UIProduct -> Bool
$c== :: UIProduct -> UIProduct -> Bool
Eq, Eq UIProduct
UIProduct -> UIProduct -> Bool
UIProduct -> UIProduct -> Ordering
UIProduct -> UIProduct -> UIProduct
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UIProduct -> UIProduct -> UIProduct
$cmin :: UIProduct -> UIProduct -> UIProduct
max :: UIProduct -> UIProduct -> UIProduct
$cmax :: UIProduct -> UIProduct -> UIProduct
>= :: UIProduct -> UIProduct -> Bool
$c>= :: UIProduct -> UIProduct -> Bool
> :: UIProduct -> UIProduct -> Bool
$c> :: UIProduct -> UIProduct -> Bool
<= :: UIProduct -> UIProduct -> Bool
$c<= :: UIProduct -> UIProduct -> Bool
< :: UIProduct -> UIProduct -> Bool
$c< :: UIProduct -> UIProduct -> Bool
compare :: UIProduct -> UIProduct -> Ordering
$ccompare :: UIProduct -> UIProduct -> Ordering
Ord, Integer -> UIProduct
UIProduct -> UIProduct
UIProduct -> UIProduct -> UIProduct
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> UIProduct
$cfromInteger :: Integer -> UIProduct
signum :: UIProduct -> UIProduct
$csignum :: UIProduct -> UIProduct
abs :: UIProduct -> UIProduct
$cabs :: UIProduct -> UIProduct
negate :: UIProduct -> UIProduct
$cnegate :: UIProduct -> UIProduct
* :: UIProduct -> UIProduct -> UIProduct
$c* :: UIProduct -> UIProduct -> UIProduct
- :: UIProduct -> UIProduct -> UIProduct
$c- :: UIProduct -> UIProduct -> UIProduct
+ :: UIProduct -> UIProduct -> UIProduct
$c+ :: UIProduct -> UIProduct -> UIProduct
Num, Num UIProduct
Ord UIProduct
UIProduct -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: UIProduct -> Rational
$ctoRational :: UIProduct -> Rational
Real, Fractional UIProduct
Real UIProduct
forall b. Integral b => UIProduct -> b
forall b. Integral b => UIProduct -> (b, UIProduct)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
floor :: forall b. Integral b => UIProduct -> b
$cfloor :: forall b. Integral b => UIProduct -> b
ceiling :: forall b. Integral b => UIProduct -> b
$cceiling :: forall b. Integral b => UIProduct -> b
round :: forall b. Integral b => UIProduct -> b
$cround :: forall b. Integral b => UIProduct -> b
truncate :: forall b. Integral b => UIProduct -> b
$ctruncate :: forall b. Integral b => UIProduct -> b
properFraction :: forall b. Integral b => UIProduct -> (b, UIProduct)
$cproperFraction :: forall b. Integral b => UIProduct -> (b, UIProduct)
RealFrac, Num UIProduct
Rational -> UIProduct
UIProduct -> UIProduct
UIProduct -> UIProduct -> UIProduct
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> UIProduct
$cfromRational :: Rational -> UIProduct
recip :: UIProduct -> UIProduct
$crecip :: UIProduct -> UIProduct
/ :: UIProduct -> UIProduct -> UIProduct
$c/ :: UIProduct -> UIProduct -> UIProduct
Fractional)

instance BoundedLattice UIProduct where
    /\ :: UIProduct -> UIProduct -> UIProduct
(/\) (UIProduct UnitInterval
x) (UIProduct UnitInterval
y) = UnitInterval -> UIProduct
UIProduct (UnitInterval
x forall l. BoundedLattice l => l -> l -> l
/\ UnitInterval
y)
    \/ :: UIProduct -> UIProduct -> UIProduct
(\/) (UIProduct UnitInterval
x) (UIProduct UnitInterval
y) = UnitInterval -> UIProduct
UIProduct (UnitInterval
x forall l. BoundedLattice l => l -> l -> l
\/ UnitInterval
y)
    bot :: UIProduct
bot = UnitInterval -> UIProduct
UIProduct forall l. BoundedLattice l => l
bot
    top :: UIProduct
top = UnitInterval -> UIProduct
UIProduct forall l. BoundedLattice l => l
top
    mkLattice :: Double -> UIProduct
mkLattice = Double -> UIProduct
mkProductUnitInterval

-- | Product (Goguen) structure of truth values

instance ResiduatedLattice UIProduct where
    tnorm :: UIProduct -> UIProduct -> UIProduct
tnorm UIProduct
x UIProduct
y = UIProduct
x forall a. Num a => a -> a -> a
* UIProduct
y
    UIProduct
a --> :: UIProduct -> UIProduct -> UIProduct
--> UIProduct
b 
        | UIProduct
a forall a. Ord a => a -> a -> Bool
<= UIProduct
b = forall l. BoundedLattice l => l
top 
        | Bool
otherwise = UIProduct
b forall a. Fractional a => a -> a -> a
/ UIProduct
a

instance Show UIProduct where 
    show :: UIProduct -> String
show (UIProduct UnitInterval
x) = forall a. Show a => a -> String
show UnitInterval
x

mkProductUnitInterval :: Double -> UIProduct
mkProductUnitInterval :: Double -> UIProduct
mkProductUnitInterval Double
x = UnitInterval -> UIProduct
UIProduct forall a b. (a -> b) -> a -> b
$ Double -> UnitInterval
mkUnitInterval Double
x

fromProductUnitInterval :: UIProduct -> Double
fromProductUnitInterval :: UIProduct -> Double
fromProductUnitInterval (UIProduct (UnitInterval Double
x)) = Double
x