{-# 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)) = 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), Boolean)] -> Relation b a 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)) ([((b, a), Boolean)] -> Relation b a) -> [((b, a), Boolean)] -> 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), Boolean) -> [((b, a), Boolean)] forall a. a -> [a] forall (m :: * -> *) a. Monad m => a -> m a return ((b y,a x), Relation a b rRelation a b -> (a, b) -> Boolean forall {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 = ((a, b), (a, b)) -> [((a, b), Boolean)] -> Relation a b forall a b. (Ix a, Ix b) => ((a, b), (a, b)) -> [((a, b), Boolean)] -> 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), Boolean)] -> Relation a b) -> [((a, b), Boolean)] -> 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), Boolean) -> [((a, b), Boolean)] forall a. a -> [a] forall (m :: * -> *) a. Monad m => a -> m a return ( (a, b) i, Boolean -> Boolean not (Boolean -> Boolean) -> Boolean -> Boolean forall a b. (a -> b) -> a -> b $ Relation a b rRelation a b -> (a, b) -> Boolean forall {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 <- [m ((a, b), Boolean)] -> m [((a, b), Boolean)] forall (t :: * -> *) (m :: * -> *) a. (Traversable t, Monad m) => t (m a) -> m (t a) forall (m :: * -> *) a. Monad m => [m a] -> m [a] sequence ([m ((a, b), Boolean)] -> m [((a, b), Boolean)]) -> [m ((a, b), Boolean)] -> m [((a, b), Boolean)] 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 m ((a, b), Boolean) -> [m ((a, b), Boolean)] forall a. a -> [a] forall (m :: * -> *) a. Monad m => a -> m a return (m ((a, b), Boolean) -> [m ((a, b), Boolean)]) -> m ((a, b), Boolean) -> [m ((a, b), Boolean)] forall a b. (a -> b) -> a -> b $ do Boolean o <- [Boolean] -> m Boolean forall (m :: * -> *). MonadSAT m => [Boolean] -> m Boolean or [ Relation a b rRelation a b -> (a, b) -> Boolean forall {a} {b}. (Ix a, Ix b) => Relation a b -> (a, b) -> Boolean !(a, b) i, Relation a b sRelation a b -> (a, b) -> Boolean forall {a} {b}. (Ix a, Ix b) => Relation a b -> (a, b) -> Boolean !(a, b) i ] ; ((a, b), Boolean) -> m ((a, b), Boolean) forall a. a -> m a forall (m :: * -> *) a. Monad m => a -> m a return ( (a, b) i, Boolean o ) Relation a b -> m (Relation a b) forall a. a -> m a forall (m :: * -> *) a. Monad m => a -> m a return (Relation a b -> m (Relation a b)) -> Relation a b -> m (Relation a b) forall a b. (a -> b) -> a -> b $ ((a, b), (a, b)) -> [((a, b), Boolean)] -> Relation a b forall a b. (Ix a, Ix b) => ((a, b), (a, b)) -> [((a, b), Boolean)] -> 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), 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)) = 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 bo,c bl),(b bu,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)) [((a, c), Boolean)] pairs <- [m ((a, c), Boolean)] -> m [((a, c), Boolean)] forall (t :: * -> *) (m :: * -> *) a. (Traversable t, Monad m) => t (m a) -> m (t a) forall (m :: * -> *) a. Monad m => [m a] -> m [a] sequence ([m ((a, c), Boolean)] -> m [((a, c), Boolean)]) -> [m ((a, c), Boolean)] -> m [((a, c), Boolean)] 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 m ((a, c), Boolean) -> [m ((a, c), Boolean)] forall a. a -> [a] forall (m :: * -> *) a. Monad m => a -> m a return (m ((a, c), Boolean) -> [m ((a, c), Boolean)]) -> m ((a, c), Boolean) -> [m ((a, c), Boolean)] forall a b. (a -> b) -> a -> b $ do Boolean o <- ([Boolean] -> m Boolean) -> [m Boolean] -> m Boolean forall (m :: * -> *) a b. Monad m => ([a] -> m b) -> [m a] -> m b monadic [Boolean] -> m Boolean forall (m :: * -> *). MonadSAT m => [Boolean] -> m Boolean or ([m Boolean] -> m Boolean) -> [m Boolean] -> m Boolean 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 ) m Boolean -> [m Boolean] forall a. a -> [a] forall (m :: * -> *) a. Monad m => a -> m a return (m Boolean -> [m Boolean]) -> m Boolean -> [m Boolean] forall a b. (a -> b) -> a -> b $ [Boolean] -> m Boolean forall (m :: * -> *). MonadSAT m => [Boolean] -> m Boolean and [ Relation a b aRelation a b -> (a, b) -> Boolean forall {a} {b}. (Ix a, Ix b) => Relation a b -> (a, b) -> Boolean !(a x,b y), Relation b c bRelation b c -> (b, c) -> Boolean forall {a} {b}. (Ix a, Ix b) => Relation a b -> (a, b) -> Boolean !(b y,c z) ] ((a, c), Boolean) -> m ((a, c), Boolean) forall a. a -> m a forall (m :: * -> *) a. Monad m => a -> m a return ( (a, c) i, Boolean o ) Relation a c -> m (Relation a c) forall a. a -> m a forall (m :: * -> *) a. Monad m => a -> m a return (Relation a c -> m (Relation a c)) -> Relation a c -> m (Relation a c) forall a b. (a -> b) -> a -> b $ ((a, c), (a, c)) -> [((a, c), Boolean)] -> Relation a c 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 = ((a, a), (a, a)) -> m (Relation a a) forall a (m :: * -> *). (Ix a, MonadSAT m) => ((a, a), (a, a)) -> m (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 -> m (Relation a a) forall a. a -> m a 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) = Int -> Int -> (Int, Int) forall a. Integral a => a -> a -> (a, a) divMod Int e Int 2 Relation a a s <- Int -> Relation a a -> m (Relation a a) 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 <- Relation a a -> Relation a a -> m (Relation a a) 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 -> Relation a a -> m (Relation a a) forall a. a -> m a forall (m :: * -> *) a. Monad m => a -> m a return Relation a a s2 Int 1 -> Relation a a -> Relation a a -> m (Relation a a) 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 <- [m ((a, b), Boolean)] -> m [((a, b), Boolean)] forall (t :: * -> *) (m :: * -> *) a. (Traversable t, Monad m) => t (m a) -> m (t a) forall (m :: * -> *) a. Monad m => [m a] -> m [a] sequence ([m ((a, b), Boolean)] -> m [((a, b), Boolean)]) -> [m ((a, b), Boolean)] -> m [((a, b), Boolean)] 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 m ((a, b), Boolean) -> [m ((a, b), Boolean)] forall a. a -> [a] forall (m :: * -> *) a. Monad m => a -> m a return (m ((a, b), Boolean) -> [m ((a, b), Boolean)]) -> m ((a, b), Boolean) -> [m ((a, b), Boolean)] forall a b. (a -> b) -> a -> b $ do Boolean a <- [Boolean] -> m Boolean forall (m :: * -> *). MonadSAT m => [Boolean] -> m Boolean and [ Relation a b rRelation a b -> (a, b) -> Boolean forall {a} {b}. (Ix a, Ix b) => Relation a b -> (a, b) -> Boolean !(a, b) i, Relation a b sRelation a b -> (a, b) -> Boolean forall {a} {b}. (Ix a, Ix b) => Relation a b -> (a, b) -> Boolean !(a, b) i ] ; ((a, b), Boolean) -> m ((a, b), Boolean) forall a. a -> m a forall (m :: * -> *) a. Monad m => a -> m a return ( (a, b) i, Boolean a ) Relation a b -> m (Relation a b) forall a. a -> m a forall (m :: * -> *) a. Monad m => a -> m a return (Relation a b -> m (Relation a b)) -> Relation a b -> m (Relation a b) forall a b. (a -> b) -> a -> b $ ((a, b), (a, b)) -> [((a, b), Boolean)] -> Relation a b forall a b. (Ix a, Ix b) => ((a, b), (a, b)) -> [((a, b), Boolean)] -> 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), Boolean)] pairs