{-# language FlexibleInstances, MultiParamTypeClasses #-} module Ersatz.Relation.Op ( mirror , union , complement , difference , product, power , intersection , reflexive_closure , symmetric_closure ) 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 :: Relation a b -> Relation b a mirror Relation a b r = let ((a a,b b),(a c,b d)) = Relation a b -> ((a, b), (a, b)) forall a b. (Ix a, Ix b) => Relation a b -> ((a, b), (a, b)) bounds Relation a b r in ((b, a), (b, a)) -> [((b, a), Bit)] -> Relation b a forall a b. (Ix a, Ix b) => ((a, b), (a, b)) -> [((a, b), Bit)] -> Relation a b build ((b b,a a),(b d,a c)) ([((b, a), Bit)] -> Relation b a) -> [((b, a), Bit)] -> Relation b a forall a b. (a -> b) -> a -> b $ do (a x,b y) <- Relation a b -> [(a, b)] forall a b. (Ix a, Ix b) => Relation a b -> [(a, b)] indices Relation a b r ; ((b, a), Bit) -> [((b, a), Bit)] forall (m :: * -> *) a. Monad m => a -> m a return ((b y,a x), Relation a b rRelation a b -> (a, b) -> Bit forall a b. (Ix a, Ix b) => Relation a b -> (a, b) -> Bit !(a x,b y)) complement :: ( Ix a , Ix b ) => Relation a b -> Relation a b complement :: Relation a b -> Relation a b complement Relation a b r = ((a, b), (a, b)) -> [((a, b), Bit)] -> Relation a b forall a b. (Ix a, Ix b) => ((a, b), (a, b)) -> [((a, b), Bit)] -> Relation a b build (Relation a b -> ((a, b), (a, b)) forall a b. (Ix a, Ix b) => Relation a b -> ((a, b), (a, b)) bounds Relation a b r) ([((a, b), Bit)] -> Relation a b) -> [((a, b), Bit)] -> Relation a b forall a b. (a -> b) -> a -> b $ do (a, b) i <- Relation a b -> [(a, b)] forall a b. (Ix a, Ix b) => Relation a b -> [(a, b)] indices Relation a b r ; ((a, b), Bit) -> [((a, b), Bit)] forall (m :: * -> *) a. Monad m => a -> m a return ( (a, b) i, Bit -> Bit forall b. Boolean b => b -> b not (Bit -> Bit) -> Bit -> Bit forall a b. (a -> b) -> a -> b $ Relation a b rRelation a b -> (a, b) -> Bit forall a b. (Ix a, Ix b) => Relation a b -> (a, b) -> Bit !(a, b) i ) difference :: ( Ix a , Ix b ) => Relation a b -> Relation a b -> Relation a b difference :: Relation a b -> Relation a b -> Relation a b difference Relation a b r Relation a b s = Relation a b -> Relation a b -> Relation a b forall a b. (Ix a, Ix b) => Relation a b -> Relation a b -> Relation a b intersection Relation a b r (Relation a b -> Relation a b) -> Relation a b -> Relation a b forall a b. (a -> b) -> a -> b $ Relation a b -> Relation a b forall a b. (Ix a, Ix b) => Relation a b -> Relation a b complement Relation a b s union :: ( Ix a , Ix b ) => Relation a b -> Relation a b -> Relation a b union :: Relation a b -> Relation a b -> Relation a b union Relation a b r Relation a b s = ((a, b), (a, b)) -> [((a, b), Bit)] -> Relation a b forall a b. (Ix a, Ix b) => ((a, b), (a, b)) -> [((a, b), Bit)] -> Relation a b build ( Relation a b -> ((a, b), (a, b)) forall a b. (Ix a, Ix b) => Relation a b -> ((a, b), (a, b)) bounds Relation a b r ) ([((a, b), Bit)] -> Relation a b) -> [((a, b), Bit)] -> Relation a b forall a b. (a -> b) -> a -> b $ do (a, b) i <- Relation a b -> [(a, b)] forall a b. (Ix a, Ix b) => Relation a b -> [(a, b)] indices Relation a b r ((a, b), Bit) -> [((a, b), Bit)] forall (m :: * -> *) a. Monad m => a -> m a return ((a, b) i, [Bit] -> Bit forall b (t :: * -> *). (Boolean b, Foldable t) => t b -> b or [ Relation a b rRelation a b -> (a, b) -> Bit forall a b. (Ix a, Ix b) => Relation a b -> (a, b) -> Bit !(a, b) i, Relation a b sRelation a b -> (a, b) -> Bit forall a b. (Ix a, Ix b) => Relation a b -> (a, b) -> Bit !(a, b) i ] ) product :: ( Ix a , Ix b, Ix c ) => Relation a b -> Relation b c -> Relation a c product :: Relation a b -> Relation b c -> Relation a c product Relation a b a Relation b c b = let ((a ao,b al),(a au,b ar)) = Relation a b -> ((a, b), (a, b)) forall a b. (Ix a, Ix b) => Relation a b -> ((a, b), (a, b)) bounds Relation a b a ((b _ ,c bl),(b _ ,c br)) = Relation b c -> ((b, c), (b, c)) forall a b. (Ix a, Ix b) => Relation a b -> ((a, b), (a, b)) bounds Relation b c b bnd :: ((a, c), (a, c)) bnd = ((a ao,c bl),(a au,c br)) in ((a, c), (a, c)) -> [((a, c), Bit)] -> Relation a c forall a b. (Ix a, Ix b) => ((a, b), (a, b)) -> [((a, b), Bit)] -> Relation a b build ((a, c), (a, c)) bnd ([((a, c), Bit)] -> Relation a c) -> [((a, c), Bit)] -> Relation a c forall a b. (a -> b) -> a -> b $ do i :: (a, c) i@(a x,c z) <- ((a, c), (a, c)) -> [(a, c)] forall a. Ix a => (a, a) -> [a] range ((a, c), (a, c)) bnd ((a, c), Bit) -> [((a, c), Bit)] forall (m :: * -> *) a. Monad m => a -> m a return ((a, c) i, [Bit] -> Bit forall b (t :: * -> *). (Boolean b, Foldable t) => t b -> b or ([Bit] -> Bit) -> [Bit] -> Bit forall a b. (a -> b) -> a -> b $ do b y <- (b, b) -> [b] forall a. Ix a => (a, a) -> [a] range ( b al, b ar ) Bit -> [Bit] forall (m :: * -> *) a. Monad m => a -> m a return (Bit -> [Bit]) -> Bit -> [Bit] forall a b. (a -> b) -> a -> b $ [Bit] -> Bit forall b (t :: * -> *). (Boolean b, Foldable t) => t b -> b and [ Relation a b aRelation a b -> (a, b) -> Bit forall a b. (Ix a, Ix b) => Relation a b -> (a, b) -> Bit !(a x,b y), Relation b c bRelation b c -> (b, c) -> Bit forall a b. (Ix a, Ix b) => Relation a b -> (a, b) -> Bit !(b y,c z) ] ) power :: ( Ix a ) => Int -> Relation a a -> Relation a a power :: Int -> Relation a a -> Relation a a power Int 0 Relation a a r = ((a, a), (a, a)) -> Relation a a forall a. Ix a => ((a, a), (a, a)) -> Relation a a identity ( Relation a a -> ((a, a), (a, a)) forall a b. (Ix a, Ix b) => Relation a b -> ((a, b), (a, b)) bounds Relation a a r ) power Int 1 Relation a a r = Relation a a r power Int e Relation a a r = let (Int d,Int m) = Int -> Int -> (Int, Int) forall a. Integral a => a -> a -> (a, a) divMod Int e Int 2 s :: Relation a a s = Int -> Relation a a -> Relation a a forall a. Ix a => Int -> Relation a a -> Relation a a power Int d Relation a a r s2 :: Relation a a s2 = Relation a a -> Relation a a -> Relation a a forall a b c. (Ix a, Ix b, Ix c) => Relation a b -> Relation b c -> Relation a c product Relation a a s Relation a a s in case Int m of Int 0 -> Relation a a s2 Int _ -> Relation a a -> Relation a a -> Relation a a forall a b c. (Ix a, Ix b, Ix c) => Relation a b -> Relation b c -> Relation a c product Relation a a s2 Relation a a r intersection :: ( Ix a , Ix b) => Relation a b -> Relation a b -> Relation a b intersection :: Relation a b -> Relation a b -> Relation a b intersection Relation a b r Relation a b s = ((a, b), (a, b)) -> [((a, b), Bit)] -> Relation a b forall a b. (Ix a, Ix b) => ((a, b), (a, b)) -> [((a, b), Bit)] -> Relation a b build ( Relation a b -> ((a, b), (a, b)) forall a b. (Ix a, Ix b) => Relation a b -> ((a, b), (a, b)) bounds Relation a b r ) ([((a, b), Bit)] -> Relation a b) -> [((a, b), Bit)] -> Relation a b forall a b. (a -> b) -> a -> b $ do (a, b) i <- Relation a b -> [(a, b)] forall a b. (Ix a, Ix b) => Relation a b -> [(a, b)] indices Relation a b r ((a, b), Bit) -> [((a, b), Bit)] forall (m :: * -> *) a. Monad m => a -> m a return ((a, b) i, [Bit] -> Bit forall b (t :: * -> *). (Boolean b, Foldable t) => t b -> b and [ Relation a b rRelation a b -> (a, b) -> Bit forall a b. (Ix a, Ix b) => Relation a b -> (a, b) -> Bit !(a, b) i, Relation a b sRelation a b -> (a, b) -> Bit forall a b. (Ix a, Ix b) => Relation a b -> (a, b) -> Bit !(a, b) i ] ) reflexive_closure :: Ix a => Relation a a -> Relation a a reflexive_closure :: Relation a a -> Relation a a reflexive_closure Relation a a t = Relation a a -> Relation a a -> Relation a a forall a b. (Ix a, Ix b) => Relation a b -> Relation a b -> Relation a b union Relation a a t (Relation a a -> Relation a a) -> Relation a a -> Relation a a forall a b. (a -> b) -> a -> b $ ((a, a), (a, a)) -> Relation a a forall a. Ix a => ((a, a), (a, a)) -> Relation a a identity (((a, a), (a, a)) -> Relation a a) -> ((a, a), (a, a)) -> Relation a a forall a b. (a -> b) -> a -> b $ Relation a a -> ((a, a), (a, a)) forall a b. (Ix a, Ix b) => Relation a b -> ((a, b), (a, b)) bounds Relation a a t symmetric_closure :: Ix a => Relation a a -> Relation a a symmetric_closure :: Relation a a -> Relation a a symmetric_closure Relation a a r = Relation a a -> Relation a a -> Relation a a forall a b. (Ix a, Ix b) => Relation a b -> Relation a b -> Relation a b union Relation a a r (Relation a a -> Relation a a) -> Relation a a -> Relation a a forall a b. (a -> b) -> a -> b $ Relation a a -> Relation a a forall a b. (Ix a, Ix b) => Relation a b -> Relation b a mirror Relation a a r