intersect

Familias de números con algún dígito en común

PorJosé A. Alonso 31-marzo-20227-abril-2022

Una familia de números es una lista de números tal que todos tienen la misma cantidad de dígitos y, además, dichos números tienen al menos un dígito común.

Por ejemplo, los números 72, 32, 25 y 22 pertenecen a la misma familia ya que son números de dos dígitos y todos tienen el dígito 2, mientras que los números 123, 245 y 568 no pertenecen a la misma familia, ya que no hay un dígito que aparezca en los tres números.

Definir la función

   esFamilia :: [Integer] -> Bool

1	esFamilia :: [Integer] -> Bool

tal que (esFamilia ns) se verifica si ns es una familia de números. Por ejemplo,

   esFamilia [72, 32, 25, 22]  ==  True
   esFamilia [123,245,568]     ==  False
   esFamilia [72, 32, 25, 223] ==  False
   esFamilia [56]              ==  True
   esFamilia []                ==  True

esFamilia [72, 32, 25, 22] == True

esFamilia [123,245,568] == False

esFamilia [72, 32, 25, 223] == False

esFamilia [56] == True

esFamilia [] == True

Soluciones

import Data.List (intersect, nub)
import Test.QuickCheck (quickCheck)

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

esFamilia1 :: [Integer] -> Bool
esFamilia1 [] = True
esFamilia1 ns =
  igualNumeroElementos dss && tieneElementoComun dss
  where dss = map show ns

-- (igualNumeroElementos xss) se verifica si todas las listas de xss
-- tienen el mismo número de elementos. Por ejemplo,
--    igualNumeroElementos [[1,3],[2,2],[4,9]]    ==  True
--    igualNumeroElementos [[1,3],[2,1,2],[4,9]]  ==  False
igualNumeroElementos :: [[a]] -> Bool
igualNumeroElementos xss =
  iguales (map length xss)

-- (iguales xs) se verifica si todos los elementos de xs son
-- iguales. Por ejemplo,
--    iguales [3,3,3,3]  ==  True
--    iguales [3,3,7,3]  ==  False
iguales :: Eq a => [a] -> Bool
iguales []     = True
iguales (x:xs) = all (==x) xs

-- (tieneElementoComun xss) se verifican si todas las listas de xss
-- tienen algún elemento común. Por ejemplo,
--    tieneElementoComun [[1,2],[2,3],[4,2,7]]  ==  True
--    tieneElementoComun [[1,2],[2,3],[4,3,7]]  ==  False
tieneElementoComun :: Eq a => [[a]] -> Bool
tieneElementoComun []       = False
tieneElementoComun (xs:xss) = any (`esElementoComun` xss) xs

-- (esElementoComun x yss) se verifica si x pertenece a todos los
-- elementos de yss. Por ejemplo,
--    esElementoComun 2 [[1,2],[2,3],[4,2,7]]  ==  True
--    esElementoComun 2 [[1,2],[2,3],[4,3,7]]  ==  False
esElementoComun :: Eq a => a -> [[a]] -> Bool
esElementoComun x = all (x `elem`)

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

esFamilia2 :: [Integer] -> Bool
esFamilia2 [] = True
esFamilia2 ns =
  igualNumeroElementos2 dss && tieneElementoComun2 dss
  where dss = map show ns

igualNumeroElementos2 :: [[a]] -> Bool
igualNumeroElementos2 xss =
  length (nub (map length xss)) == 1

tieneElementoComun2 :: Eq a => [[a]] -> Bool
tieneElementoComun2 xss =
  not (null (foldl1 intersect xss))

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

esFamilia3 :: [Integer] -> Bool
esFamilia3 [] = True
esFamilia3 ns =
  igualNumeroElementos3 dss && tieneElementoComun3 dss
  where dss = map show ns

igualNumeroElementos3 :: [[a]] -> Bool
igualNumeroElementos3 = ((==1) . length) . nub . map length

tieneElementoComun3 :: Eq a => [[a]] -> Bool
tieneElementoComun3 = (not . null) . foldl1 intersect

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

-- La propiedad es
prop_esFamilia :: [Integer] -> Bool
prop_esFamilia xss =
  all (== esFamilia1 xss)
      [esFamilia2 xss,
       esFamilia3 xss]

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

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

-- La comparación es
--    λ> esFamilia1 [10^6..4*10^6]
--    False
--    (1.85 secs, 1,931,162,984 bytes)
--    λ> esFamilia2 [10^6..4*10^6]
--    False
--    (2.31 secs, 2,288,177,752 bytes)
--    λ> esFamilia3 [10^6..4*10^6]
--    False
--    (2.23 secs, 2,288,177,864 bytes)

100

101

102

import Data.List (intersect, nub)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

esFamilia1 :: [Integer] -> Bool

esFamilia1 [] = True

esFamilia1 ns =

igualNumeroElementos dss && tieneElementoComun dss

where dss = map show ns

-- (igualNumeroElementos xss) se verifica si todas las listas de xss

-- tienen el mismo número de elementos. Por ejemplo,

-- igualNumeroElementos [[1,3],[2,2],[4,9]] == True

-- igualNumeroElementos [[1,3],[2,1,2],[4,9]] == False

igualNumeroElementos :: [[a]] -> Bool

igualNumeroElementos xss =

iguales (map length xss)

-- (iguales xs) se verifica si todos los elementos de xs son

-- iguales. Por ejemplo,

-- iguales [3,3,3,3] == True

-- iguales [3,3,7,3] == False

iguales :: Eq a => [a] -> Bool

iguales [] = True

iguales (x:xs) = all (==x) xs

-- (tieneElementoComun xss) se verifican si todas las listas de xss

-- tienen algún elemento común. Por ejemplo,

-- tieneElementoComun [[1,2],[2,3],[4,2,7]] == True

-- tieneElementoComun [[1,2],[2,3],[4,3,7]] == False

tieneElementoComun :: Eq a => [[a]] -> Bool

tieneElementoComun [] = False

tieneElementoComun (xs:xss) = any (`esElementoComun` xss) xs

-- (esElementoComun x yss) se verifica si x pertenece a todos los

-- elementos de yss. Por ejemplo,

-- esElementoComun 2 [[1,2],[2,3],[4,2,7]] == True

-- esElementoComun 2 [[1,2],[2,3],[4,3,7]] == False

esElementoComun :: Eq a => a -> [[a]] -> Bool

esElementoComun x = all (x `elem`)

-- 2ª solución

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

esFamilia2 :: [Integer] -> Bool

esFamilia2 [] = True

esFamilia2 ns =

igualNumeroElementos2 dss && tieneElementoComun2 dss

where dss = map show ns

igualNumeroElementos2 :: [[a]] -> Bool

igualNumeroElementos2 xss =

length (nub (map length xss)) == 1

tieneElementoComun2 :: Eq a => [[a]] -> Bool

tieneElementoComun2 xss =

not (null (foldl1 intersect xss))

-- 3ª solución

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

esFamilia3 :: [Integer] -> Bool

esFamilia3 [] = True

esFamilia3 ns =

igualNumeroElementos3 dss && tieneElementoComun3 dss

where dss = map show ns

igualNumeroElementos3 :: [[a]] -> Bool

igualNumeroElementos3 = ((==1) . length) . nub . map length

tieneElementoComun3 :: Eq a => [[a]] -> Bool

tieneElementoComun3 = (not . null) . foldl1 intersect

-- Comprobación de equivalencia

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

-- La propiedad es

prop_esFamilia :: [Integer] -> Bool

prop_esFamilia xss =

all (== esFamilia1 xss)

[esFamilia2 xss,

esFamilia3 xss]

-- La comprobación es

-- λ> quickCheck prop_esFamilia

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> esFamilia1 [10^6..4*10^6]

-- False

-- (1.85 secs, 1,931,162,984 bytes)

-- λ> esFamilia2 [10^6..4*10^6]

-- False

-- (2.31 secs, 2,288,177,752 bytes)

-- λ> esFamilia3 [10^6..4*10^6]

-- False

-- (2.23 secs, 2,288,177,864 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>

Conjunto de primos relativos

PorJosé A. Alonso 30-marzo-20226-abril-2022

Dos números enteros positivos son primos relativos si no tienen ningún factor primo en común; es decit, si 1 es su único divisor común. Por ejemplo, 6 y 35 son primos entre sí, pero 6 y 27 no lo son porque ambos son divisibles por 3.

Definir la función

   primosRelativos :: [Int] -> Bool

1	primosRelativos :: [Int] -> Bool

tal que (primosRelativos xs) se verifica si los elementos de xs son primos relativos dos a dos. Por ejemplo,

   primosRelativos [6,35]         ==  True
   primosRelativos [6,27]         ==  False
   primosRelativos [2,3,4]        ==  False
   primosRelativos [6,35,11]      ==  True
   primosRelativos [6,35,11,221]  ==  True
   primosRelativos [6,35,11,231]  ==  False

primosRelativos [6,35] == True

primosRelativos [6,27] == False

primosRelativos [2,3,4] == False

primosRelativos [6,35,11] == True

primosRelativos [6,35,11,221] == True

primosRelativos [6,35,11,231] == False

Soluciones

import Test.QuickCheck
import Data.List (delete, intersect)
import Data.Numbers.Primes (primeFactors, primes)
import qualified Data.Set as S (disjoint, fromList)

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

primosRelativos1 :: [Int] -> Bool
primosRelativos1 []     = True
primosRelativos1 (x:xs) =
  and [sonPrimosRelativos1 x y | y <- xs] && primosRelativos1 xs

-- (sonPrimosRelativos x y) se verifica si x e y son primos
-- relativos. Por ejemplo,
--    sonPrimosRelativos1 6 35  ==  True
--    sonPrimosRelativos1 6 27  ==  False
sonPrimosRelativos1 :: Int -> Int -> Bool
sonPrimosRelativos1 x y =
  null (divisoresPrimos x `intersect` divisoresPrimos y)

-- (divisoresPrimos x) es la lista de los divisores primos de x. Por
-- ejemplo,
--    divisoresPrimos 600  ==  [2,2,2,3,5,5]
divisoresPrimos :: Int -> [Int]
divisoresPrimos 1 = []
divisoresPrimos x =
  y : divisoresPrimos (x `div` y)
  where y = menorDivisorPrimo x

-- (menorDivisorPrimo x) es el menor divisor primo de x. Por ejemplo,
--    menorDivisorPrimo 15  ==  3
--    menorDivisorPrimo 11  ==  11
menorDivisorPrimo :: Int -> Int
menorDivisorPrimo x =
  head [y | y <- [2..], x `mod` y == 0]

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

primosRelativos2 :: [Int] -> Bool
primosRelativos2 []     = True
primosRelativos2 (x:xs) =
  all (sonPrimosRelativos1 x) xs && primosRelativos2 xs

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

primosRelativos3 :: [Int] -> Bool
primosRelativos3 []     = True
primosRelativos3 (x:xs) =
  all (sonPrimosRelativos2 x) xs && primosRelativos3 xs

sonPrimosRelativos2 :: Int -> Int -> Bool
sonPrimosRelativos2 x y =
  null (primeFactors x `intersect` primeFactors y)

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

primosRelativos4 :: [Int] -> Bool
primosRelativos4 []     = True
primosRelativos4 (x:xs) =
  all (sonPrimosRelativos3 x) xs && primosRelativos4 xs

sonPrimosRelativos3 :: Int -> Int -> Bool
sonPrimosRelativos3 x y =
  S.fromList (primeFactors x) `S.disjoint` S.fromList (primeFactors y)

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

primosRelativos5 :: [Int] -> Bool
primosRelativos5 []     = True
primosRelativos5 (x:xs) =
  all (sonPrimosRelativos5 x) xs && primosRelativos5 xs

sonPrimosRelativos5 :: Int -> Int -> Bool
sonPrimosRelativos5 x y =
  gcd x y == 1

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

-- La propiedad es
prop_primosRelativos :: [Positive Int] -> Bool
prop_primosRelativos xs =
  all (== primosRelativos1 ys)
      [primosRelativos2 ys,
       primosRelativos3 ys,
       primosRelativos4 ys,
       primosRelativos5 ys]
  where ys = getPositive <$> xs

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

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

-- La comparación es
--    λ> primosRelativos1 (take 120 primes)
--    True
--    (1.92 secs, 869,909,416 bytes)
--    λ> primosRelativos2 (take 120 primes)
--    True
--    (1.99 secs, 869,045,656 bytes)
--    λ> primosRelativos3 (take 120 primes)
--    True
--    (0.09 secs, 221,183,200 bytes)
--
--    λ> primosRelativos3 (take 600 primes)
--    True
--    (2.62 secs, 11,196,690,856 bytes)
--    λ> primosRelativos4 (take 600 primes)
--    True
--    (2.66 secs, 11,190,940,456 bytes)
--    λ> primosRelativos5 (take 600 primes)
--    True
--    (0.14 secs, 123,673,648 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

import Test.QuickCheck

import Data.List (delete, intersect)

import Data.Numbers.Primes (primeFactors, primes)

import qualified Data.Set as S (disjoint, fromList)

-- 1ª solución

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

primosRelativos1 :: [Int] -> Bool

primosRelativos1 [] = True

primosRelativos1 (x:xs) =

and [sonPrimosRelativos1 x y | y <- xs] && primosRelativos1 xs

-- (sonPrimosRelativos x y) se verifica si x e y son primos

-- relativos. Por ejemplo,

-- sonPrimosRelativos1 6 35 == True

-- sonPrimosRelativos1 6 27 == False

sonPrimosRelativos1 :: Int -> Int -> Bool

sonPrimosRelativos1 x y =

null (divisoresPrimos x `intersect` divisoresPrimos y)

-- (divisoresPrimos x) es la lista de los divisores primos de x. Por

-- ejemplo,

-- divisoresPrimos 600 == [2,2,2,3,5,5]

divisoresPrimos :: Int -> [Int]

divisoresPrimos 1 = []

divisoresPrimos x =

y : divisoresPrimos (x `div` y)

where y = menorDivisorPrimo x

-- (menorDivisorPrimo x) es el menor divisor primo de x. Por ejemplo,

-- menorDivisorPrimo 15 == 3

-- menorDivisorPrimo 11 == 11

menorDivisorPrimo :: Int -> Int

menorDivisorPrimo x =

head [y | y <- [2..], x `mod` y == 0]

-- 2ª solución

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

primosRelativos2 :: [Int] -> Bool

primosRelativos2 [] = True

primosRelativos2 (x:xs) =

all (sonPrimosRelativos1 x) xs && primosRelativos2 xs

-- 3ª solución

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

primosRelativos3 :: [Int] -> Bool

primosRelativos3 [] = True

primosRelativos3 (x:xs) =

all (sonPrimosRelativos2 x) xs && primosRelativos3 xs

sonPrimosRelativos2 :: Int -> Int -> Bool

sonPrimosRelativos2 x y =

null (primeFactors x `intersect` primeFactors y)

-- 4ª solución

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

primosRelativos4 :: [Int] -> Bool

primosRelativos4 [] = True

primosRelativos4 (x:xs) =

all (sonPrimosRelativos3 x) xs && primosRelativos4 xs

sonPrimosRelativos3 :: Int -> Int -> Bool

sonPrimosRelativos3 x y =

S.fromList (primeFactors x) `S.disjoint` S.fromList (primeFactors y)

-- 5ª solución

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

primosRelativos5 :: [Int] -> Bool

primosRelativos5 [] = True

primosRelativos5 (x:xs) =

all (sonPrimosRelativos5 x) xs && primosRelativos5 xs

sonPrimosRelativos5 :: Int -> Int -> Bool

sonPrimosRelativos5 x y =

gcd x y == 1

-- Comprobación de equivalencia

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

-- La propiedad es

prop_primosRelativos :: [Positive Int] -> Bool

prop_primosRelativos xs =

all (== primosRelativos1 ys)

[primosRelativos2 ys,

primosRelativos3 ys,

primosRelativos4 ys,

primosRelativos5 ys]

where ys = getPositive <$> xs

-- La comprobación es

-- λ> quickCheck prop_primosRelativos

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> primosRelativos1 (take 120 primes)

-- True

-- (1.92 secs, 869,909,416 bytes)

-- λ> primosRelativos2 (take 120 primes)

-- True

-- (1.99 secs, 869,045,656 bytes)

-- λ> primosRelativos3 (take 120 primes)

-- True

-- (0.09 secs, 221,183,200 bytes)

-- λ> primosRelativos3 (take 600 primes)

-- True

-- (2.62 secs, 11,196,690,856 bytes)

-- λ> primosRelativos4 (take 600 primes)

-- True

-- (2.66 secs, 11,190,940,456 bytes)

-- λ> primosRelativos5 (take 600 primes)

-- True

-- (0.14 secs, 123,673,648 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>

Reconocimiento de particiones

PorJosé A. Alonso 21-noviembre-201819-enero-2019

Una partición de un conjunto es una división del mismo en subconjuntos disjuntos no vacíos.

Definir la función

   esParticion :: Eq a => [[a]] -> Bool

1	esParticion :: Eq a => [[a]] -> Bool

tal que (esParticion xss) se verifica si xss es una partición; es decir sus elementos son listas no vacías disjuntas. Por ejemplo.

   esParticion [[1,3],[2],[9,5,7]]  ==  True
   esParticion [[1,3],[2],[9,5,1]]  ==  False
   esParticion [[1,3],[],[9,5,7]]   ==  False
   esParticion [[2,3,2],[4]]        ==  True

esParticion [[1,3],[2],[9,5,7]] == True

esParticion [[1,3],[2],[9,5,1]] == False

esParticion [[1,3],[],[9,5,7]] == False

esParticion [[2,3,2],[4]] == True

Soluciones

import Data.List ((\\), intersect)

-- 1ª definición
-- =============

esParticion :: Eq a => [[a]] -> Bool
esParticion xss =
  [] `notElem` xss &&
  and [disjuntos xs ys | xs <- xss, ys <- xss \\ [xs]] 

disjuntos :: Eq a => [a] -> [a] -> Bool
disjuntos xs ys = null (xs `intersect` ys)

-- 2ª definición
-- =============

esParticion2 :: Eq a => [[a]] -> Bool
esParticion2 []       = True
esParticion2 (xs:xss) =
  not (null xs) &&
  and [disjuntos xs ys | ys <- xss] &&
  esParticion2 xss

-- 3ª definición
-- =============

esParticion3 :: Eq a => [[a]] -> Bool
esParticion3 []       = True
esParticion3 (xs:xss) =
  not (null xs) &&
  all (disjuntos xs) xss &&
  esParticion3 xss

-- Equivalencia
prop_equiv :: [[Int]] -> Bool
prop_equiv xss =
  and [esParticion xss == f xss | f <- [ esParticion2
                                       , esParticion3]]

-- Comprobación
--    λ> quickCheck prop_equiv
--    +++ OK, passed 100 tests.

-- Comparación de eficiencia:
--    λ> esParticion [[x] | x <- [1..3000]]
--    True
--    (4.37 secs, 3,527,956,400 bytes)
--    λ> esParticion2 [[x] | x <- [1..3000]]
--    True
--    (1.26 secs, 1,045,792,552 bytes)
--    λ> esParticion3 [[x] | x <- [1..3000]]
--    True
--    (1.30 secs, 1,045,795,272 bytes)
--    λ> esParticion3 [[x] | x <- [1..3000]]
--    True
--    (1.30 secs, 1,045,795,272 bytes)

import Data.List ((\\), intersect)

-- 1ª definición

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

esParticion :: Eq a => [[a]] -> Bool

esParticion xss =

[] `notElem` xss &&

and [disjuntos xs ys | xs <- xss, ys <- xss \\ [xs]]

disjuntos :: Eq a => [a] -> [a] -> Bool

disjuntos xs ys = null (xs `intersect` ys)

-- 2ª definición

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

esParticion2 :: Eq a => [[a]] -> Bool

esParticion2 [] = True

esParticion2 (xs:xss) =

not (null xs) &&

and [disjuntos xs ys | ys <- xss] &&

esParticion2 xss

-- 3ª definición

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

esParticion3 :: Eq a => [[a]] -> Bool

esParticion3 [] = True

esParticion3 (xs:xss) =

not (null xs) &&

all (disjuntos xs) xss &&

esParticion3 xss

-- Equivalencia

prop_equiv :: [[Int]] -> Bool

prop_equiv xss =

and [esParticion xss == f xss | f <- [ esParticion2

, esParticion3]]

-- Comprobación

-- λ> quickCheck prop_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia:

-- λ> esParticion [[x] | x <- [1..3000]]

-- True

-- (4.37 secs, 3,527,956,400 bytes)

-- λ> esParticion2 [[x] | x <- [1..3000]]

-- True

-- (1.26 secs, 1,045,792,552 bytes)

-- λ> esParticion3 [[x] | x <- [1..3000]]

-- True

-- (1.30 secs, 1,045,795,272 bytes)

-- λ> esParticion3 [[x] | x <- [1..3000]]

-- True

-- (1.30 secs, 1,045,795,272 bytes)

Pensamiento

Sentía los cuatro vientos,
en la encrucijada
de su pensamiento.

Antonio Machado

Elementos con su doble en el conjunto

PorJosé A. Alonso 17-abril-201724-abril-2017

Definir la función

   conDoble :: [Int] -> [Int]

1	conDoble :: [Int] -> [Int]

tal que (conDoble xs) es la lista de los elementos del conjunto xs (representado como una lista sin elementos repetidos) cuyo doble pertenece a xs. Por ejemplo,

   conDoble [1, 4, 3, 2, 9, 7, 18, 22]  ==  [1,2,9]
   conDoble [2, 4, 8, 10]               ==  [2,4]
   conDoble [7, 5, 11, 13, 1, 3]        ==  []
   length (conDoble4 [1..10^6])         ==  500000

conDoble [1, 4, 3, 2, 9, 7, 18, 22] == [1,2,9]

conDoble [2, 4, 8, 10] == [2,4]

conDoble [7, 5, 11, 13, 1, 3] == []

length (conDoble4 [1..10^6]) == 500000

Referencia: Basado en el problema Doubles de POJ (Peking University Online Judge System).

Soluciones

import Data.List (intersect, sort)
import qualified Data.Set as S

-- 1ª Definición
conDoble :: [Int] -> [Int]
conDoble xs =
  [x | x <- xs, 2 * x `elem` xs]

-- 2ª Definición
conDoble2 :: [Int] -> [Int]
conDoble2 xs = aux (sort xs)
  where aux [] = []
        aux (y:ys) | 2 * y `elem` xs = y : aux ys
                   | otherwise       = aux ys

-- 3ª definición
conDoble3 :: [Int] -> [Int]
conDoble3 xs =
  sort (map (`div` 2) (xs `intersect` (map (*2) xs)))

-- 4ª definición
conDoble4 :: [Int] -> [Int]
conDoble4 xs =
  S.toList (S.map (`div` 2) (ys `S.intersection` (S.map (*2) ys)))
  where ys = S.fromList xs

-- Comparación de eficiencia
--    λ> length (conDoble [1..10^4])
--    5000
--    (3.27 secs, 0 bytes)
--    λ> length (conDoble2 [1..10^4])
--    5000
--    (3.42 secs, 0 bytes)
--    λ> length (conDoble3 [1..10^4])
--    5000
--    (4.78 secs, 0 bytes)
--    λ> length (conDoble4 [1..10^4])
--    5000
--    (0.02 secs, 0 bytes)

import Data.List (intersect, sort)

import qualified Data.Set as S

-- 1ª Definición

conDoble :: [Int] -> [Int]

conDoble xs =

[x | x <- xs, 2 * x `elem` xs]

-- 2ª Definición

conDoble2 :: [Int] -> [Int]

conDoble2 xs = aux (sort xs)

where aux [] = []

aux (y:ys) | 2 * y `elem` xs = y : aux ys

| otherwise = aux ys

-- 3ª definición

conDoble3 :: [Int] -> [Int]

conDoble3 xs =

sort (map (`div` 2) (xs `intersect` (map (*2) xs)))

-- 4ª definición

conDoble4 :: [Int] -> [Int]

conDoble4 xs =

S.toList (S.map (`div` 2) (ys `S.intersection` (S.map (*2) ys)))

where ys = S.fromList xs

-- Comparación de eficiencia

-- λ> length (conDoble [1..10^4])

-- 5000

-- (3.27 secs, 0 bytes)

-- λ> length (conDoble2 [1..10^4])

-- 5000

-- (3.42 secs, 0 bytes)

-- λ> length (conDoble3 [1..10^4])

-- 5000

-- (4.78 secs, 0 bytes)

-- λ> length (conDoble4 [1..10^4])

-- 5000

-- (0.02 secs, 0 bytes)

Máxima longitud de las sublistas comunes

PorJosé A. Alonso 9-marzo-201616-marzo-2016

Las sublistas comunes de «1325» y «36572» son «», «3»,»32″, «35», «2» y «5». El máximo de sus longitudes es 2.

Definir la función

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

1	maximo :: Eq a => [a] -> [a] -> Int

tal que (maximo xs ys) es el máximo de las longitudes de las sublistas comunes de xs e ys. Por ejemplo,

   maximo "1325" "36572"       == 2
   maximo [1,4..33] [2,4..33]  == 5
   maximo [1..10^6] [1..10^6]  == 100000

maximo "1325" "36572" == 2

maximo [1,4..33] [2,4..33] == 5

maximo [1..10^6] [1..10^6] == 100000

Soluciones

import Data.List (subsequences, intersect)

-- 1ª definición
-- =============

maximo1 :: Eq a => [a] -> [a] -> Int
maximo1 xs ys = 
    maximum (map length (sublistasComunes xs ys))

-- (sublistasComunes xs ys) es la lista de las sublistas comunes de xs e
-- ys. Por ejemplo,
sublistasComunes :: Eq a => [a] -> [a] -> [[a]]
sublistasComunes xs ys =
    subsequences xs `intersect` subsequences ys

-- 2ª definición
-- =============

maximo2 :: Eq a => [a] -> [a] -> Int
maximo2 l1@(x:xs) l2@(y:ys) 
    | x == y    = 1 + maximo2 xs ys
    | otherwise = max (maximo2 xs l2) (maximo2 l1 ys)  
maximo2 _ _ = 0

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

--    λ> maximo1 [1,4..30] [2,4..30]
--    5
--    (3.60 secs, 0 bytes)
--    λ> maximo2 [1,4..30] [2,4..30]
--    5
--    (1.58 secs, 216,347,472 bytes)
--    
--    λ> maximo2 [1..10^6] [1..10^6]
--    1000000
--    (2.44 secs, 407,051,096 bytes)

import Data.List (subsequences, intersect)

-- 1ª definición

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

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

maximo1 xs ys =

maximum (map length (sublistasComunes xs ys))

-- (sublistasComunes xs ys) es la lista de las sublistas comunes de xs e

-- ys. Por ejemplo,

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

sublistasComunes xs ys =

subsequences xs `intersect` subsequences ys

-- 2ª definición

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

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

maximo2 l1@(x:xs) l2@(y:ys)

| x == y = 1 + maximo2 xs ys

| otherwise = max (maximo2 xs l2) (maximo2 l1 ys)

maximo2 _ _ = 0

-- Comparación de eficiencia

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

-- λ> maximo1 [1,4..30] [2,4..30]

-- 5

-- (3.60 secs, 0 bytes)

-- λ> maximo2 [1,4..30] [2,4..30]

-- 5

-- (1.58 secs, 216,347,472 bytes)

-- λ> maximo2 [1..10^6] [1..10^6]

-- 1000000

-- (2.44 secs, 407,051,096 bytes)

Pares de enteros con sólo un factor primo común

PorJosé A. Alonso 31-marzo-201525-marzo-2022

Dos enteros positivos a y b se dirán relacionados si poseen, exactamente, un factor primo en común. Por ejemplo, 12 y 20 están relacionados, pero 6 y 30 no lo están.

Definir la lista infinita

   paresRel :: [(Int,Int)]

1	paresRel :: [(Int,Int)]

tal que paresRel enumera todos los pares (a,b), con 1 ≤ a < b, tal que a y b están relacionados. Por ejemplo,

   ghci> take 10 paresRel
   [(2,4),(2,6),(3,6),(4,6),(2,8),(4,8),(6,8),(3,9),(6,9),(2,10)]

1 2	ghci> take 10 paresRel [(2,4),(2,6),(3,6),(4,6),(2,8),(4,8),(6,8),(3,9),(6,9),(2,10)]

¿Qué lugar ocupa el par (51,111) en la lista infinita paresRel?

Soluciones

import Data.List (group, intersect, nub)
import Data.Numbers.Primes (primeFactors)

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

paresRel1 :: [(Int,Int)]
paresRel1 = [(a,b) | b <- [1..], a <- [1..b-1], relacionados a b]

relacionados :: Int -> Int -> Bool
relacionados a b = 
    length (nub (primeFactors a `intersect` primeFactors b)) == 1

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

paresRel2 :: [(Int,Int)]
paresRel2 = [(x,y) | y <- [4..], x <- [2..y-2], rel x y]
    where rel x y = m /= 1 && all (== head ps) ps
              where m  = gcd x y
                    ps = primeFactors m

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

paresRel3 :: [(Int,Int)]
paresRel3 =
    [(x,y) | y <- [2..], x <- [2..y-1], relacionados3 x y]

relacionados3 :: Int -> Int -> Bool
relacionados3 x y =
    length (group (primeFactors (gcd x y))) == 1

-- Comparación de eficiencia
--    λ> paresRel1 !! 40000
--    (216,489)
--    (3.19 secs, 1,825,423,056 bytes)
--    λ> paresRel2 !! 40000
--    (216,489)
--    (0.96 secs, 287,174,864 bytes)
--    λ> paresRel3 !! 40000
--    (216,489)
--    (0.70 secs, 264,137,928 bytes)

-- Cálculo
-- =======

-- El cálculo es
--    ghci> 1 + length (takeWhile (/=(51,111)) paresRel1)
--    2016

import Data.List (group, intersect, nub)

import Data.Numbers.Primes (primeFactors)

-- 1ª solución

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

paresRel1 :: [(Int,Int)]

paresRel1 = [(a,b) | b <- [1..], a <- [1..b-1], relacionados a b]

relacionados :: Int -> Int -> Bool

relacionados a b =

length (nub (primeFactors a `intersect` primeFactors b)) == 1

-- 2ª solución

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

paresRel2 :: [(Int,Int)]

paresRel2 = [(x,y) | y <- [4..], x <- [2..y-2], rel x y]

where rel x y = m /= 1 && all (== head ps) ps

where m = gcd x y

ps = primeFactors m

-- 3ª solución

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

paresRel3 :: [(Int,Int)]

paresRel3 =

[(x,y) | y <- [2..], x <- [2..y-1], relacionados3 x y]

relacionados3 :: Int -> Int -> Bool

relacionados3 x y =

length (group (primeFactors (gcd x y))) == 1

-- Comparación de eficiencia

-- λ> paresRel1 !! 40000

-- (216,489)

-- (3.19 secs, 1,825,423,056 bytes)

-- λ> paresRel2 !! 40000

-- (216,489)

-- (0.96 secs, 287,174,864 bytes)

-- λ> paresRel3 !! 40000

-- (216,489)

-- (0.70 secs, 264,137,928 bytes)

-- Cálculo

-- =======

-- El cálculo es

-- ghci> 1 + length (takeWhile (/=(51,111)) paresRel1)

-- 2016

Sucesión de números parientes

PorJosé A. Alonso 17-marzo-20151-mayo-2016

Se dice que dos números naturales son parientes sitienen exactamente un factor primo en común, independientemente de su multiplicidad. Por ejemplo,

Los números 12 (2²·3) y 40 (2³·5) son parientes, pues tienen al 2 como único factor primo en común.
Los números 49 (7²) y 63 (3²·7) son parientes, pues tienen al 7 como único factor primo en común.
Los números 12 (2²·3) y 30 (2·3·5) no son parientes, pues tienen dos factores primos en común.
Los números 49 (7²) y 25 (5²) no son parientes, pues no tienen factores primos en común.

Se dice que una lista de números naturales es una secuencia de parientes si cada par de números consecutivos son parientes. Por ejemplo,

La lista [12,40,35,28] es una secuencia de parientes.
La lista [12,30,21,49] no es una secuencia de parientes.

Definir la función

   secuenciaParientes :: [Integer] -> Bool

1	secuenciaParientes :: [Integer] -> Bool

tal que (secuenciaParientes xs) se verifica si xs es una secuencia de parientes. Por ejemplo,

   secuenciaParientes [12,40,35,28]           ==  True
   secuenciaParientes [12,30,21,49]           ==  False
   secuenciaParientes [2^n | n <- [1..2000]]  ==  True

secuenciaParientes [12,40,35,28] == True

secuenciaParientes [12,30,21,49] == False

secuenciaParientes [2^n | n <- [1..2000]] == True

Soluciones

import Data.List (intersect, nub)
import Data.Numbers.Primes (primes, primeFactors)

-- (parientes x y) se verifica si x e y son parientes. Por ejemplo,
--    parientes 12 40  ==  True
--    parientes 49 63  ==  True
--    parientes 12 30  ==  False
--    parientes 49 25  ==  False

-- 1ª definición (con gcd)
parientes1 :: Integer -> Integer -> Bool
parientes1 x y =
    length [p | p <- takeWhile (<= d) primes, d `mod` p == 0] == 1 
    where d = gcd x y

-- 2ª definición (con primeFactors)
parientes2 :: Integer -> Integer -> Bool
parientes2 0 0 = False
parientes2 x y = 
    length (nub (primeFactors x `intersect` primeFactors y)) == 1

-- Comparación de eficiencia
--    ghci> parientes1 (2^25) (2^25)
--    True
--    (34.34 secs, 15974866184 bytes)
--    ghci> parientes2 (2^25) (2^25)
--    True
--    (0.01 secs, 3093024 bytes)

-- Usaremos la 2ª definición
parientes :: Integer -> Integer -> Bool
parientes = parientes2

-- Definiciones de secuenciaParientes 
-- ==================================

-- 1ª definición (por recursión)
secuenciaParientes :: [Integer] -> Bool
secuenciaParientes []         = True
secuenciaParientes [x]        = True
secuenciaParientes (x1:x2:xs) =
    parientes x1 x2 && secuenciaParientes (x2:xs)

-- 2ª definición (por recursión con 2 ecuaciones)
secuenciaParientes2 :: [Integer] -> Bool
secuenciaParientes2 (x1:x2:xs) =
    parientes x1 x2 && secuenciaParientes2 (x2:xs)
secuenciaParientes2 _         = True

-- 3ª definición (sin recursión):
secuenciaParientes3 :: [Integer] -> Bool
secuenciaParientes3 xs = all (\(x,y) -> parientes x y) (zip xs (tail xs)) 

-- 4ª definición
secuenciaParientes4 :: [Integer] -> Bool
secuenciaParientes4 xs = all (uncurry parientes) (zip xs (tail xs))

import Data.List (intersect, nub)

import Data.Numbers.Primes (primes, primeFactors)

-- (parientes x y) se verifica si x e y son parientes. Por ejemplo,

-- parientes 12 40 == True

-- parientes 49 63 == True

-- parientes 12 30 == False

-- parientes 49 25 == False

-- 1ª definición (con gcd)

parientes1 :: Integer -> Integer -> Bool

parientes1 x y =

length [p | p <- takeWhile (<= d) primes, d `mod` p == 0] == 1

where d = gcd x y

-- 2ª definición (con primeFactors)

parientes2 :: Integer -> Integer -> Bool

parientes2 0 0 = False

parientes2 x y =

length (nub (primeFactors x `intersect` primeFactors y)) == 1

-- Comparación de eficiencia

-- ghci> parientes1 (2^25) (2^25)

-- True

-- (34.34 secs, 15974866184 bytes)

-- ghci> parientes2 (2^25) (2^25)

-- True

-- (0.01 secs, 3093024 bytes)

-- Usaremos la 2ª definición

parientes :: Integer -> Integer -> Bool

parientes = parientes2

-- Definiciones de secuenciaParientes

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

-- 1ª definición (por recursión)

secuenciaParientes :: [Integer] -> Bool

secuenciaParientes [] = True

secuenciaParientes [x] = True

secuenciaParientes (x1:x2:xs) =

parientes x1 x2 && secuenciaParientes (x2:xs)

-- 2ª definición (por recursión con 2 ecuaciones)

secuenciaParientes2 :: [Integer] -> Bool

secuenciaParientes2 (x1:x2:xs) =

parientes x1 x2 && secuenciaParientes2 (x2:xs)

secuenciaParientes2 _ = True

-- 3ª definición (sin recursión):

secuenciaParientes3 :: [Integer] -> Bool

secuenciaParientes3 xs = all (\(x,y) -> parientes x y) (zip xs (tail xs))

-- 4ª definición

secuenciaParientes4 :: [Integer] -> Bool

secuenciaParientes4 xs = all (uncurry parientes) (zip xs (tail xs))

Familias de números con algún dígito en común

Soluciones

Nuevas soluciones

Conjunto de primos relativos

Soluciones

Nuevas soluciones

Diferencia simétrica

Soluciones

Nuevas soluciones

Reconocimiento de particiones

Soluciones

Pensamiento

Elementos con su doble en el conjunto

Soluciones

Máxima longitud de las sublistas comunes

Soluciones

Sucesión de números parientes

Soluciones

Entradas recientes

Buscar

Correo electrónico