{-# language FlexibleInstances, MultiParamTypeClasses #-} module Satchmo.Relation.Op ( mirror , union , complement , product, power , intersection ) where import Prelude hiding ( and, or, not, product ) import qualified Prelude import Satchmo.Code import Satchmo.Boolean import Satchmo.Counting import Satchmo.Relation.Data import Control.Monad ( guard ) import Data.Ix import Satchmo.SAT mirror :: ( Ix a , Ix b ) => Relation a b -> Relation b a mirror :: forall a b. (Ix a, Ix b) => Relation a b -> Relation b a mirror Relation a b r = let ((a a,b b),(a c,b d)) = forall a b. (Ix a, Ix b) => Relation a b -> ((a, b), (a, b)) bounds Relation a b r in forall a b. (Ix a, Ix b) => ((a, b), (a, b)) -> [((a, b), Boolean)] -> Relation a b build ((b b,a a),(b d,a c)) forall a b. (a -> b) -> a -> b $ do (a x,b y) <- forall {a} {b}. (Ix a, Ix b) => Relation a b -> [(a, b)] indices Relation a b r ; forall (m :: * -> *) a. Monad m => a -> m a return ((b y,a x), Relation a b rforall {a} {b}. (Ix a, Ix b) => Relation a b -> (a, b) -> Boolean !(a x,b y)) complement :: ( Ix a , Ix b ) => Relation a b -> Relation a b complement :: forall a b. (Ix a, Ix b) => Relation a b -> Relation a b complement Relation a b r = forall a b. (Ix a, Ix b) => ((a, b), (a, b)) -> [((a, b), Boolean)] -> Relation a b build (forall a b. (Ix a, Ix b) => Relation a b -> ((a, b), (a, b)) bounds Relation a b r) forall a b. (a -> b) -> a -> b $ do (a, b) i <- forall {a} {b}. (Ix a, Ix b) => Relation a b -> [(a, b)] indices Relation a b r ; forall (m :: * -> *) a. Monad m => a -> m a return ( (a, b) i, Boolean -> Boolean not forall a b. (a -> b) -> a -> b $ Relation a b rforall {a} {b}. (Ix a, Ix b) => Relation a b -> (a, b) -> Boolean !(a, b) i ) union :: ( Ix a , Ix b, MonadSAT m ) => Relation a b -> Relation a b -> m ( Relation a b ) {-# specialize inline union :: ( Ix a , Ix b ) => Relation a b -> Relation a b -> SAT ( Relation a b ) #-} union :: forall a b (m :: * -> *). (Ix a, Ix b, MonadSAT m) => Relation a b -> Relation a b -> m (Relation a b) union Relation a b r Relation a b s = do [((a, b), Boolean)] pairs <- forall (t :: * -> *) (m :: * -> *) a. (Traversable t, Monad m) => t (m a) -> m (t a) sequence forall a b. (a -> b) -> a -> b $ do (a, b) i <- forall {a} {b}. (Ix a, Ix b) => Relation a b -> [(a, b)] indices Relation a b r forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ do Boolean o <- forall (m :: * -> *). MonadSAT m => [Boolean] -> m Boolean or [ Relation a b rforall {a} {b}. (Ix a, Ix b) => Relation a b -> (a, b) -> Boolean !(a, b) i, Relation a b sforall {a} {b}. (Ix a, Ix b) => Relation a b -> (a, b) -> Boolean !(a, b) i ] ; forall (m :: * -> *) a. Monad m => a -> m a return ( (a, b) i, Boolean o ) forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall a b. (Ix a, Ix b) => ((a, b), (a, b)) -> [((a, b), Boolean)] -> Relation a b build ( forall a b. (Ix a, Ix b) => Relation a b -> ((a, b), (a, b)) bounds Relation a b r ) [((a, b), Boolean)] pairs product :: ( Ix a , Ix b, Ix c, MonadSAT m ) => Relation a b -> Relation b c -> m ( Relation a c ) {-# specialize inline product :: ( Ix a , Ix b, Ix c ) => Relation a b -> Relation b c -> SAT ( Relation a c ) #-} product :: forall a b c (m :: * -> *). (Ix a, Ix b, Ix c, MonadSAT m) => Relation a b -> Relation b c -> m (Relation a c) product Relation a b a Relation b c b = do let ((a ao,b al),(a au,b ar)) = forall a b. (Ix a, Ix b) => Relation a b -> ((a, b), (a, b)) bounds Relation a b a ((b bo,c bl),(b bu,c br)) = 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)) [((a, c), Boolean)] pairs <- forall (t :: * -> *) (m :: * -> *) a. (Traversable t, Monad m) => t (m a) -> m (t a) sequence forall a b. (a -> b) -> a -> b $ do i :: (a, c) i@(a x,c z) <- forall a. Ix a => (a, a) -> [a] range ((a, c), (a, c)) bnd forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ do Boolean o <- forall (m :: * -> *) a b. Monad m => ([a] -> m b) -> [m a] -> m b monadic forall (m :: * -> *). MonadSAT m => [Boolean] -> m Boolean or forall a b. (a -> b) -> a -> b $ do b y <- forall a. Ix a => (a, a) -> [a] range ( b al, b ar ) forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall (m :: * -> *). MonadSAT m => [Boolean] -> m Boolean and [ Relation a b aforall {a} {b}. (Ix a, Ix b) => Relation a b -> (a, b) -> Boolean !(a x,b y), Relation b c bforall {a} {b}. (Ix a, Ix b) => Relation a b -> (a, b) -> Boolean !(b y,c z) ] forall (m :: * -> *) a. Monad m => a -> m a return ( (a, c) i, Boolean o ) forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall a b. (Ix a, Ix b) => ((a, b), (a, b)) -> [((a, b), Boolean)] -> Relation a b build ((a, c), (a, c)) bnd [((a, c), Boolean)] pairs power :: ( Ix a , MonadSAT m ) => Int -> Relation a a -> m ( Relation a a ) power :: forall a (m :: * -> *). (Ix a, MonadSAT m) => Int -> Relation a a -> m (Relation a a) power Int 0 Relation a a r = forall a (m :: * -> *). (Ix a, MonadSAT m) => ((a, a), (a, a)) -> m (Relation a a) identity ( 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 = forall (m :: * -> *) a. Monad m => a -> m a return Relation a a r power Int e Relation a a r = do let (Int d,Int m) = forall a. Integral a => a -> a -> (a, a) divMod Int e Int 2 Relation a a s <- forall a (m :: * -> *). (Ix a, MonadSAT m) => Int -> Relation a a -> m (Relation a a) power Int d Relation a a r Relation a a s2 <- forall a b c (m :: * -> *). (Ix a, Ix b, Ix c, MonadSAT m) => Relation a b -> Relation b c -> m (Relation a c) product Relation a a s Relation a a s case Int m of Int 0 -> forall (m :: * -> *) a. Monad m => a -> m a return Relation a a s2 Int 1 -> forall a b c (m :: * -> *). (Ix a, Ix b, Ix c, MonadSAT m) => Relation a b -> Relation b c -> m (Relation a c) product Relation a a s2 Relation a a r intersection :: ( Ix a , Ix b, MonadSAT m ) => Relation a b -> Relation a b -> m ( Relation a b ) {-# specialize inline intersection :: ( Ix a , Ix b ) => Relation a b -> Relation a b -> SAT ( Relation a b ) #-} intersection :: forall a b (m :: * -> *). (Ix a, Ix b, MonadSAT m) => Relation a b -> Relation a b -> m (Relation a b) intersection Relation a b r Relation a b s = do [((a, b), Boolean)] pairs <- forall (t :: * -> *) (m :: * -> *) a. (Traversable t, Monad m) => t (m a) -> m (t a) sequence forall a b. (a -> b) -> a -> b $ do (a, b) i <- forall {a} {b}. (Ix a, Ix b) => Relation a b -> [(a, b)] indices Relation a b r forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ do Boolean a <- forall (m :: * -> *). MonadSAT m => [Boolean] -> m Boolean and [ Relation a b rforall {a} {b}. (Ix a, Ix b) => Relation a b -> (a, b) -> Boolean !(a, b) i, Relation a b sforall {a} {b}. (Ix a, Ix b) => Relation a b -> (a, b) -> Boolean !(a, b) i ] ; forall (m :: * -> *) a. Monad m => a -> m a return ( (a, b) i, Boolean a ) forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall a b. (Ix a, Ix b) => ((a, b), (a, b)) -> [((a, b), Boolean)] -> Relation a b build ( forall a b. (Ix a, Ix b) => Relation a b -> ((a, b), (a, b)) bounds Relation a b r ) [((a, b), Boolean)] pairs