{-# 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