module Ersatz.Relation.Op
( mirror
, union
, complement
, product, power
, intersection
)
where
import Ersatz.Relation.Data
import Prelude hiding ( and, or, not, product )
import Ersatz.Bit (and, or, not)
import Data.Ix
mirror :: ( Ix a , Ix b ) => Relation a b -> Relation b a
mirror r =
let ((a,b),(c,d)) = bounds r
in build ((b,a),(d,c)) $ do (x,y) <- indices r ; return ((y,x), r!(x,y))
complement :: ( Ix a , Ix b ) => Relation a b -> Relation a b
complement r =
build (bounds r) $ do i <- indices r ; return ( i, not $ r!i )
union :: ( Ix a , Ix b )
=> Relation a b -> Relation a b -> Relation a b
union r s = build ( bounds r ) $ do
i <- indices r
return (i, or [ r!i, s!i ] )
product :: ( Ix a , Ix b, Ix c )
=> Relation a b -> Relation b c -> Relation a c
product a b =
let ((ao,al),(au,ar)) = bounds a
((_ ,bl),(_ ,br)) = bounds b
bnd = ((ao,bl),(au,br))
in build bnd $ do
i @ (x,z) <- range bnd
return (i, or $ do
y <- range ( al, ar )
return $ and [ a!(x,y), b!(y,z) ]
)
power :: ( Ix a )
=> Int -> Relation a a -> Relation a a
power 0 r = identity ( bounds r )
power 1 r = r
power e r =
let (d,m) = divMod e 2
s = power d r
s2 = product s s
in case m of
0 -> s2
_ -> product s2 r
intersection :: ( Ix a , Ix b)
=> Relation a b -> Relation a b
-> Relation a b
intersection r s = build ( bounds r ) $ do
i <- indices r
return (i, and [ r!i, s!i ] )