Data.List – Exercitium

Sucesión de sumas de dos números abundantes

PorJosé A. Alonso 17-mayo-202217-mayo-2022

Un número n es abundante si la suma de los divisores propios de n es mayor que n. El primer número abundante es el 12 (cuyos divisores propios son 1, 2, 3, 4 y 6 cuya suma es 16). Por tanto, el menor número que es la suma de dos números abundantes es el 24.

Definir la sucesión

   sumasDeDosAbundantes :: [Integer]

1	sumasDeDosAbundantes :: [Integer]

cuyos elementos son los números que se pueden escribir como suma de dos números abundantes. Por ejemplo,

   take 10 sumasDeDosAbundantes  ==  [24,30,32,36,38,40,42,44,48,50]

1	take 10 sumasDeDosAbundantes == [24,30,32,36,38,40,42,44,48,50]

Soluciones

import Data.List (genericLength, group)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck

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

sumasDeDosAbundantes1 :: [Integer]
sumasDeDosAbundantes1 = [n | n <- [1..], esSumaDeDosAbundantes n]

-- (esSumaDeDosAbundantes n) se verifica si n es suma de dos números
-- abundantes. Por ejemplo,
--    esSumaDeDosAbundantes 24           ==  True
--    any esSumaDeDosAbundantes [1..22]  ==  False
esSumaDeDosAbundantes :: Integer -> Bool
esSumaDeDosAbundantes n = (not . null) [x | x <- xs, n-x `elem` xs]
  where xs = takeWhile (<n) abundantes

-- abundantes es la lista de los números abundantes. Por ejemplo,
--    take 10 abundantes  ==  [12,18,20,24,30,36,40,42,48,54]
abundantes :: [Integer]
abundantes = [n | n <- [2..], abundante n]

-- (abundante n) se verifica si n es abundante. Por ejemplo,
--    abundante 12  ==  True
--    abundante 11  ==  False
abundante :: Integer -> Bool
abundante n = sum (divisores n) > n

-- (divisores n) es la lista de los divisores propios de n. Por ejemplo,
--    divisores 12  ==  [1,2,3,4,6]
divisores :: Integer -> [Integer]
divisores n = [x | x <- [1..n `div` 2], n `mod` x == 0]

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

sumasDeDosAbundantes2 :: [Integer]
sumasDeDosAbundantes2 = filter esSumaDeDosAbundantes2 [1..]

esSumaDeDosAbundantes2 :: Integer -> Bool
esSumaDeDosAbundantes2 n = (not . null) [x | x <- xs, n-x `elem` xs]
  where xs = takeWhile (<n) abundantes2

abundantes2 :: [Integer]
abundantes2 = filter abundante2 [2..]

abundante2 :: Integer -> Bool
abundante2 n = sumaDivisores n > n

sumaDivisores :: Integer -> Integer
sumaDivisores x =
  product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion x] - x

-- (factorizacion x) es la lista de las bases y exponentes de la
-- descomposición prima de x. Por ejemplo,
--    factorizacion 600  ==  [(2,3),(3,1),(5,2)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion = map primeroYlongitud . group . primeFactors

-- (primeroYlongitud xs) es el par formado por el primer elemento de xs
-- y la longitud de xs. Por ejemplo,
--    primeroYlongitud [3,2,5,7] == (3,4)
primeroYlongitud :: [a] -> (a,Integer)
primeroYlongitud (x:xs) =
  (x, 1 + genericLength xs)

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

-- La propiedad es
prop_sumasDeDosAbundantes :: Positive Int -> Bool
prop_sumasDeDosAbundantes (Positive n) =
  sumasDeDosAbundantes1 !! n == sumasDeDosAbundantes2 !! n

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

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

-- La comparación es
--    λ> sumasDeDosAbundantes1 !! (2*10^3)
--    2887
--    (2.54 secs, 516,685,168 bytes)
--    λ> sumasDeDosAbundantes2 !! (2*10^3)
--    2887
--    (1.43 secs, 141,606,136 bytes)

import Data.List (genericLength, group)

import Data.Numbers.Primes (primeFactors)

import Test.QuickCheck

-- 1ª solución

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

sumasDeDosAbundantes1 :: [Integer]

sumasDeDosAbundantes1 = [n | n <- [1..], esSumaDeDosAbundantes n]

-- (esSumaDeDosAbundantes n) se verifica si n es suma de dos números

-- abundantes. Por ejemplo,

-- esSumaDeDosAbundantes 24 == True

-- any esSumaDeDosAbundantes [1..22] == False

esSumaDeDosAbundantes :: Integer -> Bool

esSumaDeDosAbundantes n = (not . null) [x | x <- xs, n-x `elem` xs]

where xs = takeWhile (<n) abundantes

-- abundantes es la lista de los números abundantes. Por ejemplo,

-- take 10 abundantes == [12,18,20,24,30,36,40,42,48,54]

abundantes :: [Integer]

abundantes = [n | n <- [2..], abundante n]

-- (abundante n) se verifica si n es abundante. Por ejemplo,

-- abundante 12 == True

-- abundante 11 == False

abundante :: Integer -> Bool

abundante n = sum (divisores n) > n

-- (divisores n) es la lista de los divisores propios de n. Por ejemplo,

-- divisores 12 == [1,2,3,4,6]

divisores :: Integer -> [Integer]

divisores n = [x | x <- [1..n `div` 2], n `mod` x == 0]

-- 2ª solución

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

sumasDeDosAbundantes2 :: [Integer]

sumasDeDosAbundantes2 = filter esSumaDeDosAbundantes2 [1..]

esSumaDeDosAbundantes2 :: Integer -> Bool

esSumaDeDosAbundantes2 n = (not . null) [x | x <- xs, n-x `elem` xs]

where xs = takeWhile (<n) abundantes2

abundantes2 :: [Integer]

abundantes2 = filter abundante2 [2..]

abundante2 :: Integer -> Bool

abundante2 n = sumaDivisores n > n

sumaDivisores :: Integer -> Integer

sumaDivisores x =

product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion x] - x

-- (factorizacion x) es la lista de las bases y exponentes de la

-- descomposición prima de x. Por ejemplo,

-- factorizacion 600 == [(2,3),(3,1),(5,2)]

factorizacion :: Integer -> [(Integer,Integer)]

factorizacion = map primeroYlongitud . group . primeFactors

-- (primeroYlongitud xs) es el par formado por el primer elemento de xs

-- y la longitud de xs. Por ejemplo,

-- primeroYlongitud [3,2,5,7] == (3,4)

primeroYlongitud :: [a] -> (a,Integer)

primeroYlongitud (x:xs) =

(x, 1 + genericLength xs)

-- Comprobación de equivalencia

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

-- La propiedad es

prop_sumasDeDosAbundantes :: Positive Int -> Bool

prop_sumasDeDosAbundantes (Positive n) =

sumasDeDosAbundantes1 !! n == sumasDeDosAbundantes2 !! n

-- La comprobación es

-- λ> quickCheck prop_sumasDeDosAbundantes

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sumasDeDosAbundantes1 !! (2*10^3)

-- 2887

-- (2.54 secs, 516,685,168 bytes)

-- λ> sumasDeDosAbundantes2 !! (2*10^3)

-- 2887

-- (1.43 secs, 141,606,136 bytes)

El código se encuentra en GitHub.

Suma de divisores

PorJosé A. Alonso 16-mayo-2022

Definir la función

   sumaDivisores :: Integer -> Integer

1	sumaDivisores :: Integer -> Integer

tal que (sumaDivisores x) es la suma de los divisores de x. Por ejemplo,

   sumaDivisores 12  ==  28
   sumaDivisores 25  ==  31
   sumaDivisores (product [1..25])  ==  93383273455325195473152000
   length (show (sumaDivisores (product [1..30000])))  ==  121289
   maximum (map sumaDivisores [1..10^5])  ==  403200

sumaDivisores 12 == 28

sumaDivisores 25 == 31

sumaDivisores (product [1..25]) == 93383273455325195473152000

length (show (sumaDivisores (product [1..30000]))) == 121289

maximum (map sumaDivisores [1..10^5]) == 403200

Soluciones

import Data.List (genericLength, group, inits)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck

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

sumaDivisores1 :: Integer -> Integer
sumaDivisores1 = sum . divisores

-- (divisores x) es la lista de los divisores de x. Por ejemplo,
--    divisores 60  ==  [1,5,3,15,2,10,6,30,4,20,12,60]
divisores :: Integer -> [Integer]
divisores = map (product . concat)
          . productoCartesiano
          . map inits
          . group
          . primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos
-- xss. Por ejemplo,
--    λ> 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]]
productoCartesiano :: [[a]] -> [[a]]
productoCartesiano []       = [[]]
productoCartesiano (xs:xss) =
  [x:ys | x <- xs, ys <- productoCartesiano xss]

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

sumaDivisores2 :: Integer -> Integer
sumaDivisores2 = sum
               . map (product . concat)
               . sequence
               . map inits
               . group
               . primeFactors

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

-- Si la descomposición de x en factores primos es
--    x = p(1)^e(1) . p(2)^e(2) . .... . p(n)^e(n)
-- entonces la suma de los divisores de x es
--    p(1)^(e(1)+1) - 1     p(2)^(e(2)+1) - 1       p(n)^(e(2)+1) - 1
--   ------------------- . ------------------- ... -------------------
--        p(1)-1                p(2)-1                  p(n)-1
-- Ver la demostración en http://bit.ly/2zUXZPc

sumaDivisores3 :: Integer -> Integer
sumaDivisores3 x =
  product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion x]

-- (factorizacion x) es la lista de las bases y exponentes de la
-- descomposición prima de x. Por ejemplo,
--    factorizacion 600  ==  [(2,3),(3,1),(5,2)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion = map primeroYlongitud . group . primeFactors

-- (primeroYlongitud xs) es el par formado por el primer elemento de xs
-- y la longitud de xs. Por ejemplo,
--    primeroYlongitud [3,2,5,7] == (3,4)
primeroYlongitud :: [a] -> (a,Integer)
primeroYlongitud (x:xs) =
  (x, 1 + genericLength xs)

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

-- La propiedad es
prop_sumaDivisores :: Positive Integer -> Bool
prop_sumaDivisores (Positive x) =
  all (== sumaDivisores1 x)
      [ sumaDivisores2 x
      , sumaDivisores3 x
      ]

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

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

-- La comparación es
--   λ> sumaDivisores1 251888923423315469521109880000000
--   1471072204661054993275791673480320
--   (10.63 secs, 10,614,618,080 bytes)
--   λ> sumaDivisores2 251888923423315469521109880000000
--   1471072204661054993275791673480320
--   (2.51 secs, 5,719,399,056 bytes)
--   λ> sumaDivisores3 251888923423315469521109880000000
--   1471072204661054993275791673480320
--   (0.01 secs, 177,480 bytes)

import Data.List (genericLength, group, inits)

import Data.Numbers.Primes (primeFactors)

import Test.QuickCheck

-- 1ª solución

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

sumaDivisores1 :: Integer -> Integer

sumaDivisores1 = sum . divisores

-- (divisores x) es la lista de los divisores de x. Por ejemplo,

-- divisores 60 == [1,5,3,15,2,10,6,30,4,20,12,60]

divisores :: Integer -> [Integer]

divisores = map (product . concat)

. productoCartesiano

. map inits

. group

. primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos

-- xss. Por ejemplo,

-- λ> 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]]

productoCartesiano :: [[a]] -> [[a]]

productoCartesiano [] = [[]]

productoCartesiano (xs:xss) =

[x:ys | x <- xs, ys <- productoCartesiano xss]

-- 2ª solución

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

sumaDivisores2 :: Integer -> Integer

sumaDivisores2 = sum

. map (product . concat)

. sequence

. map inits

. group

. primeFactors

-- 3ª solución

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

-- Si la descomposición de x en factores primos es

-- x = p(1)^e(1) . p(2)^e(2) . .... . p(n)^e(n)

-- entonces la suma de los divisores de x es

-- p(1)^(e(1)+1) - 1 p(2)^(e(2)+1) - 1 p(n)^(e(2)+1) - 1

-- ------------------- . ------------------- ... -------------------

-- p(1)-1 p(2)-1 p(n)-1

-- Ver la demostración en http://bit.ly/2zUXZPc

sumaDivisores3 :: Integer -> Integer

sumaDivisores3 x =

product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion x]

-- (factorizacion x) es la lista de las bases y exponentes de la

-- descomposición prima de x. Por ejemplo,

-- factorizacion 600 == [(2,3),(3,1),(5,2)]

factorizacion :: Integer -> [(Integer,Integer)]

factorizacion = map primeroYlongitud . group . primeFactors

-- (primeroYlongitud xs) es el par formado por el primer elemento de xs

-- y la longitud de xs. Por ejemplo,

-- primeroYlongitud [3,2,5,7] == (3,4)

primeroYlongitud :: [a] -> (a,Integer)

primeroYlongitud (x:xs) =

(x, 1 + genericLength xs)

-- Comprobación de equivalencia

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

-- La propiedad es

prop_sumaDivisores :: Positive Integer -> Bool

prop_sumaDivisores (Positive x) =

all (== sumaDivisores1 x)

[ sumaDivisores2 x

, sumaDivisores3 x

]

-- La comprobación es

-- λ> quickCheck prop_sumaDivisores

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sumaDivisores1 251888923423315469521109880000000

-- 1471072204661054993275791673480320

-- (10.63 secs, 10,614,618,080 bytes)

-- λ> sumaDivisores2 251888923423315469521109880000000

-- 1471072204661054993275791673480320

-- (2.51 secs, 5,719,399,056 bytes)

-- λ> sumaDivisores3 251888923423315469521109880000000

-- 1471072204661054993275791673480320

-- (0.01 secs, 177,480 bytes)

El código se encuentra en GitHub.

Número de divisores

PorJosé A. Alonso 13-mayo-2022

Definir la función

   numeroDivisores :: Integer -> Integer

1	numeroDivisores :: Integer -> Integer

tal que (numeroDivisores x) es el número de divisores de x. Por ejemplo,

   numeroDivisores 12  ==  6
   numeroDivisores 25  ==  3
   length (show (numeroDivisores (product [1..3*10^4])))  ==  1948

numeroDivisores 12 == 6

numeroDivisores 25 == 3

length (show (numeroDivisores (product [1..3*10^4]))) == 1948

Soluciones

import Data.List (genericLength, group, inits)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck

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

numeroDivisores1 :: Integer -> Integer
numeroDivisores1 x =
  genericLength [y | y <- [1..x], x `mod` y == 0]

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

numeroDivisores2 :: Integer -> Integer
numeroDivisores2 1 = 1
numeroDivisores2 x
  | esCuadrado x = 2 * genericLength [y | y <- [1..raizEntera x], x `mod` y == 0] - 1
  | otherwise    = 2 * genericLength [y | y <- [1..raizEntera x], x `mod` y == 0]

-- (raizEntera x) es el mayor número entero cuyo cuadrado es menor o
-- igual que x. Por ejemplo,
--    raizEntera 3  ==  1
--    raizEntera 4  ==  2
--    raizEntera 5  ==  2
--    raizEntera 8  ==  2
--    raizEntera 9  ==  3
raizEntera :: Integer -> Integer
raizEntera x = floor (sqrt (fromInteger x))

-- (esCuadrado x) se verifica si x es un cuadrado perfecto. Por ejemplo,
--    esCuadrado 9  ==  True
--    esCuadrado 7  ==  False
esCuadrado :: Integer -> Bool
esCuadrado x =
  x == (raizEntera x)^2

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

numeroDivisores3 :: Integer -> Integer
numeroDivisores3 =
  genericLength . divisores

-- (divisores x) es la lista de los divisores de x. Por ejemplo,
--    divisores 12  ==  [1,3,2,6,4,12]
--    divisores 25  ==  [1,5,25]
divisores :: Integer -> [Integer]
divisores = map (product . concat)
          . productoCartesiano
          . map inits
          . group
          . primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos
-- xss. Por ejemplo,
--    λ> productoCartesiano [[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]]
productoCartesiano :: [[a]] -> [[a]]
productoCartesiano []       = [[]]
productoCartesiano (xs:xss) =
  [x:ys | x <- xs, ys <- productoCartesiano xss]

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

numeroDivisores4 :: Integer -> Integer
numeroDivisores4 = genericLength
                 . map (product . concat)
                 . sequence
                 . map inits
                 . group
                 . primeFactors

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

numeroDivisores5 :: Integer -> Integer
numeroDivisores5 =
  product . map ((+1) . genericLength) . group . primeFactors

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

-- La propiedad es
prop_numeroDivisores :: Positive Integer -> Bool
prop_numeroDivisores (Positive x) =
  all (== numeroDivisores1 x)
      [ numeroDivisores2 x
      , numeroDivisores3 x
      , numeroDivisores4 x
      , numeroDivisores5 x]

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

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

-- La comparación es
--    λ> numeroDivisores1 (product [1..10])
--    270
--    (1.67 secs, 726,327,208 bytes)
--    λ> numeroDivisores2 (product [1..10])
--    270
--    (0.01 secs, 929,000 bytes)
--
--    λ> numeroDivisores2 (product [1..16])
--    5376
--    (2.10 secs, 915,864,664 bytes)
--    λ> numeroDivisores3 (product [1..16])
--    5376
--    (0.01 secs, 548,472 bytes)
--
--    λ> numeroDivisores3 (product [1..30])
--    2332800
--    (3.80 secs, 4,149,811,688 bytes)
--    λ> numeroDivisores4 (product [1..30])
--    2332800
--    (0.59 secs, 722,253,848 bytes)
--    λ> numeroDivisores5 (product [1..30])
--    2332800
--    (0.00 secs, 587,856 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

124

import Data.List (genericLength, group, inits)

import Data.Numbers.Primes (primeFactors)

import Test.QuickCheck

-- 1ª solución

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

numeroDivisores1 :: Integer -> Integer

numeroDivisores1 x =

genericLength [y | y <- [1..x], x `mod` y == 0]

-- 2ª solución

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

numeroDivisores2 :: Integer -> Integer

numeroDivisores2 1 = 1

numeroDivisores2 x

| esCuadrado x = 2 * genericLength [y | y <- [1..raizEntera x], x `mod` y == 0] - 1

| otherwise = 2 * genericLength [y | y <- [1..raizEntera x], x `mod` y == 0]

-- (raizEntera x) es el mayor número entero cuyo cuadrado es menor o

-- igual que x. Por ejemplo,

-- raizEntera 3 == 1

-- raizEntera 4 == 2

-- raizEntera 5 == 2

-- raizEntera 8 == 2

-- raizEntera 9 == 3

raizEntera :: Integer -> Integer

raizEntera x = floor (sqrt (fromInteger x))

-- (esCuadrado x) se verifica si x es un cuadrado perfecto. Por ejemplo,

-- esCuadrado 9 == True

-- esCuadrado 7 == False

esCuadrado :: Integer -> Bool

esCuadrado x =

x == (raizEntera x)^2

-- 3ª solución

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

numeroDivisores3 :: Integer -> Integer

numeroDivisores3 =

genericLength . divisores

-- (divisores x) es la lista de los divisores de x. Por ejemplo,

-- divisores 12 == [1,3,2,6,4,12]

-- divisores 25 == [1,5,25]

divisores :: Integer -> [Integer]

divisores = map (product . concat)

. productoCartesiano

. map inits

. group

. primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos

-- xss. Por ejemplo,

-- λ> productoCartesiano [[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]]

productoCartesiano :: [[a]] -> [[a]]

productoCartesiano [] = [[]]

productoCartesiano (xs:xss) =

[x:ys | x <- xs, ys <- productoCartesiano xss]

-- 4ª solución

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

numeroDivisores4 :: Integer -> Integer

numeroDivisores4 = genericLength

. map (product . concat)

. sequence

. map inits

. group

. primeFactors

-- 5ª solución

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

numeroDivisores5 :: Integer -> Integer

numeroDivisores5 =

product . map ((+1) . genericLength) . group . primeFactors

-- Comprobación de equivalencia

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

-- La propiedad es

prop_numeroDivisores :: Positive Integer -> Bool

prop_numeroDivisores (Positive x) =

all (== numeroDivisores1 x)

[ numeroDivisores2 x

, numeroDivisores3 x

, numeroDivisores4 x

, numeroDivisores5 x]

-- La comprobación es

-- λ> quickCheck prop_numeroDivisores

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> numeroDivisores1 (product [1..10])

-- 270

-- (1.67 secs, 726,327,208 bytes)

-- λ> numeroDivisores2 (product [1..10])

-- 270

-- (0.01 secs, 929,000 bytes)

-- λ> numeroDivisores2 (product [1..16])

-- 5376

-- (2.10 secs, 915,864,664 bytes)

-- λ> numeroDivisores3 (product [1..16])

-- 5376

-- (0.01 secs, 548,472 bytes)

-- λ> numeroDivisores3 (product [1..30])

-- 2332800

-- (3.80 secs, 4,149,811,688 bytes)

-- λ> numeroDivisores4 (product [1..30])

-- 2332800

-- (0.59 secs, 722,253,848 bytes)

-- λ> numeroDivisores5 (product [1..30])

-- 2332800

-- (0.00 secs, 587,856 bytes)

El código se encuentra en GitHub.

Conjunto de divisores

PorJosé A. Alonso 12-mayo-202212-mayo-2022

Definir la función

   divisores :: Integer -> [Integer]

1	divisores :: Integer -> [Integer]

tal que (divisores x) es el conjunto de divisores de x. Por ejemplo,

  divisores 30  ==  [1,2,3,5,6,10,15,30]
  length (divisores (product [1..10]))  ==  270
  length (divisores (product [1..25]))  ==  340032

divisores 30 == [1,2,3,5,6,10,15,30]

length (divisores (product [1..10])) == 270

length (divisores (product [1..25])) == 340032

Soluciones

import Data.List (group, inits, nub, sort, subsequences)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck

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

divisores1 :: Integer -> [Integer]
divisores1 n = [x | x <- [1..n], n `rem` x == 0]

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

divisores2 :: Integer -> [Integer]
divisores2 n = filter ((== 0) . mod n) [1..n]

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

divisores3 :: Integer -> [Integer]
divisores3 =
  nub . sort . map product . subsequences . primeFactors

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

divisores4 :: Integer -> [Integer]
divisores4 =
  sort
  . map (product . concat)
  . productoCartesiano
  . map inits
  . group
  . primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos
-- xss. Por ejemplo,
--    λ> productoCartesiano [[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]]
productoCartesiano :: [[a]] -> [[a]]
productoCartesiano []       = [[]]
productoCartesiano (xs:xss) =
  [x:ys | x <- xs, ys <- productoCartesiano xss]

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

divisores5 :: Integer -> [Integer]
divisores5 = sort
           . map (product . concat)
           . sequence
           . map inits
           . group
           . primeFactors

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

-- La propiedad es
prop_divisores :: Positive Integer -> Bool
prop_divisores (Positive n) =
  all (== divisores1 n)
      [ divisores2 n
      , divisores3 n
      , divisores4 n
      , divisores5 n
      ]

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

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

--    λ> length (divisores (product [1..11]))
--    540
--    (12.51 secs, 7,983,499,736 bytes)
--    λ> length (divisores2 (product [1..11]))
--    540
--    (4.81 secs, 4,790,146,656 bytes)
--    λ> length (divisores3 (product [1..11]))
--    540
--    (0.10 secs, 107,339,848 bytes)
--    λ> length (divisores4 (product [1..11]))
--    540
--    (0.02 secs, 1,702,616 bytes)
--    λ> length (divisores5 (product [1..11]))
--    540
--    (0.02 secs, 1,205,824 bytes)
--
--    λ> length (divisores3 (product [1..14]))
--    2592
--    (7.89 secs, 9,378,454,912 bytes)
--    λ> length (divisores4 (product [1..14]))
--    2592
--    (0.03 secs, 9,426,528 bytes)
--    λ> length (divisores5 (product [1..14]))
--    2592
--    (0.02 secs, 6,636,608 bytes)
--    
--    λ> length (divisores4 (product [1..25]))
--    340032
--    (1.65 secs, 2,055,558,208 bytes)
--    λ> length (divisores5 (product [1..25]))
--    340032
--    (0.88 secs, 1,532,515,304 bytes)

100

101

102

103

104

105

106

107

import Data.List (group, inits, nub, sort, subsequences)

import Data.Numbers.Primes (primeFactors)

import Test.QuickCheck

-- 1ª solución

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

divisores1 :: Integer -> [Integer]

divisores1 n = [x | x <- [1..n], n `rem` x == 0]

-- 2ª solución

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

divisores2 :: Integer -> [Integer]

divisores2 n = filter ((== 0) . mod n) [1..n]

-- 3ª solución

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

divisores3 :: Integer -> [Integer]

divisores3 =

nub . sort . map product . subsequences . primeFactors

-- 4ª solución

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

divisores4 :: Integer -> [Integer]

divisores4 =

sort

. map (product . concat)

. productoCartesiano

. map inits

. group

. primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos

-- xss. Por ejemplo,

-- λ> productoCartesiano [[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]]

productoCartesiano :: [[a]] -> [[a]]

productoCartesiano [] = [[]]

productoCartesiano (xs:xss) =

[x:ys | x <- xs, ys <- productoCartesiano xss]

-- 5ª solución

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

divisores5 :: Integer -> [Integer]

divisores5 = sort

. map (product . concat)

. sequence

. map inits

. group

. primeFactors

-- Comprobación de equivalencia

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

-- La propiedad es

prop_divisores :: Positive Integer -> Bool

prop_divisores (Positive n) =

all (== divisores1 n)

[ divisores2 n

, divisores3 n

, divisores4 n

, divisores5 n

]

-- La comprobación es

-- λ> quickCheck prop_divisores

-- +++ OK, passed 100 tests.

-- Comparación de la eficiencia

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

-- λ> length (divisores (product [1..11]))

-- 540

-- (12.51 secs, 7,983,499,736 bytes)

-- λ> length (divisores2 (product [1..11]))

-- 540

-- (4.81 secs, 4,790,146,656 bytes)

-- λ> length (divisores3 (product [1..11]))

-- 540

-- (0.10 secs, 107,339,848 bytes)

-- λ> length (divisores4 (product [1..11]))

-- 540

-- (0.02 secs, 1,702,616 bytes)

-- λ> length (divisores5 (product [1..11]))

-- 540

-- (0.02 secs, 1,205,824 bytes)

-- λ> length (divisores3 (product [1..14]))

-- 2592

-- (7.89 secs, 9,378,454,912 bytes)

-- λ> length (divisores4 (product [1..14]))

-- 2592

-- (0.03 secs, 9,426,528 bytes)

-- λ> length (divisores5 (product [1..14]))

-- 2592

-- (0.02 secs, 6,636,608 bytes)

-- λ> length (divisores4 (product [1..25]))

-- 340032

-- (1.65 secs, 2,055,558,208 bytes)

-- λ> length (divisores5 (product [1..25]))

-- 340032

-- (0.88 secs, 1,532,515,304 bytes)

El código se encuentra en GitHub.

Mínimo producto escalar

PorJosé A. Alonso 9-mayo-202214-mayo-2022

El producto escalar de los vectores [a1,a2,…,an] y [b1,b2,…, bn] es

   a1 * b1 + a2 * b2 + ··· + an * bn.

1	a1 * b1 + a2 * b2 + ··· + an * bn.

Definir la función

   menorProductoEscalar :: (Ord a, Num a) => [a] -> [a] -> a

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

tal que (menorProductoEscalar xs ys) es el mínimo de los productos escalares de las permutaciones de xs y de las permutaciones de ys. Por ejemplo,

   menorProductoEscalar [3,2,5]  [1,4,6]    == 29
   menorProductoEscalar [3,2,5]  [1,4,-6]   == -19
   menorProductoEscalar [1..10^2] [1..10^2] == 171700
   menorProductoEscalar [1..10^3] [1..10^3] == 167167000
   menorProductoEscalar [1..10^4] [1..10^4] == 166716670000
   menorProductoEscalar [1..10^5] [1..10^5] == 166671666700000
   menorProductoEscalar [1..10^6] [1..10^6] == 166667166667000000

menorProductoEscalar [3,2,5] [1,4,6] == 29

menorProductoEscalar [3,2,5] [1,4,-6] == -19

menorProductoEscalar [1..10^2] [1..10^2] == 171700

menorProductoEscalar [1..10^3] [1..10^3] == 167167000

menorProductoEscalar [1..10^4] [1..10^4] == 166716670000

menorProductoEscalar [1..10^5] [1..10^5] == 166671666700000

menorProductoEscalar [1..10^6] [1..10^6] == 166667166667000000

Soluciones

module Minimo_producto_escalar where

import Data.List (sort, permutations)
import Test.QuickCheck (quickCheck)

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

menorProductoEscalar1 :: (Ord a, Num a) => [a] -> [a] -> a
menorProductoEscalar1 xs ys =
  minimum [sum (zipWith (*) pxs pys) | pxs <- permutations xs,
                                       pys <- permutations ys]

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

menorProductoEscalar2 :: (Ord a, Num a) => [a] -> [a] -> a
menorProductoEscalar2 xs ys =
  minimum [sum (zipWith (*) pxs ys) | pxs <- permutations xs]

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

menorProductoEscalar3 :: (Ord a, Num a) => [a] -> [a] -> a
menorProductoEscalar3 xs ys =
  sum (zipWith (*) (sort xs) (reverse (sort ys)))

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

-- La propiedad es
prop_menorProductoEscalar :: [Integer] -> [Integer] -> Bool
prop_menorProductoEscalar xs ys =
  all (== menorProductoEscalar1 xs' ys')
      [menorProductoEscalar2 xs' ys',
       menorProductoEscalar3 xs' ys']
  where n   = min (length xs) (length ys)
        xs' = take n xs
        ys' = take n ys

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

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

-- La comparación es
--    λ> menorProductoEscalar1 [0..5] [0..5]
--    20
--    (3.24 secs, 977385528 bytes)
--    λ> menorProductoEscalar2 [0..5] [0..5]
--    20
--    (0.01 secs, 4185776 bytes)
--
--    λ> menorProductoEscalar2 [0..9] [0..9]
--    120
--    (23.86 secs, 9342872784 bytes)
--    λ> menorProductoEscalar3 [0..9] [0..9]
--    120
--    (0.01 secs, 2580824 bytes)
--
--    λ> menorProductoEscalar3 [0..10^6] [0..10^6]
--    166666666666500000
--    (2.46 secs, 473,338,912 bytes)

module Minimo_producto_escalar where

import Data.List (sort, permutations)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

menorProductoEscalar1 :: (Ord a, Num a) => [a] -> [a] -> a

menorProductoEscalar1 xs ys =

minimum [sum (zipWith (*) pxs pys) | pxs <- permutations xs,

pys <- permutations ys]

-- 2ª solución

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

menorProductoEscalar2 :: (Ord a, Num a) => [a] -> [a] -> a

menorProductoEscalar2 xs ys =

minimum [sum (zipWith (*) pxs ys) | pxs <- permutations xs]

-- 3ª solución

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

menorProductoEscalar3 :: (Ord a, Num a) => [a] -> [a] -> a

menorProductoEscalar3 xs ys =

sum (zipWith (*) (sort xs) (reverse (sort ys)))

-- Equivalencia

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

-- La propiedad es

prop_menorProductoEscalar :: [Integer] -> [Integer] -> Bool

prop_menorProductoEscalar xs ys =

all (== menorProductoEscalar1 xs' ys')

[menorProductoEscalar2 xs' ys',

menorProductoEscalar3 xs' ys']

where n = min (length xs) (length ys)

xs' = take n xs

ys' = take n ys

-- La comprobación es

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

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> menorProductoEscalar1 [0..5] [0..5]

-- 20

-- (3.24 secs, 977385528 bytes)

-- λ> menorProductoEscalar2 [0..5] [0..5]

-- 20

-- (0.01 secs, 4185776 bytes)

-- λ> menorProductoEscalar2 [0..9] [0..9]

-- 120

-- (23.86 secs, 9342872784 bytes)

-- λ> menorProductoEscalar3 [0..9] [0..9]

-- 120

-- (0.01 secs, 2580824 bytes)

-- λ> menorProductoEscalar3 [0..10^6] [0..10^6]

-- 166666666666500000

-- (2.46 secs, 473,338,912 bytes)

El código se encuentra en GitHub.

Clausura de un conjunto respecto de una función

PorJosé A. Alonso 2-mayo-20223-mayo-2022

Un conjunto A está cerrado respecto de una función f si para elemento x de A se tiene que f(x) pertenece a A. La clausura de un conjunto B respecto de una función f es el menor conjunto A que contiene a B y es cerrado respecto de f. Por ejemplo, la clausura de {0,1,2] respecto del opuesto es {-2,-1,0,1,2}.

Definir la función

   clausura :: Ord a => (a -> a) -> [a] -> [a]

1	clausura :: Ord a => (a -> a) -> [a] -> [a]

tal que (clausura f xs) es la clausura de xs respecto de f. Por ejemplo,

   clausura (\x -> -x) [0,1,2]         ==  [-2,-1,0,1,2]
   clausura (\x -> (x+1) `mod` 5) [0]  ==  [0,1,2,3,4]
   length (clausura (\x -> (x+1) `mod` (10^6)) [0]) == 1000000

clausura (\x -> -x) [0,1,2] == [-2,-1,0,1,2]

clausura (\x -> (x+1) `mod` 5) [0] == [0,1,2,3,4]

length (clausura (\x -> (x+1) `mod` (10^6)) [0]) == 1000000

Soluciones

module Clausura where

import Data.List ((\\), nub, sort, union)
import Test.QuickCheck.HigherOrder (quickCheck')
import qualified Data.Set as S (Set, difference, fromList, map, null, toList, union)

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

clausura1 :: Ord a => (a -> a) -> [a] -> [a]
clausura1 f xs
  | esCerrado f xs = sort xs
  | otherwise      = clausura1 f (expansion f xs)

-- (esCerrado f xs) se verifica si al aplicar f a cualquier elemento de
-- xs se obtiene un elemento de xs. Por ejemplo,
--    λ> esCerrado (\x -> -x) [0,1,2]
--    False
--    λ> esCerrado (\x -> -x) [0,1,2,-2,-1]
--    True
esCerrado :: Ord a => (a -> a) -> [a] -> Bool
esCerrado f xs = all (`elem` xs) (map f xs)

-- (expansion f xs) es la lista (sin repeticiones) obtenidas añadiéndole
-- a xs el resulta de aplicar f a sus elementos. Por ejemplo,
--    expansion (\x -> -x) [0,1,2]  ==  [0,1,2,-1,-2]
expansion :: Ord a => (a -> a) -> [a] -> [a]
expansion f xs = xs `union` map f xs

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

clausura2 :: Ord a => (a -> a) -> [a] -> [a]
clausura2 f xs = sort (until (esCerrado f) (expansion f) xs)

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

clausura3 :: Ord a => (a -> a) -> [a] -> [a]
clausura3 f xs = aux xs xs
  where aux ys vs | null ns   = sort vs
                  | otherwise = aux ns (vs ++ ns)
          where ns = nub (map f ys) \\ vs

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

clausura4 :: Ord a => (a -> a) -> [a] -> [a]
clausura4 f xs = S.toList (clausura4' f (S.fromList xs))

clausura4' :: Ord a => (a -> a) -> S.Set a -> S.Set a
clausura4' f xs = aux xs xs
  where aux ys vs | S.null ns = vs
                  | otherwise = aux ns (vs `S.union` ns)
          where ns = S.map f ys `S.difference` vs

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

-- La propiedad es
prop_clausura :: (Int -> Int) -> [Int] -> Bool
prop_clausura f xs =
  all (== clausura1 f xs')
      [ clausura2 f xs'
      , clausura3 f xs'
      , clausura4 f xs'
      ]
  where xs' = sort (nub xs)

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

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

-- La comparación es
--    λ> length (clausura1 (\x -> (x+1) `mod` 800) [0])
--    800
--    (1.95 secs, 213,481,560 bytes)
--    λ> length (clausura2 (\x -> (x+1) `mod` 800) [0])
--    800
--    (1.96 secs, 213,372,824 bytes)
--    λ> length (clausura3 (\x -> (x+1) `mod` 800) [0])
--    800
--    (0.03 secs, 42,055,128 bytes)
--    λ> length (clausura4 (\x -> (x+1) `mod` 800) [0])
--    800
--    (0.01 secs, 1,779,768 bytes)
--
--    λ> length (clausura3 (\x -> (x+1) `mod` (10^4)) [0])
--    10000
--    (2.50 secs, 8,080,105,816 bytes)
--    λ> length (clausura4 (\x -> (x+1) `mod` (10^4)) [0])
--    10000
--    (0.05 secs, 27,186,920 bytes)

module Clausura where

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

import Test.QuickCheck.HigherOrder (quickCheck')

import qualified Data.Set as S (Set, difference, fromList, map, null, toList, union)

-- 1ª solución

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

clausura1 :: Ord a => (a -> a) -> [a] -> [a]

clausura1 f xs

| esCerrado f xs = sort xs

| otherwise = clausura1 f (expansion f xs)

-- (esCerrado f xs) se verifica si al aplicar f a cualquier elemento de

-- xs se obtiene un elemento de xs. Por ejemplo,

-- λ> esCerrado (\x -> -x) [0,1,2]

-- False

-- λ> esCerrado (\x -> -x) [0,1,2,-2,-1]

-- True

esCerrado :: Ord a => (a -> a) -> [a] -> Bool

esCerrado f xs = all (`elem` xs) (map f xs)

-- (expansion f xs) es la lista (sin repeticiones) obtenidas añadiéndole

-- a xs el resulta de aplicar f a sus elementos. Por ejemplo,

-- expansion (\x -> -x) [0,1,2] == [0,1,2,-1,-2]

expansion :: Ord a => (a -> a) -> [a] -> [a]

expansion f xs = xs `union` map f xs

-- 2ª solución

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

clausura2 :: Ord a => (a -> a) -> [a] -> [a]

clausura2 f xs = sort (until (esCerrado f) (expansion f) xs)

-- 3ª solución

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

clausura3 :: Ord a => (a -> a) -> [a] -> [a]

clausura3 f xs = aux xs xs

where aux ys vs | null ns = sort vs

| otherwise = aux ns (vs ++ ns)

where ns = nub (map f ys) \\ vs

-- 4ª solución

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

clausura4 :: Ord a => (a -> a) -> [a] -> [a]

clausura4 f xs = S.toList (clausura4' f (S.fromList xs))

clausura4' :: Ord a => (a -> a) -> S.Set a -> S.Set a

clausura4' f xs = aux xs xs

where aux ys vs | S.null ns = vs

| otherwise = aux ns (vs `S.union` ns)

where ns = S.map f ys `S.difference` vs

-- Comprobación de equivalencia

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

-- La propiedad es

prop_clausura :: (Int -> Int) -> [Int] -> Bool

prop_clausura f xs =

all (== clausura1 f xs')

[ clausura2 f xs'

, clausura3 f xs'

, clausura4 f xs'

]

where xs' = sort (nub xs)

-- La comprobación es

-- λ> quickCheck' prop_clausura

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (clausura1 (\x -> (x+1) `mod` 800) [0])

-- 800

-- (1.95 secs, 213,481,560 bytes)

-- λ> length (clausura2 (\x -> (x+1) `mod` 800) [0])

-- 800

-- (1.96 secs, 213,372,824 bytes)

-- λ> length (clausura3 (\x -> (x+1) `mod` 800) [0])

-- 800

-- (0.03 secs, 42,055,128 bytes)

-- λ> length (clausura4 (\x -> (x+1) `mod` 800) [0])

-- 800

-- (0.01 secs, 1,779,768 bytes)

-- λ> length (clausura3 (\x -> (x+1) `mod` (10^4)) [0])

-- 10000

-- (2.50 secs, 8,080,105,816 bytes)

-- λ> length (clausura4 (\x -> (x+1) `mod` (10^4)) [0])

-- 10000

-- (0.05 secs, 27,186,920 bytes)

El código se encuentra en GitHub.

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

Representación de Zeckendorf

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

Los primeros números de Fibonacci son

   1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, ...

1	1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, ...

tales que los dos primeros son iguales a 1 y los siguientes se obtienen sumando los dos anteriores.

El teorema de Zeckendorf establece que todo entero positivo n se puede representar, de manera única, como la suma de números de Fibonacci no consecutivos decrecientes. Dicha suma se llama la representación de Zeckendorf de n. Por ejemplo, la representación de Zeckendorf de 100 es

   100 = 89 + 8 + 3

1	100 = 89 + 8 + 3

Hay otras formas de representar 100 como sumas de números de Fibonacci; por ejemplo,

   100 = 89 +  8 + 2 + 1
   100 = 55 + 34 + 8 + 3

1 2	100 = 89 + 8 + 2 + 1 100 = 55 + 34 + 8 + 3

pero no son representaciones de Zeckendorf porque 1 y 2 son números de Fibonacci consecutivos, al igual que 34 y 55.

Definir la función

   zeckendorf :: Integer -> [Integer]

1	zeckendorf :: Integer -> [Integer]

tal que (zeckendorf n) es la representación de Zeckendorf de n. Por ejemplo,

   zeckendorf 100 == [89,8,3]
   zeckendorf 200 == [144,55,1]
   zeckendorf 300 == [233,55,8,3,1]
   length (zeckendorf (10^50000)) == 66097

zeckendorf 100 == [89,8,3]

zeckendorf 200 == [144,55,1]

zeckendorf 300 == [233,55,8,3,1]

length (zeckendorf (10^50000)) == 66097

Soluciones

module Representacion_de_Zeckendorf where

import Data.List (subsequences)
import Test.QuickCheck

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

zeckendorf1 :: Integer -> [Integer]
zeckendorf1 = head . zeckendorf1Aux

zeckendorf1Aux :: Integer -> [[Integer]]
zeckendorf1Aux n =
  [xs | xs <- subsequences (reverse (takeWhile (<= n) (tail fibs))),
        sum xs == n,
        sinFibonacciConsecutivos xs]

-- fibs es la la sucesión de los números de Fibonacci. Por ejemplo,
--    take 14 fibs  == [1,1,2,3,5,8,13,21,34,55,89,144,233,377]
fibs :: [Integer]
fibs = 1 : scanl (+) 1 fibs
-- (sinFibonacciConsecutivos xs) se verifica si en la sucesión
-- decreciente de número de Fibonacci xs no hay dos consecutivos. Por
-- ejemplo, 

-- (sinFibonacciConsecutivos xs) se verifica si en la sucesión
-- decreciente de número de Fibonacci xs no hay dos consecutivos. Por
-- ejemplo, 
--    sinFibonacciConsecutivos [89, 8, 3]      ==  True
--    sinFibonacciConsecutivos [55, 34, 8, 3]  ==  False
sinFibonacciConsecutivos :: [Integer] -> Bool
sinFibonacciConsecutivos xs =
  and [x /= siguienteFibonacci y | (x,y) <- zip xs (tail xs)]

-- (siguienteFibonacci n) es el menor número de Fibonacci mayor que
-- n. Por ejemplo, 
--    siguienteFibonacci 34  ==  55
siguienteFibonacci :: Integer -> Integer
siguienteFibonacci n =
  head (dropWhile (<= n) fibs)

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

zeckendorf2 :: Integer -> [Integer]
zeckendorf2 = head . zeckendorf2Aux

zeckendorf2Aux :: Integer -> [[Integer]]
zeckendorf2Aux n = map reverse (aux n (tail fibs))
  where aux 0 _ = [[]]
        aux m (x:y:zs)
            | x <= m     = [x:xs | xs <- aux (m-x) zs] ++ aux m (y:zs)
            | otherwise  = []

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

zeckendorf3 :: Integer -> [Integer]
zeckendorf3 0 = []
zeckendorf3 n = x : zeckendorf3 (n - x)
  where x = last (takeWhile (<= n) fibs)

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

zeckendorf4 :: Integer -> [Integer]
zeckendorf4 n = aux n (reverse (takeWhile (<= n) fibs))
  where aux 0 _      = []
        aux m (x:xs) = x : aux (m-x) (dropWhile (>m-x) xs)

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

-- La propiedad es
prop_zeckendorf :: Positive Integer -> Bool
prop_zeckendorf (Positive n) =
  all (== zeckendorf1 n)
      [zeckendorf2 n,
       zeckendorf3 n,
       zeckendorf4 n]

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

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

-- La comparación es
--    λ> zeckendorf1 (7*10^4)
--    [46368,17711,4181,1597,89,34,13,5,2]
--    (1.49 secs, 2,380,707,744 bytes)
--    λ> zeckendorf2 (7*10^4)
--    [46368,17711,4181,1597,89,34,13,5,2]
--    (0.07 secs, 21,532,008 bytes)
--
--    λ> zeckendorf2 (10^6)
--    [832040,121393,46368,144,55]
--    (1.40 secs, 762,413,432 bytes)
--    λ> zeckendorf3 (10^6)
--    [832040,121393,46368,144,55]
--    (0.01 secs, 542,488 bytes)
--    λ> zeckendorf4 (10^6)
--    [832040,121393,46368,144,55]
--    (0.01 secs, 536,424 bytes)
--
--    λ> length (zeckendorf3 (10^3000))
--    3947
--    (3.02 secs, 1,611,966,408 bytes)
--    λ> length (zeckendorf4 (10^2000))
--    2611
--    (0.02 secs, 10,434,336 bytes)
--
--    λ> length (zeckendorf4 (10^50000))
--    66097
--    (2.84 secs, 3,976,483,760 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

module Representacion_de_Zeckendorf where

import Data.List (subsequences)

import Test.QuickCheck

-- 1ª solución

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

zeckendorf1 :: Integer -> [Integer]

zeckendorf1 = head . zeckendorf1Aux

zeckendorf1Aux :: Integer -> [[Integer]]

zeckendorf1Aux n =

[xs | xs <- subsequences (reverse (takeWhile (<= n) (tail fibs))),

sum xs == n,

sinFibonacciConsecutivos xs]

-- fibs es la la sucesión de los números de Fibonacci. Por ejemplo,

-- take 14 fibs == [1,1,2,3,5,8,13,21,34,55,89,144,233,377]

fibs :: [Integer]

fibs = 1 : scanl (+) 1 fibs

-- (sinFibonacciConsecutivos xs) se verifica si en la sucesión

-- decreciente de número de Fibonacci xs no hay dos consecutivos. Por

-- ejemplo,

-- (sinFibonacciConsecutivos xs) se verifica si en la sucesión

-- decreciente de número de Fibonacci xs no hay dos consecutivos. Por

-- ejemplo,

-- sinFibonacciConsecutivos [89, 8, 3] == True

-- sinFibonacciConsecutivos [55, 34, 8, 3] == False

sinFibonacciConsecutivos :: [Integer] -> Bool

sinFibonacciConsecutivos xs =

and [x /= siguienteFibonacci y | (x,y) <- zip xs (tail xs)]

-- (siguienteFibonacci n) es el menor número de Fibonacci mayor que

-- n. Por ejemplo,

-- siguienteFibonacci 34 == 55

siguienteFibonacci :: Integer -> Integer

siguienteFibonacci n =

head (dropWhile (<= n) fibs)

-- 2ª solución

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

zeckendorf2 :: Integer -> [Integer]

zeckendorf2 = head . zeckendorf2Aux

zeckendorf2Aux :: Integer -> [[Integer]]

zeckendorf2Aux n = map reverse (aux n (tail fibs))

where aux 0 _ = [[]]

aux m (x:y:zs)

| x <= m = [x:xs | xs <- aux (m-x) zs] ++ aux m (y:zs)

| otherwise = []

-- 3ª solución

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

zeckendorf3 :: Integer -> [Integer]

zeckendorf3 0 = []

zeckendorf3 n = x : zeckendorf3 (n - x)

where x = last (takeWhile (<= n) fibs)

-- 4ª solución

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

zeckendorf4 :: Integer -> [Integer]

zeckendorf4 n = aux n (reverse (takeWhile (<= n) fibs))

where aux 0 _ = []

aux m (x:xs) = x : aux (m-x) (dropWhile (>m-x) xs)

-- Comprobación de equivalencia

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

-- La propiedad es

prop_zeckendorf :: Positive Integer -> Bool

prop_zeckendorf (Positive n) =

all (== zeckendorf1 n)

[zeckendorf2 n,

zeckendorf3 n,

zeckendorf4 n]

-- La comprobación es

-- λ> quickCheck prop_zeckendorf

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> zeckendorf1 (7*10^4)

-- [46368,17711,4181,1597,89,34,13,5,2]

-- (1.49 secs, 2,380,707,744 bytes)

-- λ> zeckendorf2 (7*10^4)

-- [46368,17711,4181,1597,89,34,13,5,2]

-- (0.07 secs, 21,532,008 bytes)

-- λ> zeckendorf2 (10^6)

-- [832040,121393,46368,144,55]

-- (1.40 secs, 762,413,432 bytes)

-- λ> zeckendorf3 (10^6)

-- [832040,121393,46368,144,55]

-- (0.01 secs, 542,488 bytes)

-- λ> zeckendorf4 (10^6)

-- [832040,121393,46368,144,55]

-- (0.01 secs, 536,424 bytes)

-- λ> length (zeckendorf3 (10^3000))

-- 3947

-- (3.02 secs, 1,611,966,408 bytes)

-- λ> length (zeckendorf4 (10^2000))

-- 2611

-- (0.02 secs, 10,434,336 bytes)

-- λ> length (zeckendorf4 (10^50000))

-- 66097

-- (2.84 secs, 3,976,483,760 bytes)

El código se encuentra en GitHub.

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

Ordenada cíclicamente

PorJosé A. Alonso 22-abril-202230-abril-2022

Se dice que una sucesión x(1), …, x(n) está ordenada cíclicamente si existe un índice i tal que la sucesión

   x(i), x(i+1), ..., x(n), x(1), ..., x(i-1)

1	x(i), x(i+1), ..., x(n), x(1), ..., x(i-1)

está ordenada crecientemente de forma estricta.

Definir la función

   ordenadaCiclicamente :: Ord a => [a] -> Maybe Int

1	ordenadaCiclicamente :: Ord a => [a] -> Maybe Int

tal que (ordenadaCiclicamente xs) es el índice a partir del cual está ordenada, si la lista está ordenado cíclicamente y Nothing en caso contrario. Por ejemplo,

   ordenadaCiclicamente [1,2,3,4]      ==  Just 0
   ordenadaCiclicamente [5,8,1,3]      ==  Just 2
   ordenadaCiclicamente [4,6,7,5,1,3]  ==  Nothing
   ordenadaCiclicamente [1,0,3,2]      ==  Nothing
   ordenadaCiclicamente [1,2,0]        ==  Just 2
   ordenadaCiclicamente "cdeab"        ==  Just 3

ordenadaCiclicamente [1,2,3,4] == Just 0

ordenadaCiclicamente [5,8,1,3] == Just 2

ordenadaCiclicamente [4,6,7,5,1,3] == Nothing

ordenadaCiclicamente [1,0,3,2] == Nothing

ordenadaCiclicamente [1,2,0] == Just 2

ordenadaCiclicamente "cdeab" == Just 3

Nota: Se supone que el argumento es una lista no vacía sin elementos repetidos.

Soluciones

module Ordenada_ciclicamente where

import Test.QuickCheck (Arbitrary, Gen, NonEmptyList (NonEmpty), Property,
                        arbitrary, chooseInt, collect, quickCheck)
import Data.List       (nub, sort)
import Data.Maybe      (isJust, listToMaybe)

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

ordenadaCiclicamente1 :: Ord a => [a] -> Maybe Int
ordenadaCiclicamente1 xs = aux 0 xs
  where n = length xs
        aux i zs
          | i == n      = Nothing
          | ordenada zs = Just i
          | otherwise   = aux (i+1) (siguienteCiclo zs)

-- (ordenada xs) se verifica si la lista xs está ordenada
-- crecientemente. Por ejemplo,
--   ordenada "acd"   ==  True
--   ordenada "acdb"  ==  False
ordenada :: Ord a => [a] -> Bool
ordenada []     = True
ordenada (x:xs) = all (x <) xs && ordenada xs

-- (siguienteCiclo xs) es la lista obtenida añadiendo el primer elemento
-- de xs al final del resto de xs. Por ejemplo,
--   siguienteCiclo [3,2,5]  =>  [2,5,3]
siguienteCiclo :: [a] -> [a]
siguienteCiclo []     = []
siguienteCiclo (x:xs) = xs ++ [x]

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

ordenadaCiclicamente2 :: Ord a => [a] -> Maybe Int
ordenadaCiclicamente2 xs =
  listToMaybe [n | n <- [0..length xs-1],
                   ordenada (drop n xs ++ take n xs)]

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

ordenadaCiclicamente3 :: Ord a => [a] -> Maybe Int
ordenadaCiclicamente3 xs
  | ordenada (bs ++ as) = Just k
  | otherwise           = Nothing
  where (_,k)   = minimum (zip xs [0..])
        (as,bs) = splitAt k xs

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

-- La propiedad es
prop_ordenadaCiclicamente1 :: NonEmptyList Int -> Bool
prop_ordenadaCiclicamente1 (NonEmpty xs) =
  ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

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

-- La propiedad para analizar los casos de prueba
prop_ordenadaCiclicamente2 :: NonEmptyList Int -> Property
prop_ordenadaCiclicamente2 (NonEmpty xs) =
  collect (isJust (ordenadaCiclicamente1 xs)) $
  ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- El análisis es
--    λ> quickCheck prop_ordenadaCiclicamente2
--    +++ OK, passed 100 tests:
--    89% False
--    11% True

-- Tipo para generar listas
newtype Lista = L [Int]
  deriving Show

-- Generador de listas.
listaArbitraria :: Gen Lista
listaArbitraria = do
  x <- arbitrary
  xs <- arbitrary
  let ys = x : xs
  k <- chooseInt (0, length ys)
  let (as,bs) = splitAt k (sort (nub ys))
  return (L (bs ++ as))

-- Lista es una subclase de Arbitrary.
instance Arbitrary Lista where
  arbitrary = listaArbitraria

-- La propiedad para analizar los casos de prueba
prop_ordenadaCiclicamente3 :: Lista -> Property
prop_ordenadaCiclicamente3 (L xs) =
  collect (isJust (ordenadaCiclicamente1 xs)) $
  ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- El análisis es
--    λ> quickCheck prop_ordenadaCiclicamente3
--    +++ OK, passed 100 tests (100% True).

-- Tipo para generar
newtype Lista2 = L2 [Int]
  deriving Show

-- Generador de listas
listaArbitraria2 :: Gen Lista2
listaArbitraria2 = do
  x' <- arbitrary
  xs <- arbitrary
  let ys = x' : xs
  k <- chooseInt (0, length ys)
  let (as,bs) = splitAt k (sort (nub ys))
  n <- chooseInt (0,1)
  return (if even n
          then L2 (bs ++ as)
          else L2 ys)

-- Lista es una subclase de Arbitrary.
instance Arbitrary Lista2 where
  arbitrary = listaArbitraria2

-- La propiedad para analizar los casos de prueba
prop_ordenadaCiclicamente4 :: Lista2 -> Property
prop_ordenadaCiclicamente4 (L2 xs) =
  collect (isJust (ordenadaCiclicamente1 xs)) $
  ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- El análisis es
--    λ> quickCheck prop_ordenadaCiclicamente4
--    +++ OK, passed 100 tests:
--    51% True
--    49% False

-- La propiedad es
prop_ordenadaCiclicamente :: Lista2 -> Bool
prop_ordenadaCiclicamente (L2 xs) =
  all (== ordenadaCiclicamente1 xs)
      [ordenadaCiclicamente2 xs,
       ordenadaCiclicamente3 xs]

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

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

-- La comparación es
--    λ> ordenadaCiclicamente1 ([100..4000] ++ [1..99])
--    Just 3901
--    (3.27 secs, 2,138,864,568 bytes)
--    λ> ordenadaCiclicamente2 ([100..4000] ++ [1..99])
--    Just 3901
--    (2.44 secs, 1,430,040,008 bytes)
--    λ> ordenadaCiclicamente3 ([100..4000] ++ [1..99])
--    Just 3901
--    (1.18 secs, 515,549,200 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

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

module Ordenada_ciclicamente where

import Test.QuickCheck (Arbitrary, Gen, NonEmptyList (NonEmpty), Property,

arbitrary, chooseInt, collect, quickCheck)

import Data.List (nub, sort)

import Data.Maybe (isJust, listToMaybe)

-- 1ª solución

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

ordenadaCiclicamente1 :: Ord a => [a] -> Maybe Int

ordenadaCiclicamente1 xs = aux 0 xs

where n = length xs

aux i zs

| i == n = Nothing

| ordenada zs = Just i

| otherwise = aux (i+1) (siguienteCiclo zs)

-- (ordenada xs) se verifica si la lista xs está ordenada

-- crecientemente. Por ejemplo,

-- ordenada "acd" == True

-- ordenada "acdb" == False

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

ordenada [] = True

ordenada (x:xs) = all (x <) xs && ordenada xs

-- (siguienteCiclo xs) es la lista obtenida añadiendo el primer elemento

-- de xs al final del resto de xs. Por ejemplo,

-- siguienteCiclo [3,2,5] => [2,5,3]

siguienteCiclo :: [a] -> [a]

siguienteCiclo [] = []

siguienteCiclo (x:xs) = xs ++ [x]

-- 2ª solución

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

ordenadaCiclicamente2 :: Ord a => [a] -> Maybe Int

ordenadaCiclicamente2 xs =

listToMaybe [n | n <- [0..length xs-1],

ordenada (drop n xs ++ take n xs)]

-- 3ª solución

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

ordenadaCiclicamente3 :: Ord a => [a] -> Maybe Int

ordenadaCiclicamente3 xs

| ordenada (bs ++ as) = Just k

| otherwise = Nothing

where (_,k) = minimum (zip xs [0..])

(as,bs) = splitAt k xs

-- Comprobación de equivalencia

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

-- La propiedad es

prop_ordenadaCiclicamente1 :: NonEmptyList Int -> Bool

prop_ordenadaCiclicamente1 (NonEmpty xs) =

ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- La comprobación es

-- λ> quickCheck prop_ordenadaCiclicamente1

-- +++ OK, passed 100 tests.

-- La propiedad para analizar los casos de prueba

prop_ordenadaCiclicamente2 :: NonEmptyList Int -> Property

prop_ordenadaCiclicamente2 (NonEmpty xs) =

collect (isJust (ordenadaCiclicamente1 xs)) $

ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- El análisis es

-- λ> quickCheck prop_ordenadaCiclicamente2

-- +++ OK, passed 100 tests:

-- 89% False

-- 11% True

-- Tipo para generar listas

newtype Lista = L [Int]

deriving Show

-- Generador de listas.

listaArbitraria :: Gen Lista

listaArbitraria = do

x <- arbitrary

xs <- arbitrary

let ys = x : xs

k <- chooseInt (0, length ys)

let (as,bs) = splitAt k (sort (nub ys))

return (L (bs ++ as))

-- Lista es una subclase de Arbitrary.

instance Arbitrary Lista where

arbitrary = listaArbitraria

-- La propiedad para analizar los casos de prueba

prop_ordenadaCiclicamente3 :: Lista -> Property

prop_ordenadaCiclicamente3 (L xs) =

collect (isJust (ordenadaCiclicamente1 xs)) $

ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- El análisis es

-- λ> quickCheck prop_ordenadaCiclicamente3

-- +++ OK, passed 100 tests (100% True).

-- Tipo para generar

newtype Lista2 = L2 [Int]

deriving Show

-- Generador de listas

listaArbitraria2 :: Gen Lista2

listaArbitraria2 = do

x' <- arbitrary

xs <- arbitrary

let ys = x' : xs

k <- chooseInt (0, length ys)

let (as,bs) = splitAt k (sort (nub ys))

n <- chooseInt (0,1)

return (if even n

then L2 (bs ++ as)

else L2 ys)

-- Lista es una subclase de Arbitrary.

instance Arbitrary Lista2 where

arbitrary = listaArbitraria2

-- La propiedad para analizar los casos de prueba

prop_ordenadaCiclicamente4 :: Lista2 -> Property

prop_ordenadaCiclicamente4 (L2 xs) =

collect (isJust (ordenadaCiclicamente1 xs)) $

ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs

-- El análisis es

-- λ> quickCheck prop_ordenadaCiclicamente4

-- +++ OK, passed 100 tests:

-- 51% True

-- 49% False

-- La propiedad es

prop_ordenadaCiclicamente :: Lista2 -> Bool

prop_ordenadaCiclicamente (L2 xs) =

all (== ordenadaCiclicamente1 xs)

[ordenadaCiclicamente2 xs,

ordenadaCiclicamente3 xs]

-- La comprobación es

-- λ> quickCheck prop_ordenadaCiclicamente

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> ordenadaCiclicamente1 ([100..4000] ++ [1..99])

-- Just 3901

-- (3.27 secs, 2,138,864,568 bytes)

-- λ> ordenadaCiclicamente2 ([100..4000] ++ [1..99])

-- Just 3901

-- (2.44 secs, 1,430,040,008 bytes)

-- λ> ordenadaCiclicamente3 ([100..4000] ++ [1..99])

-- Just 3901

-- (1.18 secs, 515,549,200 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>

Eliminación de las ocurrencias aisladas.

PorJosé A. Alonso 20-abril-202230-abril-2022

Definir la función

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

1	eliminaAisladas :: Eq a => a -> [a] -> [a]

tal que (eliminaAisladas x ys) es la lista obtenida eliminando en ys las ocurrencias aisladas de x (es decir, aquellas ocurrencias de x tales que su elemento anterior y posterior son distintos de x). Por ejemplo,

   eliminaAisladas 'X' ""                  == ""
   eliminaAisladas 'X' "X"                 == ""
   eliminaAisladas 'X' "XX"                == "XX"
   eliminaAisladas 'X' "XXX"               == "XXX"
   eliminaAisladas 'X' "abcd"              == "abcd"
   eliminaAisladas 'X' "Xabcd"             == "abcd"
   eliminaAisladas 'X' "XXabcd"            == "XXabcd"
   eliminaAisladas 'X' "XXXabcd"           == "XXXabcd"
   eliminaAisladas 'X' "abcdX"             == "abcd"
   eliminaAisladas 'X' "abcdXX"            == "abcdXX"
   eliminaAisladas 'X' "abcdXXX"           == "abcdXXX"
   eliminaAisladas 'X' "abXcd"             == "abcd"
   eliminaAisladas 'X' "abXXcd"            == "abXXcd"
   eliminaAisladas 'X' "abXXXcd"           == "abXXXcd"
   eliminaAisladas 'X' "XabXcdX"           == "abcd"
   eliminaAisladas 'X' "XXabXXcdXX"        == "XXabXXcdXX"
   eliminaAisladas 'X' "XXXabXXXcdXXX"     == "XXXabXXXcdXXX"
   eliminaAisladas 'X' "XabXXcdXeXXXfXx"   == "abXXcdeXXXfx"

eliminaAisladas 'X' "" == ""

eliminaAisladas 'X' "X" == ""

eliminaAisladas 'X' "XX" == "XX"

eliminaAisladas 'X' "XXX" == "XXX"

eliminaAisladas 'X' "abcd" == "abcd"

eliminaAisladas 'X' "Xabcd" == "abcd"

eliminaAisladas 'X' "XXabcd" == "XXabcd"

eliminaAisladas 'X' "XXXabcd" == "XXXabcd"

eliminaAisladas 'X' "abcdX" == "abcd"

eliminaAisladas 'X' "abcdXX" == "abcdXX"

eliminaAisladas 'X' "abcdXXX" == "abcdXXX"

eliminaAisladas 'X' "abXcd" == "abcd"

eliminaAisladas 'X' "abXXcd" == "abXXcd"

eliminaAisladas 'X' "abXXXcd" == "abXXXcd"

eliminaAisladas 'X' "XabXcdX" == "abcd"

eliminaAisladas 'X' "XXabXXcdXX" == "XXabXXcdXX"

eliminaAisladas 'X' "XXXabXXXcdXXX" == "XXXabXXXcdXXX"

eliminaAisladas 'X' "XabXXcdXeXXXfXx" == "abXXcdeXXXfx"

Soluciones

module Elimina_aisladas where

import Data.List (group)
import Test.QuickCheck

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

eliminaAisladas1 :: Eq a => a -> [a] -> [a]
eliminaAisladas1 _ [] = []
eliminaAisladas1 x [y]
  | x == y    = []
  | otherwise = [y]
eliminaAisladas1 x (y1:y2:ys)
  | y1 /= x   = y1 : eliminaAisladas1 x (y2:ys)
  | y2 /= x   = y2 : eliminaAisladas1 x ys
  | otherwise = takeWhile (==x) (y1:y2:ys) ++
                eliminaAisladas1 x (dropWhile (==x) ys)

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

eliminaAisladas2 :: Eq a => a -> [a] -> [a]
eliminaAisladas2 _ [] = []
eliminaAisladas2 x ys
  | cs == [x] = as ++ eliminaAisladas2 x ds
  | otherwise = as ++ cs ++ eliminaAisladas2 x ds
  where (as,bs) = span (/=x) ys
        (cs,ds) = span (==x) bs

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

eliminaAisladas3 :: Eq a => a -> [a] -> [a]
eliminaAisladas3 x ys = concat [zs | zs <- group ys, zs /= [x]]

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

eliminaAisladas4 :: Eq a => a -> [a] -> [a]
eliminaAisladas4 x = concat . filter (/= [x]) . group


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

-- La propiedad es
prop_eliminaAisladas :: Int -> [Int] -> Bool
prop_eliminaAisladas x ys =
  all (== eliminaAisladas1 x ys)
      [eliminaAisladas2 x ys,
       eliminaAisladas3 x ys,
       eliminaAisladas4 x ys]

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

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

-- La comparación es
--    λ> length (eliminaAisladas1 'a' (take (5*10^6) (cycle "abca")))
--    4999998
--    (3.86 secs, 2,030,515,400 bytes)
--    λ> length (eliminaAisladas2 'a' (take (5*10^6) (cycle "abca")))
--    4999998
--    (3.41 secs, 2,210,516,832 bytes)
--    λ> length (eliminaAisladas3 'a' (take (5*10^6) (cycle "abca")))
--    4999998
--    (2.11 secs, 2,280,516,448 bytes)
--    λ> length (eliminaAisladas4 'a' (take (5*10^6) (cycle "abca")))
--    4999998
--    (0.92 secs, 1,920,516,704 bytes)

module Elimina_aisladas where

import Data.List (group)

import Test.QuickCheck

-- 1ª solución

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

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

eliminaAisladas1 _ [] = []

eliminaAisladas1 x [y]

| x == y = []

| otherwise = [y]

eliminaAisladas1 x (y1:y2:ys)

| y1 /= x = y1 : eliminaAisladas1 x (y2:ys)

| y2 /= x = y2 : eliminaAisladas1 x ys

| otherwise = takeWhile (==x) (y1:y2:ys) ++

eliminaAisladas1 x (dropWhile (==x) ys)

-- 2ª solución

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

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

eliminaAisladas2 _ [] = []

eliminaAisladas2 x ys

| cs == [x] = as ++ eliminaAisladas2 x ds

| otherwise = as ++ cs ++ eliminaAisladas2 x ds

where (as,bs) = span (/=x) ys

(cs,ds) = span (==x) bs

-- 3ª solución

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

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

eliminaAisladas3 x ys = concat [zs | zs <- group ys, zs /= [x]]

-- 4ª solución

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

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

eliminaAisladas4 x = concat . filter (/= [x]) . group

-- Comprobación de equivalencia

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

-- La propiedad es

prop_eliminaAisladas :: Int -> [Int] -> Bool

prop_eliminaAisladas x ys =

all (== eliminaAisladas1 x ys)

[eliminaAisladas2 x ys,

eliminaAisladas3 x ys,

eliminaAisladas4 x ys]

-- La comprobación es

-- λ> quickCheck prop_eliminaAisladas

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (eliminaAisladas1 'a' (take (5*10^6) (cycle "abca")))

-- 4999998

-- (3.86 secs, 2,030,515,400 bytes)

-- λ> length (eliminaAisladas2 'a' (take (5*10^6) (cycle "abca")))

-- 4999998

-- (3.41 secs, 2,210,516,832 bytes)

-- λ> length (eliminaAisladas3 'a' (take (5*10^6) (cycle "abca")))

-- 4999998

-- (2.11 secs, 2,280,516,448 bytes)

-- λ> length (eliminaAisladas4 'a' (take (5*10^6) (cycle "abca")))

-- 4999998

-- (0.92 secs, 1,920,516,704 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>

Separación por posición

PorJosé A. Alonso 15-abril-202230-abril-2022

Definir la función

   particion :: [a] -> ([a],[a])

1	particion :: [a] -> ([a],[a])

tal que (particion xs) es el par cuya primera componente son los elementos de xs en posiciones pares y su segunda componente son los restantes elementos. Por ejemplo,

   particion [3,5,6,2]    ==  ([3,6],[5,2])
   particion [3,5,6,2,7]  ==  ([3,6,7],[5,2])
   particion "particion"  ==  ("priin","atco")

particion [3,5,6,2] == ([3,6],[5,2])

particion [3,5,6,2,7] == ([3,6,7],[5,2])

particion "particion" == ("priin","atco")

Soluciones

module Separacion_por_posicion where

import Data.List (partition)
import qualified Data.Vector as V ((!), fromList, length)
import Test.QuickCheck (quickCheck)

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

particion1 :: [a] -> ([a],[a])
particion1 xs = ([x | (n,x) <- nxs, even n],
                 [x | (n,x) <- nxs, odd n])
  where nxs = enumeracion xs

--(numeracion xs) es la enumeración de xs. Por ejemplo,
--    enumeracion [7,9,6,8]  ==  [(0,7),(1,9),(2,6),(3,8)]
enumeracion :: [a] -> [(Int,a)]
enumeracion = zip [0..]

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

particion2 :: [a] -> ([a],[a])
particion2 []     = ([],[])
particion2 (x:xs) = (x:zs,ys)
  where (ys,zs) = particion2 xs

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

particion3 :: [a] -> ([a],[a])
particion3 = foldr f ([],[])
  where f x (ys,zs) = (x:zs,ys)

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

particion4 :: [a] -> ([a],[a])
particion4 = foldr (\x (ys,zs) -> (x:zs,ys)) ([],[])

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

particion5 :: [a] -> ([a],[a])
particion5 xs =
  ([xs!!k | k <- [0,2..n]],
   [xs!!k | k <- [1,3..n]])
  where n = length xs - 1

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

particion6 :: [a] -> ([a],[a])
particion6 xs = (pares xs, impares xs)

-- (pares xs) es la lista de los elementos de xs en posiciones
-- pares. Por ejemplo,
--    pares [3,5,6,2]  ==  [3,6]
pares :: [a] -> [a]
pares []     = []
pares (x:xs) = x : impares xs

-- (impares xs) es la lista de los elementos de xs en posiciones
-- impares. Por ejemplo,
--    impares [3,5,6,2]  ==  [5,2]
impares :: [a] -> [a]
impares []     = []
impares (_:xs) = pares xs

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

particion7 :: [a] -> ([a],[a])
particion7 [] = ([],[])
particion7 xs =
  ([v V.! k | k <- [0,2..n-1]],
   [v V.! k | k <- [1,3..n-1]])
  where v = V.fromList xs
        n = V.length v

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

particion8 :: [a] -> ([a],[a])
particion8 xs =
  (map snd ys, map snd zs)
  where (ys,zs) = partition posicionPar (zip [0..] xs)

posicionPar :: (Int,a) -> Bool
posicionPar = even . fst

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

-- La propiedad es
prop_particion :: [Int] -> Bool
prop_particion xs =
  all (== particion1 xs)
      [particion2 xs,
       particion3 xs,
       particion4 xs,
       particion5 xs,
       particion6 xs,
       particion7 xs,
       particion8 xs]

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

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

-- La comparación es
--    λ> last (snd (particion1 [1..6*10^6]))
--    6000000
--    (2.74 secs, 2,184,516,080 bytes)
--    λ> last (snd (particion2 [1..6*10^6]))
--    6000000
--    (2.02 secs, 1,992,515,880 bytes)
--    λ> last (snd (particion3 [1..6*10^6]))
--    6000000
--    (3.17 secs, 1,767,423,240 bytes)
--    λ> last (snd (particion4 [1..6*10^6]))
--    6000000
--    (3.23 secs, 1,767,423,240 bytes)
--    λ> last (snd (particion5 [1..6*10^6]))
--    6000000
--    (1.62 secs, 1,032,516,192 bytes)
--    λ> last (snd (particion5 [1..6*10^6]))
--    6000000
--    (1.33 secs, 1,032,516,192 bytes)
--    λ> last (snd (particion6 [1..6*10^6]))
--    6000000
--    (1.80 secs, 888,515,960 bytes)
--    λ> last (snd (particion7 [1..6*10^6]))
--    6000000
--    (1.29 secs, 1,166,865,672 bytes)
--    λ> last (snd (particion8 [1..6*10^6]))
--    6000000
--    (0.87 secs, 3,384,516,616 bytes)
--
--    λ> last (snd (particion5 [1..10^7]))
--    10000000
--    (1.94 secs, 1,720,516,872 bytes)
--    λ> last (snd (particion7 [1..10^7]))
--    10000000
--    (2.54 secs, 1,989,215,176 bytes)
--    λ> last (snd (particion8 [1..10^7]))
--    10000000
--    (1.33 secs, 5,640,516,960 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

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

module Separacion_por_posicion where

import Data.List (partition)

import qualified Data.Vector as V ((!), fromList, length)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

particion1 :: [a] -> ([a],[a])

particion1 xs = ([x | (n,x) <- nxs, even n],

[x | (n,x) <- nxs, odd n])

where nxs = enumeracion xs

--(numeracion xs) es la enumeración de xs. Por ejemplo,

-- enumeracion [7,9,6,8] == [(0,7),(1,9),(2,6),(3,8)]

enumeracion :: [a] -> [(Int,a)]

enumeracion = zip [0..]

-- 2ª solución

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

particion2 :: [a] -> ([a],[a])

particion2 [] = ([],[])

particion2 (x:xs) = (x:zs,ys)

where (ys,zs) = particion2 xs

-- 3ª solución

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

particion3 :: [a] -> ([a],[a])

particion3 = foldr f ([],[])

where f x (ys,zs) = (x:zs,ys)

-- 4ª solución

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

particion4 :: [a] -> ([a],[a])

particion4 = foldr (\x (ys,zs) -> (x:zs,ys)) ([],[])

-- 5ª solución

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

particion5 :: [a] -> ([a],[a])

particion5 xs =

([xs!!k | k <- [0,2..n]],

[xs!!k | k <- [1,3..n]])

where n = length xs - 1

-- 6ª solución

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

particion6 :: [a] -> ([a],[a])

particion6 xs = (pares xs, impares xs)

-- (pares xs) es la lista de los elementos de xs en posiciones

-- pares. Por ejemplo,

-- pares [3,5,6,2] == [3,6]

pares :: [a] -> [a]

pares [] = []

pares (x:xs) = x : impares xs

-- (impares xs) es la lista de los elementos de xs en posiciones

-- impares. Por ejemplo,

-- impares [3,5,6,2] == [5,2]

impares :: [a] -> [a]

impares [] = []

impares (_:xs) = pares xs

-- 7ª solución

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

particion7 :: [a] -> ([a],[a])

particion7 [] = ([],[])

particion7 xs =

([v V.! k | k <- [0,2..n-1]],

[v V.! k | k <- [1,3..n-1]])

where v = V.fromList xs

n = V.length v

-- 8ª solución

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

particion8 :: [a] -> ([a],[a])

particion8 xs =

(map snd ys, map snd zs)

where (ys,zs) = partition posicionPar (zip [0..] xs)

posicionPar :: (Int,a) -> Bool

posicionPar = even . fst

-- Comprobación de equivalencia

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

-- La propiedad es

prop_particion :: [Int] -> Bool

prop_particion xs =

all (== particion1 xs)

[particion2 xs,

particion3 xs,

particion4 xs,

particion5 xs,

particion6 xs,

particion7 xs,

particion8 xs]

-- La comprobación es

-- λ> quickCheck prop_particion

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> last (snd (particion1 [1..6*10^6]))

-- 6000000

-- (2.74 secs, 2,184,516,080 bytes)

-- λ> last (snd (particion2 [1..6*10^6]))

-- 6000000

-- (2.02 secs, 1,992,515,880 bytes)

-- λ> last (snd (particion3 [1..6*10^6]))

-- 6000000

-- (3.17 secs, 1,767,423,240 bytes)

-- λ> last (snd (particion4 [1..6*10^6]))

-- 6000000

-- (3.23 secs, 1,767,423,240 bytes)

-- λ> last (snd (particion5 [1..6*10^6]))

-- 6000000

-- (1.62 secs, 1,032,516,192 bytes)

-- λ> last (snd (particion5 [1..6*10^6]))

-- 6000000

-- (1.33 secs, 1,032,516,192 bytes)

-- λ> last (snd (particion6 [1..6*10^6]))

-- 6000000

-- (1.80 secs, 888,515,960 bytes)

-- λ> last (snd (particion7 [1..6*10^6]))

-- 6000000

-- (1.29 secs, 1,166,865,672 bytes)

-- λ> last (snd (particion8 [1..6*10^6]))

-- 6000000

-- (0.87 secs, 3,384,516,616 bytes)

-- λ> last (snd (particion5 [1..10^7]))

-- 10000000

-- (1.94 secs, 1,720,516,872 bytes)

-- λ> last (snd (particion7 [1..10^7]))

-- 10000000

-- (2.54 secs, 1,989,215,176 bytes)

-- λ> last (snd (particion8 [1..10^7]))

-- 10000000

-- (1.33 secs, 5,640,516,960 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>

Código de las alergias

PorJosé A. Alonso 11-abril-2022

Para la determinación de las alergia se utiliza los siguientes códigos para los alérgenos:

   Huevos ........   1
   Cacahuetes ....   2
   Mariscos ......   4
   Fresas ........   8
   Tomates .......  16
   Chocolate .....  32
   Polen .........  64
   Gatos ......... 128

Huevos ........ 1

Cacahuetes .... 2

Mariscos ...... 4

Fresas ........ 8

Tomates ....... 16

Chocolate ..... 32

Polen ......... 64

Gatos ......... 128

Así, si Juan es alérgico a los cacahuetes y al chocolate, su puntuación es 34 (es decir, 2+32).

Los alérgenos se representan mediante el siguiente tipo de dato

  data Alergeno = Huevos
                | Cacahuetes
                | Mariscos
                | Fresas
                | Tomates
                | Chocolate
                | Polen
                | Gatos
    deriving (Enum, Eq, Show, Bounded)

data Alergeno = Huevos

| Cacahuetes

| Mariscos

| Fresas

| Tomates

| Chocolate

| Polen

| Gatos

deriving (Enum, Eq, Show, Bounded)

Definir la función

   alergias :: Int -> [Alergeno]

1	alergias :: Int -> [Alergeno]

tal que (alergias n) es la lista de alergias correspondiente a una puntuación n. Por ejemplo,

   λ> alergias 1
   [Huevos]
   λ> alergias 2
   [Cacahuetes]
   λ> alergias 3
   [Huevos,Cacahuetes]
   λ> alergias 5
   [Huevos,Mariscos]
   λ> alergias 255
   [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]

λ> alergias 1

[Huevos]

λ> alergias 2

[Cacahuetes]

λ> alergias 3

[Huevos,Cacahuetes]

λ> alergias 5

[Huevos,Mariscos]

λ> alergias 255

[Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]

Soluciones

[schedule expon=’2022-04-18′ expat=»06:00″]

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

[/schedule]

[schedule on=’2022-04-18′ at=»06:00″]

import Data.List (subsequences)
import Test.QuickCheck

data Alergeno =
    Huevos
  | Cacahuetes
  | Mariscos
  | Fresas
  | Tomates
  | Chocolate
  | Polen
  | Gatos
  deriving (Enum, Eq, Show, Bounded)

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

alergias1 :: Int -> [Alergeno]
alergias1 n =
  [a | (a,c) <- zip alergenos codigos, c `elem` descomposicion n]

-- codigos es la lista de los códigos de los alergenos.
codigos :: [Int]
codigos = [2^x| x <- [0..7]]

-- (descomposicion n) es la descomposición de n como sumas de potencias
-- de 2. Por ejemplo,
--    descomposicion 3    ==  [1,2]
--    descomposicion 5    ==  [1,4]
--    descomposicion 248  ==  [8,16,32,64,128]
--    descomposicion 255  ==  [1,2,4,8,16,32,64,128]
descomposicion :: Int -> [Int]
descomposicion n =
  head [xs | xs <- subsequences codigos, sum xs == n]

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

alergias2 :: Int -> [Alergeno]
alergias2 = map toEnum . codigosAlergias

-- (codigosAlergias n) es la lista de códigos de alergias
-- correspondiente a una puntuación n. Por ejemplo,
--    codigosAlergias 1  ==  [0]
--    codigosAlergias 2  ==  [1]
--    codigosAlergias 3  ==  [0,1]
--    codigosAlergias 4  ==  [2]
--    codigosAlergias 5  ==  [0,2]
--    codigosAlergias 6  ==  [1,2]
codigosAlergias :: Int -> [Int]
codigosAlergias = aux [0..7]
  where aux []     _             = []
        aux (x:xs) n | odd n     = x : aux xs (n `div` 2)
                     | otherwise = aux xs (n `div` 2)

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

alergias3 :: Int -> [Alergeno]
alergias3 = map toEnum . codigosAlergias3

codigosAlergias3 :: Int -> [Int]
codigosAlergias3 n =
  [x | (x,y) <- zip [0..7] (int2bin n), y == 1]

-- (int2bin n) es la representación binaria del número n. Por ejemplo,
--    int2bin 10  ==  [0,1,0,1]
-- ya que 10 = 0*1 + 1*2 + 0*4 + 1*8
int2bin :: Int -> [Int]
int2bin n | n < 2     = [n]
          | otherwise = n `rem` 2 : int2bin (n `div` 2)

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

alergias4 :: Int -> [Alergeno]
alergias4 = map toEnum . codigosAlergias4

codigosAlergias4 :: Int -> [Int]
codigosAlergias4 n =
  map fst (filter ((== 1) . snd) (zip  [0..7] (int2bin n)))

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

alergias5 :: Int -> [Alergeno]
alergias5 = map (toEnum . fst)
          . filter ((1 ==) . snd)
          . zip [0..7]
          . int2bin

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

alergias6 :: Int -> [Alergeno]
alergias6 = aux alergenos
  where aux []     _             = []
        aux (x:xs) n | odd n     = x : aux xs (n `div` 2)
                     | otherwise = aux xs (n `div` 2)

-- alergenos es la lista de los alergenos. Por ejemplo.
--    take 3 alergenos  ==  [Huevos,Cacahuetes,Mariscos]
alergenos :: [Alergeno]
alergenos = [minBound..maxBound]

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

-- La propiedad es
prop_alergias :: Property
prop_alergias =
  forAll (arbitrary `suchThat` esValido) $ \n ->
  all (== alergias1 n)
      [alergias2 n,
       alergias3 n,
       alergias4 n,
       alergias5 n,
       alergias6 n]
  where esValido x = 1 <= x && x <= 255

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

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

-- La comparación es
--    λ> last (map alergias1 [1..255])
--    [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]
--    (0.02 secs, 1,657,912 bytes)
--    λ> last (map alergias2 [1..255])
--    [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]
--    (0.01 secs, 597,080 bytes)
--    λ> last (map alergias3 [1..255])
--    [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]
--    (0.01 secs, 597,640 bytes)
--    λ> last (map alergias4 [1..255])
--    [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]
--    (0.01 secs, 598,152 bytes)
--    λ> last (map alergias5 [1..255])
--    [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]
--    (0.01 secs, 596,888 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

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

import Data.List (subsequences)

import Test.QuickCheck

data Alergeno =

Huevos

| Cacahuetes

| Mariscos

| Fresas

| Tomates

| Chocolate

| Polen

| Gatos

deriving (Enum, Eq, Show, Bounded)

-- 1ª solución

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

alergias1 :: Int -> [Alergeno]

alergias1 n =

[a | (a,c) <- zip alergenos codigos, c `elem` descomposicion n]

-- codigos es la lista de los códigos de los alergenos.

codigos :: [Int]

codigos = [2^x| x <- [0..7]]

-- (descomposicion n) es la descomposición de n como sumas de potencias

-- de 2. Por ejemplo,

-- descomposicion 3 == [1,2]

-- descomposicion 5 == [1,4]

-- descomposicion 248 == [8,16,32,64,128]

-- descomposicion 255 == [1,2,4,8,16,32,64,128]

descomposicion :: Int -> [Int]

descomposicion n =

head [xs | xs <- subsequences codigos, sum xs == n]

-- 2ª solución

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

alergias2 :: Int -> [Alergeno]

alergias2 = map toEnum . codigosAlergias

-- (codigosAlergias n) es la lista de códigos de alergias

-- correspondiente a una puntuación n. Por ejemplo,

-- codigosAlergias 1 == [0]

-- codigosAlergias 2 == [1]

-- codigosAlergias 3 == [0,1]

-- codigosAlergias 4 == [2]

-- codigosAlergias 5 == [0,2]

-- codigosAlergias 6 == [1,2]

codigosAlergias :: Int -> [Int]

codigosAlergias = aux [0..7]

where aux [] _ = []

aux (x:xs) n | odd n = x : aux xs (n `div` 2)

| otherwise = aux xs (n `div` 2)

-- 3ª solución

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

alergias3 :: Int -> [Alergeno]

alergias3 = map toEnum . codigosAlergias3

codigosAlergias3 :: Int -> [Int]

codigosAlergias3 n =

[x | (x,y) <- zip [0..7] (int2bin n), y == 1]

-- (int2bin n) es la representación binaria del número n. Por ejemplo,

-- int2bin 10 == [0,1,0,1]

-- ya que 10 = 0*1 + 1*2 + 0*4 + 1*8

int2bin :: Int -> [Int]

int2bin n | n < 2 = [n]

| otherwise = n `rem` 2 : int2bin (n `div` 2)

-- 4ª solución

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

alergias4 :: Int -> [Alergeno]

alergias4 = map toEnum . codigosAlergias4

codigosAlergias4 :: Int -> [Int]

codigosAlergias4 n =

map fst (filter ((== 1) . snd) (zip [0..7] (int2bin n)))

-- 5ª solución

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

alergias5 :: Int -> [Alergeno]

alergias5 = map (toEnum . fst)

. filter ((1 ==) . snd)

. zip [0..7]

. int2bin

-- 6ª solución

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

alergias6 :: Int -> [Alergeno]

alergias6 = aux alergenos

where aux [] _ = []

aux (x:xs) n | odd n = x : aux xs (n `div` 2)

| otherwise = aux xs (n `div` 2)

-- alergenos es la lista de los alergenos. Por ejemplo.

-- take 3 alergenos == [Huevos,Cacahuetes,Mariscos]

alergenos :: [Alergeno]

alergenos = [minBound..maxBound]

-- Comprobación de equivalencia

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

-- La propiedad es

prop_alergias :: Property

prop_alergias =

forAll (arbitrary `suchThat` esValido) $ \n ->

all (== alergias1 n)

[alergias2 n,

alergias3 n,

alergias4 n,

alergias5 n,

alergias6 n]

where esValido x = 1 <= x && x <= 255

-- La comprobación es

-- λ> quickCheck prop_alergias

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> last (map alergias1 [1..255])

-- [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]

-- (0.02 secs, 1,657,912 bytes)

-- λ> last (map alergias2 [1..255])

-- [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]

-- (0.01 secs, 597,080 bytes)

-- λ> last (map alergias3 [1..255])

-- [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]

-- (0.01 secs, 597,640 bytes)

-- λ> last (map alergias4 [1..255])

-- [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]

-- (0.01 secs, 598,152 bytes)

-- λ> last (map alergias5 [1..255])

-- [Huevos,Cacahuetes,Mariscos,Fresas,Tomates,Chocolate,Polen,Gatos]

-- (0.01 secs, 596,888 bytes)

El código se encuentra en [GitHub](https://github.com/jaalonso/Exercitium/blob/main/src/Alergias.hs).

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>

[/schedule]

Números triangulares con n cifras distintas

PorJosé A. Alonso 5-abril-202212-abril-2022

Los números triangulares se forman como sigue

   *     *      *
        * *    * *
              * * *
   1     3      6

* * *

* * * *

* * *

1 3 6

La sucesión de los números triangulares se obtiene sumando los números naturales. Así, los 5 primeros números triangulares son

    1 = 1
    3 = 1 + 2
    6 = 1 + 2 + 3
   10 = 1 + 2 + 3 + 4
   15 = 1 + 2 + 3 + 4 + 5

1 = 1

3 = 1 + 2

6 = 1 + 2 + 3

10 = 1 + 2 + 3 + 4

15 = 1 + 2 + 3 + 4 + 5

Definir la función

   triangularesConCifras :: Int -> [Integer]

1	triangularesConCifras :: Int -> [Integer]

tal que (triangulares n) es la lista de los números triangulares con n cifras distintas. Por ejemplo,

   take 6 (triangularesConCifras 1)   ==  [1,3,6,55,66,666]
   take 6 (triangularesConCifras 2)   ==  [10,15,21,28,36,45]
   take 6 (triangularesConCifras 3)   ==  [105,120,136,153,190,210]
   take 5 (triangularesConCifras 4)   ==  [1035,1275,1326,1378,1485]
   take 2 (triangularesConCifras 10)  ==  [1062489753,1239845706]

take 6 (triangularesConCifras 1) == [1,3,6,55,66,666]

take 6 (triangularesConCifras 2) == [10,15,21,28,36,45]

take 6 (triangularesConCifras 3) == [105,120,136,153,190,210]

take 5 (triangularesConCifras 4) == [1035,1275,1326,1378,1485]

take 2 (triangularesConCifras 10) == [1062489753,1239845706]

Soluciones

import Data.List (nub)
import Test.QuickCheck

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

triangularesConCifras1 :: Int -> [Integer]
triangularesConCifras1 n =
  [x | x <- triangulares1,
       nCifras x == n]

-- triangulares1 es la lista de los números triangulares. Por ejemplo,
--    take 10 triangulares1 == [1,3,6,10,15,21,28,36,45,55]
triangulares1 :: [Integer]
triangulares1 = map triangular [1..]

triangular :: Integer -> Integer
triangular 1 = 1
triangular n = triangular (n-1) + n

-- (nCifras x) es el número de cifras distintas del número x. Por
-- ejemplo,
--    nCifras 325275  ==  4
nCifras :: Integer -> Int
nCifras = length . nub . show

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

triangularesConCifras2 :: Int -> [Integer]
triangularesConCifras2 n =
  [x | x <- triangulares2,
       nCifras x == n]

triangulares2 :: [Integer]
triangulares2 = [(n*(n+1)) `div` 2 | n <- [1..]]

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

triangularesConCifras3 :: Int -> [Integer]
triangularesConCifras3 n =
  [x | x <- triangulares3,
       nCifras x == n]

triangulares3 :: [Integer]
triangulares3 = 1 : [x+y | (x,y) <- zip [2..] triangulares3]

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

triangularesConCifras4 :: Int -> [Integer]
triangularesConCifras4 n =
  [x | x <- triangulares4,
       nCifras x == n]

triangulares4 :: [Integer]
triangulares4 = 1 : zipWith (+) [2..] triangulares4

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

triangularesConCifras5 :: Int -> [Integer]
triangularesConCifras5 n =
  [x | x <- triangulares5,
       nCifras x == n]

triangulares5 :: [Integer]
triangulares5 = scanl (+) 1 [2..]

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

-- La 1ª propiedad es
prop_triangularesConCifras1 :: Bool
prop_triangularesConCifras1 =
  [take 2 (triangularesConCifras1 n) | n <- [1..7]] ==
  [take 2 (triangularesConCifras2 n) | n <- [1..7]]

-- La comprobación es
--    λ> prop_triangularesConCifras1
--    True

-- La 2ª propiedad es
prop_triangularesConCifras2 :: Int -> Bool
prop_triangularesConCifras2 n =
  all (== take 5 (triangularesConCifras2 n'))
      [take 5 (triangularesConCifras3 n'),
       take 5 (triangularesConCifras4 n'),
       take 5 (triangularesConCifras5 n')]
  where n' = 1 + n `mod` 9

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

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

-- La comparación es
--    λ> (triangularesConCifras1 3) !! 220
--    5456556
--    (2.48 secs, 1,228,690,120 bytes)
--    λ> (triangularesConCifras2 3) !! 220
--    5456556
--    (0.01 secs, 4,667,288 bytes)
--
--    λ> (triangularesConCifras2 3) !! 600
--    500010500055
--    (1.76 secs, 1,659,299,872 bytes)
--    λ> (triangularesConCifras3 3) !! 600
--    500010500055
--    (1.67 secs, 1,603,298,648 bytes)
--    λ> (triangularesConCifras4 3) !! 600
--    500010500055
--    (1.20 secs, 1,507,298,248 bytes)
--    λ> (triangularesConCifras5 3) !! 600
--    500010500055
--    (1.15 secs, 1,507,298,256 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

import Data.List (nub)

import Test.QuickCheck

-- 1ª solución

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

triangularesConCifras1 :: Int -> [Integer]

triangularesConCifras1 n =

[x | x <- triangulares1,

nCifras x == n]

-- triangulares1 es la lista de los números triangulares. Por ejemplo,

-- take 10 triangulares1 == [1,3,6,10,15,21,28,36,45,55]

triangulares1 :: [Integer]

triangulares1 = map triangular [1..]

triangular :: Integer -> Integer

triangular 1 = 1

triangular n = triangular (n-1) + n

-- (nCifras x) es el número de cifras distintas del número x. Por

-- ejemplo,

-- nCifras 325275 == 4

nCifras :: Integer -> Int

nCifras = length . nub . show

-- 2ª solución

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

triangularesConCifras2 :: Int -> [Integer]

triangularesConCifras2 n =

[x | x <- triangulares2,

nCifras x == n]

triangulares2 :: [Integer]

triangulares2 = [(n*(n+1)) `div` 2 | n <- [1..]]

-- 3ª solución

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

triangularesConCifras3 :: Int -> [Integer]

triangularesConCifras3 n =

[x | x <- triangulares3,

nCifras x == n]

triangulares3 :: [Integer]

triangulares3 = 1 : [x+y | (x,y) <- zip [2..] triangulares3]

-- 4ª solución

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

triangularesConCifras4 :: Int -> [Integer]

triangularesConCifras4 n =

[x | x <- triangulares4,

nCifras x == n]

triangulares4 :: [Integer]

triangulares4 = 1 : zipWith (+) [2..] triangulares4

-- 5ª solución

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

triangularesConCifras5 :: Int -> [Integer]

triangularesConCifras5 n =

[x | x <- triangulares5,

nCifras x == n]

triangulares5 :: [Integer]

triangulares5 = scanl (+) 1 [2..]

-- Comprobación de equivalencia

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

-- La 1ª propiedad es

prop_triangularesConCifras1 :: Bool

prop_triangularesConCifras1 =

[take 2 (triangularesConCifras1 n) | n <- [1..7]] ==

[take 2 (triangularesConCifras2 n) | n <- [1..7]]

-- La comprobación es

-- λ> prop_triangularesConCifras1

-- True

-- La 2ª propiedad es

prop_triangularesConCifras2 :: Int -> Bool

prop_triangularesConCifras2 n =

all (== take 5 (triangularesConCifras2 n'))

[take 5 (triangularesConCifras3 n'),

take 5 (triangularesConCifras4 n'),

take 5 (triangularesConCifras5 n')]

where n' = 1 + n `mod` 9

-- La comprobación es

-- λ> quickCheck prop_triangularesConCifras

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> (triangularesConCifras1 3) !! 220

-- 5456556

-- (2.48 secs, 1,228,690,120 bytes)

-- λ> (triangularesConCifras2 3) !! 220

-- 5456556

-- (0.01 secs, 4,667,288 bytes)

-- λ> (triangularesConCifras2 3) !! 600

-- 500010500055

-- (1.76 secs, 1,659,299,872 bytes)

-- λ> (triangularesConCifras3 3) !! 600

-- 500010500055

-- (1.67 secs, 1,603,298,648 bytes)

-- λ> (triangularesConCifras4 3) !! 600

-- 500010500055

-- (1.20 secs, 1,507,298,248 bytes)

-- λ> (triangularesConCifras5 3) !! 600

-- 500010500055

-- (1.15 secs, 1,507,298,256 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>

Biparticiones de una lista

PorJosé A. Alonso 1-abril-20228-abril-2022

Definir la función

   biparticiones :: [a] -> [([a],[a])]

1	biparticiones :: [a] -> [([a],[a])]

tal que (biparticiones xs) es la lista de pares formados por un prefijo de xs y el resto de xs. Por ejemplo,

   λ> biparticiones [3,2,5]
   [([],[3,2,5]),([3],[2,5]),([3,2],[5]),([3,2,5],[])]
   λ> biparticiones "Roma"
   [("","Roma"),("R","oma"),("Ro","ma"),("Rom","a"),("Roma","")]

λ> biparticiones [3,2,5]

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

λ> biparticiones "Roma"

[("","Roma"),("R","oma"),("Ro","ma"),("Rom","a"),("Roma","")]

Soluciones

import Data.List (inits, tails)
import Control.Applicative (liftA2)
import Test.QuickCheck (quickCheck)

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

biparticiones1 :: [a] -> [([a],[a])]
biparticiones1 [] = [([],[])]
biparticiones1 (x:xs) =
  ([],(x:xs)) : [(x:ys,zs) | (ys,zs) <- biparticiones1 xs]

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

biparticiones2 :: [a] -> [([a],[a])]
biparticiones2 xs =
  [(take i xs, drop i xs) | i <- [0..length xs]]

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

biparticiones3 :: [a] -> [([a],[a])]
biparticiones3 xs =
  [splitAt i xs | i <- [0..length xs]]

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

biparticiones4 :: [a] -> [([a],[a])]
biparticiones4 xs =
  zip (inits xs) (tails xs)

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

biparticiones5 :: [a] -> [([a],[a])]
biparticiones5 = liftA2 zip inits tails

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

biparticiones6 :: [a] -> [([a],[a])]
biparticiones6 = zip <$> inits <*> tails

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

-- La propiedad es
prop_biparticiones :: [Int] -> Bool
prop_biparticiones xs =
  all (== biparticiones1 xs)
      [biparticiones2 xs,
       biparticiones3 xs,
       biparticiones4 xs,
       biparticiones5 xs,
       biparticiones6 xs]

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

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

-- La comparación es
--    λ> length (biparticiones1 [1..6*10^3])
--    6001
--    (2.21 secs, 3,556,073,552 bytes)
--    λ> length (biparticiones2 [1..6*10^3])
--    6001
--    (0.01 secs, 2,508,448 bytes)
--
--    λ> length (biparticiones2 [1..6*10^6])
--    6000001
--    (2.26 secs, 2,016,494,864 bytes)
--    λ> length (biparticiones3 [1..6*10^6])
--    6000001
--    (2.12 secs, 1,584,494,792 bytes)
--    λ> length (biparticiones4 [1..6*10^6])
--    6000001
--    (0.78 secs, 1,968,494,704 bytes)
--    λ> length (biparticiones5 [1..6*10^6])
--    6000001
--    (0.79 secs, 1,968,494,688 bytes)
--    λ> length (biparticiones6 [1..6*10^6])
--    6000001
--    (0.77 secs, 1,968,494,720 bytes)
--
--    λ> length (biparticiones4 [1..10^7])
--    10000001
--    (1.30 secs, 3,280,495,432 bytes)
--    λ> length (biparticiones5 [1..10^7])
--    10000001
--    (1.42 secs, 3,280,495,416 bytes)
--    λ> length (biparticiones6 [1..10^7])
--    10000001
--    (1.30 secs, 3,280,495,448 bytes)

import Data.List (inits, tails)

import Control.Applicative (liftA2)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

biparticiones1 :: [a] -> [([a],[a])]

biparticiones1 [] = [([],[])]

biparticiones1 (x:xs) =

([],(x:xs)) : [(x:ys,zs) | (ys,zs) <- biparticiones1 xs]

-- 2ª solución

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

biparticiones2 :: [a] -> [([a],[a])]

biparticiones2 xs =

[(take i xs, drop i xs) | i <- [0..length xs]]

-- 3ª solución

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

biparticiones3 :: [a] -> [([a],[a])]

biparticiones3 xs =

[splitAt i xs | i <- [0..length xs]]

-- 4ª solución

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

biparticiones4 :: [a] -> [([a],[a])]

biparticiones4 xs =

zip (inits xs) (tails xs)

-- 5ª solución

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

biparticiones5 :: [a] -> [([a],[a])]

biparticiones5 = liftA2 zip inits tails

-- 6ª solución

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

biparticiones6 :: [a] -> [([a],[a])]

biparticiones6 = zip <$> inits <*> tails

-- Comprobación de equivalencia

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

-- La propiedad es

prop_biparticiones :: [Int] -> Bool

prop_biparticiones xs =

all (== biparticiones1 xs)

[biparticiones2 xs,

biparticiones3 xs,

biparticiones4 xs,

biparticiones5 xs,

biparticiones6 xs]

-- La comprobación es

-- λ> quickCheck prop_biparticiones

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (biparticiones1 [1..6*10^3])

-- 6001

-- (2.21 secs, 3,556,073,552 bytes)

-- λ> length (biparticiones2 [1..6*10^3])

-- 6001

-- (0.01 secs, 2,508,448 bytes)

-- λ> length (biparticiones2 [1..6*10^6])

-- 6000001

-- (2.26 secs, 2,016,494,864 bytes)

-- λ> length (biparticiones3 [1..6*10^6])

-- 6000001

-- (2.12 secs, 1,584,494,792 bytes)

-- λ> length (biparticiones4 [1..6*10^6])

-- 6000001

-- (0.78 secs, 1,968,494,704 bytes)

-- λ> length (biparticiones5 [1..6*10^6])

-- 6000001

-- (0.79 secs, 1,968,494,688 bytes)

-- λ> length (biparticiones6 [1..6*10^6])

-- 6000001

-- (0.77 secs, 1,968,494,720 bytes)

-- λ> length (biparticiones4 [1..10^7])

-- 10000001

-- (1.30 secs, 3,280,495,432 bytes)

-- λ> length (biparticiones5 [1..10^7])

-- 10000001

-- (1.42 secs, 3,280,495,416 bytes)

-- λ> length (biparticiones6 [1..10^7])

-- 10000001

-- (1.30 secs, 3,280,495,448 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>

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>

Número de pares de elementos adyacentes iguales en una matriz

PorJosé A. Alonso 25-marzo-20221-abril-2022

Una matriz se puede representar mediante una lista de listas. Por ejemplo, la matriz

   |2 1 5|
   |4 3 7|

1 2	\|2 1 5\| \|4 3 7\|

se puede representar mediante la lista

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

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

Definir la función

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

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

tal que (numeroParesAdyacentesIguales xss) es el número de pares de elementos consecutivos (en la misma fila o columna) iguales de la matriz xss. Por ejemplo,

   numeroParesAdyacentesIguales [[0,1],[0,2]]              ==  1
   numeroParesAdyacentesIguales [[0,0],[1,2]]              ==  1
   numeroParesAdyacentesIguales [[0,1],[0,0]]              ==  2
   numeroParesAdyacentesIguales [[1,2],[1,4],[4,4]]        ==  3
   numeroParesAdyacentesIguales ["ab","aa"]                ==  2
   numeroParesAdyacentesIguales [[0,0,0],[0,0,0],[0,0,0]]  ==  12
   numeroParesAdyacentesIguales [[0,0,0],[0,1,0],[0,0,0]]  ==  8

numeroParesAdyacentesIguales [[0,1],[0,2]] == 1

numeroParesAdyacentesIguales [[0,0],[1,2]] == 1

numeroParesAdyacentesIguales [[0,1],[0,0]] == 2

numeroParesAdyacentesIguales [[1,2],[1,4],[4,4]] == 3

numeroParesAdyacentesIguales ["ab","aa"] == 2

numeroParesAdyacentesIguales [[0,0,0],[0,0,0],[0,0,0]] == 12

numeroParesAdyacentesIguales [[0,0,0],[0,1,0],[0,0,0]] == 8

Soluciones

import Data.List (group,transpose)
import Data.Array ((!), listArray)
import Test.QuickCheck

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

numeroParesAdyacentesIguales1 :: Eq a => [[a]] -> Int
numeroParesAdyacentesIguales1 xss =
  length [(i,j) | i <- [1..m-1], j <- [1..n], p!(i,j) == p!(i+1,j)] +
  length [(i,j) | i <- [1..m], j <- [1..n-1], p!(i,j) == p!(i,j+1)]
  where m = length xss
        n = length (head xss)
        p = listArray ((1,1),(m,n)) (concat xss)

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

numeroParesAdyacentesIguales2 :: Eq a => [[a]] -> Int
numeroParesAdyacentesIguales2 xss =
  numeroParesAdyacentesIgualesFilas xss +
  numeroParesAdyacentesIgualesFilas (transpose xss)

-- (numeroParesAdyacentesIgualesFilas xss) es el número de pares de
-- elementos consecutivos (en la misma fila) iguales de la matriz
-- xss. Por ejemplo,
--    λ> numeroParesAdyacentesIgualesFilas [[0,0,1,0],[0,1,1,0],[0,1,0,1]]
--    2
--    λ> numeroParesAdyacentesIgualesFilas ["0010","0110","0101"]
--    2
numeroParesAdyacentesIgualesFilas :: Eq a => [[a]] -> Int
numeroParesAdyacentesIgualesFilas xss =
  sum [numeroParesAdyacentesIgualesFila xs | xs <- xss]

-- La función anterior se puede definir con map
numeroParesAdyacentesIgualesFilas2 :: Eq a => [[a]] -> Int
numeroParesAdyacentesIgualesFilas2 xss =
  sum (map numeroParesAdyacentesIgualesFila xss)

-- y también se puede definir sin argumentos:
numeroParesAdyacentesIgualesFilas3 :: Eq a => [[a]] -> Int
numeroParesAdyacentesIgualesFilas3 =
  sum . map numeroParesAdyacentesIgualesFila

-- (numeroParesAdyacentesIgualesFila xs) es el número de pares de
-- elementos consecutivos de la lista xs. Por ejemplo,
--    numeroParesAdyacentesIgualesFila [5,5,5,2,5] ==  2
numeroParesAdyacentesIgualesFila :: Eq a => [a] -> Int
numeroParesAdyacentesIgualesFila xs =
  length [(x,y) | (x,y) <- zip xs (tail xs), x == y]

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

numeroParesAdyacentesIguales3 :: Eq a => [[a]] -> Int
numeroParesAdyacentesIguales3 xss =
  length (concatMap tail (concatMap group (xss ++ transpose xss)))

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

numeroParesAdyacentesIguales4 :: Eq a => [[a]] -> Int
numeroParesAdyacentesIguales4 =
  length . (tail =<<) . (group =<<) . ((++) =<< transpose)

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

newtype Matriz = M [[Int]]
  deriving Show

-- Generador de matrices arbitrarias. Por ejemplo,
--    λ> generate matrizArbitraria
--    M [[-3,0],[8,-6],[-13,-13],[10,8],[14,29]]
--    λ> generate matrizArbitraria
--    M [[11,9,4,-25,-29,30,-18],[13,8,-2,-22,29,-3,-13]]
matrizArbitraria :: Gen Matriz
matrizArbitraria = do
  m <- chooseInt (1,10)
  n <- chooseInt (1,10)
  xss <- vectorOf m (vectorOf n arbitrary)
  return (M xss)

-- Matriz es una subclase de Arbitrary.
instance Arbitrary Matriz where
  arbitrary = matrizArbitraria

-- La propiedad es
prop_numeroParesAdyacentesIguales :: Matriz -> Bool
prop_numeroParesAdyacentesIguales (M xss) =
  all (== numeroParesAdyacentesIguales1 xss)
      [numeroParesAdyacentesIguales2 xss,
       numeroParesAdyacentesIguales3 xss,
       numeroParesAdyacentesIguales4 xss]

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

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

-- La comparación es
--    λ> numeroParesAdyacentesIguales1 (replicate (3*10^3) (replicate (10^3) 0))
--    5996000
--    (5.51 secs, 4,751,249,472 bytes)
--    λ> numeroParesAdyacentesIguales2 (replicate (3*10^3) (replicate (10^3) 0))
--    5996000
--    (2.62 secs, 1,681,379,960 bytes)
--    λ> numeroParesAdyacentesIguales3 (replicate (3*10^3) (replicate (10^3) 0))
--    5996000
--    (0.48 secs, 1,393,672,616 bytes)
--    λ> numeroParesAdyacentesIguales4 (replicate (3*10^3) (replicate (10^3) 0))
--    5996000
--    (0.38 secs, 1,393,560,848 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

import Data.List (group,transpose)

import Data.Array ((!), listArray)

import Test.QuickCheck

-- 1ª solución

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

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

numeroParesAdyacentesIguales1 xss =

length [(i,j) | i <- [1..m-1], j <- [1..n], p!(i,j) == p!(i+1,j)] +

length [(i,j) | i <- [1..m], j <- [1..n-1], p!(i,j) == p!(i,j+1)]

where m = length xss

n = length (head xss)

p = listArray ((1,1),(m,n)) (concat xss)

-- 2ª solución

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

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

numeroParesAdyacentesIguales2 xss =

numeroParesAdyacentesIgualesFilas xss +

numeroParesAdyacentesIgualesFilas (transpose xss)

-- (numeroParesAdyacentesIgualesFilas xss) es el número de pares de

-- elementos consecutivos (en la misma fila) iguales de la matriz

-- xss. Por ejemplo,

-- λ> numeroParesAdyacentesIgualesFilas [[0,0,1,0],[0,1,1,0],[0,1,0,1]]

-- 2

-- λ> numeroParesAdyacentesIgualesFilas ["0010","0110","0101"]

-- 2

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

numeroParesAdyacentesIgualesFilas xss =

sum [numeroParesAdyacentesIgualesFila xs | xs <- xss]

-- La función anterior se puede definir con map

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

numeroParesAdyacentesIgualesFilas2 xss =

sum (map numeroParesAdyacentesIgualesFila xss)

-- y también se puede definir sin argumentos:

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

numeroParesAdyacentesIgualesFilas3 =

sum . map numeroParesAdyacentesIgualesFila

-- (numeroParesAdyacentesIgualesFila xs) es el número de pares de

-- elementos consecutivos de la lista xs. Por ejemplo,

-- numeroParesAdyacentesIgualesFila [5,5,5,2,5] == 2

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

numeroParesAdyacentesIgualesFila xs =

length [(x,y) | (x,y) <- zip xs (tail xs), x == y]

-- 3ª solución

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

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

numeroParesAdyacentesIguales3 xss =

length (concatMap tail (concatMap group (xss ++ transpose xss)))

-- 4ª solución

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

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

numeroParesAdyacentesIguales4 =

length . (tail =<<) . (group =<<) . ((++) =<< transpose)

-- Comprobación de equivalencia

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

newtype Matriz = M [[Int]]

deriving Show

-- Generador de matrices arbitrarias. Por ejemplo,

-- λ> generate matrizArbitraria

-- M [[-3,0],[8,-6],[-13,-13],[10,8],[14,29]]

-- λ> generate matrizArbitraria

-- M [[11,9,4,-25,-29,30,-18],[13,8,-2,-22,29,-3,-13]]

matrizArbitraria :: Gen Matriz

matrizArbitraria = do

m <- chooseInt (1,10)

n <- chooseInt (1,10)

xss <- vectorOf m (vectorOf n arbitrary)

return (M xss)

-- Matriz es una subclase de Arbitrary.

instance Arbitrary Matriz where

arbitrary = matrizArbitraria

-- La propiedad es

prop_numeroParesAdyacentesIguales :: Matriz -> Bool

prop_numeroParesAdyacentesIguales (M xss) =

all (== numeroParesAdyacentesIguales1 xss)

[numeroParesAdyacentesIguales2 xss,

numeroParesAdyacentesIguales3 xss,

numeroParesAdyacentesIguales4 xss]

-- La comprobación es

-- λ> quickCheck prop_numeroParesAdyacentesIguales

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> numeroParesAdyacentesIguales1 (replicate (3*10^3) (replicate (10^3) 0))

-- 5996000

-- (5.51 secs, 4,751,249,472 bytes)

-- λ> numeroParesAdyacentesIguales2 (replicate (3*10^3) (replicate (10^3) 0))

-- 5996000

-- (2.62 secs, 1,681,379,960 bytes)

-- λ> numeroParesAdyacentesIguales3 (replicate (3*10^3) (replicate (10^3) 0))

-- 5996000

-- (0.48 secs, 1,393,672,616 bytes)

-- λ> numeroParesAdyacentesIguales4 (replicate (3*10^3) (replicate (10^3) 0))

-- 5996000

-- (0.38 secs, 1,393,560,848 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>

Elemento más repetido de manera consecutiva

PorJosé A. Alonso 24-marzo-202231-marzo-2022

Definir la función

   masRepetido :: Ord a => [a] -> (a,Int)

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

tal que (masRepetido xs) es el elemento de xs que aparece más veces de manera consecutiva en la lista junto con el número de sus apariciones consecutivas; en caso de empate, se devuelve el mayor de dichos elementos. Por ejemplo,

   masRepetido [1,1,4,4,1]  ==  (4,2)
   masRepetido [4,4,1,1,5]  ==  (4,2)
   masRepetido "aadda"      ==  ('d',2)
   masRepetido "ddaab"      ==  ('d',2)
   masRepetido (show (product [1..5*10^4]))  ==  ('0',12499)

masRepetido [1,1,4,4,1] == (4,2)

masRepetido [4,4,1,1,5] == (4,2)

masRepetido "aadda" == ('d',2)

masRepetido "ddaab" == ('d',2)

masRepetido (show (product [1..5*10^4])) == ('0',12499)

Soluciones

import Data.List (group)
import Data.Tuple (swap)
import Control.Arrow ((&&&))
import Test.QuickCheck

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

masRepetido1 :: Ord a => [a] -> (a,Int)
masRepetido1 [x] = (x,1)
masRepetido1 (x:y:zs) | m > n      = (x,m)
                      | m == n     = (max x u,m)
                      | otherwise  = (u,n)
  where (u,n)  = masRepetido1 (y:zs)
        m      = length (takeWhile (==x) (x:y:zs))

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

masRepetido2 :: Ord a => [a] -> (a,Int)
masRepetido2 (x:xs)
  | null xs'   = (x,length (x:xs))
  | m > n      = (x,m)
  | m == n     = (max x u,m)
  | otherwise  = (u,n)
  where xs'    = dropWhile (== x) xs
        m      = length (takeWhile (==x) (x:xs))
        (u,n)  = masRepetido2 xs'

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

masRepetido3 :: Ord a => [a] -> (a,Int)
masRepetido3 xs = (n,z)
  where (z,n) = maximum [(1 + length ys,y) | (y:ys) <- group xs]

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

masRepetido4 :: Ord a => [a] -> (a,Int)
masRepetido4 xs =
  swap (maximum [(1 + length ys,y) | (y:ys) <- group xs])

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

masRepetido5 :: Ord a => [a] -> (a,Int)
masRepetido5 xs =
  swap (maximum (map (\ys -> (length ys, head ys)) (group xs)))

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

masRepetido6 :: Ord a => [a] -> (a,Int)
masRepetido6 =
  swap . maximum . map ((,) <$> length <*> head) . group

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

masRepetido7 :: Ord a => [a] -> (a,Int)
masRepetido7 =
  swap . maximum . map (length &&& head) . group

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

-- La propiedad es
prop_masRepetido :: NonEmptyList Int -> Bool
prop_masRepetido (NonEmpty xs) =
  all (== masRepetido1 xs)
      [masRepetido2 xs,
       masRepetido3 xs,
       masRepetido4 xs,
       masRepetido5 xs,
       masRepetido6 xs,
       masRepetido7 xs]

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

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

-- La comparación es
--    λ> masRepetido1 (show (product [1..3*10^4]))
--    ('0',7498)
--    (3.72 secs, 2,589,930,952 bytes)
--    λ> masRepetido2 (show (product [1..3*10^4]))
--    ('0',7498)
--    (1.27 secs, 991,406,232 bytes)
--    λ> masRepetido3 (show (product [1..3*10^4]))
--    ('0',7498)
--    (0.85 secs, 945,399,976 bytes)
--    λ> masRepetido4 (show (product [1..3*10^4]))
--    ('0',7498)
--    (0.86 secs, 945,399,888 bytes)
--    λ> masRepetido5 (show (product [1..3*10^4]))
--    ('0',7498)
--    (0.80 secs, 943,760,760 bytes)
--    λ> masRepetido6 (show (product [1..3*10^4]))
--    ('0',7498)
--    (0.78 secs, 945,400,400 bytes)
--    λ> masRepetido7 (show (product [1..3*10^4]))
--    ('0',7498)
--    (0.78 secs, 942,122,088 bytes)
--
--    λ> masRepetido2 (show (product [1..5*10^4]))
--    ('0',12499)
--    (3.27 secs, 2,798,156,008 bytes)
--    λ> masRepetido3 (show (product [1..5*10^4]))
--    ('0',12499)
--    (2.20 secs, 2,716,952,408 bytes)
--    λ> masRepetido4 (show (product [1..5*10^4]))
--    ('0',12499)
--    (2.22 secs, 2,716,952,320 bytes)
--    λ> masRepetido5 (show (product [1..5*10^4]))
--    ('0',12499)
--    (2.18 secs, 2,714,062,328 bytes)
--    λ> masRepetido6 (show (product [1..5*10^4]))
--    ('0',12499)
--    (2.17 secs, 2,716,952,832 bytes)
--    λ> masRepetido7 (show (product [1..5*10^4]))
--    ('0',12499)
--    (2.17 secs, 2,711,172,792 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

124

125

126

import Data.List (group)

import Data.Tuple (swap)

import Control.Arrow ((&&&))

import Test.QuickCheck

-- 1ª solución

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

masRepetido1 :: Ord a => [a] -> (a,Int)

masRepetido1 [x] = (x,1)

masRepetido1 (x:y:zs) | m > n = (x,m)

| m == n = (max x u,m)

| otherwise = (u,n)

where (u,n) = masRepetido1 (y:zs)

m = length (takeWhile (==x) (x:y:zs))

-- 2ª solución

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

masRepetido2 :: Ord a => [a] -> (a,Int)

masRepetido2 (x:xs)

| null xs' = (x,length (x:xs))

| m > n = (x,m)

| m == n = (max x u,m)

| otherwise = (u,n)

where xs' = dropWhile (== x) xs

m = length (takeWhile (==x) (x:xs))

(u,n) = masRepetido2 xs'

-- 3ª solución

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

masRepetido3 :: Ord a => [a] -> (a,Int)

masRepetido3 xs = (n,z)

where (z,n) = maximum [(1 + length ys,y) | (y:ys) <- group xs]

-- 4ª solución

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

masRepetido4 :: Ord a => [a] -> (a,Int)

masRepetido4 xs =

swap (maximum [(1 + length ys,y) | (y:ys) <- group xs])

-- 5ª solución

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

masRepetido5 :: Ord a => [a] -> (a,Int)

masRepetido5 xs =

swap (maximum (map (\ys -> (length ys, head ys)) (group xs)))

-- 6ª solución

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

masRepetido6 :: Ord a => [a] -> (a,Int)

masRepetido6 =

swap . maximum . map ((,) <$> length <*> head) . group

-- 7ª solución

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

masRepetido7 :: Ord a => [a] -> (a,Int)

masRepetido7 =

swap . maximum . map (length &&& head) . group

-- Comprobación de equivalencia

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

-- La propiedad es

prop_masRepetido :: NonEmptyList Int -> Bool

prop_masRepetido (NonEmpty xs) =

all (== masRepetido1 xs)

[masRepetido2 xs,

masRepetido3 xs,

masRepetido4 xs,

masRepetido5 xs,

masRepetido6 xs,

masRepetido7 xs]

-- La comprobación es

-- λ> quickCheck prop_masRepetido

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> masRepetido1 (show (product [1..3*10^4]))

-- ('0',7498)

-- (3.72 secs, 2,589,930,952 bytes)

-- λ> masRepetido2 (show (product [1..3*10^4]))

-- ('0',7498)

-- (1.27 secs, 991,406,232 bytes)

-- λ> masRepetido3 (show (product [1..3*10^4]))

-- ('0',7498)

-- (0.85 secs, 945,399,976 bytes)

-- λ> masRepetido4 (show (product [1..3*10^4]))

-- ('0',7498)

-- (0.86 secs, 945,399,888 bytes)

-- λ> masRepetido5 (show (product [1..3*10^4]))

-- ('0',7498)

-- (0.80 secs, 943,760,760 bytes)

-- λ> masRepetido6 (show (product [1..3*10^4]))

-- ('0',7498)

-- (0.78 secs, 945,400,400 bytes)

-- λ> masRepetido7 (show (product [1..3*10^4]))

-- ('0',7498)

-- (0.78 secs, 942,122,088 bytes)

-- λ> masRepetido2 (show (product [1..5*10^4]))

-- ('0',12499)

-- (3.27 secs, 2,798,156,008 bytes)

-- λ> masRepetido3 (show (product [1..5*10^4]))

-- ('0',12499)

-- (2.20 secs, 2,716,952,408 bytes)

-- λ> masRepetido4 (show (product [1..5*10^4]))

-- ('0',12499)

-- (2.22 secs, 2,716,952,320 bytes)

-- λ> masRepetido5 (show (product [1..5*10^4]))

-- ('0',12499)

-- (2.18 secs, 2,714,062,328 bytes)

-- λ> masRepetido6 (show (product [1..5*10^4]))

-- ('0',12499)

-- (2.17 secs, 2,716,952,832 bytes)

-- λ> masRepetido7 (show (product [1..5*10^4]))

-- ('0',12499)

-- (2.17 secs, 2,711,172,792 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>

Regiones determinadas por n rectas del plano

PorJosé A. Alonso 23-marzo-20222-abril-2022

En los siguientes dibujos se observa que el número máximo de regiones en el plano generadas con 1, 2 ó 3 líneas son 2, 4 ó 7, respectivamente.

                      \  |
                       \5|
                        \|
                         \
                         |\
                         | \
               |         |  \
    1        1 | 3     1 | 3 \  6
   ------   ---|---   ---|----\---
    2        2 | 4     2 | 4   \ 7
               |         |      \

\ |

\5|

| \

| | \

1 1 | 3 1 | 3 \ 6

------ ---|--- ---|----\---

2 2 | 4 2 | 4 \ 7

| | \

Definir la función

   regiones :: Integer -> Integer

1	regiones :: Integer -> Integer

tal que (regiones n) es el número máximo de regiones en el plano generadas con n líneas. Por ejemplo,

   regiones 1     ==  2
   regiones 2     ==  4
   regiones 3     ==  7
   regiones 100   ==  5051
   regiones 1000  ==  500501
   regiones 10000 ==  50005001
   length (show (regiones (10^(10^5)))) ==  200000
   length (show (regiones (10^(10^6)))) ==  2000000
   length (show (regiones (10^(10^6)))) ==  2000000
   length (show (regiones (10^(10^7)))) ==  20000000

regiones 1 == 2

regiones 2 == 4

regiones 3 == 7

regiones 100 == 5051

regiones 1000 == 500501

regiones 10000 == 50005001

length (show (regiones (10^(10^5)))) == 200000

length (show (regiones (10^(10^6)))) == 2000000

length (show (regiones (10^(10^7)))) == 20000000

Soluciones

import Data.List (genericIndex)
import Test.QuickCheck

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

regiones1 :: Integer -> Integer
regiones1 0 = 1
regiones1 n = regiones1 (n-1) + n

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

regiones2 :: Integer -> Integer
regiones2 n = 1 + sum [0..n]

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

regiones3 :: Integer -> Integer
regiones3 n = 1 + sumas `genericIndex` n

-- (sumas n) es la suma 0 + 1 + 2 +...+ n. Por ejemplo,
--    take 10 sumas  ==  [0,1,3,6,10,15,21,28,36,45]
sumas :: [Integer]
sumas = scanl1 (+) [0..]

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

regiones4 :: Integer -> Integer
regiones4 n = 1 + n*(n+1) `div` 2

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

-- La propiedad es
prop_regiones :: Positive Integer -> Bool
prop_regiones (Positive n) =
  all (== regiones1 n)
      [regiones2 n,
       regiones3 n,
       regiones4 n]

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

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

-- La comparación es
--    λ> regiones1 (4*10^6)
--    8000002000001
--    (2.20 secs, 938,105,888 bytes)
--    λ> regiones2 (4*10^6)
--    8000002000001
--    (0.77 secs, 645,391,624 bytes)
--    λ> regiones3 (4*10^6)
--    8000002000001
--    (1.22 secs, 1,381,375,296 bytes)
--    λ> regiones4 (4*10^6)
--    8000002000001
--    (0.01 secs, 484,552 bytes)

import Data.List (genericIndex)

import Test.QuickCheck

-- 1ª solución

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

regiones1 :: Integer -> Integer

regiones1 0 = 1

regiones1 n = regiones1 (n-1) + n

-- 2ª solución

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

regiones2 :: Integer -> Integer

regiones2 n = 1 + sum [0..n]

-- 3ª solución

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

regiones3 :: Integer -> Integer

regiones3 n = 1 + sumas `genericIndex` n

-- (sumas n) es la suma 0 + 1 + 2 +...+ n. Por ejemplo,

-- take 10 sumas == [0,1,3,6,10,15,21,28,36,45]

sumas :: [Integer]

sumas = scanl1 (+) [0..]

-- 4ª solución

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

regiones4 :: Integer -> Integer

regiones4 n = 1 + n*(n+1) `div` 2

-- Comprobación de equivalencia

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

-- La propiedad es

prop_regiones :: Positive Integer -> Bool

prop_regiones (Positive n) =

all (== regiones1 n)

[regiones2 n,

regiones3 n,

regiones4 n]

-- La comprobación es

-- λ> quickCheck prop_regiones

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> regiones1 (4*10^6)

-- 8000002000001

-- (2.20 secs, 938,105,888 bytes)

-- λ> regiones2 (4*10^6)

-- 8000002000001

-- (0.77 secs, 645,391,624 bytes)

-- λ> regiones3 (4*10^6)

-- 8000002000001

-- (1.22 secs, 1,381,375,296 bytes)

-- λ> regiones4 (4*10^6)

-- 8000002000001

-- (0.01 secs, 484,552 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>

Ordenación de estructuras

PorJosé A. Alonso 18-marzo-202225-marzo-2022

Las notas de los dos primeros exámenes se pueden representar mediante el siguiente tipo de dato

   data Notas = Notas String Int Int
     deriving (Read, Show, Eq)

1 2	data Notas = Notas String Int Int deriving (Read, Show, Eq)

Por ejemplo, (Notas «Juan» 6 5) representa las notas de un alumno cuyo nombre es Juan, la nota del primer examen es 6 y la del segundo es 5.

Definir la función

   ordenadas :: [Notas] -> [Notas]

1	ordenadas :: [Notas] -> [Notas]

tal que (ordenadas ns) es la lista de las notas ns ordenadas considerando primero la nota del examen 2, a continuación la del examen 1 y finalmente el nombre. Por ejemplo,

   λ> ordenadas [Notas "Juan" 6 5, Notas "Luis" 3 7]
   [Notas "Juan" 6 5,Notas "Luis" 3 7]
   λ> ordenadas [Notas "Juan" 6 5, Notas "Luis" 3 4]
   [Notas "Luis" 3 4,Notas "Juan" 6 5]
   λ> ordenadas [Notas "Juan" 6 5, Notas "Luis" 7 4]
   [Notas "Luis" 7 4,Notas "Juan" 6 5]
   λ> ordenadas [Notas "Juan" 6 4, Notas "Luis" 7 4]
   [Notas "Juan" 6 4,Notas "Luis" 7 4]
   λ> ordenadas [Notas "Juan" 6 4, Notas "Luis" 5 4]
   [Notas "Luis" 5 4,Notas "Juan" 6 4]
   λ> ordenadas [Notas "Juan" 5 4, Notas "Luis" 5 4]
   [Notas "Juan" 5 4,Notas "Luis" 5 4]
   λ> ordenadas [Notas "Juan" 5 4, Notas "Eva" 5 4]
   [Notas "Eva" 5 4,Notas "Juan" 5 4]

λ> ordenadas [Notas "Juan" 6 5, Notas "Luis" 3 7]

[Notas "Juan" 6 5,Notas "Luis" 3 7]

λ> ordenadas [Notas "Juan" 6 5, Notas "Luis" 3 4]

[Notas "Luis" 3 4,Notas "Juan" 6 5]

λ> ordenadas [Notas "Juan" 6 5, Notas "Luis" 7 4]

[Notas "Luis" 7 4,Notas "Juan" 6 5]

λ> ordenadas [Notas "Juan" 6 4, Notas "Luis" 7 4]

[Notas "Juan" 6 4,Notas "Luis" 7 4]

λ> ordenadas [Notas "Juan" 6 4, Notas "Luis" 5 4]

[Notas "Luis" 5 4,Notas "Juan" 6 4]

λ> ordenadas [Notas "Juan" 5 4, Notas "Luis" 5 4]

[Notas "Juan" 5 4,Notas "Luis" 5 4]

λ> ordenadas [Notas "Juan" 5 4, Notas "Eva" 5 4]

[Notas "Eva" 5 4,Notas "Juan" 5 4]

Soluciones

import Data.List (sort, sortBy)
import Test.QuickCheck

data Notas = Notas String Int Int
  deriving (Read, Show, Eq)

-- 1ª solución
ordenadas1 :: [Notas] -> [Notas]
ordenadas1 ns =
  [Notas n x y | (y,x,n) <- sort [(y1,x1,n1) | (Notas n1 x1 y1) <- ns]]

-- 2ª solución
ordenadas2 :: [Notas] -> [Notas]
ordenadas2 ns =
  map (\(y,x,n) -> Notas n x y) (sort [(y1,x1,n1) | (Notas n1 x1 y1) <- ns])

-- 3ª solución
ordenadas3 :: [Notas] -> [Notas]
ordenadas3 ns = sortBy (\(Notas n1 x1 y1) (Notas n2 x2 y2) ->
                          compare (y1,x1,n1) (y2,x2,n2))
                       ns

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

instance Ord Notas where
  Notas n1 x1 y1 <= Notas n2 x2 y2 = (y1,x1,n1) <= (y2,x2,n2)

ordenadas4 :: [Notas] -> [Notas]
ordenadas4 = sort

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

-- notasArbitraria es un generador aleatorio de notas. Por ejemplo,
--    λ> sample notasArbitraria
--    Notas "achjkqruvxy" 3 3
--    Notas "abfgikmptuvy" 10 10
--    Notas "degjmptvwx" 7 9
--    Notas "cdefghjmnoqrsuw" 0 9
--    Notas "bcdfikmstuxz" 1 8
--    Notas "abcdhkopqsvwx" 10 7
--    Notas "abghiklnoqstvwx" 0 0
--    Notas "abfghklmnoptuvx" 4 9
--    Notas "bdehjkmpqsxyz" 0 4
--    Notas "afghijmopsvwz" 3 7
--    Notas "bdefghjklnoqx" 2 3
notasArbitraria :: Gen Notas
notasArbitraria = do
  n <- sublistOf ['a'..'z']
  x <- chooseInt (0, 10)
  y <- chooseInt (0, 10)
  return (Notas n x y)

-- Notas es una subclase de Arbitrary
instance Arbitrary Notas where
  arbitrary = notasArbitraria

-- La propiedad es
prop_ordenadas :: [Notas] -> Bool
prop_ordenadas ns =
  all (== ordenadas1 ns)
      [f ns | f <- [ordenadas2,
                    ordenadas3,
                    ordenadas4]]

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

import Data.List (sort, sortBy)

import Test.QuickCheck

data Notas = Notas String Int Int

deriving (Read, Show, Eq)

-- 1ª solución

ordenadas1 :: [Notas] -> [Notas]

ordenadas1 ns =

[Notas n x y | (y,x,n) <- sort [(y1,x1,n1) | (Notas n1 x1 y1) <- ns]]

-- 2ª solución

ordenadas2 :: [Notas] -> [Notas]

ordenadas2 ns =

map (\(y,x,n) -> Notas n x y) (sort [(y1,x1,n1) | (Notas n1 x1 y1) <- ns])

-- 3ª solución

ordenadas3 :: [Notas] -> [Notas]

ordenadas3 ns = sortBy (\(Notas n1 x1 y1) (Notas n2 x2 y2) ->

compare (y1,x1,n1) (y2,x2,n2))

-- 4ª solución

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

instance Ord Notas where

Notas n1 x1 y1 <= Notas n2 x2 y2 = (y1,x1,n1) <= (y2,x2,n2)

ordenadas4 :: [Notas] -> [Notas]

ordenadas4 = sort

-- Comprobación de equivalencia

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

-- notasArbitraria es un generador aleatorio de notas. Por ejemplo,

-- λ> sample notasArbitraria

-- Notas "achjkqruvxy" 3 3

-- Notas "abfgikmptuvy" 10 10

-- Notas "degjmptvwx" 7 9

-- Notas "cdefghjmnoqrsuw" 0 9

-- Notas "bcdfikmstuxz" 1 8

-- Notas "abcdhkopqsvwx" 10 7

-- Notas "abghiklnoqstvwx" 0 0

-- Notas "abfghklmnoptuvx" 4 9

-- Notas "bdehjkmpqsxyz" 0 4

-- Notas "afghijmopsvwz" 3 7

-- Notas "bdefghjklnoqx" 2 3

notasArbitraria :: Gen Notas

notasArbitraria = do

n <- sublistOf ['a'..'z']

x <- chooseInt (0, 10)

y <- chooseInt (0, 10)

return (Notas n x y)

-- Notas es una subclase de Arbitrary

instance Arbitrary Notas where

arbitrary = notasArbitraria

-- La propiedad es

prop_ordenadas :: [Notas] -> Bool

prop_ordenadas ns =

all (== ordenadas1 ns)

[f ns | f <- [ordenadas2,

ordenadas3,

ordenadas4]]

-- La comprobación es

-- λ> quickCheck prop_ordenadas

-- +++ OK, passed 100 tests.

El código se encuentra en GitHub.

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

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:

Anagramas

PorJosé A. Alonso 1-marzo-20228-marzo-2022

Una palabra es una anagrama de otra si se puede obtener permutando sus letras. Por ejemplo, «mora» y «roma» son anagramas de «amor».

Definir la función

   anagramas :: String -> [String] -> [String]

1	anagramas :: String -> [String] -> [String]

tal que (anagramas x ys) es la lista de los elementos de ys que son anagramas de x. Por ejemplo,

   λ> anagramas "amor" ["Roma","mola","loma","moRa", "rama"]
   ["Roma","moRa"]
   λ> anagramas "rama" ["aMar","amaRa","roMa","marr","aRma"]
   ["aMar","aRma"]

λ> anagramas "amor" ["Roma","mola","loma","moRa", "rama"]

["Roma","moRa"]

λ> anagramas "rama" ["aMar","amaRa","roMa","marr","aRma"]

["aMar","aRma"]

Soluciones

import Data.List (delete, permutations, sort)
import Data.Char (toLower)
import Data.Function (on)

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

anagramas :: String -> [String] -> [String]
anagramas _ [] = []
anagramas x (y:ys)
  | sonAnagramas x y = y : anagramas x ys
  | otherwise        = anagramas x ys

-- (sonAnagramas xs ys) se verifica si xs e ys son anagramas. Por
-- ejemplo,
--    sonAnagramas "amor" "Roma"  ==  True
--    sonAnagramas "amor" "mola"  ==  False
sonAnagramas :: String -> String -> Bool
sonAnagramas xs ys =
  sort (map toLower xs) == sort (map toLower ys)

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

anagramas2 :: String -> [String] -> [String]
anagramas2 _ [] = []
anagramas2 x (y:ys)
  | sonAnagramas2 x y = y : anagramas2 x ys
  | otherwise         = anagramas2 x ys

sonAnagramas2 :: String -> String -> Bool
sonAnagramas2 xs ys =
  (sort . map toLower) xs == (sort . map toLower) ys

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

anagramas3 :: String -> [String] -> [String]
anagramas3 _ [] = []
anagramas3 x (y:ys)
  | sonAnagramas3 x y = y : anagramas3 x ys
  | otherwise         = anagramas3 x ys

sonAnagramas3 :: String -> String -> Bool
sonAnagramas3 = (==) `on` (sort . map toLower)

-- Nota. En la solución anterior se usa la función on ya que
--    (f `on` g) x y
-- es equivalente a
--    f (g x) (g y)
-- Por ejemplo,
--    λ> ((*) `on` (+2)) 3 4
--    30

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

anagramas4 :: String -> [String] -> [String]
anagramas4 x ys = [y | y <- ys, sonAnagramas x y]

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

anagramas5 :: String -> [String] -> [String]
anagramas5 x = filter (`sonAnagramas` x)

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

anagramas6 :: String -> [String] -> [String]
anagramas6 x = filter (((==) `on` (sort . map toLower)) x)

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

anagramas7 :: String -> [String] -> [String]
anagramas7 _ [] = []
anagramas7 x (y:ys)
  | sonAnagramas7 x y = y : anagramas7 x ys
  | otherwise         = anagramas7 x ys

sonAnagramas7 :: String -> String -> Bool
sonAnagramas7 xs ys = aux (map toLower xs) (map toLower ys)
  where
    aux [] [] = True
    aux [] _  = False
    aux (u:us) vs | u `notElem` vs = False
                  | otherwise      = aux us (delete u vs)

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

-- La comparación es
--    λ> ej = take (10^6) (permutations "1234567890")
--    λ> length (anagramas "1234567890" ej)
--    1000000
--    (2.27 secs, 5,627,236,104 bytes)
--    λ> length (anagramas2 "1234567890" ej)
--    1000000
--    (2.80 secs, 5,513,260,584 bytes)
--    λ> length (anagramas3 "1234567890" ej)
--    1000000
--    (1.86 secs, 5,097,260,856 bytes)
--    λ> length (anagramas4 "1234567890" ej)
--    1000000
--    (2.25 secs, 5,073,260,632 bytes)
--    λ> length (anagramas5 "1234567890" ej)
--    1000000
--    (2.14 secs, 5,009,260,616 bytes)
--    λ> length (anagramas6 "1234567890" ej)
--    1000000
--    (1.58 secs, 4,977,260,976 bytes)
--    λ> length (anagramas7 "1234567890" ej)
--    1000000
--    (6.63 secs, 6,904,821,648 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

import Data.List (delete, permutations, sort)

import Data.Char (toLower)

import Data.Function (on)

-- 1ª solución

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

anagramas :: String -> [String] -> [String]

anagramas _ [] = []

anagramas x (y:ys)

| sonAnagramas x y = y : anagramas x ys

| otherwise = anagramas x ys

-- (sonAnagramas xs ys) se verifica si xs e ys son anagramas. Por

-- ejemplo,

-- sonAnagramas "amor" "Roma" == True

-- sonAnagramas "amor" "mola" == False

sonAnagramas :: String -> String -> Bool

sonAnagramas xs ys =

sort (map toLower xs) == sort (map toLower ys)

-- 2ª solución

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

anagramas2 :: String -> [String] -> [String]

anagramas2 _ [] = []

anagramas2 x (y:ys)

| sonAnagramas2 x y = y : anagramas2 x ys

| otherwise = anagramas2 x ys

sonAnagramas2 :: String -> String -> Bool

sonAnagramas2 xs ys =

(sort . map toLower) xs == (sort . map toLower) ys

-- 3ª solución

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

anagramas3 :: String -> [String] -> [String]

anagramas3 _ [] = []

anagramas3 x (y:ys)

| sonAnagramas3 x y = y : anagramas3 x ys

| otherwise = anagramas3 x ys

sonAnagramas3 :: String -> String -> Bool

sonAnagramas3 = (==) `on` (sort . map toLower)

-- Nota. En la solución anterior se usa la función on ya que

-- (f `on` g) x y

-- es equivalente a

-- f (g x) (g y)

-- Por ejemplo,

-- λ> ((*) `on` (+2)) 3 4

-- 30

-- 4ª solución

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

anagramas4 :: String -> [String] -> [String]

anagramas4 x ys = [y | y <- ys, sonAnagramas x y]

-- 5ª solución

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

anagramas5 :: String -> [String] -> [String]

anagramas5 x = filter (`sonAnagramas` x)

-- 6ª solución

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

anagramas6 :: String -> [String] -> [String]

anagramas6 x = filter (((==) `on` (sort . map toLower)) x)

-- 7ª solución

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

anagramas7 :: String -> [String] -> [String]

anagramas7 _ [] = []

anagramas7 x (y:ys)

| sonAnagramas7 x y = y : anagramas7 x ys

| otherwise = anagramas7 x ys

sonAnagramas7 :: String -> String -> Bool

sonAnagramas7 xs ys = aux (map toLower xs) (map toLower ys)

where

aux [] [] = True

aux [] _ = False

aux (u:us) vs | u `notElem` vs = False

| otherwise = aux us (delete u vs)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> ej = take (10^6) (permutations "1234567890")

-- λ> length (anagramas "1234567890" ej)

-- 1000000

-- (2.27 secs, 5,627,236,104 bytes)

-- λ> length (anagramas2 "1234567890" ej)

-- 1000000

-- (2.80 secs, 5,513,260,584 bytes)

-- λ> length (anagramas3 "1234567890" ej)

-- 1000000

-- (1.86 secs, 5,097,260,856 bytes)

-- λ> length (anagramas4 "1234567890" ej)

-- 1000000

-- (2.25 secs, 5,073,260,632 bytes)

-- λ> length (anagramas5 "1234567890" ej)

-- 1000000

-- (2.14 secs, 5,009,260,616 bytes)

-- λ> length (anagramas6 "1234567890" ej)

-- 1000000

-- (1.58 secs, 4,977,260,976 bytes)

-- λ> length (anagramas7 "1234567890" ej)

-- 1000000

-- (6.63 secs, 6,904,821,648 bytes)

El código se encuentra en GitHub.

La bandera tricolor

PorJosé A. Alonso 28-febrero-20227-marzo-2022

El problema de la bandera tricolor consiste en lo siguiente: Dada un lista de objetos xs que pueden ser rojos, amarillos o morados, se pide devolver una lista ys que contiene los elementos de xs, primero los rojos, luego los amarillos y por último los morados.

Definir el tipo de dato Color para representar los colores con los constructores R, A y M correspondientes al rojo, azul y morado y la función

   banderaTricolor :: [Color] -> [Color]

1	banderaTricolor :: [Color] -> [Color]

tal que (banderaTricolor xs) es la bandera tricolor formada con los elementos de xs. Por ejemplo,

   bandera [M,R,A,A,R,R,A,M,M]  ==  [R,R,R,A,A,A,M,M,M]
   bandera [M,R,A,R,R,A]        ==  [R,R,R,A,A,M]

1 2	bandera [M,R,A,A,R,R,A,M,M] == [R,R,R,A,A,A,M,M,M] bandera [M,R,A,R,R,A] == [R,R,R,A,A,M]

Soluciones

import Data.List (sort)
import Test.QuickCheck (Arbitrary(arbitrary), elements, quickCheck)

data Color = R | A | M
  deriving (Show, Eq, Ord, Enum)

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

banderaTricolor1 :: [Color] -> [Color]
banderaTricolor1 xs =
  [x | x <- xs, x == R] ++
  [x | x <- xs, x == A] ++
  [x | x <- xs, x == M]

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

banderaTricolor2 :: [Color] -> [Color]
banderaTricolor2 xs =
  colores R ++ colores A ++ colores M
  where colores c = filter (== c) xs

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

banderaTricolor3 :: [Color] -> [Color]
banderaTricolor3 xs =
  concat [[x | x <- xs, x == c] | c <- [R,A,M]]

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

banderaTricolor4 :: [Color] -> [Color]
banderaTricolor4 xs = aux xs ([],[],[])
  where aux []     (rs,as,ms) = rs ++ as ++ ms
        aux (R:ys) (rs,as,ms) = aux ys (R:rs,   as,   ms)
        aux (A:ys) (rs,as,ms) = aux ys (  rs, A:as,   ms)
        aux (M:ys) (rs,as,ms) = aux ys (  rs,   as, M:ms)

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

banderaTricolor5 :: [Color] -> [Color]
banderaTricolor5 = sort

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

instance Arbitrary Color where
  arbitrary = elements [A,R,M]

-- La propiedad es
prop_banderaTricolor :: [Color] -> Bool
prop_banderaTricolor xs =
  all (== banderaTricolor1 xs)
      [banderaTricolor2 xs,
       banderaTricolor3 xs,
       banderaTricolor4 xs,
       banderaTricolor5 xs]

verifica_banderaTricolor :: IO ()
verifica_banderaTricolor =
  quickCheck prop_banderaTricolor

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

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

-- La comparación es
--    λ> bandera n = concat [replicate n c | c <- [M,R,A]]
--    λ> length (banderaTricolor1 (bandera (10^6)))
--    3000000
--    (1.51 secs, 1,024,454,768 bytes)
--    λ> length (banderaTricolor1 (bandera (2*10^6)))
--    6000000
--    (2.94 secs, 2,048,454,832 bytes)
--    λ> length (banderaTricolor2 (bandera (2*10^6)))
--    6000000
--    (2.35 secs, 1,232,454,920 bytes)
--    λ> length (banderaTricolor3 (bandera (2*10^6)))
--    6000000
--    (4.28 secs, 2,304,455,360 bytes)
--    λ> length (banderaTricolor4 (bandera (2*10^6)))
--    6000000
--    (3.01 secs, 1,904,454,672 bytes)
--    λ> length (banderaTricolor5 (bandera (2*10^6)))
--    6000000
--    (2.47 secs, 1,248,454,744 bytes)

import Data.List (sort)

import Test.QuickCheck (Arbitrary(arbitrary), elements, quickCheck)

data Color = R | A | M

deriving (Show, Eq, Ord, Enum)

-- 1ª solución

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

banderaTricolor1 :: [Color] -> [Color]

banderaTricolor1 xs =

[x | x <- xs, x == R] ++

[x | x <- xs, x == A] ++

[x | x <- xs, x == M]

-- 2ª solución

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

banderaTricolor2 :: [Color] -> [Color]

banderaTricolor2 xs =

colores R ++ colores A ++ colores M

where colores c = filter (== c) xs

-- 3ª solución

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

banderaTricolor3 :: [Color] -> [Color]

banderaTricolor3 xs =

concat [[x | x <- xs, x == c] | c <- [R,A,M]]

-- 4ª solución

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

banderaTricolor4 :: [Color] -> [Color]

banderaTricolor4 xs = aux xs ([],[],[])

where aux [] (rs,as,ms) = rs ++ as ++ ms

aux (R:ys) (rs,as,ms) = aux ys (R:rs, as, ms)

aux (A:ys) (rs,as,ms) = aux ys ( rs, A:as, ms)

aux (M:ys) (rs,as,ms) = aux ys ( rs, as, M:ms)

-- 5ª solución

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

banderaTricolor5 :: [Color] -> [Color]

banderaTricolor5 = sort

-- Comprobación de equivalencia

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

instance Arbitrary Color where

arbitrary = elements [A,R,M]

-- La propiedad es

prop_banderaTricolor :: [Color] -> Bool

prop_banderaTricolor xs =

all (== banderaTricolor1 xs)

[banderaTricolor2 xs,

banderaTricolor3 xs,

banderaTricolor4 xs,

banderaTricolor5 xs]

verifica_banderaTricolor :: IO ()

verifica_banderaTricolor =

quickCheck prop_banderaTricolor

-- La comprobación es

-- λ> verifica_banderaTricolor

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> bandera n = concat [replicate n c | c <- [M,R,A]]

-- λ> length (banderaTricolor1 (bandera (10^6)))

-- 3000000

-- (1.51 secs, 1,024,454,768 bytes)

-- λ> length (banderaTricolor1 (bandera (2*10^6)))

-- 6000000

-- (2.94 secs, 2,048,454,832 bytes)

-- λ> length (banderaTricolor2 (bandera (2*10^6)))

-- 6000000

-- (2.35 secs, 1,232,454,920 bytes)

-- λ> length (banderaTricolor3 (bandera (2*10^6)))

-- 6000000

-- (4.28 secs, 2,304,455,360 bytes)

-- λ> length (banderaTricolor4 (bandera (2*10^6)))

-- 6000000

-- (3.01 secs, 1,904,454,672 bytes)

-- λ> length (banderaTricolor5 (bandera (2*10^6)))

-- 6000000

-- (2.47 secs, 1,248,454,744 bytes)

El código se encuentra en GitHub.

Ordenación por el máximo

PorJosé A. Alonso 25-febrero-20224-marzo-2022

Definir la función

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

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

tal que (ordenadosPorMaximo xss) es la lista de los elementos de xss ordenada por sus máximos (se supone que los elementos de xss son listas no vacía) y cuando tiene el mismo máximo se conserva el orden original. Por ejemplo,

   λ> ordenadosPorMaximo [[0,8],[9],[8,1],[6,3],[8,2],[6,1],[6,2]]
   [[6,3],[6,1],[6,2],[0,8],[8,1],[8,2],[9]]
   λ> ordenadosPorMaximo ["este","es","el","primero"]
   ["el","primero","es","este"]

λ> ordenadosPorMaximo [[0,8],[9],[8,1],[6,3],[8,2],[6,1],[6,2]]

[[6,3],[6,1],[6,2],[0,8],[8,1],[8,2],[9]]

λ> ordenadosPorMaximo ["este","es","el","primero"]

["el","primero","es","este"]

Soluciones

import Data.List (sort, sortBy)
import GHC.Exts (sortWith)
import Test.QuickCheck (quickCheck)

-- 1ª solución
ordenadosPorMaximo1 :: Ord a => [[a]] -> [[a]]
ordenadosPorMaximo1 xss =
  map snd (sort [((maximum xs,k),xs) | (k,xs) <- zip [0..] xss])

-- 2ª solución
ordenadosPorMaximo2 :: Ord a => [[a]] -> [[a]]
ordenadosPorMaximo2 xss =
  [xs | (_,xs) <- sort [((maximum xs,k),xs) | (k,xs) <- zip [0..] xss]]

-- 3ª solución
ordenadosPorMaximo3 :: Ord a => [[a]] -> [[a]]
ordenadosPorMaximo3 =
  sortBy (\xs ys -> compare (maximum xs) (maximum ys))

-- 4ª solución
ordenadosPorMaximo4 :: Ord a => [[a]] -> [[a]]
ordenadosPorMaximo4 = sortWith maximum

-- Equivalencia de las definiciones
-- ================================

-- La propiedad es
prop_ordenadosPorMaximo :: [[Int]] -> Bool
prop_ordenadosPorMaximo xss =
  all (== ordenadosPorMaximo1 yss)
      [ordenadosPorMaximo2 yss,
       ordenadosPorMaximo3 yss,
       ordenadosPorMaximo4 yss]
  where yss = filter (not . null) xss

verifica_ordenadosPorMaximo :: IO ()
verifica_ordenadosPorMaximo =
  quickCheck prop_ordenadosPorMaximo

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

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

-- La comparación es
--    λ> length (ordenadosPorMaximo1 [[1..k] | k <- [1..10^4]])
--    10000
--    (6.00 secs, 8,763,714,848 bytes)
--    λ> length (ordenadosPorMaximo2 [[1..k] | k <- [1..10^4]])
--    10000
--    (6.15 secs, 8,764,177,472 bytes)
--    λ> length (ordenadosPorMaximo3 [[1..k] | k <- [1..10^4]])
--    10000
--    (8.16 secs, 13,914,503,672 bytes)
--    λ> length (ordenadosPorMaximo4 [[1..k] | k <- [1..10^4]])
--    10000
--    (7.77 secs, 13,914,183,776 bytes)

import Data.List (sort, sortBy)

import GHC.Exts (sortWith)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

ordenadosPorMaximo1 xss =

map snd (sort [((maximum xs,k),xs) | (k,xs) <- zip [0..] xss])

-- 2ª solución

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

ordenadosPorMaximo2 xss =

[xs | (_,xs) <- sort [((maximum xs,k),xs) | (k,xs) <- zip [0..] xss]]

-- 3ª solución

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

ordenadosPorMaximo3 =

sortBy (\xs ys -> compare (maximum xs) (maximum ys))

-- 4ª solución

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

ordenadosPorMaximo4 = sortWith maximum

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_ordenadosPorMaximo :: [[Int]] -> Bool

prop_ordenadosPorMaximo xss =

all (== ordenadosPorMaximo1 yss)

[ordenadosPorMaximo2 yss,

ordenadosPorMaximo3 yss,

ordenadosPorMaximo4 yss]

where yss = filter (not . null) xss

verifica_ordenadosPorMaximo :: IO ()

verifica_ordenadosPorMaximo =

quickCheck prop_ordenadosPorMaximo

-- La comprobación es

-- λ> verifica_ordenadosPorMaximo

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (ordenadosPorMaximo1 [[1..k] | k <- [1..10^4]])

-- 10000

-- (6.00 secs, 8,763,714,848 bytes)

-- λ> length (ordenadosPorMaximo2 [[1..k] | k <- [1..10^4]])

-- 10000

-- (6.15 secs, 8,764,177,472 bytes)

-- λ> length (ordenadosPorMaximo3 [[1..k] | k <- [1..10^4]])

-- 10000

-- (8.16 secs, 13,914,503,672 bytes)

-- λ> length (ordenadosPorMaximo4 [[1..k] | k <- [1..10^4]])

-- 10000

-- (7.77 secs, 13,914,183,776 bytes)

El código se encuentra en GitHub.

Iguales al siguiente

PorJosé A. Alonso 24-febrero-20223-marzo-2022

Definir la función

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

1	igualesAlSiguiente :: Eq a => [a] -> [a]

tal que (igualesAlSiguiente xs) es la lista de los elementos de xs que son iguales a su siguiente. Por ejemplo,

   igualesAlSiguiente [1,2,2,2,3,3,4]  ==  [2,2,3]
   igualesAlSiguiente [1..10]          ==  []

1 2	igualesAlSiguiente [1,2,2,2,3,3,4] == [2,2,3] igualesAlSiguiente [1..10] == []

Soluciones

import Data.List (group)
import Test.QuickCheck (quickCheck)

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

igualesAlSiguiente1 :: Eq a => [a] -> [a]
igualesAlSiguiente1 xs =
  [x | (x, y) <- consecutivos1 xs, x == y]

-- (consecutivos1 xs) es la lista de pares de elementos consecutivos en
-- xs. Por ejemplo,
--    consecutivos1 [3,5,2,7]  ==  [(3,5),(5,2),(2,7)]
consecutivos1 :: [a] -> [(a, a)]
consecutivos1 xs = zip xs (tail xs)

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

igualesAlSiguiente2 :: Eq a => [a] -> [a]
igualesAlSiguiente2 xs =
  [x | (x,y) <- consecutivos2 xs, x == y]

-- (consecutivos2 xs) es la lista de pares de elementos consecutivos en
-- xs. Por ejemplo,
--    consecutivos2 [3,5,2,7]  ==  [(3,5),(5,2),(2,7)]
consecutivos2 :: [a] -> [(a, a)]
consecutivos2 (x:y:zs) = (x,y) : consecutivos2 (y:zs)
consecutivos2 _        = []

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

igualesAlSiguiente3 :: Eq a => [a] -> [a]
igualesAlSiguiente3 (x:y:zs) | x == y    = x : igualesAlSiguiente3 (y:zs)
                             | otherwise = igualesAlSiguiente3 (y:zs)
igualesAlSiguiente3 _                    = []

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

igualesAlSiguiente4 :: Eq a => [a] -> [a]
igualesAlSiguiente4 xs = concat [ys | (_:ys) <- group xs]

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

igualesAlSiguiente5 :: Eq a => [a] -> [a]
igualesAlSiguiente5 xs = concat (map tail (group xs))

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

igualesAlSiguiente6 :: Eq a => [a] -> [a]
igualesAlSiguiente6 xs = tail =<< group xs

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

igualesAlSiguiente7 :: Eq a => [a] -> [a]
igualesAlSiguiente7 = (tail =<<) . group

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

igualesAlSiguiente8 :: Eq a => [a] -> [a]
igualesAlSiguiente8 xs = concatMap tail (group xs)

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

igualesAlSiguiente9 :: Eq a => [a] -> [a]
igualesAlSiguiente9 = concatMap tail . group

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

igualesAlSiguiente10 :: Eq a => [a] -> [a]
igualesAlSiguiente10 xs = aux xs (tail xs)
  where aux (u:us) (v:vs) | u == v    = u : aux us vs
                          | otherwise = aux us vs
        aux _ _ = []

-- Equivalencia de las definiciones
-- ================================

-- La propiedad es
prop_igualesAlSiguiente :: [Int] -> Bool
prop_igualesAlSiguiente xs =
  all (== igualesAlSiguiente1 xs)
      [igualesAlSiguiente2 xs,
       igualesAlSiguiente3 xs,
       igualesAlSiguiente4 xs,
       igualesAlSiguiente5 xs,
       igualesAlSiguiente6 xs,
       igualesAlSiguiente7 xs,
       igualesAlSiguiente8 xs,
       igualesAlSiguiente9 xs,
       igualesAlSiguiente10 xs]

verificacion :: IO ()
verificacion = quickCheck prop_igualesAlSiguiente

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

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

-- La comparación es
--    > ej = concatMap show [1..10^6]
--    (0.01 secs, 446,752 bytes)
--    λ> length ej
--    5888896
--    (0.16 secs, 669,787,856 bytes)
--    λ> length (show (igualesAlSiguiente1 ej))
--    588895
--    (1.60 secs, 886,142,944 bytes)
--    λ> length (show (igualesAlSiguiente2 ej))
--    588895
--    (1.95 secs, 1,734,143,816 bytes)
--    λ> length (show (igualesAlSiguiente3 ej))
--    588895
--    (1.81 secs, 1,178,232,104 bytes)
--    λ> length (show (igualesAlSiguiente4 ej))
--    588895
--    (1.43 secs, 1,932,010,304 bytes)
--    λ> length (show (igualesAlSiguiente5 ej))
--    588895
--    (0.40 secs, 2,016,810,320 bytes)
--    λ> length (show (igualesAlSiguiente6 ej))
--    588895
--    (0.32 secs, 1,550,409,984 bytes)
--    λ> length (show (igualesAlSiguiente7 ej))
--    588895
--    (0.34 secs, 1,550,410,104 bytes)
--    λ> length (show (igualesAlSiguiente8 ej))
--    588895
--    (0.33 secs, 1,550,410,024 bytes)
--    λ> length (show (igualesAlSiguiente9 ej))
--    588895
--    (0.33 secs, 1,550,450,968 bytes)
--    λ> length (show (igualesAlSiguiente10 ej))
--    588895
--    (1.54 secs, 754,272,600 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

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

import Data.List (group)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

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

igualesAlSiguiente1 xs =

[x | (x, y) <- consecutivos1 xs, x == y]

-- (consecutivos1 xs) es la lista de pares de elementos consecutivos en

-- xs. Por ejemplo,

-- consecutivos1 [3,5,2,7] == [(3,5),(5,2),(2,7)]

consecutivos1 :: [a] -> [(a, a)]

consecutivos1 xs = zip xs (tail xs)

-- 2ª solución

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

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

igualesAlSiguiente2 xs =

[x | (x,y) <- consecutivos2 xs, x == y]

-- (consecutivos2 xs) es la lista de pares de elementos consecutivos en

-- xs. Por ejemplo,

-- consecutivos2 [3,5,2,7] == [(3,5),(5,2),(2,7)]

consecutivos2 :: [a] -> [(a, a)]

consecutivos2 (x:y:zs) = (x,y) : consecutivos2 (y:zs)

consecutivos2 _ = []

-- 3ª solución

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

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

igualesAlSiguiente3 (x:y:zs) | x == y = x : igualesAlSiguiente3 (y:zs)

| otherwise = igualesAlSiguiente3 (y:zs)

igualesAlSiguiente3 _ = []

-- 4ª solución

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

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

igualesAlSiguiente4 xs = concat [ys | (_:ys) <- group xs]

-- 5ª solución

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

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

igualesAlSiguiente5 xs = concat (map tail (group xs))

-- 6ª solución

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

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

igualesAlSiguiente6 xs = tail =<< group xs

-- 7ª solución

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

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

igualesAlSiguiente7 = (tail =<<) . group

-- 8ª solución

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

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

igualesAlSiguiente8 xs = concatMap tail (group xs)

-- 9ª solución

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

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

igualesAlSiguiente9 = concatMap tail . group

-- 10ª solución

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

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

igualesAlSiguiente10 xs = aux xs (tail xs)

where aux (u:us) (v:vs) | u == v = u : aux us vs

| otherwise = aux us vs

aux _ _ = []

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_igualesAlSiguiente :: [Int] -> Bool

prop_igualesAlSiguiente xs =

all (== igualesAlSiguiente1 xs)

[igualesAlSiguiente2 xs,

igualesAlSiguiente3 xs,

igualesAlSiguiente4 xs,

igualesAlSiguiente5 xs,

igualesAlSiguiente6 xs,

igualesAlSiguiente7 xs,

igualesAlSiguiente8 xs,

igualesAlSiguiente9 xs,

igualesAlSiguiente10 xs]

verificacion :: IO ()

verificacion = quickCheck prop_igualesAlSiguiente

-- La comprobación es

-- λ> verificacion

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- > ej = concatMap show [1..10^6]

-- (0.01 secs, 446,752 bytes)

-- λ> length ej

-- 5888896

-- (0.16 secs, 669,787,856 bytes)

-- λ> length (show (igualesAlSiguiente1 ej))

-- 588895

-- (1.60 secs, 886,142,944 bytes)

-- λ> length (show (igualesAlSiguiente2 ej))

-- 588895

-- (1.95 secs, 1,734,143,816 bytes)

-- λ> length (show (igualesAlSiguiente3 ej))

-- 588895

-- (1.81 secs, 1,178,232,104 bytes)

-- λ> length (show (igualesAlSiguiente4 ej))

-- 588895

-- (1.43 secs, 1,932,010,304 bytes)

-- λ> length (show (igualesAlSiguiente5 ej))

-- 588895

-- (0.40 secs, 2,016,810,320 bytes)

-- λ> length (show (igualesAlSiguiente6 ej))

-- 588895

-- (0.32 secs, 1,550,409,984 bytes)

-- λ> length (show (igualesAlSiguiente7 ej))

-- 588895

-- (0.34 secs, 1,550,410,104 bytes)

-- λ> length (show (igualesAlSiguiente8 ej))

-- 588895

-- (0.33 secs, 1,550,410,024 bytes)

-- λ> length (show (igualesAlSiguiente9 ej))

-- 588895

-- (0.33 secs, 1,550,450,968 bytes)

-- λ> length (show (igualesAlSiguiente10 ej))

-- 588895

-- (1.54 secs, 754,272,600 bytes)

El código se encuentra en GitHub.

Primos consecutivos con media capicúa

PorJosé A. Alonso 23-febrero-202215-abril-2022

Definir la lista

   primosConsecutivosConMediaCapicua :: [(Int,Int,Int)]

1	primosConsecutivosConMediaCapicua :: [(Int,Int,Int)]

formada por las ternas (x,y,z) tales que x e y son primos consecutivos cuya media, z, es capicúa. Por ejemplo,

   λ> take 5 primosConsecutivosConMediaCapicua
   [(3,5,4),(5,7,6),(7,11,9),(97,101,99),(109,113,111)]
   λ> primosConsecutivosConMediaCapicua !! 500
   (5687863,5687867,5687865)

λ> take 5 primosConsecutivosConMediaCapicua

[(3,5,4),(5,7,6),(7,11,9),(97,101,99),(109,113,111)]

λ> primosConsecutivosConMediaCapicua !! 500

(5687863,5687867,5687865)

Soluciones

import Data.List (genericTake)
import Data.Numbers.Primes (primes)

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

primosConsecutivosConMediaCapicua :: [(Integer,Integer,Integer)]
primosConsecutivosConMediaCapicua =
  [(x,y,z) | (x,y) <- zip primosImpares (tail primosImpares),
             let z = (x + y) `div` 2,
             capicua z]

-- (primo x) se verifica si x es primo. Por ejemplo,
--    primo 7  ==  True
--    primo 8  ==  False
primo :: Integer -> Bool
primo x = [y | y <- [1..x], x `rem` y == 0] == [1,x]

-- primosImpares es la lista de los números primos impares. Por ejemplo,
--    take 10 primosImpares  ==  [3,5,7,11,13,17,19,23,29]
primosImpares :: [Integer]
primosImpares = [x | x <- [3,5..], primo x]

-- (capicua x) se verifica si x es capicúa. Por ejemplo,
capicua :: Integer -> Bool
capicua x = ys == reverse ys
  where ys = show x

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

primosConsecutivosConMediaCapicua2 :: [(Integer,Integer,Integer)]
primosConsecutivosConMediaCapicua2 =
  [(x,y,z) | (x,y) <- zip primosImpares2 (tail primosImpares2),
             let z = (x + y) `div` 2,
             capicua z]

primosImpares2 :: [Integer]
primosImpares2 = tail (criba [2..])
  where criba (p:ps) = p : criba [n | n <- ps, mod n p /= 0]
        criba []     = error "Imposible"

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

primosConsecutivosConMediaCapicua3 :: [(Integer,Integer,Integer)]
primosConsecutivosConMediaCapicua3 =
  [(x,y,z) | (x,y) <- zip (tail primos3) (drop 2 primos3),
             let z = (x + y) `div` 2,
             capicua z]

primos3 :: [Integer]
primos3 = 2 : 3 : criba3 0 (tail primos3) 3
  where criba3 k (p:ps) x = [n | n <- [x+2,x+4..p*p-2],
                                 and [n `rem` q /= 0 | q <- take k (tail primos3)]]
                            ++ criba3 (k+1) ps (p*p)
        criba3 _ [] _     = error "Imposible"

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

primosConsecutivosConMediaCapicua4 :: [(Integer,Integer,Integer)]
primosConsecutivosConMediaCapicua4 =
  [(x,y,z) | (x,y) <- zip (tail primes) (drop 2 primes),
             let z = (x + y) `div` 2,
             capicua z]

-- Equivalencia de definiciones
-- ============================

-- La propiedad es
prop_primosConsecutivosConMediaCapicua :: Integer -> Bool
prop_primosConsecutivosConMediaCapicua n =
  all (== genericTake n primosConsecutivosConMediaCapicua)
      [genericTake n primosConsecutivosConMediaCapicua2,
       genericTake n primosConsecutivosConMediaCapicua3,
       genericTake n primosConsecutivosConMediaCapicua4]

-- La comprobación es
--    λ> prop_primosConsecutivosConMediaCapicua 25 {-# SCC "" #-}
--    True

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

-- La comparación es
--    λ> primosConsecutivosConMediaCapicua !! 30
--    (12919,12923,12921)
--    (4.60 secs, 1,877,064,288 bytes)
--    λ> primosConsecutivosConMediaCapicua2 !! 30
--    (12919,12923,12921)
--    (0.69 secs, 407,055,848 bytes)
--    λ> primosConsecutivosConMediaCapicua3 !! 30
--    (12919,12923,12921)
--    (0.07 secs, 18,597,104 bytes)
--    λ> primosConsecutivosConMediaCapicua4 !! 30
--    (12919,12923,12921)
--    (0.01 secs, 10,065,784 bytes)
--
--    λ> primosConsecutivosConMediaCapicua2 !! 40
--    (29287,29297,29292)
--    (2.67 secs, 1,775,554,576 bytes)
--    λ> primosConsecutivosConMediaCapicua3 !! 40
--    (29287,29297,29292)
--    (0.09 secs, 32,325,808 bytes)
--    λ> primosConsecutivosConMediaCapicua4 !! 40
--    (29287,29297,29292)
--    (0.01 secs, 22,160,072 bytes)
--
--    λ> primosConsecutivosConMediaCapicua3 !! 150
--    (605503,605509,605506)
--    (3.68 secs, 2,298,403,864 bytes)
--    λ> primosConsecutivosConMediaCapicua4 !! 150
--    (605503,605509,605506)
--    (0.24 secs, 491,917,240 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

import Data.List (genericTake)

import Data.Numbers.Primes (primes)

-- 1ª solución

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

primosConsecutivosConMediaCapicua :: [(Integer,Integer,Integer)]

primosConsecutivosConMediaCapicua =

[(x,y,z) | (x,y) <- zip primosImpares (tail primosImpares),

let z = (x + y) `div` 2,

capicua z]

-- (primo x) se verifica si x es primo. Por ejemplo,

-- primo 7 == True

-- primo 8 == False

primo :: Integer -> Bool

primo x = [y | y <- [1..x], x `rem` y == 0] == [1,x]

-- primosImpares es la lista de los números primos impares. Por ejemplo,

-- take 10 primosImpares == [3,5,7,11,13,17,19,23,29]

primosImpares :: [Integer]

primosImpares = [x | x <- [3,5..], primo x]

-- (capicua x) se verifica si x es capicúa. Por ejemplo,

capicua :: Integer -> Bool

capicua x = ys == reverse ys

where ys = show x

-- 2ª solución

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

primosConsecutivosConMediaCapicua2 :: [(Integer,Integer,Integer)]

primosConsecutivosConMediaCapicua2 =

[(x,y,z) | (x,y) <- zip primosImpares2 (tail primosImpares2),

let z = (x + y) `div` 2,

capicua z]

primosImpares2 :: [Integer]

primosImpares2 = tail (criba [2..])

where criba (p:ps) = p : criba [n | n <- ps, mod n p /= 0]

criba [] = error "Imposible"

-- 3ª solución

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

primosConsecutivosConMediaCapicua3 :: [(Integer,Integer,Integer)]

primosConsecutivosConMediaCapicua3 =

[(x,y,z) | (x,y) <- zip (tail primos3) (drop 2 primos3),

let z = (x + y) `div` 2,

capicua z]

primos3 :: [Integer]

primos3 = 2 : 3 : criba3 0 (tail primos3) 3

where criba3 k (p:ps) x = [n | n <- [x+2,x+4..p*p-2],

and [n `rem` q /= 0 | q <- take k (tail primos3)]]

++ criba3 (k+1) ps (p*p)

criba3 _ [] _ = error "Imposible"

-- 4ª solución

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

primosConsecutivosConMediaCapicua4 :: [(Integer,Integer,Integer)]

primosConsecutivosConMediaCapicua4 =

[(x,y,z) | (x,y) <- zip (tail primes) (drop 2 primes),

let z = (x + y) `div` 2,

capicua z]

-- Equivalencia de definiciones

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

-- La propiedad es

prop_primosConsecutivosConMediaCapicua :: Integer -> Bool

prop_primosConsecutivosConMediaCapicua n =

all (== genericTake n primosConsecutivosConMediaCapicua)

[genericTake n primosConsecutivosConMediaCapicua2,

genericTake n primosConsecutivosConMediaCapicua3,

genericTake n primosConsecutivosConMediaCapicua4]

-- La comprobación es

-- λ> prop_primosConsecutivosConMediaCapicua 25 {-# SCC "" #-}

-- True

-- Comparación de eficiencia

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

-- La comparación es

-- λ> primosConsecutivosConMediaCapicua !! 30

-- (12919,12923,12921)

-- (4.60 secs, 1,877,064,288 bytes)

-- λ> primosConsecutivosConMediaCapicua2 !! 30

-- (12919,12923,12921)

-- (0.69 secs, 407,055,848 bytes)

-- λ> primosConsecutivosConMediaCapicua3 !! 30

-- (12919,12923,12921)

-- (0.07 secs, 18,597,104 bytes)

-- λ> primosConsecutivosConMediaCapicua4 !! 30

-- (12919,12923,12921)

-- (0.01 secs, 10,065,784 bytes)

-- λ> primosConsecutivosConMediaCapicua2 !! 40

-- (29287,29297,29292)

-- (2.67 secs, 1,775,554,576 bytes)

-- λ> primosConsecutivosConMediaCapicua3 !! 40

-- (29287,29297,29292)

-- (0.09 secs, 32,325,808 bytes)

-- λ> primosConsecutivosConMediaCapicua4 !! 40

-- (29287,29297,29292)

-- (0.01 secs, 22,160,072 bytes)

-- λ> primosConsecutivosConMediaCapicua3 !! 150

-- (605503,605509,605506)

-- (3.68 secs, 2,298,403,864 bytes)

-- λ> primosConsecutivosConMediaCapicua4 !! 150

-- (605503,605509,605506)

-- (0.24 secs, 491,917,240 bytes)

El código se encuentra en GitHub.

Determinación de los elementos minimales

PorJosé A. Alonso 21-febrero-202215-abril-2022

Definir la función

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

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

tal que (minimales xss) es la lista de los elementos de xss que no están contenidos en otros elementos de xss. Por ejemplo,

   minimales [[1,3],[2,3,1],[3,2,5]]        ==  [[2,3,1],[3,2,5]]
   minimales [[1,3],[2,3,1],[3,2,5],[3,1]]  ==  [[2,3,1],[3,2,5]]
   map sum (minimales [[1..n] | n <- [1..300]])  ==  [45150]

minimales [[1,3],[2,3,1],[3,2,5]] == [[2,3,1],[3,2,5]]

minimales [[1,3],[2,3,1],[3,2,5],[3,1]] == [[2,3,1],[3,2,5]]

map sum (minimales [[1..n] | n <- [1..300]]) == [45150]

Soluciones

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

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

minimales :: Ord a => [[a]] -> [[a]]
minimales xss =
  [xs | xs <- xss,
        null [ys | ys <- xss, subconjuntoPropio xs ys]]

-- (subconjuntoPropio xs ys) se verifica si xs es un subconjunto propio
-- de ys. Por ejemplo,
--    subconjuntoPropio [1,3] [3,1,3]    ==  False
--    subconjuntoPropio [1,3,1] [3,1,2]  ==  True
subconjuntoPropio :: Ord a => [a] -> [a] -> Bool
subconjuntoPropio xs ys = aux (nub xs) (nub ys)
  where
    aux _       []  = False
    aux []      _   = True
    aux (u:us) vs = u `elem` vs && aux us (delete u vs)

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

minimales2 :: Ord a => [[a]] -> [[a]]
minimales2 xss =
  [xs | xs <- xss,
        null [ys | ys <- xss, subconjuntoPropio2 xs ys]]

subconjuntoPropio2 :: Ord a => [a] -> [a] -> Bool
subconjuntoPropio2 xs ys =
  subconjunto xs ys && not (subconjunto ys xs)

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

-- Equivalencia de las definiciones
-- ================================

-- La propiedad es
prop_minimales :: [[Int]] -> Bool
prop_minimales xss =
   minimales xss == minimales2 xss

verifica_minimales :: IO ()
verifica_minimales =
  quickCheck prop_minimales

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

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

-- La comparación es
--    λ> length (minimales [[1..n] | n <- [1..200]])
--    1
--    (2.30 secs, 657,839,560 bytes)
--    λ> length (minimales2 [[1..n] | n <- [1..200]])
--    1
--    (0.84 secs, 101,962,480 bytes)

import Data.List (delete, nub)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

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

minimales xss =

[xs | xs <- xss,

null [ys | ys <- xss, subconjuntoPropio xs ys]]

-- (subconjuntoPropio xs ys) se verifica si xs es un subconjunto propio

-- de ys. Por ejemplo,

-- subconjuntoPropio [1,3] [3,1,3] == False

-- subconjuntoPropio [1,3,1] [3,1,2] == True

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

subconjuntoPropio xs ys = aux (nub xs) (nub ys)

where

aux _ [] = False

aux [] _ = True

aux (u:us) vs = u `elem` vs && aux us (delete u vs)

-- 2ª solución

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

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

minimales2 xss =

[xs | xs <- xss,

null [ys | ys <- xss, subconjuntoPropio2 xs ys]]

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

subconjuntoPropio2 xs ys =

subconjunto xs ys && not (subconjunto ys xs)

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

-- ejemplo,

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

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

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

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

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

subconjunto xs ys =

all (`elem` ys) xs

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_minimales :: [[Int]] -> Bool

prop_minimales xss =

minimales xss == minimales2 xss

verifica_minimales :: IO ()

verifica_minimales =

quickCheck prop_minimales

-- La comprobación es

-- λ> verifica_minimales

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (minimales [[1..n] | n <- [1..200]])

-- 1

-- (2.30 secs, 657,839,560 bytes)

-- λ> length (minimales2 [[1..n] | n <- [1..200]])

-- 1

-- (0.84 secs, 101,962,480 bytes)

El código se encuentra en GitHub.

Suma de los números amigos menores que n

PorJosé A. Alonso 18-febrero-202215-abril-2022

Dos números amigos son dos números enteros positivos distintos tales que la suma de los divisores propios de cada uno es igual al otro. Los divisores propios de un número incluyen la unidad pero no al propio número. Por ejemplo, los divisores propios de 220 son 1, 2, 4, 5, 10, 11, 20, 22, 44, 55 y 110. La suma de estos números equivale a 284. A su vez, los divisores propios de 284 son 1, 2, 4, 71 y 142. Su suma equivale a 220. Por tanto, 220 y 284 son amigos.

Definir la función

   sumaAmigosMenores :: Integer -> Integer

1	sumaAmigosMenores :: Integer -> Integer

tal que (sumaAmigosMenores n) es la suma de los números amigos menores que n. Por ejemplo,

   sumaAmigosMenores 2000   == 2898
   sumaAmigosMenores (10^5) == 852810

1 2	sumaAmigosMenores 2000 == 2898 sumaAmigosMenores (10^5) == 852810

Soluciones

import Data.List (genericLength, group, inits, nub, sort, subsequences)
import Data.Numbers.Primes (primeFactors)

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

sumaAmigosMenores1 :: Integer -> Integer
sumaAmigosMenores1 n =
  sum [x+y | (x,y) <- amigosMenores1 n]

-- (amigosMenores1 n) es la lista de los pares de números amigos (con la
-- primera componente menor que la segunda) que son menores que n. Por
-- ejemplo,
--    amigosMenores1 2000  ==  [(220,284),(1184,1210)]
amigosMenores1 :: Integer -> [(Integer,Integer)]
amigosMenores1 n =
  takeWhile (\(_,y) -> y < n) sucesionAmigos1

sucesionAmigos1 :: [(Integer,Integer)]
sucesionAmigos1 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios1 x,
           y > x,
           sumaDivisoresPropios1 y == x]

-- (sumaDivisoresPropios1 x) es la suma de los divisores propios de
-- x. Por ejemplo,
--    sumaDivisoresPropios1 220  ==  284
--    sumaDivisoresPropios1 284  ==  220
sumaDivisoresPropios1 :: Integer -> Integer
sumaDivisoresPropios1 = sum . divisoresPropios1

-- (divisoresPropios1 x) es la lista de los divisores propios de x. Por
-- ejemplo,
--    divisoresPropios1 220  ==  [1,2,4,5,10,11,20,22,44,55,110]
--    divisoresPropios1 284  ==  [1,2,4,71,142]
divisoresPropios1 :: Integer -> [Integer]
divisoresPropios1 x = [n | n <- [1..x-1], x `mod` n == 0]

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

sumaAmigosMenores2 :: Integer -> Integer
sumaAmigosMenores2 n =
  sum [x+y | (x,y) <- amigosMenores2 n]

amigosMenores2 :: Integer -> [(Integer,Integer)]
amigosMenores2 n =
  takeWhile (\(_,y) -> y < n) sucesionAmigos2

sucesionAmigos2 :: [(Integer,Integer)]
sucesionAmigos2 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios2 x,
           y > x,
           sumaDivisoresPropios2 y == x]

sumaDivisoresPropios2 :: Integer -> Integer
sumaDivisoresPropios2 = sum . divisoresPropios2

divisoresPropios2 :: Integer -> [Integer]
divisoresPropios2 x = filter ((== 0) . mod x) [1..x-1]

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

sumaAmigosMenores3 :: Integer -> Integer
sumaAmigosMenores3 n =
  sum [x+y | (x,y) <- amigosMenores3 n]

amigosMenores3 :: Integer -> [(Integer,Integer)]
amigosMenores3 n =
  takeWhile (\(_,y) -> y < n) sucesionAmigos3

sucesionAmigos3 :: [(Integer,Integer)]
sucesionAmigos3 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios3 x,
           y > x,
           sumaDivisoresPropios3 y == x]

sumaDivisoresPropios3 :: Integer -> Integer
sumaDivisoresPropios3 = sum . divisoresPropios3

divisoresPropios3 :: Integer -> [Integer]
divisoresPropios3 =
  init . nub . sort . map product . subsequences . primeFactors

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

sumaAmigosMenores4 :: Integer -> Integer
sumaAmigosMenores4 n =
  sum [x+y | (x,y) <- amigosMenores4 n]

amigosMenores4 :: Integer -> [(Integer,Integer)]
amigosMenores4 n =
  takeWhile (\(_,y) -> y < n) sucesionAmigos4

sucesionAmigos4 :: [(Integer,Integer)]
sucesionAmigos4 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios4 x,
           y > x,
           sumaDivisoresPropios4 y == x]

sumaDivisoresPropios4 :: Integer -> Integer
sumaDivisoresPropios4 = sum . divisoresPropios4

divisoresPropios4 :: Integer -> [Integer]
divisoresPropios4 =
  init
  . sort
  . map (product . concat)
  . productoCartesiano
  . map inits
  . group
  . primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos
-- xss. Por ejemplo,
--    λ> productoCartesiano [[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]]
productoCartesiano :: [[a]] -> [[a]]
productoCartesiano []       = [[]]
productoCartesiano (xs:xss) =
  [x:ys | x <- xs, ys <- productoCartesiano xss]

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

sumaAmigosMenores5 :: Integer -> Integer
sumaAmigosMenores5 n =
  sum [x+y | (x,y) <- amigosMenores5 n]

amigosMenores5 :: Integer -> [(Integer,Integer)]
amigosMenores5 n =
  takeWhile (\(_,y) -> y < n) sucesionAmigos5

sucesionAmigos5 :: [(Integer,Integer)]
sucesionAmigos5 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios5 x,
           y > x,
           sumaDivisoresPropios5 y == x]

sumaDivisoresPropios5 :: Integer -> Integer
sumaDivisoresPropios5 = sum . divisoresPropios5

divisoresPropios5 :: Integer -> [Integer]
divisoresPropios5 =
  init
  . sort
  . map (product . concat)
  . sequence
  . map inits
  . group
  . primeFactors

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

sumaAmigosMenores6 :: Integer -> Integer
sumaAmigosMenores6 n =
  sum [x+y | (x,y) <- amigosMenores6 n]

amigosMenores6 :: Integer -> [(Integer,Integer)]
amigosMenores6 n =
  takeWhile (\(_,y) -> y < n) sucesionAmigos6

sucesionAmigos6 :: [(Integer,Integer)]
sucesionAmigos6 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios6 x,
           y > x,
           sumaDivisoresPropios6 y == x]

sumaDivisoresPropios6 :: Integer -> Integer
sumaDivisoresPropios6 =
  sum
  . init
  . map (product . concat)
  . sequence
  . map inits
  . group
  . primeFactors

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

sumaAmigosMenores7 :: Integer -> Integer
sumaAmigosMenores7 n =
  sum [x+y | (x,y) <- amigosMenores7 n]

amigosMenores7 :: Integer -> [(Integer,Integer)]
amigosMenores7 n =
  takeWhile (\(_,y) -> y < n) sucesionAmigos7

sucesionAmigos7 :: [(Integer,Integer)]
sucesionAmigos7 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios7 x,
           y > x,
           sumaDivisoresPropios7 y == x]

-- Si la descomposición de x en factores primos es
--    x = p(1)^e(1) . p(2)^e(2) . .... . p(n)^e(n)
-- entonces la suma de los divisores de x es
--    p(1)^(e(1)+1) - 1     p(2)^(e(2)+1) - 1       p(n)^(e(2)+1) - 1
--   ------------------- . ------------------- ... -------------------
--        p(1)-1                p(2)-1                  p(n)-1
-- Ver la demostración en http://bit.ly/2zUXZPc

sumaDivisoresPropios7 :: Integer -> Integer
sumaDivisoresPropios7 x =
  product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion x] - x

-- (factorizacion x) es la lista de las bases y exponentes de la
-- descomposición prima de x. Por ejemplo,
--    factorizacion 600  ==  [(2,3),(3,1),(5,2)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion = map primeroYlongitud . group . primeFactors

-- (primeroYlongitud xs) es el par formado por el primer elemento de xs
-- y la longitud de xs. Por ejemplo,
--    primeroYlongitud [3,2,5,7] == (3,4)
primeroYlongitud :: [a] -> (a,Integer)
primeroYlongitud (x:xs) = (x, 1 + genericLength xs)

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

-- La comparación es
--    λ> sumaAmigosMenores1 6000
--    19026
--    (10.37 secs, 5,261,392,352 bytes)
--    λ> sumaAmigosMenores2 6000
--    19026
--    (3.86 secs, 3,161,700,400 bytes)
--    λ> sumaAmigosMenores3 6000
--    19026
--    (0.15 secs, 308,520,248 bytes)
--    λ> sumaAmigosMenores4 6000
--    19026
--    (0.23 secs, 271,421,184 bytes)
--    λ> sumaAmigosMenores5 6000
--    19026
--    (0.13 secs, 230,042,112 bytes)
--    λ> sumaAmigosMenores6 6000
--    19026
--    (0.12 secs, 202,638,880 bytes)
--    λ> sumaAmigosMenores7 6000
--    19026
--    (0.13 secs, 159,022,448 bytes)
--
--    λ> sumaAmigosMenores3 (10^5)
--    852810
--    (4.83 secs, 10,726,377,728 bytes)
--    λ> sumaAmigosMenores4 (10^5)
--    852810
--    (4.79 secs, 7,832,234,120 bytes)
--    λ> sumaAmigosMenores5 (10^5)
--    852810
--    (2.79 secs, 6,837,118,464 bytes)
--    λ> sumaAmigosMenores6 (10^5)
--    852810
--    (2.39 secs, 6,229,730,472 bytes)
--    λ> sumaAmigosMenores7 (10^5)
--    852810
--    (2.65 secs, 5,170,949,168 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

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

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

import Data.List (genericLength, group, inits, nub, sort, subsequences)

import Data.Numbers.Primes (primeFactors)

-- 1ª solución --

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

sumaAmigosMenores1 :: Integer -> Integer

sumaAmigosMenores1 n =

sum [x+y | (x,y) <- amigosMenores1 n]

-- (amigosMenores1 n) es la lista de los pares de números amigos (con la

-- primera componente menor que la segunda) que son menores que n. Por

-- ejemplo,

-- amigosMenores1 2000 == [(220,284),(1184,1210)]

amigosMenores1 :: Integer -> [(Integer,Integer)]

amigosMenores1 n =

takeWhile (\(_,y) -> y < n) sucesionAmigos1

sucesionAmigos1 :: [(Integer,Integer)]

sucesionAmigos1 =

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

let y = sumaDivisoresPropios1 x,

y > x,

sumaDivisoresPropios1 y == x]

-- (sumaDivisoresPropios1 x) es la suma de los divisores propios de

-- x. Por ejemplo,

-- sumaDivisoresPropios1 220 == 284

-- sumaDivisoresPropios1 284 == 220

sumaDivisoresPropios1 :: Integer -> Integer

sumaDivisoresPropios1 = sum . divisoresPropios1

-- (divisoresPropios1 x) es la lista de los divisores propios de x. Por

-- ejemplo,

-- divisoresPropios1 220 == [1,2,4,5,10,11,20,22,44,55,110]

-- divisoresPropios1 284 == [1,2,4,71,142]

divisoresPropios1 :: Integer -> [Integer]

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

-- 2ª solución --

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

sumaAmigosMenores2 :: Integer -> Integer

sumaAmigosMenores2 n =

sum [x+y | (x,y) <- amigosMenores2 n]

amigosMenores2 :: Integer -> [(Integer,Integer)]

amigosMenores2 n =

takeWhile (\(_,y) -> y < n) sucesionAmigos2

sucesionAmigos2 :: [(Integer,Integer)]

sucesionAmigos2 =

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

let y = sumaDivisoresPropios2 x,

y > x,

sumaDivisoresPropios2 y == x]

sumaDivisoresPropios2 :: Integer -> Integer

sumaDivisoresPropios2 = sum . divisoresPropios2

divisoresPropios2 :: Integer -> [Integer]

divisoresPropios2 x = filter ((== 0) . mod x) [1..x-1]

-- 3ª solución --

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

sumaAmigosMenores3 :: Integer -> Integer

sumaAmigosMenores3 n =

sum [x+y | (x,y) <- amigosMenores3 n]

amigosMenores3 :: Integer -> [(Integer,Integer)]

amigosMenores3 n =

takeWhile (\(_,y) -> y < n) sucesionAmigos3

sucesionAmigos3 :: [(Integer,Integer)]

sucesionAmigos3 =

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

let y = sumaDivisoresPropios3 x,

y > x,

sumaDivisoresPropios3 y == x]

sumaDivisoresPropios3 :: Integer -> Integer

sumaDivisoresPropios3 = sum . divisoresPropios3

divisoresPropios3 :: Integer -> [Integer]

divisoresPropios3 =

init . nub . sort . map product . subsequences . primeFactors

-- 4ª solución --

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

sumaAmigosMenores4 :: Integer -> Integer

sumaAmigosMenores4 n =

sum [x+y | (x,y) <- amigosMenores4 n]

amigosMenores4 :: Integer -> [(Integer,Integer)]

amigosMenores4 n =

takeWhile (\(_,y) -> y < n) sucesionAmigos4

sucesionAmigos4 :: [(Integer,Integer)]

sucesionAmigos4 =

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

let y = sumaDivisoresPropios4 x,

y > x,

sumaDivisoresPropios4 y == x]

sumaDivisoresPropios4 :: Integer -> Integer

sumaDivisoresPropios4 = sum . divisoresPropios4

divisoresPropios4 :: Integer -> [Integer]

divisoresPropios4 =

init

. sort

. map (product . concat)

. productoCartesiano

. map inits

. group

. primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos

-- xss. Por ejemplo,

-- λ> productoCartesiano [[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]]

productoCartesiano :: [[a]] -> [[a]]

productoCartesiano [] = [[]]

productoCartesiano (xs:xss) =

[x:ys | x <- xs, ys <- productoCartesiano xss]

-- 5ª solución --

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

sumaAmigosMenores5 :: Integer -> Integer

sumaAmigosMenores5 n =

sum [x+y | (x,y) <- amigosMenores5 n]

amigosMenores5 :: Integer -> [(Integer,Integer)]

amigosMenores5 n =

takeWhile (\(_,y) -> y < n) sucesionAmigos5

sucesionAmigos5 :: [(Integer,Integer)]

sucesionAmigos5 =

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

let y = sumaDivisoresPropios5 x,

y > x,

sumaDivisoresPropios5 y == x]

sumaDivisoresPropios5 :: Integer -> Integer

sumaDivisoresPropios5 = sum . divisoresPropios5

divisoresPropios5 :: Integer -> [Integer]

divisoresPropios5 =

init

. sort

. map (product . concat)

. sequence

. map inits

. group

. primeFactors

-- 6ª solución --

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

sumaAmigosMenores6 :: Integer -> Integer

sumaAmigosMenores6 n =

sum [x+y | (x,y) <- amigosMenores6 n]

amigosMenores6 :: Integer -> [(Integer,Integer)]

amigosMenores6 n =

takeWhile (\(_,y) -> y < n) sucesionAmigos6

sucesionAmigos6 :: [(Integer,Integer)]

sucesionAmigos6 =

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

let y = sumaDivisoresPropios6 x,

y > x,

sumaDivisoresPropios6 y == x]

sumaDivisoresPropios6 :: Integer -> Integer

sumaDivisoresPropios6 =

sum

. init

. map (product . concat)

. sequence

. map inits

. group

. primeFactors

-- 7ª solución --

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

sumaAmigosMenores7 :: Integer -> Integer

sumaAmigosMenores7 n =

sum [x+y | (x,y) <- amigosMenores7 n]

amigosMenores7 :: Integer -> [(Integer,Integer)]

amigosMenores7 n =

takeWhile (\(_,y) -> y < n) sucesionAmigos7

sucesionAmigos7 :: [(Integer,Integer)]

sucesionAmigos7 =

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

let y = sumaDivisoresPropios7 x,

y > x,

sumaDivisoresPropios7 y == x]

-- Si la descomposición de x en factores primos es

-- x = p(1)^e(1) . p(2)^e(2) . .... . p(n)^e(n)

-- entonces la suma de los divisores de x es

-- p(1)^(e(1)+1) - 1 p(2)^(e(2)+1) - 1 p(n)^(e(2)+1) - 1

-- ------------------- . ------------------- ... -------------------

-- p(1)-1 p(2)-1 p(n)-1

-- Ver la demostración en http://bit.ly/2zUXZPc

sumaDivisoresPropios7 :: Integer -> Integer

sumaDivisoresPropios7 x =

product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion x] - x

-- (factorizacion x) es la lista de las bases y exponentes de la

-- descomposición prima de x. Por ejemplo,

-- factorizacion 600 == [(2,3),(3,1),(5,2)]

factorizacion :: Integer -> [(Integer,Integer)]

factorizacion = map primeroYlongitud . group . primeFactors

-- (primeroYlongitud xs) es el par formado por el primer elemento de xs

-- y la longitud de xs. Por ejemplo,

-- primeroYlongitud [3,2,5,7] == (3,4)

primeroYlongitud :: [a] -> (a,Integer)

primeroYlongitud (x:xs) = (x, 1 + genericLength xs)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sumaAmigosMenores1 6000

-- 19026

-- (10.37 secs, 5,261,392,352 bytes)

-- λ> sumaAmigosMenores2 6000

-- 19026

-- (3.86 secs, 3,161,700,400 bytes)

-- λ> sumaAmigosMenores3 6000

-- 19026

-- (0.15 secs, 308,520,248 bytes)

-- λ> sumaAmigosMenores4 6000

-- 19026

-- (0.23 secs, 271,421,184 bytes)

-- λ> sumaAmigosMenores5 6000

-- 19026

-- (0.13 secs, 230,042,112 bytes)

-- λ> sumaAmigosMenores6 6000

-- 19026

-- (0.12 secs, 202,638,880 bytes)

-- λ> sumaAmigosMenores7 6000

-- 19026

-- (0.13 secs, 159,022,448 bytes)

-- λ> sumaAmigosMenores3 (10^5)

-- 852810

-- (4.83 secs, 10,726,377,728 bytes)

-- λ> sumaAmigosMenores4 (10^5)

-- 852810

-- (4.79 secs, 7,832,234,120 bytes)

-- λ> sumaAmigosMenores5 (10^5)

-- 852810

-- (2.79 secs, 6,837,118,464 bytes)

-- λ> sumaAmigosMenores6 (10^5)

-- 852810

-- (2.39 secs, 6,229,730,472 bytes)

-- λ> sumaAmigosMenores7 (10^5)

-- 852810

-- (2.65 secs, 5,170,949,168 bytes)

El código se encuentra en GitHub.

Sucesión de números amigos

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

Definir la lista

   sucesionAmigos :: [(Integer,Integer)]

1	sucesionAmigos :: [(Integer,Integer)]

cuyos elementos son los pares de números amigos con la primera componente menor que la segunda. Por ejemplo,

   take 4 sucesionAmigos == [(220,284),(1184,1210),(2620,2924),(5020,5564)]
   sucesionAmigos6 !! 20 == (185368,203432)

1 2	take 4 sucesionAmigos == [(220,284),(1184,1210),(2620,2924),(5020,5564)] sucesionAmigos6 !! 20 == (185368,203432)

Soluciones

import Data.List (genericLength, group, inits, nub, sort, subsequences)
import Data.Numbers.Primes (primeFactors)

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

sucesionAmigos1 :: [(Integer,Integer)]
sucesionAmigos1 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios1 x,
           y > x,
           sumaDivisoresPropios1 y == x]

-- (sumaDivisoresPropios1 x) es la suma de los divisores propios de
-- x. Por ejemplo,
--    sumaDivisoresPropios1 220  ==  284
--    sumaDivisoresPropios1 284  ==  220
sumaDivisoresPropios1 :: Integer -> Integer
sumaDivisoresPropios1 = sum . divisoresPropios1

-- (divisoresPropios1 x) es la lista de los divisores propios de x. Por
-- ejemplo,
--    divisoresPropios1 220  ==  [1,2,4,5,10,11,20,22,44,55,110]
--    divisoresPropios1 284  ==  [1,2,4,71,142]
divisoresPropios1 :: Integer -> [Integer]
divisoresPropios1 x = [n | n <- [1..x-1], x `mod` n == 0]

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

sucesionAmigos2 :: [(Integer,Integer)]
sucesionAmigos2 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios2 x,
           y > x,
           sumaDivisoresPropios2 y == x]

sumaDivisoresPropios2 :: Integer -> Integer
sumaDivisoresPropios2 = sum . divisoresPropios2

divisoresPropios2 :: Integer -> [Integer]
divisoresPropios2 x = filter ((== 0) . mod x) [1..x-1]

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

sucesionAmigos3 :: [(Integer,Integer)]
sucesionAmigos3 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios3 x,
           y > x,
           sumaDivisoresPropios3 y == x]

sumaDivisoresPropios3 :: Integer -> Integer
sumaDivisoresPropios3 = sum . divisoresPropios3

divisoresPropios3 :: Integer -> [Integer]
divisoresPropios3 =
  init . nub . sort . map product . subsequences . primeFactors

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

sucesionAmigos4 :: [(Integer,Integer)]
sucesionAmigos4 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios4 x,
           y > x,
           sumaDivisoresPropios4 y == x]

sumaDivisoresPropios4 :: Integer -> Integer
sumaDivisoresPropios4 = sum . divisoresPropios4

divisoresPropios4 :: Integer -> [Integer]
divisoresPropios4 =
  init
  . sort
  . map (product . concat)
  . productoCartesiano
  . map inits
  . group
  . primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos
-- xss. Por ejemplo,
--    λ> productoCartesiano [[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]]
productoCartesiano :: [[a]] -> [[a]]
productoCartesiano []       = [[]]
productoCartesiano (xs:xss) =
  [x:ys | x <- xs, ys <- productoCartesiano xss]

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

sucesionAmigos5 :: [(Integer,Integer)]
sucesionAmigos5 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios5 x,
           y > x,
           sumaDivisoresPropios5 y == x]

sumaDivisoresPropios5 :: Integer -> Integer
sumaDivisoresPropios5 = sum . divisoresPropios5

divisoresPropios5 :: Integer -> [Integer]
divisoresPropios5 =
  init
  . sort
  . map (product . concat)
  . sequence
  . map inits
  . group
  . primeFactors

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

sucesionAmigos6 :: [(Integer,Integer)]
sucesionAmigos6 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios6 x,
           y > x,
           sumaDivisoresPropios6 y == x]

sumaDivisoresPropios6 :: Integer -> Integer
sumaDivisoresPropios6 =
  sum
  . init
  . map (product . concat)
  . sequence
  . map inits
  . group
  . primeFactors

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

sucesionAmigos7 :: [(Integer,Integer)]
sucesionAmigos7 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios7 x,
           y > x,
           sumaDivisoresPropios7 y == x]

-- Si la descomposición de x en factores primos es
--    x = p(1)^e(1) . p(2)^e(2) . .... . p(n)^e(n)
-- entonces la suma de los divisores de x es
--    p(1)^(e(1)+1) - 1     p(2)^(e(2)+1) - 1       p(n)^(e(2)+1) - 1
--   ------------------- . ------------------- ... -------------------
--        p(1)-1                p(2)-1                  p(n)-1
-- Ver la demostración en http://bit.ly/2zUXZPc

sumaDivisoresPropios7 :: Integer -> Integer
sumaDivisoresPropios7 x =
  product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion x] - x

-- (factorizacion x) es la lista de las bases y exponentes de la
-- descomposición prima de x. Por ejemplo,
--    factorizacion 600  ==  [(2,3),(3,1),(5,2)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion = map primeroYlongitud . group . primeFactors

-- (primeroYlongitud xs) es el par formado por el primer elemento de xs
-- y la longitud de xs. Por ejemplo,
--    primeroYlongitud [3,2,5,7] == (3,4)
primeroYlongitud :: [a] -> (a,Integer)
primeroYlongitud (x:xs) = (x, 1 + genericLength xs)

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

-- La comparación es
--    λ> take 4 sucesionAmigos1
--    [(220,284),(1184,1210),(2620,2924),(5020,5564)]
--    (6.00 secs, 3,413,777,560 bytes)
--    λ> take 4 sucesionAmigos2
--    [(220,284),(1184,1210),(2620,2924),(5020,5564)]
--    (2.38 secs, 2,052,151,800 bytes)
--    λ> take 4 sucesionAmigos3
--    [(220,284),(1184,1210),(2620,2924),(5020,5564)]
--    (0.14 secs, 235,238,864 bytes)
--    λ> take 4 sucesionAmigos4
--    [(220,284),(1184,1210),(2620,2924),(5020,5564)]
--    (0.20 secs, 208,315,832 bytes)
--    λ> take 4 sucesionAmigos5
--    [(220,284),(1184,1210),(2620,2924),(5020,5564)]
--    (0.09 secs, 176,149,160 bytes)
--    λ> take 4 sucesionAmigos6
--    [(220,284),(1184,1210),(2620,2924),(5020,5564)]
--    (0.07 secs, 154,686,728 bytes)
--    λ> take 4 sucesionAmigos7
--    [(220,284),(1184,1210),(2620,2924),(5020,5564)]
--    (0.12 secs, 120,826,648 bytes)
--
--    λ> sucesionAmigos3 !! 10
--    (67095,71145)
--    (3.52 secs, 6,749,059,064 bytes)
--    λ> sucesionAmigos4 !! 10
--    (67095,71145)
--    (3.11 secs, 4,951,018,904 bytes)
--    λ> sucesionAmigos5 !! 10
--    (67095,71145)
--    (1.69 secs, 4,294,457,320 bytes)
--    λ> sucesionAmigos6 !! 10
--    (67095,71145)
--    (1.43 secs, 3,889,045,760 bytes)
--    λ> sucesionAmigos7 !! 10
--    (67095,71145)
--    (1.63 secs, 3,191,073,224 bytes)
--
--    λ> sucesionAmigos5 !! 12
--    (79750,88730)
--    (2.13 secs, 5,312,053,312 bytes)
--    λ> sucesionAmigos6 !! 12
--    (79750,88730)
--    (1.78 secs, 4,820,560,920 bytes)
--    λ> sucesionAmigos7 !! 12
--    (79750,88730)
--    (2.11 secs, 3,971,113,184 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

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

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

import Data.List (genericLength, group, inits, nub, sort, subsequences)

import Data.Numbers.Primes (primeFactors)

-- 1ª solución --

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

sucesionAmigos1 :: [(Integer,Integer)]

sucesionAmigos1 =

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

let y = sumaDivisoresPropios1 x,

y > x,

sumaDivisoresPropios1 y == x]

-- (sumaDivisoresPropios1 x) es la suma de los divisores propios de

-- x. Por ejemplo,

-- sumaDivisoresPropios1 220 == 284

-- sumaDivisoresPropios1 284 == 220

sumaDivisoresPropios1 :: Integer -> Integer

sumaDivisoresPropios1 = sum . divisoresPropios1

-- (divisoresPropios1 x) es la lista de los divisores propios de x. Por

-- ejemplo,

-- divisoresPropios1 220 == [1,2,4,5,10,11,20,22,44,55,110]

-- divisoresPropios1 284 == [1,2,4,71,142]

divisoresPropios1 :: Integer -> [Integer]

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

-- 2ª solución --

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

sucesionAmigos2 :: [(Integer,Integer)]

sucesionAmigos2 =

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

let y = sumaDivisoresPropios2 x,

y > x,

sumaDivisoresPropios2 y == x]

sumaDivisoresPropios2 :: Integer -> Integer

sumaDivisoresPropios2 = sum . divisoresPropios2

divisoresPropios2 :: Integer -> [Integer]

divisoresPropios2 x = filter ((== 0) . mod x) [1..x-1]

-- 3ª solución --

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

sucesionAmigos3 :: [(Integer,Integer)]

sucesionAmigos3 =

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

let y = sumaDivisoresPropios3 x,

y > x,

sumaDivisoresPropios3 y == x]

sumaDivisoresPropios3 :: Integer -> Integer

sumaDivisoresPropios3 = sum . divisoresPropios3

divisoresPropios3 :: Integer -> [Integer]

divisoresPropios3 =

init . nub . sort . map product . subsequences . primeFactors

-- 4ª solución --

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

sucesionAmigos4 :: [(Integer,Integer)]

sucesionAmigos4 =

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

let y = sumaDivisoresPropios4 x,

y > x,

sumaDivisoresPropios4 y == x]

sumaDivisoresPropios4 :: Integer -> Integer

sumaDivisoresPropios4 = sum . divisoresPropios4

divisoresPropios4 :: Integer -> [Integer]

divisoresPropios4 =

init

. sort

. map (product . concat)

. productoCartesiano

. map inits

. group

. primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos

-- xss. Por ejemplo,

-- λ> productoCartesiano [[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]]

productoCartesiano :: [[a]] -> [[a]]

productoCartesiano [] = [[]]

productoCartesiano (xs:xss) =

[x:ys | x <- xs, ys <- productoCartesiano xss]

-- 5ª solución --

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

sucesionAmigos5 :: [(Integer,Integer)]

sucesionAmigos5 =

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

let y = sumaDivisoresPropios5 x,

y > x,

sumaDivisoresPropios5 y == x]

sumaDivisoresPropios5 :: Integer -> Integer

sumaDivisoresPropios5 = sum . divisoresPropios5

divisoresPropios5 :: Integer -> [Integer]

divisoresPropios5 =

init

. sort

. map (product . concat)

. sequence

. map inits

. group

. primeFactors

-- 6ª solución --

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

sucesionAmigos6 :: [(Integer,Integer)]

sucesionAmigos6 =

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

let y = sumaDivisoresPropios6 x,

y > x,

sumaDivisoresPropios6 y == x]

sumaDivisoresPropios6 :: Integer -> Integer

sumaDivisoresPropios6 =

sum

. init

. map (product . concat)

. sequence

. map inits

. group

. primeFactors

-- 7ª solución --

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

sucesionAmigos7 :: [(Integer,Integer)]

sucesionAmigos7 =

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

let y = sumaDivisoresPropios7 x,

y > x,

sumaDivisoresPropios7 y == x]

-- Si la descomposición de x en factores primos es

-- x = p(1)^e(1) . p(2)^e(2) . .... . p(n)^e(n)

-- entonces la suma de los divisores de x es

-- p(1)^(e(1)+1) - 1 p(2)^(e(2)+1) - 1 p(n)^(e(2)+1) - 1

-- ------------------- . ------------------- ... -------------------

-- p(1)-1 p(2)-1 p(n)-1

-- Ver la demostración en http://bit.ly/2zUXZPc

sumaDivisoresPropios7 :: Integer -> Integer

sumaDivisoresPropios7 x =

product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion x] - x

-- (factorizacion x) es la lista de las bases y exponentes de la

-- descomposición prima de x. Por ejemplo,

-- factorizacion 600 == [(2,3),(3,1),(5,2)]

factorizacion :: Integer -> [(Integer,Integer)]

factorizacion = map primeroYlongitud . group . primeFactors

-- (primeroYlongitud xs) es el par formado por el primer elemento de xs

-- y la longitud de xs. Por ejemplo,

-- primeroYlongitud [3,2,5,7] == (3,4)

primeroYlongitud :: [a] -> (a,Integer)

primeroYlongitud (x:xs) = (x, 1 + genericLength xs)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> take 4 sucesionAmigos1

-- [(220,284),(1184,1210),(2620,2924),(5020,5564)]

-- (6.00 secs, 3,413,777,560 bytes)

-- λ> take 4 sucesionAmigos2

-- [(220,284),(1184,1210),(2620,2924),(5020,5564)]

-- (2.38 secs, 2,052,151,800 bytes)

-- λ> take 4 sucesionAmigos3

-- [(220,284),(1184,1210),(2620,2924),(5020,5564)]

-- (0.14 secs, 235,238,864 bytes)

-- λ> take 4 sucesionAmigos4

-- [(220,284),(1184,1210),(2620,2924),(5020,5564)]

-- (0.20 secs, 208,315,832 bytes)

-- λ> take 4 sucesionAmigos5

-- [(220,284),(1184,1210),(2620,2924),(5020,5564)]

-- (0.09 secs, 176,149,160 bytes)

-- λ> take 4 sucesionAmigos6

-- [(220,284),(1184,1210),(2620,2924),(5020,5564)]

-- (0.07 secs, 154,686,728 bytes)

-- λ> take 4 sucesionAmigos7

-- [(220,284),(1184,1210),(2620,2924),(5020,5564)]

-- (0.12 secs, 120,826,648 bytes)

-- λ> sucesionAmigos3 !! 10

-- (67095,71145)

-- (3.52 secs, 6,749,059,064 bytes)

-- λ> sucesionAmigos4 !! 10

-- (67095,71145)

-- (3.11 secs, 4,951,018,904 bytes)

-- λ> sucesionAmigos5 !! 10

-- (67095,71145)

-- (1.69 secs, 4,294,457,320 bytes)

-- λ> sucesionAmigos6 !! 10

-- (67095,71145)

-- (1.43 secs, 3,889,045,760 bytes)

-- λ> sucesionAmigos7 !! 10

-- (67095,71145)

-- (1.63 secs, 3,191,073,224 bytes)

-- λ> sucesionAmigos5 !! 12

-- (79750,88730)

-- (2.13 secs, 5,312,053,312 bytes)

-- λ> sucesionAmigos6 !! 12

-- (79750,88730)

-- (1.78 secs, 4,820,560,920 bytes)

-- λ> sucesionAmigos7 !! 12

-- (79750,88730)

-- (2.11 secs, 3,971,113,184 bytes)

El código se encuentra en GitHub.

Números amigos

PorJosé A. Alonso 16-febrero-202215-abril-2022

Definir la función

   amigos :: Integer -> Integer -> Bool

1	amigos :: Integer -> Integer -> Bool

tal que (amigos x y) se verifica si los números x e y son amigos. Por ejemplo,

   amigos 220 284 == True
   amigos 220 23  == False
   amigos 42262694537514864075544955198125 42405817271188606697466971841875 == True

amigos 220 284 == True

amigos 220 23 == False

amigos 42262694537514864075544955198125 42405817271188606697466971841875 == True

Soluciones

import Data.List (genericLength, group, inits, nub, sort, subsequences)
import Data.Numbers.Primes (primeFactors)

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

amigos1 :: Integer -> Integer -> Bool
amigos1 x y = sumaDivisoresPropios1 x == y &&
              sumaDivisoresPropios1 y == x

-- (sumaDivisoresPropios1 x) es la suma de los divisores propios de
-- x. Por ejemplo,
--    sumaDivisoresPropios1 220  ==  284
--    sumaDivisoresPropios1 284  ==  220
sumaDivisoresPropios1 :: Integer -> Integer
sumaDivisoresPropios1 = sum . divisoresPropios1

-- (divisoresPropios1 x) es la lista de los divisores propios de x. Por
-- ejemplo,
--    divisoresPropios1 220  ==  [1,2,4,5,10,11,20,22,44,55,110]
--    divisoresPropios1 284  ==  [1,2,4,71,142]
divisoresPropios1 :: Integer -> [Integer]
divisoresPropios1 x = [n | n <- [1..x-1], x `mod` n == 0]

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

amigos2 :: Integer -> Integer -> Bool
amigos2 x y = sumaDivisoresPropios2 x == y &&
              sumaDivisoresPropios2 y == x

sumaDivisoresPropios2 :: Integer -> Integer
sumaDivisoresPropios2 = sum . divisoresPropios2

divisoresPropios2 :: Integer -> [Integer]
divisoresPropios2 x = filter ((== 0) . mod x) [1..x-1]

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

amigos3 :: Integer -> Integer -> Bool
amigos3 x y = sumaDivisoresPropios3 x == y &&
              sumaDivisoresPropios3 y == x

sumaDivisoresPropios3 :: Integer -> Integer
sumaDivisoresPropios3 = sum . divisoresPropios3

divisoresPropios3 :: Integer -> [Integer]
divisoresPropios3 =
  init . nub . sort . map product . subsequences . primeFactors

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

amigos4 :: Integer -> Integer -> Bool
amigos4 x y = sumaDivisoresPropios4 x == y &&
              sumaDivisoresPropios4 y == x

sumaDivisoresPropios4 :: Integer -> Integer
sumaDivisoresPropios4 = sum . divisoresPropios4

divisoresPropios4 :: Integer -> [Integer]
divisoresPropios4 =
  init
  . sort
  . map (product . concat)
  . productoCartesiano
  . map inits
  . group
  . primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos
-- xss. Por ejemplo,
--    λ> productoCartesiano [[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]]
productoCartesiano :: [[a]] -> [[a]]
productoCartesiano []       = [[]]
productoCartesiano (xs:xss) =
  [x:ys | x <- xs, ys <- productoCartesiano xss]

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

amigos5 :: Integer -> Integer -> Bool
amigos5 x y = sumaDivisoresPropios5 x == y &&
              sumaDivisoresPropios5 y == x

sumaDivisoresPropios5 :: Integer -> Integer
sumaDivisoresPropios5 =
  sum . divisoresPropios5

divisoresPropios5 :: Integer -> [Integer]
divisoresPropios5 =
  init
  . sort
  . map (product . concat)
  . sequence
  . map inits
  . group
  . primeFactors

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

amigos6 :: Integer -> Integer -> Bool
amigos6 x y = sumaDivisoresPropios6 x == y &&
              sumaDivisoresPropios6 y == x

sumaDivisoresPropios6 :: Integer -> Integer
sumaDivisoresPropios6 =
  sum
  . init
  . map (product . concat)
  . sequence
  . map inits
  . group
  . primeFactors

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

amigos7 :: Integer -> Integer -> Bool
amigos7 x y = sumaDivisoresPropios7 x == y &&
              sumaDivisoresPropios7 y == x

-- Si la descomposición de x en factores primos es
--    x = p(1)^e(1) . p(2)^e(2) . .... . p(n)^e(n)
-- entonces la suma de los divisores de x es
--    p(1)^(e(1)+1) - 1     p(2)^(e(2)+1) - 1       p(n)^(e(2)+1) - 1
--   ------------------- . ------------------- ... -------------------
--        p(1)-1                p(2)-1                  p(n)-1
-- Ver la demostración en http://bit.ly/2zUXZPc

-- (sumaDivisoresPropios7 x) es la suma de los divisores propios de
-- x. Por ejemplo,
--    sumaDivisoresPropios7 220  ==  284
--    sumaDivisoresPropios7 284  ==  220
sumaDivisoresPropios7 :: Integer -> Integer
sumaDivisoresPropios7 x =
  product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion x] - x

-- (factorizacion x) es la lista de las bases y exponentes de la
-- descomposición prima de x. Por ejemplo,
--    factorizacion 600  ==  [(2,3),(3,1),(5,2)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion = map primeroYlongitud . group . primeFactors

-- (primeroYlongitud xs) es el par formado por el primer elemento de xs
-- y la longitud de xs. Por ejemplo,
--    primeroYlongitud [3,2,5,7] == (3,4)
primeroYlongitud :: [a] -> (a,Integer)
primeroYlongitud (x:xs) = (x, 1 + genericLength xs)

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

-- La comparación es
--    λ> amigos1 2803580 3716164
--    True
--    (2.27 secs, 1,304,055,864 bytes)
--    λ> amigos2 2803580 3716164
--    True
--    (0.81 secs, 782,478,584 bytes)
--    λ> amigos3 2803580 3716164
--    True
--    (0.01 secs, 383,888 bytes)
--    λ> amigos4 2803580 3716164
--    True
--    (0.01 secs, 461,376 bytes)
--    λ> amigos5 2803580 3716164
--    True
--    (0.00 secs, 412,560 bytes)
--    λ> amigos6 2803580 3716164
--    True
--    (0.00 secs, 387,816 bytes)
--    λ> amigos7 2803580 3716164
--    True
--    (0.01 secs, 339,008 bytes)
--
--    λ> amigos2 5864660 7489324
--    True
--    (1.74 secs, 1,602,582,592 bytes)
--    λ> amigos3 5864660 7489324
--    True
--    (0.00 secs, 277,056 bytes)
--    λ> amigos4 5864660 7489324
--    True
--    (0.01 secs, 354,872 bytes)
--    λ> amigos5 5864660 7489324
--    True
--    (0.01 secs, 305,792 bytes)
--    λ> amigos6 5864660 7489324
--    True
--    (0.00 secs, 281,528 bytes)
--    λ> amigos7 5864660 7489324
--    True
--    (0.01 secs, 237,176 bytes)
--
--    λ> amigos3 42262694537514864075544955198125 42405817271188606697466971841875
--    True
--    (107.54 secs, 5,594,306,392 bytes)
--    λ> amigos4 42262694537514864075544955198125 42405817271188606697466971841875
--    True
--    (1.03 secs, 942,530,824 bytes)
--    λ> amigos5 42262694537514864075544955198125 42405817271188606697466971841875
--    True
--    (0.51 secs, 591,144,304 bytes)
--    λ> amigos6 42262694537514864075544955198125 42405817271188606697466971841875
--    True
--    (0.26 secs, 379,534,608 bytes)
--    λ> amigos7 42262694537514864075544955198125 42405817271188606697466971841875
--    True
--    (0.05 secs, 25,635,464 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

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

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

import Data.List (genericLength, group, inits, nub, sort, subsequences)

import Data.Numbers.Primes (primeFactors)

-- 1ª solución --

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

amigos1 :: Integer -> Integer -> Bool

amigos1 x y = sumaDivisoresPropios1 x == y &&

sumaDivisoresPropios1 y == x

-- (sumaDivisoresPropios1 x) es la suma de los divisores propios de

-- x. Por ejemplo,

-- sumaDivisoresPropios1 220 == 284

-- sumaDivisoresPropios1 284 == 220

sumaDivisoresPropios1 :: Integer -> Integer

sumaDivisoresPropios1 = sum . divisoresPropios1

-- (divisoresPropios1 x) es la lista de los divisores propios de x. Por

-- ejemplo,

-- divisoresPropios1 220 == [1,2,4,5,10,11,20,22,44,55,110]

-- divisoresPropios1 284 == [1,2,4,71,142]

divisoresPropios1 :: Integer -> [Integer]

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

-- 2ª solución --

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

amigos2 :: Integer -> Integer -> Bool

amigos2 x y = sumaDivisoresPropios2 x == y &&

sumaDivisoresPropios2 y == x

sumaDivisoresPropios2 :: Integer -> Integer

sumaDivisoresPropios2 = sum . divisoresPropios2

divisoresPropios2 :: Integer -> [Integer]

divisoresPropios2 x = filter ((== 0) . mod x) [1..x-1]

-- 3ª solución --

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

amigos3 :: Integer -> Integer -> Bool

amigos3 x y = sumaDivisoresPropios3 x == y &&

sumaDivisoresPropios3 y == x

sumaDivisoresPropios3 :: Integer -> Integer

sumaDivisoresPropios3 = sum . divisoresPropios3

divisoresPropios3 :: Integer -> [Integer]

divisoresPropios3 =

init . nub . sort . map product . subsequences . primeFactors

-- 4ª solución --

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

amigos4 :: Integer -> Integer -> Bool

amigos4 x y = sumaDivisoresPropios4 x == y &&

sumaDivisoresPropios4 y == x

sumaDivisoresPropios4 :: Integer -> Integer

sumaDivisoresPropios4 = sum . divisoresPropios4

divisoresPropios4 :: Integer -> [Integer]

divisoresPropios4 =

init

. sort

. map (product . concat)

. productoCartesiano

. map inits

. group

. primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos

-- xss. Por ejemplo,

-- λ> productoCartesiano [[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]]

productoCartesiano :: [[a]] -> [[a]]

productoCartesiano [] = [[]]

productoCartesiano (xs:xss) =

[x:ys | x <- xs, ys <- productoCartesiano xss]

-- 5ª solución --

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

amigos5 :: Integer -> Integer -> Bool

amigos5 x y = sumaDivisoresPropios5 x == y &&

sumaDivisoresPropios5 y == x

sumaDivisoresPropios5 :: Integer -> Integer

sumaDivisoresPropios5 =

sum . divisoresPropios5

divisoresPropios5 :: Integer -> [Integer]

divisoresPropios5 =

init

. sort

. map (product . concat)

. sequence

. map inits

. group

. primeFactors

-- 6ª solución --

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

amigos6 :: Integer -> Integer -> Bool

amigos6 x y = sumaDivisoresPropios6 x == y &&

sumaDivisoresPropios6 y == x

sumaDivisoresPropios6 :: Integer -> Integer

sumaDivisoresPropios6 =

sum

. init

. map (product . concat)

. sequence

. map inits

. group

. primeFactors

-- 7ª solución --

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

amigos7 :: Integer -> Integer -> Bool

amigos7 x y = sumaDivisoresPropios7 x == y &&

sumaDivisoresPropios7 y == x

-- Si la descomposición de x en factores primos es

-- x = p(1)^e(1) . p(2)^e(2) . .... . p(n)^e(n)

-- entonces la suma de los divisores de x es

-- p(1)^(e(1)+1) - 1 p(2)^(e(2)+1) - 1 p(n)^(e(2)+1) - 1

-- ------------------- . ------------------- ... -------------------

-- p(1)-1 p(2)-1 p(n)-1

-- Ver la demostración en http://bit.ly/2zUXZPc

-- (sumaDivisoresPropios7 x) es la suma de los divisores propios de

-- x. Por ejemplo,

-- sumaDivisoresPropios7 220 == 284

-- sumaDivisoresPropios7 284 == 220

sumaDivisoresPropios7 :: Integer -> Integer

sumaDivisoresPropios7 x =

product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion x] - x

-- (factorizacion x) es la lista de las bases y exponentes de la

-- descomposición prima de x. Por ejemplo,

-- factorizacion 600 == [(2,3),(3,1),(5,2)]

factorizacion :: Integer -> [(Integer,Integer)]

factorizacion = map primeroYlongitud . group . primeFactors

-- (primeroYlongitud xs) es el par formado por el primer elemento de xs

-- y la longitud de xs. Por ejemplo,

-- primeroYlongitud [3,2,5,7] == (3,4)

primeroYlongitud :: [a] -> (a,Integer)

primeroYlongitud (x:xs) = (x, 1 + genericLength xs)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> amigos1 2803580 3716164

-- True

-- (2.27 secs, 1,304,055,864 bytes)

-- λ> amigos2 2803580 3716164

-- True

-- (0.81 secs, 782,478,584 bytes)

-- λ> amigos3 2803580 3716164

-- True

-- (0.01 secs, 383,888 bytes)

-- λ> amigos4 2803580 3716164

-- True

-- (0.01 secs, 461,376 bytes)

-- λ> amigos5 2803580 3716164

-- True

-- (0.00 secs, 412,560 bytes)

-- λ> amigos6 2803580 3716164

-- True

-- (0.00 secs, 387,816 bytes)

-- λ> amigos7 2803580 3716164

-- True

-- (0.01 secs, 339,008 bytes)

-- λ> amigos2 5864660 7489324

-- True

-- (1.74 secs, 1,602,582,592 bytes)

-- λ> amigos3 5864660 7489324

-- True

-- (0.00 secs, 277,056 bytes)

-- λ> amigos4 5864660 7489324

-- True

-- (0.01 secs, 354,872 bytes)

-- λ> amigos5 5864660 7489324

-- True

-- (0.01 secs, 305,792 bytes)

-- λ> amigos6 5864660 7489324

-- True

-- (0.00 secs, 281,528 bytes)

-- λ> amigos7 5864660 7489324

-- True

-- (0.01 secs, 237,176 bytes)

-- λ> amigos3 42262694537514864075544955198125 42405817271188606697466971841875

-- True

-- (107.54 secs, 5,594,306,392 bytes)

-- λ> amigos4 42262694537514864075544955198125 42405817271188606697466971841875

-- True

-- (1.03 secs, 942,530,824 bytes)

-- λ> amigos5 42262694537514864075544955198125 42405817271188606697466971841875

-- True

-- (0.51 secs, 591,144,304 bytes)

-- λ> amigos6 42262694537514864075544955198125 42405817271188606697466971841875

-- True

-- (0.26 secs, 379,534,608 bytes)

-- λ> amigos7 42262694537514864075544955198125 42405817271188606697466971841875

-- True

-- (0.05 secs, 25,635,464 bytes)

El código se encuentra en GitHub

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico