Ejercicio

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.

Número de particiones en k subconjuntos

PorJosé A. Alonso 11-julio-202229-junio-2022

Definir la función

   numeroParticiones :: Int -> Int -> Int

1	numeroParticiones :: Int -> Int -> Int

tal que (numeroParticiones n k) es el número de particiones de conjunto de n elementos en k subconjuntos disjuntos. Por ejemplo,

   numeroParticiones 3 2    ==  3
   numeroParticiones 3 3    ==  1
   numeroParticiones 4 3    ==  6
   numeroParticiones 4 1    ==  1
   numeroParticiones 4 4    ==  1
   numeroParticiones 91 89  ==  8139495

numeroParticiones 3 2 == 3

numeroParticiones 3 3 == 1

numeroParticiones 4 3 == 6

numeroParticiones 4 1 == 1

numeroParticiones 4 4 == 1

numeroParticiones 91 89 == 8139495

Soluciones

import Data.Array (Array, (!), array)
import Test.QuickCheck (Positive (Positive), quickCheckWith)

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

numeroParticiones1 :: Int -> Int -> Int
numeroParticiones1 n k =
  length (particiones1 [1..n] k)

particiones1 :: [a] -> Int -> [[[a]]]
particiones1 [] _     = []
particiones1 _  0     = []
particiones1 xs 1     = [[xs]]
particiones1 (x:xs) k = [[x]:ys | ys <- particiones1 xs (k-1)] ++ 
                        concat [inserta x ys | ys <- particiones1 xs k]

-- (inserta x yss) es la lista obtenida insertando x en cada uno de los
-- conjuntos de yss. Por ejemplo,
--    inserta 4 [[3],[2,5]]  ==  [[[4,3],[2,5]],[[3],[4,2,5]]]
inserta :: a -> [[a]] -> [[[a]]]
inserta _ []       = []
inserta x (ys:yss) = ((x:ys):yss) : [ys:zss | zss <- inserta x yss]
  
-- 2ª solución
-- ===========

numeroParticiones2 :: Int -> Int -> Int
numeroParticiones2 0 _ = 0
numeroParticiones2 _ 0 = 0
numeroParticiones2 _ 1 = 1
numeroParticiones2 n k = k * numeroParticiones2 (n-1) k +
                         numeroParticiones2 (n-1) (k-1) 

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

numeroParticiones3 :: Int -> Int -> Int
numeroParticiones3 n k = matrizNumeroParticiones n k ! (n,k)

matrizNumeroParticiones :: Int -> Int -> Array (Int,Int) Int
matrizNumeroParticiones n k = q where
  q = array ((0,0),(n,k)) [((i,j), f i j) | i <- [0..n], j <- [0..k]]
  f _ 0 = 0
  f 0 _ = 0
  f _ 1 = 1
  f i j | i == j    = 1
        | otherwise = j * f (i-1) j + f (i-1) (j-1)

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

-- La propiedad es
prop_numeroParticiones :: Positive Int -> Positive Int -> Bool
prop_numeroParticiones (Positive n) (Positive k) =
  all (== numeroParticiones1 n k)
      [numeroParticiones2 n k,
       numeroParticiones3 n k]

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

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

-- La comparación es
--    λ> numeroParticiones1 12 6
--    1323652
--    (1.22 secs, 1,152,945,608 bytes)
--    λ> numeroParticiones2 12 6
--    1323652
--    (0.00 secs, 1,283,152 bytes)
--    λ> numeroParticiones3 12 6
--    1323652
--    (0.01 secs, 1,155,864 bytes)
--
--    λ> numeroParticiones2 21 19
--    19285
--    (2.04 secs, 990,274,976 bytes)
--    λ> numeroParticiones3 21 19
--    19285
--    (0.00 secs, 940,736 bytes)

import Data.Array (Array, (!), array)

import Test.QuickCheck (Positive (Positive), quickCheckWith)

-- 1ª solución

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

numeroParticiones1 :: Int -> Int -> Int

numeroParticiones1 n k =

length (particiones1 [1..n] k)

particiones1 :: [a] -> Int -> [[[a]]]

particiones1 [] _ = []

particiones1 _ 0 = []

particiones1 xs 1 = [[xs]]

particiones1 (x:xs) k = [[x]:ys | ys <- particiones1 xs (k-1)] ++

concat [inserta x ys | ys <- particiones1 xs k]

-- (inserta x yss) es la lista obtenida insertando x en cada uno de los

-- conjuntos de yss. Por ejemplo,

-- inserta 4 [[3],[2,5]] == [[[4,3],[2,5]],[[3],[4,2,5]]]

inserta :: a -> [[a]] -> [[[a]]]

inserta _ [] = []

inserta x (ys:yss) = ((x:ys):yss) : [ys:zss | zss <- inserta x yss]

-- 2ª solución

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

numeroParticiones2 :: Int -> Int -> Int

numeroParticiones2 0 _ = 0

numeroParticiones2 _ 0 = 0

numeroParticiones2 _ 1 = 1

numeroParticiones2 n k = k * numeroParticiones2 (n-1) k +

numeroParticiones2 (n-1) (k-1)

-- 3ª solución

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

numeroParticiones3 :: Int -> Int -> Int

numeroParticiones3 n k = matrizNumeroParticiones n k ! (n,k)

matrizNumeroParticiones :: Int -> Int -> Array (Int,Int) Int

matrizNumeroParticiones n k = q where

q = array ((0,0),(n,k)) [((i,j), f i j) | i <- [0..n], j <- [0..k]]

f _ 0 = 0

f 0 _ = 0

f _ 1 = 1

f i j | i == j = 1

| otherwise = j * f (i-1) j + f (i-1) (j-1)

-- Comprobación de equivalencia

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

-- La propiedad es

prop_numeroParticiones :: Positive Int -> Positive Int -> Bool

prop_numeroParticiones (Positive n) (Positive k) =

all (== numeroParticiones1 n k)

[numeroParticiones2 n k,

numeroParticiones3 n k]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=10}) prop_numeroParticiones

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> numeroParticiones1 12 6

-- 1323652

-- (1.22 secs, 1,152,945,608 bytes)

-- λ> numeroParticiones2 12 6

-- 1323652

-- (0.00 secs, 1,283,152 bytes)

-- λ> numeroParticiones3 12 6

-- 1323652

-- (0.01 secs, 1,155,864 bytes)

-- λ> numeroParticiones2 21 19

-- 19285

-- (2.04 secs, 990,274,976 bytes)

-- λ> numeroParticiones3 21 19

-- 19285

-- (0.00 secs, 940,736 bytes)

El código se encuentra en GitHub.

Particiones en k subconjuntos

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

Definir la función

   particiones :: [a] -> Int -> [[[a]]]

1	particiones :: [a] -> Int -> [[[a]]]

tal que (particiones xs k) es la lista de las particiones de xs en k subconjuntos disjuntos. Por ejemplo,

   λ> particiones [2,3,6] 2
   [[[2],[3,6]],[[2,3],[6]],[[3],[2,6]]]
   λ> particiones [2,3,6] 3
   [[[2],[3],[6]]]
   λ> particiones [4,2,3,6] 3
   [[[4],[2],[3,6]],[[4],[2,3],[6]],[[4],[3],[2,6]],
    [[4,2],[3],[6]],[[2],[4,3],[6]],[[2],[3],[4,6]]]
   λ> particiones [4,2,3,6] 1
   [[[4,2,3,6]]]
   λ> particiones [4,2,3,6] 4
   [[[4],[2],[3],[6]]]

λ> particiones [2,3,6] 2

[[[2],[3,6]],[[2,3],[6]],[[3],[2,6]]]

λ> particiones [2,3,6] 3

[[[2],[3],[6]]]

λ> particiones [4,2,3,6] 3

[[[4],[2],[3,6]],[[4],[2,3],[6]],[[4],[3],[2,6]],

[[4,2],[3],[6]],[[2],[4,3],[6]],[[2],[3],[4,6]]]

λ> particiones [4,2,3,6] 1

[[[4,2,3,6]]]

λ> particiones [4,2,3,6] 4

[[[4],[2],[3],[6]]]

Soluciones

import Data.List (nub, sort)
import Data.Array (Array, (!), array, listArray)
import Test.QuickCheck (Positive (Positive), quickCheckWith)

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

particiones1 :: [a] -> Int -> [[[a]]]
particiones1 [] _     = []
particiones1 _  0     = []
particiones1 xs 1     = [[xs]]
particiones1 (x:xs) k = [[x]:ys | ys <- particiones1 xs (k-1)] ++ 
                        concat [inserta x ys | ys <- particiones1 xs k]

-- (inserta x yss) es la lista obtenida insertando x en cada uno de los
-- conjuntos de yss. Por ejemplo,
--    inserta 4 [[3],[2,5]]  ==  [[[4,3],[2,5]],[[3],[4,2,5]]]
inserta :: a -> [[a]] -> [[[a]]]
inserta _ []       = []
inserta x (ys:yss) = ((x:ys):yss) : [ys:zss | zss <- inserta x yss]

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

particiones2 :: [a] -> Int -> [[[a]]]
particiones2 [] _     = []
particiones2 _  0     = []
particiones2 xs 1     = [[xs]]
particiones2 (x:xs) k = map ([x]:) (particiones2 xs (k-1)) ++ 
                        concatMap (inserta x) (particiones2 xs k)

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

particiones3 :: [a] -> Int -> [[[a]]]
particiones3 xs k = matrizParticiones xs k ! (length xs, k)

matrizParticiones :: [a] -> Int -> Array (Int,Int) [[[a]]]
matrizParticiones xs k = q where
  q = array ((0,0),(n,k)) [((i,j), f i j) | i <- [0..n], j <- [0..k]]
  n = length xs
  v = listArray (1,n) xs
  f _ 0 = []
  f 0 _ = []
  f m 1 = [[take m xs]]
  f i j | i == j = [[[x] | x <- take i xs]]
        | otherwise = map ([v!i] :) (q!(i-1,j-1)) ++
                      concatMap (inserta (v!i)) (q!(i-1,j))

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

-- La propiedad es
prop_particiones :: [Int] -> Positive Int -> Bool
prop_particiones xs (Positive k) =
  all (iguales (particiones1 xs' k))
      [particiones2 xs' k,
       particiones3 xs' k]
  where
    xs' = nub xs
    iguales xss yss = sort (map sort [map sort x | x <- xss]) ==
                      sort (map sort [map sort y | y <- yss])

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

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

-- La comparación es
--    λ> length (particiones1 [1..12] 6)
--    1323652
--    (1.33 secs, 1,152,945,584 bytes)
--    λ> length (particiones2 [1..12] 6)
--    1323652
--    (1.07 secs, 1,104,960,360 bytes)
--    λ> length (particiones3 [1..12] 6)
--    1323652
--    (1.68 secs, 1,047,004,368 bytes)

import Data.List (nub, sort)

import Data.Array (Array, (!), array, listArray)

import Test.QuickCheck (Positive (Positive), quickCheckWith)

-- 1ª solución

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

particiones1 :: [a] -> Int -> [[[a]]]

particiones1 [] _ = []

particiones1 _ 0 = []

particiones1 xs 1 = [[xs]]

particiones1 (x:xs) k = [[x]:ys | ys <- particiones1 xs (k-1)] ++

concat [inserta x ys | ys <- particiones1 xs k]

-- (inserta x yss) es la lista obtenida insertando x en cada uno de los

-- conjuntos de yss. Por ejemplo,

-- inserta 4 [[3],[2,5]] == [[[4,3],[2,5]],[[3],[4,2,5]]]

inserta :: a -> [[a]] -> [[[a]]]

inserta _ [] = []

inserta x (ys:yss) = ((x:ys):yss) : [ys:zss | zss <- inserta x yss]

-- 2ª solución

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

particiones2 :: [a] -> Int -> [[[a]]]

particiones2 [] _ = []

particiones2 _ 0 = []

particiones2 xs 1 = [[xs]]

particiones2 (x:xs) k = map ([x]:) (particiones2 xs (k-1)) ++

concatMap (inserta x) (particiones2 xs k)

-- 3ª solución

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

particiones3 :: [a] -> Int -> [[[a]]]

particiones3 xs k = matrizParticiones xs k ! (length xs, k)

matrizParticiones :: [a] -> Int -> Array (Int,Int) [[[a]]]

matrizParticiones xs k = q where

q = array ((0,0),(n,k)) [((i,j), f i j) | i <- [0..n], j <- [0..k]]

n = length xs

v = listArray (1,n) xs

f _ 0 = []

f 0 _ = []

f m 1 = [[take m xs]]

f i j | i == j = [[[x] | x <- take i xs]]

| otherwise = map ([v!i] :) (q!(i-1,j-1)) ++

concatMap (inserta (v!i)) (q!(i-1,j))

-- Comprobación de equivalencia

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

-- La propiedad es

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

prop_particiones xs (Positive k) =

all (iguales (particiones1 xs' k))

[particiones2 xs' k,

particiones3 xs' k]

where

xs' = nub xs

iguales xss yss = sort (map sort [map sort x | x <- xss]) ==

sort (map sort [map sort y | y <- yss])

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=10}) prop_particiones

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (particiones1 [1..12] 6)

-- 1323652

-- (1.33 secs, 1,152,945,584 bytes)

-- λ> length (particiones2 [1..12] 6)

-- 1323652

-- (1.07 secs, 1,104,960,360 bytes)

-- λ> length (particiones3 [1..12] 6)

-- 1323652

-- (1.68 secs, 1,047,004,368 bytes)

El código se encuentra en GitHub.

Mayor semiprimo menor que n

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

Un número semiprimo es un número natural es producto de dos números primos no necesariamente distintos. Por ejemplo, 26 es semiprimo (porque 26 = 2·13) y 49 también lo es (porque 49 = 7·7).

Definir la función

   mayorSemiprimoMenor :: Integer -> Integer

1	mayorSemiprimoMenor :: Integer -> Integer

tal que (mayorSemiprimoMenor n) es el mayor semiprimo menor que n (suponiendo que n > 4). Por ejemplo,

   mayorSemiprimoMenor 27      ==  26
   mayorSemiprimoMenor 50      ==  49
   mayorSemiprimoMenor 49      ==  46
   mayorSemiprimoMenor (10^15) == 999999999999998

mayorSemiprimoMenor 27 == 26

mayorSemiprimoMenor 50 == 49

mayorSemiprimoMenor 49 == 46

mayorSemiprimoMenor (10^15) == 999999999999998

Soluciones

import Data.Numbers.Primes (primeFactors, isPrime, primes)
import Test.QuickCheck

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

mayorSemiprimoMenor1 :: Integer -> Integer
mayorSemiprimoMenor1 n =
  head [x | x <- [n-1,n-2..2], semiPrimo x]

semiPrimo :: Integer -> Bool
semiPrimo n =
  not (null [x | x <- [n,n-1..2], 
                 primo x,
                 n `mod` x == 0,
                 primo (n `div` x)])

primo :: Integer -> Bool
primo n = [x | x <- [1..n], n `mod` x == 0] == [1,n] 

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

mayorSemiprimoMenor2 :: Integer -> Integer
mayorSemiprimoMenor2 n =
  head [x | x <- [n-1,n-2..2], semiPrimo2 x]

semiPrimo2 :: Integer -> Bool
semiPrimo2 n =
  not (null [x | x <- [n-1,n-2..2], 
                 isPrime x,
                 n `mod` x == 0,
                 isPrime (n `div` x)])

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

mayorSemiprimoMenor3 :: Integer -> Integer
mayorSemiprimoMenor3 n =
  head [x | x <- [n-1,n-2..2], semiPrimo3 x]

semiPrimo3 :: Integer -> Bool
semiPrimo3 n =
  not (null [x | x <- reverse (takeWhile (<n) primes),
                 n `mod` x == 0,
                 isPrime (n `div` x)])

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

mayorSemiprimoMenor4 :: Integer -> Integer
mayorSemiprimoMenor4 n =
  head [ p | p <- [n-1,n-2..2]
           , (length . primeFactors) p == 2]

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

mayorSemiprimoMenor5 :: Integer -> Integer
mayorSemiprimoMenor5 n
  | semiPrimo5 (n-1) = n-1
  | otherwise        = mayorSemiprimoMenor5 (n-1)

semiPrimo5 :: Integer -> Bool
semiPrimo5 x = length (primeFactors x) == 2

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

-- La propiedad es
prop_mayorSemiprimoMenor :: Integer -> Property
prop_mayorSemiprimoMenor n =
  n > 4 ==>
  all (== mayorSemiprimoMenor1 n)
      [mayorSemiprimoMenor2 n,
       mayorSemiprimoMenor3 n,
       mayorSemiprimoMenor4 n,
       mayorSemiprimoMenor5 n]

-- La comprobación es
--    λ> quickCheck prop_mayorSemiprimoMenor
--    +++ OK, passed 100 tests; 353 discarded.

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

-- La comparación es
--    λ> mayorSemiprimoMenor1 5000
--    4997
--    (1.92 secs, 945,507,880 bytes)
--    λ> mayorSemiprimoMenor2 5000
--    4997
--    (0.05 secs, 123,031,264 bytes)
--    λ> mayorSemiprimoMenor3 5000
--    4997
--    (0.01 secs, 5,865,120 bytes)
--    λ> mayorSemiprimoMenor4 5000
--    4997
--    (0.00 secs, 593,528 bytes)
--    λ> mayorSemiprimoMenor5 5000
--    4997
--    (0.00 secs, 593,200 bytes)
--
--    λ> mayorSemiprimoMenor3 (3*10^6)
--    2999995
--    (2.34 secs, 6,713,620,000 bytes)
--    λ> mayorSemiprimoMenor4 (2*10^6)
--    1999997
--    (0.01 secs, 728,936 bytes)
--    λ> mayorSemiprimoMenor5 (2*10^6)
--    1999997
--    (0.01 secs, 728,608 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

import Data.Numbers.Primes (primeFactors, isPrime, primes)

import Test.QuickCheck

-- 1ª solución

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

mayorSemiprimoMenor1 :: Integer -> Integer

mayorSemiprimoMenor1 n =

head [x | x <- [n-1,n-2..2], semiPrimo x]

semiPrimo :: Integer -> Bool

semiPrimo n =

not (null [x | x <- [n,n-1..2],

primo x,

n `mod` x == 0,

primo (n `div` x)])

primo :: Integer -> Bool

primo n = [x | x <- [1..n], n `mod` x == 0] == [1,n]

-- 2ª solución

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

mayorSemiprimoMenor2 :: Integer -> Integer

mayorSemiprimoMenor2 n =

head [x | x <- [n-1,n-2..2], semiPrimo2 x]

semiPrimo2 :: Integer -> Bool

semiPrimo2 n =

not (null [x | x <- [n-1,n-2..2],

isPrime x,

n `mod` x == 0,

isPrime (n `div` x)])

-- 3ª solución

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

mayorSemiprimoMenor3 :: Integer -> Integer

mayorSemiprimoMenor3 n =

head [x | x <- [n-1,n-2..2], semiPrimo3 x]

semiPrimo3 :: Integer -> Bool

semiPrimo3 n =

not (null [x | x <- reverse (takeWhile (<n) primes),

n `mod` x == 0,

isPrime (n `div` x)])

-- 4ª solución

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

mayorSemiprimoMenor4 :: Integer -> Integer

mayorSemiprimoMenor4 n =

head [ p | p <- [n-1,n-2..2]

, (length . primeFactors) p == 2]

-- 5ª solución

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

mayorSemiprimoMenor5 :: Integer -> Integer

mayorSemiprimoMenor5 n

| semiPrimo5 (n-1) = n-1

| otherwise = mayorSemiprimoMenor5 (n-1)

semiPrimo5 :: Integer -> Bool

semiPrimo5 x = length (primeFactors x) == 2

-- Comprobación de equivalencia

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

-- La propiedad es

prop_mayorSemiprimoMenor :: Integer -> Property

prop_mayorSemiprimoMenor n =

n > 4 ==>

all (== mayorSemiprimoMenor1 n)

[mayorSemiprimoMenor2 n,

mayorSemiprimoMenor3 n,

mayorSemiprimoMenor4 n,

mayorSemiprimoMenor5 n]

-- La comprobación es

-- λ> quickCheck prop_mayorSemiprimoMenor

-- +++ OK, passed 100 tests; 353 discarded.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> mayorSemiprimoMenor1 5000

-- 4997

-- (1.92 secs, 945,507,880 bytes)

-- λ> mayorSemiprimoMenor2 5000

-- 4997

-- (0.05 secs, 123,031,264 bytes)

-- λ> mayorSemiprimoMenor3 5000

-- 4997

-- (0.01 secs, 5,865,120 bytes)

-- λ> mayorSemiprimoMenor4 5000

-- 4997

-- (0.00 secs, 593,528 bytes)

-- λ> mayorSemiprimoMenor5 5000

-- 4997

-- (0.00 secs, 593,200 bytes)

-- λ> mayorSemiprimoMenor3 (3*10^6)

-- 2999995

-- (2.34 secs, 6,713,620,000 bytes)

-- λ> mayorSemiprimoMenor4 (2*10^6)

-- 1999997

-- (0.01 secs, 728,936 bytes)

-- λ> mayorSemiprimoMenor5 (2*10^6)

-- 1999997

-- (0.01 secs, 728,608 bytes)

El código se encuentra en GitHub.

Transitividad de una relación

Soluciones

Composición de relaciones binarias

Soluciones

Número de particiones en k subconjuntos

Soluciones

Particiones en k subconjuntos

Soluciones

Mayor semiprimo menor que n

Soluciones

Entradas recientes

Buscar

Correo electrónico