Teoría de conjuntos

Clausura transitiva de una relación binaria

PorJosé A. Alonso 14-julio-20228-julio-2022

La clausura transitiva de una relación binaria R es la relación transitiva que contiene a R. Se puede calcular
usando la composición de relaciones. Veamos un ejemplo, en el que (R ∘ S) representa la composición de R y S: sea

   R = [(1,2),(2,5),(5,6)]

1	R = [(1,2),(2,5),(5,6)]

la relación R no es transitiva ya que (1,2) y (1,5) pertenecen a R pero (1,5) no pertenece; sea

   R1 = R ∪ (R ∘ R)
      = [(1,2),(2,5),(5,6),(1,5),(2,6)]

1 2	R1 = R ∪ (R ∘ R) = [(1,2),(2,5),(5,6),(1,5),(2,6)]

la relación R1 tampoco es transitiva ya que (1,2) y (2,6) pertenecen a R pero (1,6) no pertenece; sea

   R2 = R1 ∪ (R1 ∘ R1)
      = [(1,2),(2,5),(5,6),(1,5),(2,6),(1,6)]

1 2	R2 = R1 ∪ (R1 ∘ R1) = [(1,2),(2,5),(5,6),(1,5),(2,6),(1,6)]

La relación R2 es transitiva y contiene a R. Además, R2 es la clausura transitiva de R.

Definir la función

   clausuraTransitiva :: Ord a => [(a,a)] -> [(a,a)]

1	clausuraTransitiva :: Ord a => [(a,a)] -> [(a,a)]

tal que (clausuraTransitiva r) es la clausura transitiva de r; es decir, la menor relación transitiva que contiene a r. Por ejemplo,

   λ> clausuraTransitiva [(1,2),(2,5),(5,6)]
   [(1,2),(2,5),(5,6),(1,5),(2,6),(1,6)]
   λ> clausuraTransitiva [(1,2),(2,5),(5,6),(6,3)]
   [(1,2),(2,5),(5,6),(6,3),(1,5),(2,6),(5,3),(1,6),(2,3),(1,3)]
   λ> length (clausuraTransitiva [(n,n+1) | n <- [1..100]])
   5050

λ> clausuraTransitiva [(1,2),(2,5),(5,6)]

[(1,2),(2,5),(5,6),(1,5),(2,6),(1,6)]

λ> clausuraTransitiva [(1,2),(2,5),(5,6),(6,3)]

[(1,2),(2,5),(5,6),(6,3),(1,5),(2,6),(5,3),(1,6),(2,3),(1,3)]

λ> length (clausuraTransitiva [(n,n+1) | n <- [1..100]])

5050

Soluciones

import Data.List (union, nub, sort)
import Data.Maybe (mapMaybe)
import qualified Data.Map as M (Map, assocs, empty, insertWith, lookup, map)
import Test.QuickCheck (quickCheck)

-- 1ª solución
-- ===========

clausuraTransitiva1 :: Ord a => [(a,a)] -> [(a,a)]  
clausuraTransitiva1 r
  | transitiva r = r
  | otherwise    = clausuraTransitiva1 r1
  where r1 = r `union` composicion r r

-- (transitiva r) se verifica si la relación r es transitiva. Por
-- ejemplo, 
--    transitiva [(1,1),(1,3),(3,1),(3,3),(5,5)]  ==  True
--    transitiva [(1,1),(1,3),(3,1),(5,5)]        ==  False
transitiva :: Ord a => [(a,a)] -> Bool
transitiva r = subconjunto (composicion r r) r

-- (composicion r s) es la composición de las relaciones binarias r y
-- s. Por ejemplo, 
--    λ> composicion [(1,2)] [(2,3),(2,4)]
--    [(1,3),(1,4)]
--    λ> composicion [(1,2),(5,2)] [(2,3),(2,4)]
--    [(1,3),(1,4),(5,3),(5,4)]
--    λ> composicion [(1,2),(1,4),(1,5)] [(2,3),(4,3)]
--    [(1,3)]
composicion :: Ord a => [(a,a)] -> [(a,a)] -> [(a,a)]
composicion r s = nub [(x,y) | (x,u) <- r, (v,y) <- s, u == v] 

-- (subconjunto xs ys) se verifica si xs es un subconjunto de xs. Por
-- ejemplo, 
--    subconjunto [1,3] [3,1,5]  ==  True
--    subconjunto [3,1,5] [1,3]  ==  False
subconjunto :: Ord a => [a] -> [a] -> Bool
subconjunto xs ys = all (`elem` ys) xs

-- 2ª solución
-- =============

clausuraTransitiva2 :: Ord a => [(a,a)] -> [(a,a)]  
clausuraTransitiva2 r
  | r1 == r   = r
  | otherwise = clausuraTransitiva2 r1
  where r1 = r `union` composicion r r

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_clausuraTransitiva :: [(Int,Int)] -> Bool
prop_clausuraTransitiva r =
  all (== sort (clausuraTransitiva1 r))
      [sort (clausuraTransitiva2 r),
       sort (clausuraTransitiva3 r)]
  
-- La comprobación es
--    λ> quickCheck prop_clausuraTransitiva
--    +++ OK, passed 100 tests.

-- 3ª solución
-- ===========

clausuraTransitiva3 :: Ord a => [(a,a)] -> [(a,a)]  
clausuraTransitiva3 r
  | transitiva3 r = r
  | otherwise     = clausuraTransitiva3 r1
  where r1 = r `union` composicion3 r r

transitiva3 :: Ord a => [(a,a)] -> Bool
transitiva3 r = subconjunto (composicion3 r r) r

composicion3 :: Ord a => [(a,a)] -> [(a,a)] -> [(a,a)]
composicion3 r s =
  relAlista (composicionRel (listaArel r) (listaArel s))

-- Una relación se puede representar por un diccionario donde las claves
-- son los elementos y los valores son las listas de los elementos con
-- los que se relaciona.
type Rel a = M.Map a [a]

-- (listaArel xys) es la relación correspondiente a la lista de pares
-- xys. Por ejemplo.
--    λ> listaArel [(1,1),(1,2),(1,3),(1,6),(2,2),(2,6),(3,3),(3,6),(6,6)]
--    fromList [(1,[1,2,3,6]),(2,[2,6]),(3,[3,6]),(6,[6])]
listaArel :: Ord a => [(a,a)] -> Rel a
listaArel []          = M.empty
listaArel ((x,y):xys) = M.insertWith (++) x [y] (listaArel xys)

-- (composicionRel r s) es la composición de las relaciones r y s. Por
-- ejemplo,
--    λ> r = listaArel [(1,2),(5,2)]
--    λ> s = listaArel [(2,3),(2,4)]
--    λ> composicionRel r s
--    fromList [(1,[3,4]),(5,[3,4])]
composicionRel :: Ord a => Rel a -> Rel a -> Rel a
composicionRel r s =
  M.map f r 
  where f xs = concat (mapMaybe (`M.lookup` s) xs)

-- (relAlista r) es la lista de pares correspondientes a la relación
-- r. Por ejemplo,
--    λ> relAlista (M.fromList [(1,[3,4]),(5,[3,4])])
--    [(1,3),(1,4),(5,3),(5,4)]
relAlista :: Ord a => Rel a -> [(a,a)]
relAlista r =
  nub [(x,y) | (x,ys) <- M.assocs r, y <- ys] 

-- Comparación de eficiencia
-- =========================

-- La comparación es
--    λ> length (clausuraTransitiva1 [(n,n+1) | n <- [1..60]])
--    1830
--    (2.15 secs, 453,533,992 bytes)
--    λ> length (clausuraTransitiva2 [(n,n+1) | n <- [1..60]])
--    1830
--    (2.23 secs, 558,571,904 bytes)
--    λ> length (clausuraTransitiva3 [(n,n+1) | n <- [1..60]])
--    1830
--    (0.25 secs, 207,168,552 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

import Data.List (union, nub, sort)

import Data.Maybe (mapMaybe)

import qualified Data.Map as M (Map, assocs, empty, insertWith, lookup, map)

import Test.QuickCheck (quickCheck)

-- 1ª solución

-- ===========

clausuraTransitiva1 :: Ord a => [(a,a)] -> [(a,a)]

clausuraTransitiva1 r

| transitiva r = r

| otherwise = clausuraTransitiva1 r1

where r1 = r `union` composicion r r

-- (transitiva r) se verifica si la relación r es transitiva. Por

-- ejemplo,

-- transitiva [(1,1),(1,3),(3,1),(3,3),(5,5)] == True

-- transitiva [(1,1),(1,3),(3,1),(5,5)] == False

transitiva :: Ord a => [(a,a)] -> Bool

transitiva r = subconjunto (composicion r r) r

-- (composicion r s) es la composición de las relaciones binarias r y

-- s. Por ejemplo,

-- λ> composicion [(1,2)] [(2,3),(2,4)]

-- [(1,3),(1,4)]

-- λ> composicion [(1,2),(5,2)] [(2,3),(2,4)]

-- [(1,3),(1,4),(5,3),(5,4)]

-- λ> composicion [(1,2),(1,4),(1,5)] [(2,3),(4,3)]

-- [(1,3)]

composicion :: Ord a => [(a,a)] -> [(a,a)] -> [(a,a)]

composicion r s = nub [(x,y) | (x,u) <- r, (v,y) <- s, u == v]

-- (subconjunto xs ys) se verifica si xs es un subconjunto de xs. Por

-- ejemplo,

-- subconjunto [1,3] [3,1,5] == True

-- subconjunto [3,1,5] [1,3] == False

subconjunto :: Ord a => [a] -> [a] -> Bool

subconjunto xs ys = all (`elem` ys) xs

-- 2ª solución

-- =============

clausuraTransitiva2 :: Ord a => [(a,a)] -> [(a,a)]

clausuraTransitiva2 r

| r1 == r = r

| otherwise = clausuraTransitiva2 r1

where r1 = r `union` composicion r r

-- Comprobación de equivalencia

-- ============================

-- La propiedad es

prop_clausuraTransitiva :: [(Int,Int)] -> Bool

prop_clausuraTransitiva r =

all (== sort (clausuraTransitiva1 r))

[sort (clausuraTransitiva2 r),

sort (clausuraTransitiva3 r)]

-- La comprobación es

-- λ> quickCheck prop_clausuraTransitiva

-- +++ OK, passed 100 tests.

-- 3ª solución

-- ===========

clausuraTransitiva3 :: Ord a => [(a,a)] -> [(a,a)]

clausuraTransitiva3 r

| transitiva3 r = r

| otherwise = clausuraTransitiva3 r1

where r1 = r `union` composicion3 r r

transitiva3 :: Ord a => [(a,a)] -> Bool

transitiva3 r = subconjunto (composicion3 r r) r

composicion3 :: Ord a => [(a,a)] -> [(a,a)] -> [(a,a)]

composicion3 r s =

relAlista (composicionRel (listaArel r) (listaArel s))

-- Una relación se puede representar por un diccionario donde las claves

-- son los elementos y los valores son las listas de los elementos con

-- los que se relaciona.

type Rel a = M.Map a [a]

-- (listaArel xys) es la relación correspondiente a la lista de pares

-- xys. Por ejemplo.

-- λ> listaArel [(1,1),(1,2),(1,3),(1,6),(2,2),(2,6),(3,3),(3,6),(6,6)]

-- fromList [(1,[1,2,3,6]),(2,[2,6]),(3,[3,6]),(6,[6])]

listaArel :: Ord a => [(a,a)] -> Rel a

listaArel [] = M.empty

listaArel ((x,y):xys) = M.insertWith (++) x [y] (listaArel xys)

-- (composicionRel r s) es la composición de las relaciones r y s. Por

-- ejemplo,

-- λ> r = listaArel [(1,2),(5,2)]

-- λ> s = listaArel [(2,3),(2,4)]

-- λ> composicionRel r s

-- fromList [(1,[3,4]),(5,[3,4])]

composicionRel :: Ord a => Rel a -> Rel a -> Rel a

composicionRel r s =

M.map f r

where f xs = concat (mapMaybe (`M.lookup` s) xs)

-- (relAlista r) es la lista de pares correspondientes a la relación

-- r. Por ejemplo,

-- λ> relAlista (M.fromList [(1,[3,4]),(5,[3,4])])

-- [(1,3),(1,4),(5,3),(5,4)]

relAlista :: Ord a => Rel a -> [(a,a)]

relAlista r =

nub [(x,y) | (x,ys) <- M.assocs r, y <- ys]

-- Comparación de eficiencia

-- =========================

-- La comparación es

-- λ> length (clausuraTransitiva1 [(n,n+1) | n <- [1..60]])

-- 1830

-- (2.15 secs, 453,533,992 bytes)

-- λ> length (clausuraTransitiva2 [(n,n+1) | n <- [1..60]])

-- 1830

-- (2.23 secs, 558,571,904 bytes)

-- λ> length (clausuraTransitiva3 [(n,n+1) | n <- [1..60]])

-- 1830

-- (0.25 secs, 207,168,552 bytes)

El código se encuentra en GitHub.

Transitividad de una relación

PorJosé A. Alonso 13-julio-20226-julio-2022

Una relación binaria R sobre un conjunto A es transitiva cuando se cumple que siempre que un elemento se relaciona con otro y éste último con un tercero, entonces el primero se relaciona con el tercero.

Definir la función

   transitiva :: Ord a => [(a,a)] -> Bool

1	transitiva :: Ord a => [(a,a)] -> Bool

tal que (transitiva r) se verifica si la relación r es transitiva. Por ejemplo,

   transitiva [(1,1),(1,3),(3,1),(3,3),(5,5)]  ==  True
   transitiva [(1,1),(1,3),(3,1),(5,5)]        ==  False
   transitiva [(n,n) | n <- [1..10^4]]         ==  True

transitiva [(1,1),(1,3),(3,1),(3,3),(5,5)] == True

transitiva [(1,1),(1,3),(3,1),(5,5)] == False

transitiva [(n,n) | n <- [1..10^4]] == True

Soluciones

import Data.List (nub)
import Data.Maybe (mapMaybe)
import qualified Data.Map as M (Map, assocs, empty, insertWith, lookup, map)
import Test.QuickCheck (maxSize, quickCheckWith, stdArgs)

-- 1ª solución
-- ===========

transitiva1 :: Ord a => [(a,a)] -> Bool
transitiva1 r = 
  and [(x,y) `elem` r | (x,u) <- r, (v,y) <- r, u == v]

-- 2ª solución
-- ===========

transitiva2 :: Ord a => [(a,a)] -> Bool
transitiva2 r = 
  all (`elem` r) [(x,y) | (x,u) <- r, (v,y) <- r, u == v]

-- 3ª solución
-- ===========

transitiva3 :: Ord a => [(a,a)] -> Bool
transitiva3 r =
  subconjunto (composicion r r) r

-- (subconjunto xs ys) se verifica si xs es un subconjunto de xs. Por
-- ejemplo, 
--    subconjunto [1,3] [3,1,5]  ==  True
--    subconjunto [3,1,5] [1,3]  ==  False
subconjunto :: Ord a => [a] -> [a] -> Bool
subconjunto xs ys =
  all (`elem`ys) xs

-- (composicion r s) es la composición de las relaciones binarias r y
-- s. Por ejemplo, 
--    λ> composicion [(1,2)] [(2,3),(2,4)]
--    [(1,3),(1,4)]
--    λ> composicion [(1,2),(5,2)] [(2,3),(2,4)]
--    [(1,3),(1,4),(5,3),(5,4)]
--    λ> composicion [(1,2),(1,4),(1,5)] [(2,3),(4,3)]
--    [(1,3)]
composicion :: Ord a => [(a,a)] -> [(a,a)] -> [(a,a)]
composicion r s =
  nub [(x,y) | (x,u) <- r, (v,y) <- s, u == v] 

-- 3ª solución
-- ===========

transitiva4 :: Ord a => [(a,a)] -> Bool
transitiva4 r =
  subconjunto (composicion4 r r) r

composicion4 :: Ord a => [(a,a)] -> [(a,a)] -> [(a,a)]
composicion4 r s =
  relAlista (composicionRel (listaArel r) (listaArel s))

-- Una relación se puede representar por un diccionario donde las claves
-- son los elementos y los valores son las listas de los elementos con
-- los que se relaciona.
type Rel a = M.Map a [a]

-- (listaArel xys) es la relación correspondiente a la lista de pares
-- xys. Por ejemplo.
--    λ> listaArel [(1,1),(1,2),(1,3),(1,6),(2,2),(2,6),(3,3),(3,6),(6,6)]
--    fromList [(1,[1,2,3,6]),(2,[2,6]),(3,[3,6]),(6,[6])]
listaArel :: Ord a => [(a,a)] -> Rel a
listaArel []          = M.empty
listaArel ((x,y):xys) = M.insertWith (++) x [y] (listaArel xys)

-- (composicionRel r s) es la composición de las relaciones r y s. Por
-- ejemplo,
--    λ> r = listaArel [(1,2),(5,2)]
--    λ> s = listaArel [(2,3),(2,4)]
--    λ> composicionRel r s
--    fromList [(1,[3,4]),(5,[3,4])]
composicionRel :: Ord a => Rel a -> Rel a -> Rel a
composicionRel r s =
  M.map f r 
  where f xs = concat (mapMaybe (`M.lookup` s) xs)

-- (relAlista r) es la lista de pares correspondientes a la relación
-- r. Por ejemplo,
--    λ> relAlista (M.fromList [(1,[3,4]),(5,[3,4])])
--    [(1,3),(1,4),(5,3),(5,4)]
relAlista :: Ord a => Rel a -> [(a,a)]
relAlista r =
  nub [(x,y) | (x,ys) <- M.assocs r, y <- ys] 

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_transitiva :: [(Int,Int)] -> Bool
prop_transitiva r =
  all (== transitiva1 r)
      [transitiva2 r,
       transitiva3 r,
       transitiva4 r] 

-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=7}) prop_transitiva
--    +++ OK, passed 100 tests.

-- Comparación de eficiencia
-- =========================

-- La comparación es
--    λ> transitiva1 [(n,n) | n <- [1..5*10^3]]
--    True
--    (4.27 secs, 1,403,139,032 bytes)
--    λ> transitiva2 [(n,n) | n <- [1..5*10^3]]
--    True
--    (4.24 secs, 1,402,739,056 bytes)
--    λ> transitiva3 [(n,n) | n <- [1..5*10^3]]
--    True
--    (4.41 secs, 1,403,219,880 bytes)
--    λ> transitiva4 [(n,n) | n <- [1..5*10^3]]
--    True
--    (0.46 secs, 16,206,624 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

import Data.List (nub)

import Data.Maybe (mapMaybe)

import qualified Data.Map as M (Map, assocs, empty, insertWith, lookup, map)

import Test.QuickCheck (maxSize, quickCheckWith, stdArgs)

-- 1ª solución

-- ===========

transitiva1 :: Ord a => [(a,a)] -> Bool

transitiva1 r =

and [(x,y) `elem` r | (x,u) <- r, (v,y) <- r, u == v]

-- 2ª solución

-- ===========

transitiva2 :: Ord a => [(a,a)] -> Bool

transitiva2 r =

all (`elem` r) [(x,y) | (x,u) <- r, (v,y) <- r, u == v]

-- 3ª solución

-- ===========

transitiva3 :: Ord a => [(a,a)] -> Bool

transitiva3 r =

subconjunto (composicion r r) r

-- (subconjunto xs ys) se verifica si xs es un subconjunto de xs. Por

-- ejemplo,

-- subconjunto [1,3] [3,1,5] == True

-- subconjunto [3,1,5] [1,3] == False

subconjunto :: Ord a => [a] -> [a] -> Bool

subconjunto xs ys =

all (`elem`ys) xs

-- (composicion r s) es la composición de las relaciones binarias r y

-- s. Por ejemplo,

-- λ> composicion [(1,2)] [(2,3),(2,4)]

-- [(1,3),(1,4)]

-- λ> composicion [(1,2),(5,2)] [(2,3),(2,4)]

-- [(1,3),(1,4),(5,3),(5,4)]

-- λ> composicion [(1,2),(1,4),(1,5)] [(2,3),(4,3)]

-- [(1,3)]

composicion :: Ord a => [(a,a)] -> [(a,a)] -> [(a,a)]

composicion r s =

nub [(x,y) | (x,u) <- r, (v,y) <- s, u == v]

-- 3ª solución

-- ===========

transitiva4 :: Ord a => [(a,a)] -> Bool

transitiva4 r =

subconjunto (composicion4 r r) r

composicion4 :: Ord a => [(a,a)] -> [(a,a)] -> [(a,a)]

composicion4 r s =

relAlista (composicionRel (listaArel r) (listaArel s))

-- Una relación se puede representar por un diccionario donde las claves

-- son los elementos y los valores son las listas de los elementos con

-- los que se relaciona.

type Rel a = M.Map a [a]

-- (listaArel xys) es la relación correspondiente a la lista de pares

-- xys. Por ejemplo.

-- λ> listaArel [(1,1),(1,2),(1,3),(1,6),(2,2),(2,6),(3,3),(3,6),(6,6)]

-- fromList [(1,[1,2,3,6]),(2,[2,6]),(3,[3,6]),(6,[6])]

listaArel :: Ord a => [(a,a)] -> Rel a

listaArel [] = M.empty

listaArel ((x,y):xys) = M.insertWith (++) x [y] (listaArel xys)

-- (composicionRel r s) es la composición de las relaciones r y s. Por

-- ejemplo,

-- λ> r = listaArel [(1,2),(5,2)]

-- λ> s = listaArel [(2,3),(2,4)]

-- λ> composicionRel r s

-- fromList [(1,[3,4]),(5,[3,4])]

composicionRel :: Ord a => Rel a -> Rel a -> Rel a

composicionRel r s =

M.map f r

where f xs = concat (mapMaybe (`M.lookup` s) xs)

-- (relAlista r) es la lista de pares correspondientes a la relación

-- r. Por ejemplo,

-- λ> relAlista (M.fromList [(1,[3,4]),(5,[3,4])])

-- [(1,3),(1,4),(5,3),(5,4)]

relAlista :: Ord a => Rel a -> [(a,a)]

relAlista r =

nub [(x,y) | (x,ys) <- M.assocs r, y <- ys]

-- Comprobación de equivalencia

-- ============================

-- La propiedad es

prop_transitiva :: [(Int,Int)] -> Bool

prop_transitiva r =

all (== transitiva1 r)

[transitiva2 r,

transitiva3 r,

transitiva4 r]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=7}) prop_transitiva

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

-- =========================

-- La comparación es

-- λ> transitiva1 [(n,n) | n <- [1..5*10^3]]

-- True

-- (4.27 secs, 1,403,139,032 bytes)

-- λ> transitiva2 [(n,n) | n <- [1..5*10^3]]

-- True

-- (4.24 secs, 1,402,739,056 bytes)

-- λ> transitiva3 [(n,n) | n <- [1..5*10^3]]

-- True

-- (4.41 secs, 1,403,219,880 bytes)

-- λ> transitiva4 [(n,n) | n <- [1..5*10^3]]

-- True

-- (0.46 secs, 16,206,624 bytes)

El código se encuentra en GitHub.

Composición de relaciones binarias

PorJosé A. Alonso 12-julio-20225-julio-2022

Las relaciones binarias en un conjunto A se pueden representar mediante conjuntos de pares de elementos de A. Por ejemplo, la relación de divisibilidad en el conjunto {1,2,3,6} se representa por

   [(1,1),(1,2),(1,3),(1,6),(2,2),(2,6),(3,3),(3,6),(6,6)]

1	[(1,1),(1,2),(1,3),(1,6),(2,2),(2,6),(3,3),(3,6),(6,6)]

La composición de dos relaciones binarias R y S en el conjunto A es la relación binaria formada por los pares (x,y) para los que existe un z tal que (x,z) ∈ R y (z,y) ∈ S.

Definir la función

   composicion :: Ord a => [(a,a)] -> [(a,a)] -> [(a,a)]

1	composicion :: Ord a => [(a,a)] -> [(a,a)] -> [(a,a)]

tal que (composicion r s) es la composición de las relaciones binarias r y s. Por ejemplo,

   λ> composicion [(1,2)] [(2,3),(2,4)]
   [(1,3),(1,4)]
   λ> composicion [(1,2),(5,2)] [(2,3),(2,4)]
   [(1,3),(1,4),(5,3),(5,4)]
   λ> composicion [(1,2),(1,4),(1,5)] [(2,3),(4,3)]
   [(1,3)]

λ> composicion [(1,2)] [(2,3),(2,4)]

[(1,3),(1,4)]

λ> composicion [(1,2),(5,2)] [(2,3),(2,4)]

[(1,3),(1,4),(5,3),(5,4)]

λ> composicion [(1,2),(1,4),(1,5)] [(2,3),(4,3)]

[(1,3)]

Nota: Se supone que las relaciones binarias son listas sin elementos repetidos.

Soluciones

import Data.List (nub, sort)
import Data.Maybe (mapMaybe)
import qualified Data.Set.Monad as S (Set, fromList, toList)
import qualified Data.Map as M (Map, assocs, empty, insertWith, lookup, map)
import Test.QuickCheck (quickCheck)

-- 1ª solución
-- ===========

composicion1 :: Ord a => [(a,a)] -> [(a,a)] -> [(a,a)]
composicion1 r s =
  nub [(x,y) | (x,u) <- r, (v,y) <- s, u == v] 

-- 2ª solución
-- ===========

composicion2 :: Ord a => [(a,a)] -> [(a,a)] -> [(a,a)]
composicion2 r s =
  S.toList (composicionS (S.fromList r) (S.fromList s))

composicionS :: Ord a => S.Set (a,a) -> S.Set (a,a) -> S.Set (a,a)
composicionS r s =  
  [(x,y) | (x,u) <- r, (v,y) <- s, u == v] 

-- 3ª solución
-- ===========

composicion3 :: Ord a => [(a,a)] -> [(a,a)] -> [(a,a)]
composicion3 r s =
  relAlista (composicionRel (listaArel r) (listaArel s))

-- Una relación se puede representar por un diccionario donde las claves
-- son los elementos y los valores son las listas de los elementos con
-- los que se relaciona.
type Rel a = M.Map a [a]

-- (listaArel xys) es la relación correspondiente a la lista de pares
-- xys. Por ejemplo.
--    λ> listaArel [(1,1),(1,2),(1,3),(1,6),(2,2),(2,6),(3,3),(3,6),(6,6)]
--    fromList [(1,[1,2,3,6]),(2,[2,6]),(3,[3,6]),(6,[6])]
listaArel :: Ord a => [(a,a)] -> Rel a
listaArel []          = M.empty
listaArel ((x,y):xys) = M.insertWith (++) x [y] (listaArel xys)

-- (composicionRel r s) es la composición de las relaciones r y s. Por
-- ejemplo,
--    λ> r = listaArel [(1,2),(5,2)]
--    λ> s = listaArel [(2,3),(2,4)]
--    λ> composicionRel r s
--    fromList [(1,[3,4]),(5,[3,4])]
composicionRel :: Ord a => Rel a -> Rel a -> Rel a
composicionRel r s =
  M.map f r 
  where f xs = concat (mapMaybe (`M.lookup` s) xs)

-- (relAlista r) es la lista de pares correspondientes a la relación
-- r. Por ejemplo,
--    λ> relAlista (M.fromList [(1,[3,4]),(5,[3,4])])
--    [(1,3),(1,4),(5,3),(5,4)]
relAlista :: Ord a => Rel a -> [(a,a)]
relAlista r =
  nub [(x,y) | (x,ys) <- M.assocs r, y <- ys] 

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_composicion :: [(Int,Int)] -> [(Int,Int)] -> Bool
prop_composicion r s =
  all (== sort (composicion1 r' s'))
      [sort (composicion2 r' s'),
       sort (composicion3 r' s')]
  where r' = nub r
        s' = nub s

-- La comprobación es
--    λ> quickCheck prop_composicion
--    +++ OK, passed 100 tests.

-- Comparación de eficiencia
-- =========================

-- La comparación es
--    λ> length (composicion1 [(n,n+1) | n <- [1..2000]] [(n,n+1) | n <- [1..2000]])
--    1999
--    (1.54 secs, 770,410,352 bytes)
--    λ> length (composicion2 [(n,n+1) | n <- [1..2000]] [(n,n+1) | n <- [1..2000]])
--    1999
--    (1.66 secs, 1,348,948,096 bytes)
--    λ> length (composicion3 [(n,n+1) | n <- [1..2000]] [(n,n+1) | n <- [1..2000]])
--    1999
--    (0.07 secs, 6,960,552 bytes)
--
--    λ> r100 = [(n,k) | n <- [1..100], k <- [1..n]]
--    λ> length (composicion1 r100 r100)
--    5050
--    (9.91 secs, 4,946,556,944 bytes)
--    λ> length (composicion2 r100 r100)
--    5050
--    (13.59 secs, 15,241,357,536 bytes)
--    λ> length (composicion3 r100 r100)
--    5050
--    (0.35 secs, 52,015,544 bytes)

100

101

102

103

import Data.List (nub, sort)

import Data.Maybe (mapMaybe)

import qualified Data.Set.Monad as S (Set, fromList, toList)

import qualified Data.Map as M (Map, assocs, empty, insertWith, lookup, map)

import Test.QuickCheck (quickCheck)

-- 1ª solución

-- ===========

composicion1 :: Ord a => [(a,a)] -> [(a,a)] -> [(a,a)]

composicion1 r s =

nub [(x,y) | (x,u) <- r, (v,y) <- s, u == v]

-- 2ª solución

-- ===========

composicion2 :: Ord a => [(a,a)] -> [(a,a)] -> [(a,a)]

composicion2 r s =

S.toList (composicionS (S.fromList r) (S.fromList s))

composicionS :: Ord a => S.Set (a,a) -> S.Set (a,a) -> S.Set (a,a)

composicionS r s =

[(x,y) | (x,u) <- r, (v,y) <- s, u == v]

-- 3ª solución

-- ===========

composicion3 :: Ord a => [(a,a)] -> [(a,a)] -> [(a,a)]

composicion3 r s =

relAlista (composicionRel (listaArel r) (listaArel s))

-- Una relación se puede representar por un diccionario donde las claves

-- son los elementos y los valores son las listas de los elementos con

-- los que se relaciona.

type Rel a = M.Map a [a]

-- (listaArel xys) es la relación correspondiente a la lista de pares

-- xys. Por ejemplo.

-- λ> listaArel [(1,1),(1,2),(1,3),(1,6),(2,2),(2,6),(3,3),(3,6),(6,6)]

-- fromList [(1,[1,2,3,6]),(2,[2,6]),(3,[3,6]),(6,[6])]

listaArel :: Ord a => [(a,a)] -> Rel a

listaArel [] = M.empty

listaArel ((x,y):xys) = M.insertWith (++) x [y] (listaArel xys)

-- (composicionRel r s) es la composición de las relaciones r y s. Por

-- ejemplo,

-- λ> r = listaArel [(1,2),(5,2)]

-- λ> s = listaArel [(2,3),(2,4)]

-- λ> composicionRel r s

-- fromList [(1,[3,4]),(5,[3,4])]

composicionRel :: Ord a => Rel a -> Rel a -> Rel a

composicionRel r s =

M.map f r

where f xs = concat (mapMaybe (`M.lookup` s) xs)

-- (relAlista r) es la lista de pares correspondientes a la relación

-- r. Por ejemplo,

-- λ> relAlista (M.fromList [(1,[3,4]),(5,[3,4])])

-- [(1,3),(1,4),(5,3),(5,4)]

relAlista :: Ord a => Rel a -> [(a,a)]

relAlista r =

nub [(x,y) | (x,ys) <- M.assocs r, y <- ys]

-- Comprobación de equivalencia

-- ============================

-- La propiedad es

prop_composicion :: [(Int,Int)] -> [(Int,Int)] -> Bool

prop_composicion r s =

all (== sort (composicion1 r' s'))

[sort (composicion2 r' s'),

sort (composicion3 r' s')]

where r' = nub r

s' = nub s

-- La comprobación es

-- λ> quickCheck prop_composicion

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

-- =========================

-- La comparación es

-- λ> length (composicion1 [(n,n+1) | n <- [1..2000]] [(n,n+1) | n <- [1..2000]])

-- 1999

-- (1.54 secs, 770,410,352 bytes)

-- λ> length (composicion2 [(n,n+1) | n <- [1..2000]] [(n,n+1) | n <- [1..2000]])

-- 1999

-- (1.66 secs, 1,348,948,096 bytes)

-- λ> length (composicion3 [(n,n+1) | n <- [1..2000]] [(n,n+1) | n <- [1..2000]])

-- 1999

-- (0.07 secs, 6,960,552 bytes)

-- λ> r100 = [(n,k) | n <- [1..100], k <- [1..n]]

-- λ> length (composicion1 r100 r100)

-- 5050

-- (9.91 secs, 4,946,556,944 bytes)

-- λ> length (composicion2 r100 r100)

-- 5050

-- (13.59 secs, 15,241,357,536 bytes)

-- λ> length (composicion3 r100 r100)

-- 5050

-- (0.35 secs, 52,015,544 bytes)

El código se encuentra en GitHub.

Intersecciones parciales

PorJosé A. Alonso 6-julio-20226-julio-2022

Definir la función

   interseccionParcial :: Ord a => Int -> [[a]] -> [a]

1	interseccionParcial :: Ord a => Int -> [[a]] -> [a]

tal que (interseccionParcial n xss) es la lista de los elementos que pertenecen al menos a n conjuntos de xss. Por ejemplo,

   interseccionParcial 1 [[3,4],[4,5,9],[5,4,7]]  == [3,4,5,9,7]
   interseccionParcial 2 [[3,4],[4,5,9],[5,4,7]]  == [4,5]
   interseccionParcial 3 [[3,4],[4,5,9],[5,4,7]]  == [4]
   interseccionParcial 4 [[3,4],[4,5,9],[5,4,7]]  == []

interseccionParcial 1 [[3,4],[4,5,9],[5,4,7]] == [3,4,5,9,7]

interseccionParcial 2 [[3,4],[4,5,9],[5,4,7]] == [4,5]

interseccionParcial 3 [[3,4],[4,5,9],[5,4,7]] == [4]

interseccionParcial 4 [[3,4],[4,5,9],[5,4,7]] == []

Soluciones

import Data.List (foldl', nub, union, sort)
import Test.QuickCheck

-- 1ª solución
-- ===========

interseccionParcial1 :: Ord a => Int -> [[a]] -> [a]
interseccionParcial1 n xss = 
  [x | x <- sort (elementos xss)
     , pertenecenAlMenos n xss x]

elementos :: Ord a => [[a]] -> [a]
elementos []       = []
elementos (xs:xss) = xs `union` elementos xss

pertenecenAlMenos :: Ord a => Int -> [[a]] -> a -> Bool
pertenecenAlMenos n xss x =
  length [xs | xs <- xss, x `elem` xs] >= n
  
-- 2ª solución
-- ===========

interseccionParcial2 :: Ord a => Int -> [[a]] -> [a]
interseccionParcial2 n xss = 
  [x | x <- sort (elementos2 xss)
     , pertenecenAlMenos2 n xss x]

elementos2 :: Ord a => [[a]] -> [a]
elementos2 = foldl' union []
  
pertenecenAlMenos2 :: Ord a => Int -> [[a]] -> a -> Bool
pertenecenAlMenos2 n xss x =
  length (filter (x `elem`) xss) >= n
  
-- 3ª solución
-- ===========

interseccionParcial3 :: Ord a => Int -> [[a]] -> [a]
interseccionParcial3 n xss = 
  [x | x <- sort (nub (concat xss))
     , length [xs | xs <- xss, x `elem` xs] >= n]

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_interseccionParcial :: Positive Int -> [[Int]] -> Bool
prop_interseccionParcial (Positive n) xss =
  all (== interseccionParcial1 n yss)
      [interseccionParcial2 n yss,
       interseccionParcial3 n yss]
  where yss = map nub xss

-- La comprobación es
--    λ> quickCheck prop_interseccionParcial
--    +++ OK, passed 100 tests.

import Data.List (foldl', nub, union, sort)

import Test.QuickCheck

-- 1ª solución

-- ===========

interseccionParcial1 :: Ord a => Int -> [[a]] -> [a]

interseccionParcial1 n xss =

[x | x <- sort (elementos xss)

, pertenecenAlMenos n xss x]

elementos :: Ord a => [[a]] -> [a]

elementos [] = []

elementos (xs:xss) = xs `union` elementos xss

pertenecenAlMenos :: Ord a => Int -> [[a]] -> a -> Bool

pertenecenAlMenos n xss x =

length [xs | xs <- xss, x `elem` xs] >= n

-- 2ª solución

-- ===========

interseccionParcial2 :: Ord a => Int -> [[a]] -> [a]

interseccionParcial2 n xss =

[x | x <- sort (elementos2 xss)

, pertenecenAlMenos2 n xss x]

elementos2 :: Ord a => [[a]] -> [a]

elementos2 = foldl' union []

pertenecenAlMenos2 :: Ord a => Int -> [[a]] -> a -> Bool

pertenecenAlMenos2 n xss x =

length (filter (x `elem`) xss) >= n

-- 3ª solución

-- ===========

interseccionParcial3 :: Ord a => Int -> [[a]] -> [a]

interseccionParcial3 n xss =

[x | x <- sort (nub (concat xss))

, length [xs | xs <- xss, x `elem` xs] >= n]

-- Comprobación de equivalencia

-- ============================

-- La propiedad es

prop_interseccionParcial :: Positive Int -> [[Int]] -> Bool

prop_interseccionParcial (Positive n) xss =

all (== interseccionParcial1 n yss)

[interseccionParcial2 n yss,

interseccionParcial3 n yss]

where yss = map nub xss

-- La comprobación es

-- λ> quickCheck prop_interseccionParcial

-- +++ OK, passed 100 tests.

El código se encuentra en GitHub.

Unión e intersección general de conjuntos

PorJosé A. Alonso 5-julio-20226-julio-2022

Definir las funciones

   unionGeneral        :: Eq a => [[a]] -> [a]
   interseccionGeneral :: Eq a => [[a]] -> [a]

1 2	unionGeneral :: Eq a => [[a]] -> [a] interseccionGeneral :: Eq a => [[a]] -> [a]

tales que

(unionGeneral xs) es la unión de los conjuntos de la lista de conjuntos xs (es decir, el conjunto de los elementos que pertenecen a alguno de los elementos de xs). Por ejemplo,

     unionGeneral []                    ==  []
     unionGeneral [[1]]                 ==  [1]
     unionGeneral [[1],[1,2],[2,3]]     ==  [1,2,3]
     unionGeneral ([[x] | x <- [1..9]]) ==  [1,2,3,4,5,6,7,8,9]

unionGeneral [] == []

unionGeneral [[1]] == [1]

unionGeneral [[1],[1,2],[2,3]] == [1,2,3]

unionGeneral ([[x] | x <- [1..9]]) == [1,2,3,4,5,6,7,8,9]

(interseccionGeneral xs) es la intersección de los conjuntos de la lista de conjuntos xs (es decir, el conjunto de los elementos que pertenecen a todos los elementos de xs). Por ejemplo,

     interseccionGeneral [[1]]                      ==  [1]
     interseccionGeneral [[2],[1,2],[2,3]]          ==  [2]
     interseccionGeneral [[2,7,5],[1,5,2],[5,2,3]]  ==  [2,5]
     interseccionGeneral ([[x] | x <- [1..9]])      ==  []
     interseccionGeneral (replicate (10^6) [1..5])  ==  [1,2,3,4,5]

interseccionGeneral [[1]] == [1]

interseccionGeneral [[2],[1,2],[2,3]] == [2]

interseccionGeneral [[2,7,5],[1,5,2],[5,2,3]] == [2,5]

interseccionGeneral ([[x] | x <- [1..9]]) == []

interseccionGeneral (replicate (10^6) [1..5]) == [1,2,3,4,5]

Soluciones

import Data.List (foldl', foldl1', intersect, nub, union)
import Test.QuickCheck (NonEmptyList (NonEmpty), quickCheck)

-- 1ª definición de unionGeneral
-- =============================

unionGeneral1 :: Eq a => [[a]] -> [a]
unionGeneral1 []     = []
unionGeneral1 (x:xs) = x `union` unionGeneral1 xs 

-- 2ª definición de unionGeneral
-- =============================

unionGeneral2 :: Eq a => [[a]] -> [a]
unionGeneral2 = foldr union []

-- 3ª definición de unionGeneral
-- =============================

unionGeneral3 :: Eq a => [[a]] -> [a]
unionGeneral3 = foldl' union []

-- Comprobación de equivalencia de unionGeneral
-- ============================================

-- La propiedad es
prop_unionGeneral :: [[Int]] -> Bool
prop_unionGeneral xss =
  all (== unionGeneral1 xss')
      [unionGeneral2 xss',
       unionGeneral3 xss']
  where xss' = nub (map nub xss)
  
-- La comprobación es
--    λ> quickCheck prop_unionGeneral
--    +++ OK, passed 100 tests.
--    (0.85 secs, 1,017,807,600 bytes)

-- Comparación de eficiencia de unionGeneral
-- =========================================

-- La comparación es
--    λ> length (unionGeneral1 ([[x] | x <- [1..10^3]]))
--    1000
--    (1.56 secs, 107,478,456 bytes)
--    λ> length (unionGeneral2 ([[x] | x <- [1..10^3]]))
--    1000
--    (1.50 secs, 107,406,560 bytes)
--    λ> length (unionGeneral3 ([[x] | x <- [1..10^3]]))
--    1000
--    (0.07 secs, 92,874,024 bytes)

-- 1ª definición de interseccionGeneral
-- ====================================

interseccionGeneral1 :: Eq a => [[a]] -> [a]
interseccionGeneral1 [x]    = x
interseccionGeneral1 (x:xs) = x `intersect` interseccionGeneral1 xs 

-- 2ª definición de interseccionGeneral
-- ====================================

interseccionGeneral2 :: Eq a => [[a]] -> [a]
interseccionGeneral2 = foldr1 intersect

-- 3ª definición de interseccionGeneral
-- ====================================

interseccionGeneral3 :: Eq a => [[a]] -> [a]
interseccionGeneral3 = foldl1' intersect

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_interseccionGeneral :: NonEmptyList [Int] -> Bool
prop_interseccionGeneral (NonEmpty xss) =
  all (== interseccionGeneral1 xss')
      [interseccionGeneral2 xss',
       interseccionGeneral3 xss']
  where xss' = nub (map nub xss)

-- La comprobación es
--    λ> quickCheck prop_interseccionGeneral
--    +++ OK, passed 100 tests.

-- Comparación de eficiencia
-- =========================

-- La comparación es
--    λ> interseccionGeneral1 (replicate (10^6) [1..5])
--    [1,2,3,4,5]
--    (2.02 secs, 1,173,618,400 bytes)
--    λ> interseccionGeneral2 (replicate (10^6) [1..5])
--    [1,2,3,4,5]
--    (1.83 secs, 1,092,120,224 bytes)
--    λ> interseccionGeneral3 (replicate (10^6) [1..5])
--    [1,2,3,4,5]
--    (1.33 secs, 985,896,136 bytes)

import Data.List (foldl', foldl1', intersect, nub, union)

import Test.QuickCheck (NonEmptyList (NonEmpty), quickCheck)

-- 1ª definición de unionGeneral

-- =============================

unionGeneral1 :: Eq a => [[a]] -> [a]

unionGeneral1 [] = []

unionGeneral1 (x:xs) = x `union` unionGeneral1 xs

-- 2ª definición de unionGeneral

-- =============================

unionGeneral2 :: Eq a => [[a]] -> [a]

unionGeneral2 = foldr union []

-- 3ª definición de unionGeneral

-- =============================

unionGeneral3 :: Eq a => [[a]] -> [a]

unionGeneral3 = foldl' union []

-- Comprobación de equivalencia de unionGeneral

-- ============================================

-- La propiedad es

prop_unionGeneral :: [[Int]] -> Bool

prop_unionGeneral xss =

all (== unionGeneral1 xss')

[unionGeneral2 xss',

unionGeneral3 xss']

where xss' = nub (map nub xss)

-- La comprobación es

-- λ> quickCheck prop_unionGeneral

-- +++ OK, passed 100 tests.

-- (0.85 secs, 1,017,807,600 bytes)

-- Comparación de eficiencia de unionGeneral

-- =========================================

-- La comparación es

-- λ> length (unionGeneral1 ([[x] | x <- [1..10^3]]))

-- 1000

-- (1.56 secs, 107,478,456 bytes)

-- λ> length (unionGeneral2 ([[x] | x <- [1..10^3]]))

-- 1000

-- (1.50 secs, 107,406,560 bytes)

-- λ> length (unionGeneral3 ([[x] | x <- [1..10^3]]))

-- 1000

-- (0.07 secs, 92,874,024 bytes)

-- 1ª definición de interseccionGeneral

-- ====================================

interseccionGeneral1 :: Eq a => [[a]] -> [a]

interseccionGeneral1 [x] = x

interseccionGeneral1 (x:xs) = x `intersect` interseccionGeneral1 xs

-- 2ª definición de interseccionGeneral

-- ====================================

interseccionGeneral2 :: Eq a => [[a]] -> [a]

interseccionGeneral2 = foldr1 intersect

-- 3ª definición de interseccionGeneral

-- ====================================

interseccionGeneral3 :: Eq a => [[a]] -> [a]

interseccionGeneral3 = foldl1' intersect

-- Comprobación de equivalencia

-- ============================

-- La propiedad es

prop_interseccionGeneral :: NonEmptyList [Int] -> Bool

prop_interseccionGeneral (NonEmpty xss) =

all (== interseccionGeneral1 xss')

[interseccionGeneral2 xss',

interseccionGeneral3 xss']

where xss' = nub (map nub xss)

-- La comprobación es

-- λ> quickCheck prop_interseccionGeneral

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

-- =========================

-- La comparación es

-- λ> interseccionGeneral1 (replicate (10^6) [1..5])

-- [1,2,3,4,5]

-- (2.02 secs, 1,173,618,400 bytes)

-- λ> interseccionGeneral2 (replicate (10^6) [1..5])

-- [1,2,3,4,5]

-- (1.83 secs, 1,092,120,224 bytes)

-- λ> interseccionGeneral3 (replicate (10^6) [1..5])

-- [1,2,3,4,5]

-- (1.33 secs, 985,896,136 bytes)

El código se encuentra en GitHub.

Producto cartesiano de una familia de conjuntos

PorJosé A. Alonso 27-abril-20221-mayo-2022

Definir la función

   producto :: [[a]] -> [[a]]

1	producto :: [[a]] -> [[a]]

tal que (producto xss) es el producto cartesiano de los conjuntos xss. Por ejemplo,

   λ> producto [[1,3],[2,5]]
   [[1,2],[1,5],[3,2],[3,5]]
   λ> producto [[1,3],[2,5],[6,4]]
   [[1,2,6],[1,2,4],[1,5,6],[1,5,4],[3,2,6],[3,2,4],[3,5,6],[3,5,4]]
   λ> producto [[1,3,5],[2,4]]
   [[1,2],[1,4],[3,2],[3,4],[5,2],[5,4]]
   λ> producto []
   [[]]

λ> producto [[1,3],[2,5]]

[[1,2],[1,5],[3,2],[3,5]]

λ> producto [[1,3],[2,5],[6,4]]

[[1,2,6],[1,2,4],[1,5,6],[1,5,4],[3,2,6],[3,2,4],[3,5,6],[3,5,4]]

λ> producto [[1,3,5],[2,4]]

[[1,2],[1,4],[3,2],[3,4],[5,2],[5,4]]

λ> producto []

[[]]

Comprobar con QuickCheck que para toda lista de listas de números enteros, xss, se verifica que el número de elementos de (producto xss) es igual al producto de los números de elementos de cada una de las listas de xss.

Soluciones

module Producto_cartesiano where

import Test.QuickCheck (quickCheck)
import Control.Monad (liftM2)
import Control.Applicative (liftA2)

-- 1ª solución
-- ===========

producto1 :: [[a]] -> [[a]]
producto1 []       = [[]]
producto1 (xs:xss) = [x:ys | x <- xs, ys <- producto1 xss]

-- 2ª solución
-- ===========

producto2 :: [[a]] -> [[a]]
producto2 []       = [[]]
producto2 (xs:xss) = [x:ys | x <- xs, ys <- ps]
  where ps = producto2 xss

-- 3ª solución
-- ===========

producto3 :: [[a]] -> [[a]]
producto3 []       = [[]]
producto3 (xs:xss) = inserta3 xs (producto3 xss)

-- (inserta xs xss) inserta cada elemento de xs en los elementos de
-- xss. Por ejemplo,
--    λ> inserta [1,2] [[3,4],[5,6]]
--    [[1,3,4],[1,5,6],[2,3,4],[2,5,6]]
inserta3 :: [a] -> [[a]] -> [[a]]
inserta3 [] _       = []
inserta3 (x:xs) yss = [x:ys | ys <- yss] ++ inserta3 xs yss

-- 4ª solución
-- ===========

producto4 :: [[a]] -> [[a]]
producto4 = foldr inserta4 [[]]

inserta4 :: [a] -> [[a]] -> [[a]]
inserta4 []     _   = []
inserta4 (x:xs) yss = map (x:) yss ++ inserta4 xs yss

-- 5ª solución
-- ===========

producto5 :: [[a]] -> [[a]]
producto5 = foldr inserta5 [[]]

inserta5 :: [a] -> [[a]] -> [[a]]
inserta5 xs yss = [x:ys | x <- xs, ys <- yss]

-- 6ª solución
-- ===========

producto6 :: [[a]] -> [[a]]
producto6 = foldr inserta6 [[]]

inserta6 :: [a] -> [[a]] -> [[a]]
inserta6 xs yss = concatMap (\x -> map (x:) yss) xs

-- 7ª solución
-- ===========

producto7 :: [[a]] -> [[a]]
producto7 = foldr inserta7 [[]]

inserta7 :: [a] -> [[a]] -> [[a]]
inserta7 xs yss = xs >>= (\x -> map (x:) yss)

-- 8ª solución
-- ===========

producto8 :: [[a]] -> [[a]]
producto8 = foldr inserta8 [[]]

inserta8 :: [a] -> [[a]] -> [[a]]
inserta8 xs yss = (:) <$> xs <*> yss

-- 9ª solución
-- ===========

producto9 :: [[a]] -> [[a]]
producto9 = foldr inserta9 [[]]

inserta9 :: [a] -> [[a]] -> [[a]]
inserta9 = liftA2 (:)

-- 10ª solución
-- ============

producto10 :: [[a]] -> [[a]]
producto10 = foldr (liftM2 (:)) [[]]

-- 11ª solución
-- ============

producto11 :: [[a]] -> [[a]]
producto11 = sequence

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_producto :: [[Int]] -> Bool
prop_producto xss =
  all (== producto1 xss)
      [ producto2 xss
      , producto3 xss
      , producto4 xss
      , producto5 xss
      , producto6 xss
      , producto7 xss
      , producto8 xss
      , producto9 xss
      , producto10 xss
      , producto11 xss
      ]

-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize = 9}) prop_producto
--    +++ OK, passed 100 tests.

-- Comparación de eficiencia
-- =========================

-- La comparación es
--    λ> length (producto1 (replicate 7 [0..9]))
--    10000000
--    (10.51 secs, 10,169,418,496 bytes)
--    λ> length (producto2 (replicate 7 [0..9]))
--    10000000
--    (2.14 secs, 1,333,870,712 bytes)
--    λ> length (producto3 (replicate 7 [0..9]))
--    10000000
--    (3.33 secs, 1,956,102,056 bytes)
--    λ> length (producto4 (replicate 7 [0..9]))
--    10000000
--    (0.98 secs, 1,600,542,752 bytes)
--    λ> length (producto5 (replicate 7 [0..9]))
--    10000000
--    (2.10 secs, 1,333,870,288 bytes)
--    λ> length (producto6 (replicate 7 [0..9]))
--    10000000
--    (1.17 secs, 1,600,534,632 bytes)
--    λ> length (producto7 (replicate 7 [0..9]))
--    10000000
--    (0.35 secs, 1,600,534,352 bytes)
--    λ> length (producto8 (replicate 7 [0..9]))
--    10000000
--    (0.87 secs, 978,317,848 bytes)
--    λ> length (producto9 (replicate 7 [0..9]))
--    10000000
--    (1.38 secs, 1,067,201,016 bytes)
--    λ> length (producto10 (replicate 7 [0..9]))
--    10000000
--    (0.54 secs, 2,311,645,392 bytes)
--    λ> length (producto11 (replicate 7 [0..9]))
--    10000000
--    (1.32 secs, 1,067,200,992 bytes)
--
--    λ> length (producto7 (replicate 7 [1..14]))
--    105413504
--    (3.77 secs, 16,347,739,040 bytes)
--    λ> length (producto10 (replicate 7 [1..14]))
--    105413504
--    (5.11 secs, 23,613,162,016 bytes)

-- Comprobación de la propiedad
-- ============================

-- La propiedad es
prop_longitud :: [[Int]] -> Bool
prop_longitud xss =
  length (producto7 xss) == product (map length xss)

-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize = 7}) prop_longitud
--    +++ OK, passed 100 tests.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

module Producto_cartesiano where

import Test.QuickCheck (quickCheck)

import Control.Monad (liftM2)

import Control.Applicative (liftA2)

-- 1ª solución

-- ===========

producto1 :: [[a]] -> [[a]]

producto1 [] = [[]]

producto1 (xs:xss) = [x:ys | x <- xs, ys <- producto1 xss]

-- 2ª solución

-- ===========

producto2 :: [[a]] -> [[a]]

producto2 [] = [[]]

producto2 (xs:xss) = [x:ys | x <- xs, ys <- ps]

where ps = producto2 xss

-- 3ª solución

-- ===========

producto3 :: [[a]] -> [[a]]

producto3 [] = [[]]

producto3 (xs:xss) = inserta3 xs (producto3 xss)

-- (inserta xs xss) inserta cada elemento de xs en los elementos de

-- xss. Por ejemplo,

-- λ> inserta [1,2] [[3,4],[5,6]]

-- [[1,3,4],[1,5,6],[2,3,4],[2,5,6]]

inserta3 :: [a] -> [[a]] -> [[a]]

inserta3 [] _ = []

inserta3 (x:xs) yss = [x:ys | ys <- yss] ++ inserta3 xs yss

-- 4ª solución

-- ===========

producto4 :: [[a]] -> [[a]]

producto4 = foldr inserta4 [[]]

inserta4 :: [a] -> [[a]] -> [[a]]

inserta4 [] _ = []

inserta4 (x:xs) yss = map (x:) yss ++ inserta4 xs yss

-- 5ª solución

-- ===========

producto5 :: [[a]] -> [[a]]

producto5 = foldr inserta5 [[]]

inserta5 :: [a] -> [[a]] -> [[a]]

inserta5 xs yss = [x:ys | x <- xs, ys <- yss]

-- 6ª solución

-- ===========

producto6 :: [[a]] -> [[a]]

producto6 = foldr inserta6 [[]]

inserta6 :: [a] -> [[a]] -> [[a]]

inserta6 xs yss = concatMap (\x -> map (x:) yss) xs

-- 7ª solución

-- ===========

producto7 :: [[a]] -> [[a]]

producto7 = foldr inserta7 [[]]

inserta7 :: [a] -> [[a]] -> [[a]]

inserta7 xs yss = xs >>= (\x -> map (x:) yss)

-- 8ª solución

-- ===========

producto8 :: [[a]] -> [[a]]

producto8 = foldr inserta8 [[]]

inserta8 :: [a] -> [[a]] -> [[a]]

inserta8 xs yss = (:) <$> xs <*> yss

-- 9ª solución

-- ===========

producto9 :: [[a]] -> [[a]]

producto9 = foldr inserta9 [[]]

inserta9 :: [a] -> [[a]] -> [[a]]

inserta9 = liftA2 (:)

-- 10ª solución

-- ============

producto10 :: [[a]] -> [[a]]

producto10 = foldr (liftM2 (:)) [[]]

-- 11ª solución

-- ============

producto11 :: [[a]] -> [[a]]

producto11 = sequence

-- Comprobación de equivalencia

-- ============================

-- La propiedad es

prop_producto :: [[Int]] -> Bool

prop_producto xss =

all (== producto1 xss)

[ producto2 xss

, producto3 xss

, producto4 xss

, producto5 xss

, producto6 xss

, producto7 xss

, producto8 xss

, producto9 xss

, producto10 xss

, producto11 xss

]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize = 9}) prop_producto

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

-- =========================

-- La comparación es

-- λ> length (producto1 (replicate 7 [0..9]))

-- 10000000

-- (10.51 secs, 10,169,418,496 bytes)

-- λ> length (producto2 (replicate 7 [0..9]))

-- 10000000

-- (2.14 secs, 1,333,870,712 bytes)

-- λ> length (producto3 (replicate 7 [0..9]))

-- 10000000

-- (3.33 secs, 1,956,102,056 bytes)

-- λ> length (producto4 (replicate 7 [0..9]))

-- 10000000

-- (0.98 secs, 1,600,542,752 bytes)

-- λ> length (producto5 (replicate 7 [0..9]))

-- 10000000

-- (2.10 secs, 1,333,870,288 bytes)

-- λ> length (producto6 (replicate 7 [0..9]))

-- 10000000

-- (1.17 secs, 1,600,534,632 bytes)

-- λ> length (producto7 (replicate 7 [0..9]))

-- 10000000

-- (0.35 secs, 1,600,534,352 bytes)

-- λ> length (producto8 (replicate 7 [0..9]))

-- 10000000

-- (0.87 secs, 978,317,848 bytes)

-- λ> length (producto9 (replicate 7 [0..9]))

-- 10000000

-- (1.38 secs, 1,067,201,016 bytes)

-- λ> length (producto10 (replicate 7 [0..9]))

-- 10000000

-- (0.54 secs, 2,311,645,392 bytes)

-- λ> length (producto11 (replicate 7 [0..9]))

-- 10000000

-- (1.32 secs, 1,067,200,992 bytes)

-- λ> length (producto7 (replicate 7 [1..14]))

-- 105413504

-- (3.77 secs, 16,347,739,040 bytes)

-- λ> length (producto10 (replicate 7 [1..14]))

-- 105413504

-- (5.11 secs, 23,613,162,016 bytes)

-- Comprobación de la propiedad

-- ============================

-- La propiedad es

prop_longitud :: [[Int]] -> Bool

prop_longitud xss =

length (producto7 xss) == product (map length xss)

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize = 7}) prop_longitud

-- +++ OK, passed 100 tests.

El código se encuentra en GitHub.

La elaboración de las soluciones se describe en el siguiente vídeo

Reiteración de una función

PorJosé A. Alonso 8-abril-202216-abril-2022

Definir la función

   reiteracion :: (a -> a) -> Int -> a -> a

1	reiteracion :: (a -> a) -> Int -> a -> a

tal que (reiteracion f n x) es el resultado de aplicar n veces la función f a x. Por ejemplo,

   reiteracion (+1) 10 5  ==  15
   reiteracion (+5) 10 0  ==  50
   reiteracion (*2)  4 1  ==  16
   reiteracion (5:)  4 [] ==  [5,5,5,5]

reiteracion (+1) 10 5 == 15

reiteracion (+5) 10 0 == 50

reiteracion (*2) 4 1 == 16

reiteracion (5:) 4 [] == [5,5,5,5]

Soluciones

import Test.QuickCheck (Fun (..), Positive (..), quickCheck)

-- 1ª solución
-- ===========

reiteracion1 :: (a -> a) -> Int -> a -> a
reiteracion1 _ 0 x = x
reiteracion1 f n x = f (reiteracion1 f (n-1) x)

-- 2ª solución
-- ===========

reiteracion2 :: (a -> a) -> Int -> a -> a
reiteracion2 _ 0 = id
reiteracion2 f n = f . reiteracion2 f (n-1)

-- 3ª solución
-- ===========

reiteracion3 :: (a -> a) -> Int -> a -> a
reiteracion3 _ 0 = id
reiteracion3 f n
  | even n    = reiteracion3 (f . f) (n `div` 2)
  | otherwise = f . reiteracion3 (f . f) (n `div` 2)

-- 4ª solución
-- ===========

reiteracion4 :: (a -> a) -> Int -> a -> a
reiteracion4 f n x = reiteraciones f x !! n

reiteraciones :: (a -> a) -> a -> [a]
reiteraciones f x = x : reiteraciones f (f x)

-- 5ª solución
-- ===========

reiteracion5 :: (a -> a) -> Int -> a -> a
reiteracion5 f n x = (iterate f x) !! n

-- 6ª solución
-- ===========

-- Se puede eliminar los argumentos de la definición anterior como sigue:
--    reiteracion4 f n x = iterate f x !! n
--    reiteracion4 f n x = ((!!) (iterate f x)) n
--    reiteracion4 f n x = (((!!) . (iterate f)) x) n
--    reiteracion4 f n x = ((!!) . (iterate f)) x n
--    reiteracion4 f n x = flip ((!!) . (iterate f)) n x
--    reiteracion4 f = flip ((!!) . (iterate f))
--    reiteracion4 f = flip (((!!) .) (iterate f))
--    reiteracion4 f = flip (((!!) .) . iterate) f
--    reiteracion4 f = (flip . ((!!) .) . iterate) f
--    reiteracion4   = flip . ((!!) .) . iterate

reiteracion6 :: (a -> a) -> Int -> a -> a
reiteracion6 = flip . ((!!) .) . iterate

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_reiteracion :: Fun Int Int -> Positive Int -> Int -> Bool
prop_reiteracion (Fun _ f) (Positive n) x =
  all (== reiteracion1 f n x)
      [reiteracion2 f n x,
       reiteracion3 f n x,
       reiteracion4 f n x,
       reiteracion5 f n x,
       reiteracion6 f n x]

-- La comprobación es
--    λ> quickCheck prop_reiteracion
--    +++ OK, passed 100 tests.

-- Comparación de eficiencia
-- =========================

-- La comparación es
--    λ> reiteracion1 (+1) (10^7) 0
--    10000000
--    (5.09 secs, 2,505,392,792 bytes)
--    λ> reiteracion2 (+1) (10^7) 0
--    10000000
--    (5.45 secs, 2,896,899,728 bytes)
--    λ> reiteracion3 (+1) (10^7) 0
--    10000000
--    (2.14 secs, 816,909,416 bytes)
--    λ> reiteracion4 (+1) (10^7) 0
--    10000000
--    (4.24 secs, 1,696,899,816 bytes)
--    λ> reiteracion5 (+1) (10^7) 0
--    10000000
--    (2.53 secs, 1,376,899,800 bytes)
--    λ> reiteracion6 (+1) (10^7) 0
--    10000000
--    (2.34 secs, 1,376,899,984 bytes)

import Test.QuickCheck (Fun (..), Positive (..), quickCheck)

-- 1ª solución

-- ===========

reiteracion1 :: (a -> a) -> Int -> a -> a

reiteracion1 _ 0 x = x

reiteracion1 f n x = f (reiteracion1 f (n-1) x)

-- 2ª solución

-- ===========

reiteracion2 :: (a -> a) -> Int -> a -> a

reiteracion2 _ 0 = id

reiteracion2 f n = f . reiteracion2 f (n-1)

-- 3ª solución

-- ===========

reiteracion3 :: (a -> a) -> Int -> a -> a

reiteracion3 _ 0 = id

reiteracion3 f n

| even n = reiteracion3 (f . f) (n `div` 2)

| otherwise = f . reiteracion3 (f . f) (n `div` 2)

-- 4ª solución

-- ===========

reiteracion4 :: (a -> a) -> Int -> a -> a

reiteracion4 f n x = reiteraciones f x !! n

reiteraciones :: (a -> a) -> a -> [a]

reiteraciones f x = x : reiteraciones f (f x)

-- 5ª solución

-- ===========

reiteracion5 :: (a -> a) -> Int -> a -> a

reiteracion5 f n x = (iterate f x) !! n

-- 6ª solución

-- ===========

-- Se puede eliminar los argumentos de la definición anterior como sigue:

-- reiteracion4 f n x = iterate f x !! n

-- reiteracion4 f n x = ((!!) (iterate f x)) n

-- reiteracion4 f n x = (((!!) . (iterate f)) x) n

-- reiteracion4 f n x = ((!!) . (iterate f)) x n

-- reiteracion4 f n x = flip ((!!) . (iterate f)) n x

-- reiteracion4 f = flip ((!!) . (iterate f))

-- reiteracion4 f = flip (((!!) .) (iterate f))

-- reiteracion4 f = flip (((!!) .) . iterate) f

-- reiteracion4 f = (flip . ((!!) .) . iterate) f

-- reiteracion4 = flip . ((!!) .) . iterate

reiteracion6 :: (a -> a) -> Int -> a -> a

reiteracion6 = flip . ((!!) .) . iterate

-- Comprobación de equivalencia

-- ============================

-- La propiedad es

prop_reiteracion :: Fun Int Int -> Positive Int -> Int -> Bool

prop_reiteracion (Fun _ f) (Positive n) x =

all (== reiteracion1 f n x)

[reiteracion2 f n x,

reiteracion3 f n x,

reiteracion4 f n x,

reiteracion5 f n x,

reiteracion6 f n x]

-- La comprobación es

-- λ> quickCheck prop_reiteracion

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

-- =========================

-- La comparación es

-- λ> reiteracion1 (+1) (10^7) 0

-- 10000000

-- (5.09 secs, 2,505,392,792 bytes)

-- λ> reiteracion2 (+1) (10^7) 0

-- 10000000

-- (5.45 secs, 2,896,899,728 bytes)

-- λ> reiteracion3 (+1) (10^7) 0

-- 10000000

-- (2.14 secs, 816,909,416 bytes)

-- λ> reiteracion4 (+1) (10^7) 0

-- 10000000

-- (4.24 secs, 1,696,899,816 bytes)

-- λ> reiteracion5 (+1) (10^7) 0

-- 10000000

-- (2.53 secs, 1,376,899,800 bytes)

-- λ> reiteracion6 (+1) (10^7) 0

-- 10000000

-- (2.34 secs, 1,376,899,984 bytes)

El código se encuentra en GitHub.

La elaboración de las soluciones se describe en el siguiente vídeo

Nuevas soluciones

En los comentarios se pueden escribir nuevas soluciones.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Diferencia simétrica

PorJosé A. Alonso 29-marzo-20225-abril-2022

La diferencia simétrica de dos conjuntos es el conjunto cuyos elementos son aquellos que pertenecen a alguno de los conjuntos iniciales, sin pertenecer a ambos a la vez. Por ejemplo, la diferencia simétrica de {2,5,3} y {4,2,3,7} es {5,4,7}.

Definir la función

   diferenciaSimetrica :: Ord a => [a] -> [a] -> [a]

1	diferenciaSimetrica :: Ord a => [a] -> [a] -> [a]

tal que (diferenciaSimetrica xs ys) es la diferencia simétrica de xs e ys. Por ejemplo,

   diferenciaSimetrica [2,5,3] [4,2,3,7]    ==  [4,5,7]
   diferenciaSimetrica [2,5,3] [5,2,3]      ==  []
   diferenciaSimetrica [2,5,2] [4,2,3,7]    ==  [3,4,5,7]
   diferenciaSimetrica [2,5,2] [4,2,4,7]    ==  [4,5,7]
   diferenciaSimetrica [2,5,2,4] [4,2,4,7]  ==  [5,7]

diferenciaSimetrica [2,5,3] [4,2,3,7] == [4,5,7]

diferenciaSimetrica [2,5,3] [5,2,3] == []

diferenciaSimetrica [2,5,2] [4,2,3,7] == [3,4,5,7]

diferenciaSimetrica [2,5,2] [4,2,4,7] == [4,5,7]

diferenciaSimetrica [2,5,2,4] [4,2,4,7] == [5,7]

Soluciones

import Test.QuickCheck
import Data.List ((\\), intersect, nub, sort, union)
import qualified Data.Set as S

-- 1ª solución
-- ===========

diferenciaSimetrica1 :: Ord a => [a] -> [a] -> [a]
diferenciaSimetrica1 xs ys =
  sort (nub ([x | x <- xs, x `notElem` ys] ++ [y | y <- ys, y `notElem` xs]))

-- 2ª solución
-- ===========

diferenciaSimetrica2 :: Ord a => [a] -> [a] -> [a]
diferenciaSimetrica2 xs ys =
  sort (nub (filter (`notElem` ys) xs ++ filter (`notElem` xs) ys))

-- 3ª solución
-- ===========

diferenciaSimetrica3 :: Ord a => [a] -> [a] -> [a]
diferenciaSimetrica3 xs ys =
  sort (nub (union xs ys \\ intersect xs ys))

-- 4ª solución
-- ===========

diferenciaSimetrica4 :: Ord a => [a] -> [a] -> [a]
diferenciaSimetrica4 xs ys =
  [x | x <- sort (nub (xs ++ ys))
     , x `notElem` xs || x `notElem` ys]

-- 5ª solución
-- ===========

diferenciaSimetrica5 :: Ord a => [a] -> [a] -> [a]
diferenciaSimetrica5 xs ys =
  S.elems ((xs' `S.union` ys') `S.difference` (xs' `S.intersection` ys'))
  where xs' = S.fromList xs
        ys' = S.fromList ys

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_diferenciaSimetrica :: [Int] -> [Int] -> Bool
prop_diferenciaSimetrica xs ys =
  all (== diferenciaSimetrica1 xs ys)
      [diferenciaSimetrica2 xs ys,
       diferenciaSimetrica3 xs ys,
       diferenciaSimetrica4 xs ys,
       diferenciaSimetrica5 xs ys]

-- La comprobación es
--    λ> quickCheck prop_diferenciaSimetrica
--    +++ OK, passed 100 tests.

-- Comparación de eficiencia
-- =========================

-- La comparación es
--    λ> length (diferenciaSimetrica1 [1..2*10^4] [2,4..2*10^4])
--    10000
--    (2.34 secs, 10,014,360 bytes)
--    λ> length (diferenciaSimetrica2 [1..2*10^4] [2,4..2*10^4])
--    10000
--    (2.41 secs, 8,174,264 bytes)
--    λ> length (diferenciaSimetrica3 [1..2*10^4] [2,4..2*10^4])
--    10000
--    (5.84 secs, 10,232,006,288 bytes)
--    λ> length (diferenciaSimetrica4 [1..2*10^4] [2,4..2*10^4])
--    10000
--    (5.83 secs, 14,814,184 bytes)
--    λ> length (diferenciaSimetrica5 [1..2*10^4] [2,4..2*10^4])
--    10000
--    (0.02 secs, 7,253,496 bytes)

import Test.QuickCheck

import Data.List ((\\), intersect, nub, sort, union)

import qualified Data.Set as S

-- 1ª solución

-- ===========

diferenciaSimetrica1 :: Ord a => [a] -> [a] -> [a]

diferenciaSimetrica1 xs ys =

sort (nub ([x | x <- xs, x `notElem` ys] ++ [y | y <- ys, y `notElem` xs]))

-- 2ª solución

-- ===========

diferenciaSimetrica2 :: Ord a => [a] -> [a] -> [a]

diferenciaSimetrica2 xs ys =

sort (nub (filter (`notElem` ys) xs ++ filter (`notElem` xs) ys))

-- 3ª solución

-- ===========

diferenciaSimetrica3 :: Ord a => [a] -> [a] -> [a]

diferenciaSimetrica3 xs ys =

sort (nub (union xs ys \\ intersect xs ys))

-- 4ª solución

-- ===========

diferenciaSimetrica4 :: Ord a => [a] -> [a] -> [a]

diferenciaSimetrica4 xs ys =

[x | x <- sort (nub (xs ++ ys))

, x `notElem` xs || x `notElem` ys]

-- 5ª solución

-- ===========

diferenciaSimetrica5 :: Ord a => [a] -> [a] -> [a]

diferenciaSimetrica5 xs ys =

S.elems ((xs' `S.union` ys') `S.difference` (xs' `S.intersection` ys'))

where xs' = S.fromList xs

ys' = S.fromList ys

-- Comprobación de equivalencia

-- ============================

-- La propiedad es

prop_diferenciaSimetrica :: [Int] -> [Int] -> Bool

prop_diferenciaSimetrica xs ys =

all (== diferenciaSimetrica1 xs ys)

[diferenciaSimetrica2 xs ys,

diferenciaSimetrica3 xs ys,

diferenciaSimetrica4 xs ys,

diferenciaSimetrica5 xs ys]

-- La comprobación es

-- λ> quickCheck prop_diferenciaSimetrica

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

-- =========================

-- La comparación es

-- λ> length (diferenciaSimetrica1 [1..2*10^4] [2,4..2*10^4])

-- 10000

-- (2.34 secs, 10,014,360 bytes)

-- λ> length (diferenciaSimetrica2 [1..2*10^4] [2,4..2*10^4])

-- 10000

-- (2.41 secs, 8,174,264 bytes)

-- λ> length (diferenciaSimetrica3 [1..2*10^4] [2,4..2*10^4])

-- 10000

-- (5.84 secs, 10,232,006,288 bytes)

-- λ> length (diferenciaSimetrica4 [1..2*10^4] [2,4..2*10^4])

-- 10000

-- (5.83 secs, 14,814,184 bytes)

-- λ> length (diferenciaSimetrica5 [1..2*10^4] [2,4..2*10^4])

-- 10000

-- (0.02 secs, 7,253,496 bytes)

El código se encuentra en GitHub.

La elaboración de las soluciones se describe en el siguiente vídeo

Nuevas soluciones

En los comentarios se pueden escribir nuevas soluciones.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Numeración de las ternas de números naturales

PorJosé A. Alonso 17-marzo-202215-abril-2022

Las ternas de números naturales se pueden ordenar como sigue

   (0,0,0),
   (0,0,1),(0,1,0),(1,0,0),
   (0,0,2),(0,1,1),(0,2,0),(1,0,1),(1,1,0),(2,0,0),
   (0,0,3),(0,1,2),(0,2,1),(0,3,0),(1,0,2),(1,1,1),(1,2,0),(2,0,1),...
   ...

(0,0,0),

(0,0,1),(0,1,0),(1,0,0),

(0,0,2),(0,1,1),(0,2,0),(1,0,1),(1,1,0),(2,0,0),

(0,0,3),(0,1,2),(0,2,1),(0,3,0),(1,0,2),(1,1,1),(1,2,0),(2,0,1),...

...

Definir la función

   posicion :: (Int,Int,Int) -> Int

1	posicion :: (Int,Int,Int) -> Int

tal que (posicion (x,y,z)) es la posición de la terna de números naturales (x,y,z) en la ordenación anterior. Por ejemplo,

   posicion (0,1,0)  ==  2
   posicion (0,0,2)  ==  4
   posicion (0,1,1)  ==  5

posicion (0,1,0) == 2

posicion (0,0,2) == 4

posicion (0,1,1) == 5

Comprobar con QuickCheck que

la posición de (x,0,0) es x(x²+6x+11)/6
la posición de (0,y,0) es y(y²+3y+ 8)/6
la posición de (0,0,z) es z(z²+3z+ 2)/6
la posición de (x,x,x) es x(9x²+14x+7)/2

Soluciones

import Data.List (elemIndex)
import Data.Maybe (fromJust)
import Test.QuickCheck

-- 1ª solución
-- ===========

posicion1 :: (Int,Int,Int) -> Int
posicion1 t = aux 0 ternas
  where aux n (t':ts) | t' == t   = n
                      | otherwise = aux (n+1) ts

-- ternas es la lista ordenada de las ternas de números naturales. Por ejemplo,
--    λ> take 9 ternas
--    [(0,0,0),(0,0,1),(0,1,0),(1,0,0),(0,0,2),(0,1,1),(0,2,0),(1,0,1),(1,1,0)]
ternas :: [(Int,Int,Int)]
ternas = [(x,y,n-x-y) | n <- [0..], x <- [0..n], y <- [0..n-x]]

-- 2ª solución
-- ===========

posicion2 :: (Int,Int,Int) -> Int
posicion2 t =
  head [n | (n,t') <- zip [0..] ternas, t' == t]

-- 3ª solución
-- ===========

posicion3 :: (Int,Int,Int) -> Int
posicion3 t = indice t ternas

-- (indice x ys) es el índice de x en ys. Por ejemplo,
--    indice 5 [0..]  ==  5
indice :: Eq a => a -> [a] -> Int
indice x ys = length (takeWhile (/= x) ys)

-- 4ª solución
-- ===========

posicion4 :: (Int,Int,Int) -> Int
posicion4 t = fromJust (elemIndex t ternas)

-- 5ª solución
-- ===========

posicion5 :: (Int,Int,Int) -> Int
posicion5 = fromJust . (`elemIndex` ternas)

-- Equivalencia
-- ============

-- La propiedad es
prop_posicion_equiv :: NonNegative Int
                    -> NonNegative Int
                    -> NonNegative Int
                    -> Bool
prop_posicion_equiv (NonNegative x) (NonNegative y) (NonNegative z) =
  all (== posicion1 (x,y,z))
      [f (x,y,z) | f <- [ posicion2
                        , posicion3
                        , posicion4
                        , posicion5 ]]

-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion_equiv
--    +++ OK, passed 100 tests.

-- Comparación de eficiencia
-- =========================

-- La comparación es
--    λ> posicion1 (147,46,116)
--    5000000
--    (5.84 secs, 2,621,428,184 bytes)
--    λ> posicion2 (147,46,116)
--    5000000
--    (3.63 secs, 2,173,230,200 bytes)
--    λ> posicion3 (147,46,116)
--    5000000
--    (2.48 secs, 1,453,229,880 bytes)
--    λ> posicion4 (147,46,116)
--    5000000
--    (1.91 secs, 1,173,229,840 bytes)
--    λ> posicion5 (147,46,116)
--    5000000
--    (1.94 secs, 1,173,229,960 bytes)

-- En lo que sigue, usaremos la 5ª definición
posicion :: (Int,Int,Int) -> Int
posicion = posicion5

-- Propiedades
-- ===========

-- La 1ª propiedad es
prop_posicion1 :: NonNegative Int -> Bool
prop_posicion1 (NonNegative x) =
  posicion (x,0,0) == x * (x^2 + 6*x + 11) `div` 6

-- Su comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion1
--    +++ OK, passed 100 tests.

-- La 2ª propiedad es
prop_posicion2 :: NonNegative Int -> Bool
prop_posicion2 (NonNegative y) =
  posicion (0,y,0) == y * (y^2 + 3*y + 8) `div` 6

-- Su comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion2
--    +++ OK, passed 100 tests.

-- La 3ª propiedad es
prop_posicion3 :: NonNegative Int -> Bool
prop_posicion3 (NonNegative z) =
  posicion (0,0,z) == z * (z^2 + 3*z + 2) `div` 6

-- Su comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion3
--    +++ OK, passed 100 tests.

-- La 4ª propiedad es
prop_posicion4 :: NonNegative Int -> Bool
prop_posicion4 (NonNegative x) =
  posicion (x,x,x) == x * (9 * x^2 + 14 * x + 7) `div` 2

-- Su comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion4
--    +++ OK, passed 100 tests.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

import Data.List (elemIndex)

import Data.Maybe (fromJust)

import Test.QuickCheck

-- 1ª solución

-- ===========

posicion1 :: (Int,Int,Int) -> Int

posicion1 t = aux 0 ternas

where aux n (t':ts) | t' == t = n

| otherwise = aux (n+1) ts

-- ternas es la lista ordenada de las ternas de números naturales. Por ejemplo,

-- λ> take 9 ternas

-- [(0,0,0),(0,0,1),(0,1,0),(1,0,0),(0,0,2),(0,1,1),(0,2,0),(1,0,1),(1,1,0)]

ternas :: [(Int,Int,Int)]

ternas = [(x,y,n-x-y) | n <- [0..], x <- [0..n], y <- [0..n-x]]

-- 2ª solución

-- ===========

posicion2 :: (Int,Int,Int) -> Int

posicion2 t =

head [n | (n,t') <- zip [0..] ternas, t' == t]

-- 3ª solución

-- ===========

posicion3 :: (Int,Int,Int) -> Int

posicion3 t = indice t ternas

-- (indice x ys) es el índice de x en ys. Por ejemplo,

-- indice 5 [0..] == 5

indice :: Eq a => a -> [a] -> Int

indice x ys = length (takeWhile (/= x) ys)

-- 4ª solución

-- ===========

posicion4 :: (Int,Int,Int) -> Int

posicion4 t = fromJust (elemIndex t ternas)

-- 5ª solución

-- ===========

posicion5 :: (Int,Int,Int) -> Int

posicion5 = fromJust . (`elemIndex` ternas)

-- Equivalencia

-- ============

-- La propiedad es

prop_posicion_equiv :: NonNegative Int

-> NonNegative Int

-> Bool

prop_posicion_equiv (NonNegative x) (NonNegative y) (NonNegative z) =

all (== posicion1 (x,y,z))

[f (x,y,z) | f <- [ posicion2

, posicion3

, posicion4

, posicion5 ]]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

-- =========================

-- La comparación es

-- λ> posicion1 (147,46,116)

-- 5000000

-- (5.84 secs, 2,621,428,184 bytes)

-- λ> posicion2 (147,46,116)

-- 5000000

-- (3.63 secs, 2,173,230,200 bytes)

-- λ> posicion3 (147,46,116)

-- 5000000

-- (2.48 secs, 1,453,229,880 bytes)

-- λ> posicion4 (147,46,116)

-- 5000000

-- (1.91 secs, 1,173,229,840 bytes)

-- λ> posicion5 (147,46,116)

-- 5000000

-- (1.94 secs, 1,173,229,960 bytes)

-- En lo que sigue, usaremos la 5ª definición

posicion :: (Int,Int,Int) -> Int

posicion = posicion5

-- Propiedades

-- ===========

-- La 1ª propiedad es

prop_posicion1 :: NonNegative Int -> Bool

prop_posicion1 (NonNegative x) =

posicion (x,0,0) == x * (x^2 + 6*x + 11) `div` 6

-- Su comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion1

-- +++ OK, passed 100 tests.

-- La 2ª propiedad es

prop_posicion2 :: NonNegative Int -> Bool

prop_posicion2 (NonNegative y) =

posicion (0,y,0) == y * (y^2 + 3*y + 8) `div` 6

-- Su comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion2

-- +++ OK, passed 100 tests.

-- La 3ª propiedad es

prop_posicion3 :: NonNegative Int -> Bool

prop_posicion3 (NonNegative z) =

posicion (0,0,z) == z * (z^2 + 3*z + 2) `div` 6

-- Su comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion3

-- +++ OK, passed 100 tests.

-- La 4ª propiedad es

prop_posicion4 :: NonNegative Int -> Bool

prop_posicion4 (NonNegative x) =

posicion (x,x,x) == x * (9 * x^2 + 14 * x + 7) `div` 2

-- Su comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion4

-- +++ OK, passed 100 tests.

El código se encuentra en GitHub.

La elaboración de las soluciones se muestra en el siguiente vídeo:

Teoría de conjuntos

Clausura transitiva de una relación binaria

Soluciones

Transitividad de una relación

Soluciones

Composición de relaciones binarias

Soluciones

Intersecciones parciales

Soluciones

Unión e intersección general de conjuntos

Soluciones

Producto cartesiano de una familia de conjuntos

Soluciones

Reiteración de una función

Soluciones

Nuevas soluciones

Diferencia simétrica

Soluciones

Nuevas soluciones

Numeración de las ternas de números naturales

Soluciones

Entradas recientes

Buscar

Correo electrónico