diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,30 +1,31 @@
-Copyright (c)2010, Leonel Fonseca
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-    * Redistributions of source code must retain the above copyright
-      notice, this list of conditions and the following disclaimer.
-
-    * Redistributions in binary form must reproduce the above
-      copyright notice, this list of conditions and the following
-      disclaimer in the documentation and/or other materials provided
-      with the distribution.
-
-    * Neither the name of Leonel Fonseca nor the names of other
-      contributors may be used to endorse or promote products derived
-      from this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+Copyright (c)2019, John Ky
+Copyright (c)2010, Leonel Fonseca
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Author name here nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/relation.cabal b/relation.cabal
--- a/relation.cabal
+++ b/relation.cabal
@@ -1,7 +1,7 @@
 cabal-version:      2.2
 
 name:               relation
-version:            0.4
+version:            0.5
 synopsis:           A data structure representing Relations on Sets.
 description:        A library to model relationships between two objects that are subclasses of Ord.
 
@@ -42,10 +42,13 @@
           , containers
   hs-source-dirs:     src
   exposed-modules:    Data.Relation
+                    , Data.Relation.Ops
+                    , Data.Relation.Internal
+                    , Data.Relation.Internal.Set
 
 test-suite relation-test
-  import:   base
-          , common
+  import:   base, common
+          , containers
           , hedgehog
           , hspec
           , hw-hspec-hedgehog
@@ -53,7 +56,8 @@
   type:               exitcode-stdio-1.0
   main-is:            Spec.hs
   build-depends:      relation
-  other-modules:      Paths_relation
+  other-modules:      Data.RelationSpec
+                    , Paths_relation
   autogen-modules:    Paths_relation
   hs-source-dirs:     test
   ghc-options:        -threaded -rtsopts -with-rtsopts=-N
diff --git a/src/Data/Relation.hs b/src/Data/Relation.hs
--- a/src/Data/Relation.hs
+++ b/src/Data/Relation.hs
@@ -1,7 +1,8 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Relation
--- Copyright   :  (c) DD.  2012
+-- Copyright   :  (c) JK.  2019
+--                (c) DD.  2012
 --                (c) LFL. 2009
 -- License     :  BSD-style
 -- Maintainer  :  Drew Day<drewday@gmail.com>
@@ -25,461 +26,207 @@
 --
 --
 module Data.Relation (
-
-   -- * The @Relation@ Type
-
-   Relation ()
-
-   -- *  Provided functionality:
-
-   -- ** Questions
-
- , size         --  # Tuples in the relation?
- , null         --  Is empty?
-
-   -- ** Construction
-
- , empty        --  Construct an empty relation.
- , fromList     --  Relation <- []
- , singleton    --  Construct a relation with a single element.
-
-   -- ** Operations
-
- , union        --  Union of two relations.
- , unions       --  Union on a list of relations.
- , intersection --  Intersection of two relations.
- , insert       --  Insert a tuple to the relation.
- , delete       --  Delete a tuple from the relation.
-   -- The Set of values associated with a value in the domain.
- , lookupDom
-   -- The Set of values associated with a value in the range.
- , lookupRan
- , memberDom    --  Is the element in the domain?
- , memberRan    --  Is the element in the range?
- , member       --  Is the tuple   in the relation?
- , notMember
-
-   -- ** Conversion
-
- , toList       --  Construct a list from a relation
-   --  Extract the elements of the range to a Set.
- , dom
-   --  Extract the elements of the domain to a Set.
- , ran
-
-  -- ** Invertible Relations
- , c
-
-   -- ** Utilities
-
- , compactSet --  Compact a Set of Maybe's.
-
- -- $selectops
- , (|$>) -- Restrict the range according to a subset. PICA.
-
- , (<$|) -- Restrict the domain according to a subset. PICA.
-
- , (<|)  -- Domain restriction. Z.
-
- , (|>)  -- Range restriction. z.
-
-   -- Not implemented
-     --   filter :: (a -> b -> Bool) -> Relation a b -> Relation a b
-     --   map
-)
-
-where
-
-import           Control.Monad (MonadPlus, guard)
-import           Data.Functor  (Functor ((<$)))
-import qualified Data.Map      as M
-import           Data.Maybe    (fromJust, fromMaybe, isJust)
-import qualified Data.Set      as S
-import           Prelude       hiding (null)
+    -- * The @Relation@ Type
+    Relation
 
--- |
--- This implementation avoids using @"S.Set (a,b)"@ because
--- it it is necessary to search for an item without knowing both @D@ and @R@.
---
--- In "S.Set", you must know both values to search.
---
--- Thus, we have are two maps to updated together.
---
--- 1. Always be careful with the associated set of the key.
---
--- 2. If you union two relations, apply union to the set of values.
---
--- 3. If you subtract, take care when handling the set of values.
---
--- As a multi-map, each key is asscoated with a Set of values v.
---
--- We do not allow the associations with the 'empty' Set.
---
+    -- *  Provided functionality:
+    -- ** Questions
+  , size            -- Number of Tuples in the relation?
+  , null            -- Is empty?
 
-data Relation a b  = Relation { domain ::  M.Map a (S.Set b)
-                              , range  ::  M.Map b (S.Set a)
-                              }
+    -- ** Construction
+  , empty           -- Construct an empty relation.
+  , fromList        -- Relation <- []
+  , singleton       -- Construct a relation with a single element.
 
-    deriving (Show, Eq, Ord)
+    -- ** Operations
+  , union           -- Union of two relations.
+  , unions          -- Union on a list of relations.
+  , intersection    -- Intersection of two relations.
+  , insert          -- Insert a tuple to the relation.
+  , delete          -- Delete a tuple from the relation.
+  , lookupDom       -- The Set of values associated with a value in the domain.
+  , lookupRan       -- The Set of values associated with a value in the range.
+  , memberDom       -- Is the element in the domain?
+  , memberRan       -- Is the element in the range?
+  , member          -- Is the tuple   in the relation?
+  , notMember
+  , restrictDom     -- Restrict the domain to that of the provided set
+  , restrictRan     -- Restrict the range to that of the provided set
+  , withoutDom      -- Restrict the domain to exclude elements of the provided set
+  , withoutRan      -- Restrict the range to exclude elements of the provided set
 
+    -- ** Conversion
+  , toList          -- Construct a list from a relation
+  , dom             -- Extract the elements of the range to a Set.
+  , ran             -- Extract the elements of the domain to a Set.
+  , converse        -- Converse of the relation
+  ) where
 
+import Control.Monad          (MonadPlus, guard)
+import Data.Functor           (Functor ((<$)))
+import Data.Map               (Map)
+import Data.Maybe             (fromMaybe)
+import Data.Relation.Internal (Relation (Relation))
+import Data.Set               (Set)
+import Prelude                hiding (null)
 
+import qualified Data.Foldable              as F
+import qualified Data.Map                   as M
+import qualified Data.Relation.Internal     as R
+import qualified Data.Relation.Internal.Set as S
+import qualified Data.Set                   as S
 
 -- * Functions about relations
 
-
 -- The size is calculated using the domain.
 -- |  @size r@ returns the number of tuples in the relation.
-
-size    ::  Relation a b -> Int
-size r  =   M.foldr ((+) . S.size) 0 (domain r)
-
-
+size :: Relation a b -> Int
+size r = M.foldr ((+) . S.size) 0 (R.domain r)
 
 -- | Construct a relation with no elements.
-
-empty   ::  Relation a b
-empty   =   Relation M.empty M.empty
-
-
+empty :: Relation a b
+empty = Relation M.empty M.empty
 
 -- |
 -- The list must be formatted like: [(k1, v1), (k2, v2),..,(kn, vn)].
-
-fromList    ::  (Ord a, Ord b) => [(a, b)] -> Relation a b
-fromList xs =
-    Relation
-        { domain =  M.fromListWith S.union $ snd2Set    xs
-        , range   =  M.fromListWith S.union $ flipAndSet xs
-        }
-    where
-       snd2Set    = map ( \(x,y) -> (x, S.singleton y) )
-       flipAndSet = map ( \(x,y) -> (y, S.singleton x) )
-
+fromList :: (Ord a, Ord b) => [(a, b)] -> Relation a b
+fromList xs = Relation
+  { R.domain  = M.fromListWith S.union $ snd2Set    xs
+  , R.range   = M.fromListWith S.union $ flipAndSet xs
+  }
+  where snd2Set    = map (\(x, y) -> (x, S.singleton y))
+        flipAndSet = map (\(x, y) -> (y, S.singleton x))
 
 -- |
 -- Builds a List from a Relation.
-toList   ::  Relation a b -> [(a,b)]
-toList r =   concatMap
-               ( \(x,y) -> zip (repeat x) (S.toList y) )
-               ( M.toList . domain $ r)
-
-
+toList :: Relation a b -> [(a, b)]
+toList r = concatMap (\(x, y) -> zip (repeat x) (S.toList y)) (M.toList . R.domain $ r)
 
 -- |
 -- Builds a 'Relation' consiting of an association between: @x@ and @y@.
-
-singleton      ::  a -> b -> Relation a b
-singleton x y  =   Relation
-                     { domain = M.singleton x (S.singleton y)
-                     , range   = M.singleton y (S.singleton x)
-                     }
-
-
+singleton :: a -> b -> Relation a b
+singleton x y  = Relation
+  { R.domain  = M.singleton x (S.singleton y)
+  , R.range   = M.singleton y (S.singleton x)
+  }
 
 -- | The 'Relation' that results from the union of two relations: @r@ and @s@.
-
-union ::  (Ord a, Ord b)
-      =>  Relation a b -> Relation a b -> Relation a b
-
-union r s       =
-    Relation
-      { domain =  M.unionWith S.union (domain r) (domain s)
-      , range   =  M.unionWith S.union (range   r) (range   s)
-      }
-
-
----------------------------------------------------------------
--- |
--- This fragment provided by:
---
--- @
--- \  Module      :  Data.Map
--- \  Copyright   :  (c) Daan Leijen 2002
--- \                 (c) Andriy Palamarchuk 2008
--- \  License     :  BSD-style
--- \  Maintainer  :  libraries\@haskell.org
--- \  Stability   :  provisional
--- \  Portability :  portable
--- @
---
---
-foldlStrict         ::  (a -> b -> a) -> a -> [b] -> a
-foldlStrict f z xs  =   case xs of
-      []     -> z
-      (x:xx) -> let z' = f z x in seq z' (foldlStrict f z' xx)
----------------------------------------------------------------
-
+union :: (Ord a, Ord b) => Relation a b -> Relation a b -> Relation a b
+union r s = Relation
+  { R.domain  = M.unionWith S.union (R.domain r) (R.domain s)
+  , R.range   = M.unionWith S.union (R.range  r) (R.range  s)
+  }
 
 -- | Union a list of relations using the 'empty' relation.
-
-unions       ::  (Ord a, Ord b) => [Relation a b] -> Relation a b
-
-unions       =   foldlStrict union empty
-
-
+unions :: (Ord a, Ord b) => [Relation a b] -> Relation a b
+unions = F.foldl' union empty
 
 -- | Intersection of two relations: @a@ and @b@ are related by @intersection r
 -- s@ exactly when @a@ and @b@ are related by @r@ and @s@.
-
-intersection ::  (Ord a, Ord b)
-             =>  Relation a b -> Relation a b -> Relation a b
-
+intersection :: (Ord a, Ord b) => Relation a b -> Relation a b -> Relation a b
 intersection r s = Relation
-  { domain = doubleIntersect (domain r) (domain s)
-  , range  = doubleIntersect (range  r) (range  s)
+  { R.domain = doubleIntersect (R.domain r) (R.domain s)
+  , R.range  = doubleIntersect (R.range  r) (R.range  s)
   }
 
-
 ensure :: MonadPlus m => (a -> Bool) -> a -> m a
 ensure p x = x <$ guard (p x)
 
 -- This function is like M.intersectionWith S.intersection except that it
 -- also removes keys that would then be associated with empty sets.
-doubleIntersect :: (Ord k, Ord v)
-                => M.Map k (S.Set v)
-                -> M.Map k (S.Set v)
-                -> M.Map k (S.Set v)
+doubleIntersect :: (Ord k, Ord v) => Map k (Set v) -> Map k (Set v) -> Map k (Set v)
 doubleIntersect = M.mergeWithKey
   (\_ l r -> ensure (not . S.null) (S.intersection l r))
   (const M.empty)
   (const M.empty)
 
-
 -- | Insert a relation @ x @ and @ y @ in the relation @ r @
-
-insert       ::  (Ord a, Ord b)
-             =>  a -> b -> Relation a b -> Relation a b
-
-insert x y r =  -- r { domain = domain', range = range' }
-                Relation domain' range'
-  where
-   domain'  =  M.insertWith S.union x (S.singleton y) (domain r)
-   range'    =  M.insertWith S.union y (S.singleton x) (range   r)
-
-
--- $deletenotes
---
--- The deletion is not difficult but is delicate:
---
--- @
---   r = { domain {  (k1, {v1a, v3})
---                 ,  (k2, {v2a})
---                 ,  (k3, {v3b, v3})
---                 }
---       , range   {  (v1a, {k1}
---                 ,  (v2a, {k2{
---                 ,  (v3 , {k1, k3}
---                 ,  (v3b, {k3}
---                 }
---      }
--- @
---
---   To delete (k,v) in the relation do:
---    1. Working with the domain:
---       1a. Delete v from the Set VS associated with k.
---       1b. If VS is empty, delete k in the domain.
---    2. Working in the range:
---       2a. Delete k from the Set VS associated with v.
---       2b. If VS is empty, delete v in the range.
---
---
+insert :: (Ord a, Ord b) => a -> b -> Relation a b -> Relation a b
+insert x y r = Relation domain' range'
+  where domain' = M.insertWith S.union x (S.singleton y) (R.domain r)
+        range'  = M.insertWith S.union y (S.singleton x) (R.range  r)
 
 -- |  Delete an association in the relation.
-delete       ::  (Ord a, Ord b)
-             =>  a -> b -> Relation a b -> Relation a b
-
-delete x y r  =  r { domain = domain', range = range' }
-   where
-   domain'   =  M.update (erase y) x (domain r)
-   range'     =  M.update (erase x) y (range   r)
-   erase e s =  if  S.singleton e == s
-                     then  Nothing
-                     else  Just $ S.delete e s
+delete :: (Ord a, Ord b) => a -> b -> Relation a b -> Relation a b
+delete x y r = Relation
+  { R.domain  = domain'
+  , R.range   = range'
+  }
+  where domain'   = M.update (erase y) x (R.domain r)
+        range'    = M.update (erase x) y (R.range  r)
+        erase e s = if S.singleton e == s then Nothing else Just $ S.delete e s
 
 -- | The Set of values associated with a value in the domain.
-
-lookupDom     ::  Ord a =>  a -> Relation a b -> S.Set b
-lookupDom x r =   fromMaybe S.empty
-              $   M.lookup  x  (domain r)
-
-
+lookupDom :: Ord a => a -> Relation a b -> Set b
+lookupDom x r = fromMaybe S.empty $ M.lookup x (R.domain r)
 
 -- | The Set of values associated with a value in the range.
-
-lookupRan     ::  Ord b =>  b -> Relation a b -> S.Set a
-lookupRan y r =   fromMaybe S.empty
-              $   M.lookup  y  (range   r)
-
-
+lookupRan :: Ord b => b -> Relation a b -> Set a
+lookupRan y r = fromMaybe S.empty $ M.lookup y (R.range r)
 
 -- | True if the element @ x @ exists in the domain of @ r @.
-
-memberDom     ::  Ord a =>  a -> Relation a b -> Bool
-memberDom x r =   not . S.null $ lookupDom x r
-
-
+memberDom :: Ord a => a -> Relation a b -> Bool
+memberDom x r = not . S.null $ lookupDom x r
 
 -- | True if the element exists in the range.
-
-memberRan     ::  Ord b =>  b -> Relation a b -> Bool
-memberRan y r =   not . S.null $ lookupRan y r
-
-
+memberRan :: Ord b => b -> Relation a b -> Bool
+memberRan y r = not . S.null $ lookupRan y r
 
 -- |
 -- True if the relation @r@ is the 'empty' relation.
-null    ::  Relation a b -> Bool
-null r  =   M.null $ domain r
--- Before 2010/11/09 null::Ord b =>  Relation a b -> Bool
-
-
+null :: Relation a b -> Bool
+null r = M.null $ R.domain r
 
 -- | True if the relation contains the association @x@ and @y@
-
-member       ::  (Ord a, Ord b) =>  a -> b -> Relation a b -> Bool
-member x y r =   S.member y (lookupDom x r)
-
-
+member :: (Ord a, Ord b) => a -> b -> Relation a b -> Bool
+member x y r = S.member y (lookupDom x r)
 
 -- | True if the relation /does not/ contain the association @x@ and @y@
-
-notMember       ::  (Ord a, Ord b) =>  a -> b -> Relation a b -> Bool
-notMember x y r =   not $ member x y r
-
-
+notMember :: (Ord a, Ord b) => a -> b -> Relation a b -> Bool
+notMember x y r = not $ member x y r
 
 -- | Returns the domain in the relation, as a Set, in its entirety.
-
-dom            ::  Relation a b -> S.Set a
-dom r          =   M.keysSet (domain r)
-
-
+dom :: Relation a b -> Set a
+dom r = M.keysSet (R.domain r)
 
 -- | Returns the range of the relation, as a Set, in its entirety.
-
-ran            ::  Relation a b -> S.Set b
-ran r          =   M.keysSet (range   r)
-
+ran :: Relation a b -> Set b
+ran r = M.keysSet (R.range r)
 
 -- | Returns the converse of the relation.
-c :: Relation a b -> Relation b a
-
-c r = Relation {
-                    domain = range'
-                    ,range  = domain'
-               }
-     where
-           range' = range r
-           domain' = domain r
-
--- |
--- A compact set of sets the values of which can be @Just (Set x)@ or @Nothing@.
---
--- The cases of 'Nothing' are purged.
---
--- It is similar to 'concat'.
-compactSet ::  Ord a => S.Set (S.Set a) -> S.Set a
-
-compactSet =   S.foldr S.union S.empty
-
-
-
--- $selectops
---
--- Primitive implementation for the /right selection/ and /left selection/ operators.
---
--- PICA provides both operators:
---        '|>'  and  '<|'
--- and    '|$>' and '<$|'
---
--- in this library, for working with Relations and OIS (Ordered, Inductive Sets?).
---
--- PICA exposes the operators defined here, so as not to interfere with the abstraction
--- of the Relation type and because having access to Relation hidden components is a more
--- efficient implementation of the operation of restriction.
---
--- @
---     (a <$| b) r
---
---       denotes: for every element     @b@ from the Set      @B@,
---                select an element @a@     from the Set @A@     ,
---                              if  @a@
---                   is related to      @b@
---                   in @r@
--- @
---
--- @
---     (a |$> b) r
---
---       denotes: for every element @a@      from the Set @A@    ,
---                select an element     @b@  from the Set     @B@,
---                              if  @a@
---                   is related to      @b@
---                   in @r@
--- @
---
--- With regard to domain restriction and range restriction operators
--- of the language, those are described differently and return the domain or the range.
-
--- |
--- @(Case b <| r a)@
---
-(<$|)          ::  (Ord a, Ord b)
-               =>  S.Set a -> S.Set b -> Relation a b -> S.Set a
-
-(as <$| bs) r  =   as `S.intersection` generarAS bs
-
-    where  generarAS = compactSet . S.map (`lookupRan` r)
-
-    -- The subsets of the domain (a) associated with each @b@
-    -- such that @b@ in @B@ and (b) are in the range of the relation.
-    -- The expression 'S.map' returns a set of @Either (S.Set a)@.
-
-
--- |
--- @( Case a |> r b )@
-(|$>)          ::  (Ord a, Ord b)
-               =>  S.Set a -> S.Set b -> Relation a b -> S.Set b
-
-(as |$> bs) r  =   bs `S.intersection`  generarBS as
-
-    where  generarBS = compactSet . S.map (`lookupDom` r)
-
-
-
--- | Domain restriction for a relation. Modeled on z.
-
-(<|) :: (Ord a, Ord b) => S.Set a -> Relation a b  -> Relation a b
-
-s <| r  =  fromList $ concatMap
-               ( \(x,y) -> zip (repeat x) (S.toList y) )
-               ( M.toList domain' )
-    where
-    domain'  =  M.unions . map filtrar . S.toList $ s
-    filtrar x =  M.filterWithKey (\k _ -> k == x) dr
-    dr        =  domain r  -- just to memoize the value
-
-
--- | Range restriction for a relation. Modeled on z.
-
-(|>) :: (Ord a, Ord b) => Relation a b -> S.Set b -> Relation a b
+converse :: Relation a b -> Relation b a
+converse r = Relation
+  { R.domain = range'
+  , R.range  = domain'
+  }
+  where range'  = R.range r
+        domain' = R.domain r
 
-r |> t =  fromList $ concatMap
-               ( \(x,y) -> zip (S.toList y) (repeat x) )
-               ( M.toList range' )
-    where
-    range'    =  M.unions . map filtrar . S.toList $ t
-    filtrar x =  M.filterWithKey (\k _ -> k == x) rr
-    rr        =  range r   -- just to memoize the value
+-- | Restrict the domain to that of the provided set
+restrictDom :: (Ord a, Ord b) => S.Set a -> Relation a b -> Relation a b
+restrictDom s r = Relation
+  { R.domain = M.restrictKeys (R.domain r) s
+  , R.range  = M.mapMaybe (S.justUnlessEmpty . S.intersection s) (R.range r)
+  }
 
+-- | Restrict the range to that of the provided set
+restrictRan :: (Ord a, Ord b) => S.Set b -> Relation a b -> Relation a b
+restrictRan s r = Relation
+  { R.domain  = M.mapMaybe (S.justUnlessEmpty . S.intersection s) (R.domain r)
+  , R.range   = M.restrictKeys (R.range r) s
+  }
 
--- Note:
---
---    As you have seen this implementation is expensive in terms
---    of storage. Information is registered twice.
---    For the operators |> and <| we follow a pattern used in
---    the @fromList@ constructor and @toList@ flattener:
---    It is enough to know one half of the Relation (the domain or
---    the range) to create to other half.
+-- | Restrict the domain to exclude elements of the provided set
+withoutDom :: (Ord a, Ord b) => S.Set a -> Relation a b -> Relation a b
+withoutDom s r = Relation
+  { R.domain = M.withoutKeys (R.domain r) s
+  , R.range  = M.mapMaybe (S.justUnlessEmpty . flip S.difference s) (R.range r)
+  }
 
+-- | Restrict the range to exclude elements of the provided set
+withoutRan :: (Ord a, Ord b) => S.Set b -> Relation a b -> Relation a b
+withoutRan s r = Relation
+  { R.domain  = M.mapMaybe (S.justUnlessEmpty . flip S.difference s) (R.domain r)
+  , R.range   = M.withoutKeys (R.range r) s
+  }
diff --git a/src/Data/Relation/Internal.hs b/src/Data/Relation/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Relation/Internal.hs
@@ -0,0 +1,13 @@
+module Data.Relation.Internal
+  ( Relation(..)
+  ) where
+
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+-- |
+-- Representation of a relation on ordered (@Ord@) values
+data Relation a b  = Relation
+  { domain :: M.Map a (S.Set b)
+  , range  :: M.Map b (S.Set a)
+  } deriving (Show, Eq, Ord)
diff --git a/src/Data/Relation/Internal/Set.hs b/src/Data/Relation/Internal/Set.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Relation/Internal/Set.hs
@@ -0,0 +1,16 @@
+module Data.Relation.Internal.Set
+  ( flatten
+  , justUnlessEmpty
+  ) where
+
+import Data.Set (Set)
+
+import qualified Data.Set as S
+
+-- |
+-- Flatten a set of sets.
+flatten :: Ord a => Set (Set a) -> Set a
+flatten = S.foldr S.union S.empty
+
+justUnlessEmpty :: S.Set a -> Maybe (S.Set a)
+justUnlessEmpty c = if S.null c then Nothing else Just c
diff --git a/src/Data/Relation/Ops.hs b/src/Data/Relation/Ops.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Relation/Ops.hs
@@ -0,0 +1,74 @@
+module Data.Relation.Ops
+  (  -- $selectops
+    (|$>) -- Restrict the range according to a subset. PICA.
+  , (<$|) -- Restrict the domain according to a subset. PICA.
+  , (<|)  -- Domain restriction. Z.
+  , (|>)  -- Range restriction. z.
+  ) where
+
+import Data.Relation.Internal (Relation)
+import Data.Set               (Set)
+
+import qualified Data.Relation              as R
+import qualified Data.Relation.Internal.Set as S
+import qualified Data.Set                   as S
+
+-- $selectops
+--
+-- Primitive implementation for the /right selection/ and /left selection/ operators.
+--
+-- PICA provides both operators:
+--        '|>'  and  '<|'
+-- and    '|$>' and '<$|'
+--
+-- in this library, for working with Relations and OIS (Ordered, Inductive Sets?).
+--
+-- PICA exposes the operators defined here, so as not to interfere with the abstraction
+-- of the Relation type and because having access to Relation hidden components is a more
+-- efficient implementation of the operation of restriction.
+--
+-- @
+--     (a <$| b) r
+--
+--       denotes: for every element     @b@ from the Set      @B@,
+--                select an element @a@     from the Set @A@     ,
+--                              if  @a@
+--                   is related to      @b@
+--                   in @r@
+-- @
+--
+-- @
+--     (a |$> b) r
+--
+--       denotes: for every element @a@      from the Set @A@    ,
+--                select an element     @b@  from the Set     @B@,
+--                              if  @a@
+--                   is related to      @b@
+--                   in @r@
+-- @
+--
+-- With regard to domain restriction and range restriction operators
+-- of the language, those are described differently and return the domain or the range.
+
+-- |
+-- @(Case b <| r a)@
+(<$|) :: (Ord a, Ord b) => Set a -> Set b -> Relation a b -> Set a
+(as <$| bs) r = as `S.intersection` generarAS bs
+  where generarAS = S.flatten . S.map (`R.lookupRan` r)
+  -- The subsets of the domain (a) associated with each @b@
+  -- such that @b@ in @B@ and (b) are in the range of the relation.
+  -- The expression 'S.map' returns a set of @Either (Set a)@.
+
+-- |
+-- @(Case a |> r b)@
+(|$>) :: (Ord a, Ord b) => Set a -> Set b -> Relation a b -> Set b
+(as |$> bs) r  = bs `S.intersection` generarBS as
+  where generarBS = S.flatten . S.map (`R.lookupDom` r)
+
+-- | Domain restriction for a relation. Modeled on z.
+(<|) :: (Ord a, Ord b) => Set a -> Relation a b  -> Relation a b
+s <| r = R.restrictDom s r
+
+-- | Range restriction for a relation. Modeled on z.
+(|>) :: (Ord a, Ord b) => Relation a b -> Set b -> Relation a b
+r |> t = R.restrictRan t r
diff --git a/test/Data/RelationSpec.hs b/test/Data/RelationSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Data/RelationSpec.hs
@@ -0,0 +1,195 @@
+module Data.RelationSpec
+  ( spec
+  ) where
+
+import Data.Relation.Ops
+import HaskellWorks.Hspec.Hedgehog
+import Hedgehog
+import Test.Hspec
+
+import qualified Data.List              as L
+import qualified Data.Map               as M
+import qualified Data.Relation          as DR
+import qualified Data.Relation.Internal as DR
+import qualified Data.Set               as S
+import qualified Hedgehog.Gen           as G
+import qualified Hedgehog.Range         as R
+
+{-# ANN module ("HLint: ignore Redundant do" :: String) #-}
+
+e :: DR.Relation String String
+e = DR.fromList
+  [ ("Rebeca" , "History"        )
+  , ("Rebeca" , "Mathematics"    )
+  , ("Rolando", "Religion"       )
+  , ("Rolando", "Comunication"   )
+  , ("Teresa" , "Religion"       )
+  , ("Teresa" , "Architecture"   )
+  , ("Antonio", "History"        )
+  ]
+
+rebecaE :: S.Set String
+rebecaE = (S.singleton "Rebeca" |$> DR.ran e) e
+
+takingreligion :: S.Set String
+takingreligion = (DR.dom e <$| S.singleton "Religion") e
+
+others :: S.Set String
+others = (takingreligion |$> DR.ran e) e
+
+takingreligion2 :: DR.Relation String String
+takingreligion2 = e |> S.singleton "Religion"
+
+twoStudents :: DR.Relation String String
+twoStudents = (<|) (S.union (S.singleton "Rolando") (S.singleton "Teresa")) e
+
+id1 :: S.Set String -> (Bool, S.Set String)
+id1 s = (v1 == v2, v1)
+  where v1 = (DR.dom  e |$> s) e
+        v2 =  DR.ran (e |>  s)
+
+id2 :: S.Set String -> (Bool, S.Set String)
+id2 s = (v1 == v2, v1)
+  where v1 = (DR.dom  e <$| s) e
+        v2 =  DR.dom (e |>  s)
+
+id3 :: S.Set String -> (Bool, S.Set String)
+id3 s = (v1 == v2, v1)
+  where v1 = (s       <$| DR.ran e) e
+        v2 = DR.dom (s <|  e)
+
+id4 :: S.Set String -> (Bool, S.Set String)
+id4 s = (v1 == v2, v2)
+  where v1 = (s       |$> DR.ran e) e
+        v2 = DR.ran (s <|  e)
+
+religion :: S.Set String
+religion = S.singleton "Religion"  -- has students
+
+teresa :: S.Set String
+teresa = S.singleton "Teresa" -- enrolled
+
+spec :: Spec
+spec = describe "Data.RelationSpec" $ do
+  describe "Unit tests" $ do
+    it "fromList" $ requireTest $ do
+      e ===  DR.Relation
+        { DR.domain = M.fromList
+          [ ("Antonio"      , S.fromList ["History"                 ])
+          , ("Rebeca"       , S.fromList ["History", "Mathematics"  ])
+          , ("Rolando"      , S.fromList ["Comunication", "Religion"])
+          , ("Teresa"       , S.fromList ["Architecture", "Religion"])
+          ]
+        , DR.range = M.fromList
+          [ ("Architecture" , S.fromList ["Teresa"                  ])
+          , ("Comunication" , S.fromList ["Rolando"                 ])
+          , ("History"      , S.fromList ["Antonio", "Rebeca"       ])
+          , ("Mathematics"  , S.fromList ["Rebeca"                  ])
+          , ("Religion"     , S.fromList ["Rolando", "Teresa"       ])
+          ]
+        }
+    it "singleton & range" $ requireTest $ do
+      rebecaE === S.fromList ["History", "Mathematics"]
+    it "singleton & domain" $ requireTest $ do
+      takingreligion === S.fromList ["Rolando", "Teresa"]
+    it "(|$>)" $ requireTest $ do
+      others === S.fromList ["Architecture", "Comunication", "Religion"]
+    it "test1" $ requireTest $ do
+      (takingreligion <$| DR.ran e) e === takingreligion
+    it "Exploring |>" $ requireTest $ do
+      takingreligion2 === DR.Relation
+        { DR.domain = M.fromList
+          [ ("Rolando"  , S.fromList ["Religion"          ])
+          , ("Teresa"   , S.fromList ["Religion"          ])
+          ]
+        , DR.range = M.fromList
+          [ ("Religion" , S.fromList ["Rolando", "Teresa" ])
+          ]
+        }
+    it "twoStudents" $ requireTest $ do
+      twoStudents === DR.Relation
+        { DR.domain = M.fromList
+          [ ("Rolando"      , S.fromList ["Comunication", "Religion"])
+          , ("Teresa"       , S.fromList ["Architecture", "Religion"])
+          ]
+        , DR.range = M.fromList
+          [ ("Architecture" , S.fromList ["Teresa"                  ])
+          , ("Comunication" , S.fromList ["Rolando"                 ])
+          , ("Religion"     , S.fromList ["Rolando", "Teresa"       ])
+          ]
+        }
+    it "test 2" $ requireTest $ do
+      (|$>) (S.union (S.singleton "Rolando") (S.singleton "Teresa")) (DR.ran e) e === S.fromList ["Architecture", "Comunication", "Religion"]
+    it "test 3" $ requireTest $ do
+      id1 religion === (True, S.fromList ["Religion"])
+    it "test 4" $ requireTest $ do
+      id2 religion === (True, S.fromList ["Rolando", "Teresa"])
+    it "test 5" $ requireTest $ do
+      id3 teresa === (True, S.fromList ["Teresa"])
+    it "test 6" $ requireTest $ do
+      id4 teresa === (True, S.fromList ["Architecture", "Religion"])
+    it "test 7"  $ requireTest $ do
+      (DR.dom e |$> religion) e === DR.ran (e |> religion)
+    it "test 8"  $ requireTest $ do
+      (DR.dom e <$| religion) e === DR.dom (e |> religion)
+    it "test 9"  $ requireTest $ do
+      (teresa  <$| DR.ran e) e === DR.dom (teresa <| e)
+    it "test 10"  $ requireTest $ do
+      (teresa |$> DR.ran e) e === DR.ran (teresa <| e)
+
+  describe "property tests" $ do
+    it "List roundtrip" $ require $ property $ do
+      as <- forAll $ G.list (R.linear 0 10) $ (,)
+        <$> G.int R.constantBounded
+        <*> G.alpha
+      L.sort (DR.toList (DR.fromList as)) === L.sort as
+    it "Full domain restriction" $ require $ property $ do
+      as <- forAll $ G.list (R.linear 0 10) $ (,)
+        <$> G.int R.constantBounded
+        <*> G.alpha
+
+      DR.restrictDom S.empty (DR.fromList as) === DR.empty
+    it "Full range restriction" $ require $ property $ do
+      as <- forAll $ G.list (R.linear 0 10) $ (,)
+        <$> G.int R.constantBounded
+        <*> G.alpha
+
+      DR.restrictRan S.empty (DR.fromList as) === DR.empty
+    it "No domain restriction" $ require $ property $ do
+      as <- forAll $ G.list (R.linear 0 10) $ (,)
+        <$> G.int R.constantBounded
+        <*> G.alpha
+      let r = DR.fromList as
+
+      DR.restrictDom (DR.dom r) r === r
+    it "No range restriction" $ require $ property $ do
+      as <- forAll $ G.list (R.linear 0 10) $ (,)
+        <$> G.int R.constantBounded
+        <*> G.alpha
+      let r = DR.fromList as
+      DR.restrictRan (DR.ran r) r === r
+    it "Full domain without" $ require $ property $ do
+      as <- forAll $ G.list (R.linear 0 10) $ (,)
+        <$> G.int R.constantBounded
+        <*> G.alpha
+      let r = DR.fromList as
+      DR.withoutDom S.empty r === r
+    it "Full range without" $ require $ property $ do
+      as <- forAll $ G.list (R.linear 0 10) $ (,)
+        <$> G.int R.constantBounded
+        <*> G.alpha
+      let r = DR.fromList as
+      DR.withoutRan S.empty r === r
+    it "No domain without" $ require $ property $ do
+      as <- forAll $ G.list (R.linear 0 10) $ (,)
+        <$> G.int R.constantBounded
+        <*> G.alpha
+      let r = DR.fromList as
+
+      DR.withoutDom (DR.dom r) r === DR.empty
+    it "No range without" $ require $ property $ do
+      as <- forAll $ G.list (R.linear 0 10) $ (,)
+        <$> G.int R.constantBounded
+        <*> G.alpha
+      let r = DR.fromList as
+      DR.withoutRan (DR.ran r) r === DR.empty