relation (empty) → 0.2
raw patch · 7 files changed
+731/−0 lines, 7 filesdep +arraydep +basedep +containerssetup-changed
Dependencies added: array, base, containers
Files
- Changes.txt +3/−0
- Examples/T01_Relation.hs +100/−0
- Examples/T02_Relation.hs +90/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- relation.cabal +62/−0
- src/Data/Relation.hs +444/−0
+ Changes.txt view
@@ -0,0 +1,3 @@+ Change log. + + 2010/nov/14 [LFL]: coined as a library.
+ Examples/T01_Relation.hs view
@@ -0,0 +1,100 @@+-- | Leonel Fonseca. 2010/nov/14. +-- Dull test module. + +module T01_Relation + +where + +import qualified Data.Relation as R +import qualified Data.Set as S +import qualified Data.Map as M +import Data.Maybe (fromMaybe) + +x1 :: [(Int, String)] +x1 = [ (1, "a"), (1, "b"), (1, "c"), (2, "c") + , (2, "f"), (2, "g"), (1, "d") + ] + + +r01 = R.fromList x1 -- construye a partir de una lista. +r02 = R.empty -- construye una relación vacía. +r03 = R.singleton 2 "c" -- construye una relación unitaria. +r04 = R.singleton 3 "i" +r05 = R.insert 3 "i" r03 + +t01 r = putStrLn $ + "size = " ++ (show $ R.size r) + ++ (if x1 == R.toList r01 + then "\ntoList funciona como identidad " + else "\ntoList no converge ") + ++ (if (r02 `R.union` r01 == r01 `R.union` r02) + then "\nunion tiene elemento neutro" + else "\nunion no converge") + + +r06 = R.unions [r01, r02, r03, r04] +r07 = r01 `R.union` r04 + -- Concatena una lista de relaciones +t02 = if r06 == r07 + then "unions ok" + else "unions falla" + +t03 = if R.null r02 && (not . R.null) r01 + then "null ok" + else "null incorrecto" + + +-- genera un producto cartesiano entre +-- el dominio a asociado al N +-- y el rango asociado a C. +-- Luego para cada elemento del producto cartesiano, +-- indica si ese par existe en la relación r01. + +t04 n c = map mem drive + + where + + mem = \(x,y) -> (x, y, R.member x y r01) + + -- proyecta y de (1,y) + dom = S.toList . fromMaybe S.empty $ R.lookupDom n r01 + + -- proyecta x de (x,"c") + ran = S.toList . fromMaybe S.empty $ R.lookupRan c r01 + + -- recombinarlos dominios y rangos de parejas + -- distintas produce pares que antes no existían. + drive = [ (x,y) | x <- ran, y <- dom ] + + + -- otra versión +t04b n c = map mem drive + + where + + mem = \(x,y) -> (x, y, R.member x y r01) + + -- proyecta y de (1,y) + dom = S.toList . fromMaybe S.empty $ R.lookupDom n r01 + + -- proyecta x de (x,"c") + ran = S.toList . fromMaybe S.empty $ R.lookupRan c r01 + + -- recombinarlos dominios y rangos de parejas + -- distintas produce pares que antes no existían. + drive = [ (x,y) | x <- ran, y <- dom ] + +t05 = R.member 2 "c" r01 + +r08 = R.delete 1 "a" $ + R.delete 1 "b" $ + R.delete 1 "d" $ + r01 + +t06 = (R.dom r01) R.<$| (R.ran r01) $ r01 + +t07 = (R.dom r01) R.|$> (R.ran r01) $ r01 + +t09 = (R.dom r01) R.<$| (R.ran r08) $ r01 -- usando r08 + +t10 = (S.singleton 1) R.|$> (R.ran r01) $ r01
+ Examples/T02_Relation.hs view
@@ -0,0 +1,90 @@+-- | Leonel Fonseca. 2010/nov/14. +-- Test module showing how to use Data.Relation. + +module T02_Relation where + +import Data.Relation +import qualified Data.Set as S + +-- | Para estar en la relación lleva +-- - Un estudiante lleva al menos una materia. +-- - Una materia al menos es llevada por un estudiante. + +lleva = fromList + [ ("Rebeca" , "Historia" ) + , ("Rebeca" , "Matemática" ) + , ("Rolando", "Religión" ) + , ("Rolando", "Comunicación") + , ("Teresa" , "Religión" ) + , ("Teresa" , "Arquitectura") + , ("Antonio", "Historia" ) + ] + +rebecaLleva = (S.singleton "Rebeca" |$> ran lleva) lleva + +llevanReligión = (dom lleva <$| S.singleton "Religión") lleva + +-- otros cursos para aquellos que llevan Religión +otros = (llevanReligión |$> ran lleva) lleva + +prueba1 = (llevanReligión <$| ran lleva) lleva == llevanReligión + +-- Explorando |> + +llevanReligión2 = lleva |> S.singleton "Religión" + +identidad1 s = ( v1 == v2, v1 ) + where + v1 = (dom lleva |$> s) lleva + v2 = ran (lleva |> s) + + +identidad2 s = ( v1 == v2, v1 ) + where + v1 = (dom lleva <$| s) lleva + v2 = dom (lleva |> s) + + +-- Explorando <| + +identidad3 s = ( v1 == v2, v1 ) + where + v1 = (s <$| ran lleva) lleva + v2 = dom (s <| lleva) + + +identidad4 s = ( v1 == v2, v2 ) + where + v1 = (s |$> ran lleva) lleva + v2 = ran (s <| lleva) + + +religión = S.singleton "Religión" + +t11 = identidad1 religión + +t12 = identidad2 religión + +teresa = S.singleton "Teresa" + +t13 = identidad3 teresa + +t14 = identidad4 teresa + + +identidad1R, identidad2R + :: (Ord a, Ord b) => S.Set b -> Relación a b -> Bool + +identidad3R , identidad4R + :: (Ord a, Ord b) => S.Set a -> Relación a b -> Bool + +identidad1R s r = (dom r |$> s) r == ran (r |> s) +identidad2R s r = (dom r <$| s) r == dom (r |> s) +identidad3R s r = (s <$| ran r) r == dom (s <| r) +identidad4R s r = (s |$> ran r) r == ran (s <| r) + +probarTodas = all id [ identidad1R religión lleva + , identidad2R religión lleva + , identidad3R teresa lleva + , identidad4R teresa lleva + ]
+ LICENSE view
@@ -0,0 +1,30 @@+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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple +main = defaultMain
+ relation.cabal view
@@ -0,0 +1,62 @@+name: relation+version: 0.2+synopsis: A data structure representing Relations on Sets.+description:+ A library to model relationships between two objects that are subclasses of+ Ord.+ .+ Instead using a Map structure we use a two Maps that allows + fast searching either by the key element or the value element.+ .+ Each of Map is between an element and a set of values. + Thus careful coordination of operations is required.+ . + This library lacks of extensive testing, formal testing or automated testing.+ Also in comparison to Data.Set or Data.Map (which provide the underlying+ infrastructure used) there are some missing methods.+ . + Two small examples are currently provided.+ .+ Changes:+ .+ @+ \ 2012.06.06. DD. Translated to English.+ .+ \ 2009.11.09. LFL. Corrected the definition of delete.+ .+ \ 2009.11.26. LFL. Construction+ @+ .+homepage: https://www.github.com/d-day/relation/+bug-reports: https://www.github.com/d-day/relation/issues+license: BSD3+license-file: LICENSE+author: Leonel Fonseca+maintainer: Drew Day+copyright: (C) 2012 Drew Day,+ (C) 2010 Leonel Fonseca+category: Data Structures+stability: Experimental+build-type: Simple+cabal-version: >= 1.8+tested-with: GHC==7.4++extra-source-files:+ LICENSE,+ Changes.txt, + src/Data/Relation.hs,+ Examples/T01_Relation.hs,+ Examples/T02_Relation.hs+++library+ hs-source-dirs : src+ exposed-modules: Data.Relation+ build-depends : base >= 4.2 && < 6.0,+ array >= 0.4 && < 0.5,+ containers >= 0.4 && < 0.6++source-repository head+ type: git+ location: https://www.github.com/d-day/relation+
+ src/Data/Relation.hs view
@@ -0,0 +1,444 @@+----------------------------------------------------------------------------- +-- | +-- Module : Data.Relation +-- Copyright : (c) DD. 2012 +-- (c) LFL. 2009 +-- License : BSD-style +-- Maintainer : Drew Day<drewday@gmail.com> +-- Stability : experimental +-- Portability : portable +-- +-- Relations are modeled as assciations between two elements. +-- +-- Relations offer efficient search for any of the two elements. +-- +-- Unlike "Data.Map", an element ca be associated more than once. +-- +-- The two purposes of this structure are: +-- +-- 1. Associating elements +-- +-- 2. Provide efficient searches for either of the two elements. +-- +-- Since neither 'map' nor 'fold' are implemented, you /must/ convert +-- the structure to a list to process sequentially. +-- +-- +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. + , 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 + + -- ** 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 Prelude hiding (null) +import qualified Data.Map as M +import qualified Data.Set as S +import Data.Maybe (isJust, fromJust, fromMaybe) + +-- | +-- 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. +-- + +data Relation a b = Relation { domain :: M.Map a (S.Set b) + , range :: M.Map b (S.Set a) + } + + deriving (Show, Eq, Ord) + + +-- * 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.fold ((+) . S.size) 0 (domain r) + + + +-- | Construct a relation with no elements. + +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) ) + + +-- | +-- 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) + + + +-- | +-- 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) + } + + + +-- | 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 a list of relations using the 'empty' relation. + +unions :: (Ord a, Ord b) => [Relation a b] -> Relation a b + +unions = foldlStrict union 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. +-- +-- + +-- | 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 + +-- | The Set of values associated with a value in the domain. + +lookupDom :: Ord a => a -> Relation a b -> Maybe (S.Set b) +lookupDom x r = M.lookup x (domain r) + + + +-- | The Set of values associated with a value in the range. + +lookupRan :: Ord b => b -> Relation a b -> Maybe (S.Set a) +lookupRan y r = M.lookup y (range r) + + + +-- | True if the element @ x @ exists in the domain of @ r @. + +memberDom :: Ord a => a -> Relation a b -> Bool +memberDom x r = isJust $ lookupDom x r + + + +-- | True if the element exists in the range. + +memberRan :: Ord b => b -> Relation a b -> Bool +memberRan y r = isJust $ 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 + + + +-- | 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 = case lookupDom x r of + Just s -> S.member y s + Nothing -> False + + + +-- | 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 + + + +-- | 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) + + + +-- | 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) + + + +-- | +-- 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 (Maybe (S.Set a)) -> S.Set a + +compactSet = S.fold ( S.union . fromMaybe S.empty ) 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 + +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 + + +-- 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. +-- +-- + + +