div – 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.

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]

Reiteración de una función

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

Definir la función

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

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

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

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

reiteracion (+1) 10 5 == 15

reiteracion (+5) 10 0 == 50

reiteracion (*2) 4 1 == 16

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

Soluciones

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- 1ª solución

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

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

reiteracion1 _ 0 x = x

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

-- 2ª solución

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

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

reiteracion2 _ 0 = id

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

-- 3ª solución

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

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

reiteracion3 _ 0 = id

reiteracion3 f n

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

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

-- 4ª solución

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

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

reiteracion4 f n x = reiteraciones f x !! n

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

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

-- 5ª solución

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

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

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

-- 6ª solución

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- Comprobación de equivalencia

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

-- La propiedad es

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

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

all (== reiteracion1 f n x)

[reiteracion2 f n x,

reiteracion3 f n x,

reiteracion4 f n x,

reiteracion5 f n x,

reiteracion6 f n x]

-- La comprobación es

-- λ> quickCheck prop_reiteracion

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

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

-- 10000000

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

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

-- 10000000

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

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

-- 10000000

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

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

-- 10000000

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

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

-- 10000000

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

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

-- 10000000

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

El código se encuentra en GitHub.

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

Nuevas soluciones

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

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>

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>

Sucesión duplicadora

PorJosé A. Alonso 26-mayo-20202-junio-2020

Para cada entero positivo n, existe una única sucesión que empieza en 1, termina en n y en la que cada uno de sus elementos es el doble de su anterior o el doble más uno. Dicha sucesión se llama la sucesión duplicadora de n. Por ejemplo, la sucesión duplicadora de 13 es [1, 3, 6, 13], ya que

    3 = 2*1 +1
    6 = 2*3
   13 = 2*6 +1

3 = 2*1 +1

6 = 2*3

13 = 2*6 +1

Definir la función

   duplicadora :: Integer -> [Integer]

1	duplicadora :: Integer -> [Integer]

tal que (duplicadora n) es la sucesión duplicadora de n. Por ejemplo,

   duplicadora 13                   ==  [1,3,6,13]
   duplicadora 17                   ==  [1,2,4,8,17]
   length (duplicadora (10^40000))  ==  132878

duplicadora 13 == [1,3,6,13]

duplicadora 17 == [1,2,4,8,17]

length (duplicadora (10^40000)) == 132878

Soluciones

-- 1ª definición
duplicadora :: Integer -> [Integer]
duplicadora x =
  reverse (takeWhile (>=1) (iterate (`div` 2) x))

-- 2ª definición
duplicadora2 :: Integer -> [Integer]
duplicadora2  =
  reverse . takeWhile (>=1) . iterate (`div` 2)

-- 1ª definición

duplicadora :: Integer -> [Integer]

duplicadora x =

reverse (takeWhile (>=1) (iterate (`div` 2) x))

-- 2ª definición

duplicadora2 :: Integer -> [Integer]

duplicadora2 =

reverse . takeWhile (>=1) . iterate (`div` 2)

Cadenas de primos complementarios

PorJosé A. Alonso 25-mayo-20201-junio-2020

El complemento de un número positivo x se calcula por el siguiente procedimiento:

si x es mayor que 9, se toma cada dígito por su valor posicional y se resta del mayor los otro dígitos. Por ejemplo, el complemento de 1448 es 1000 – 400 – 40 – 8 = 552. Para
si x es menor que 10, su complemento es x.

Definir las funciones

   cadena    :: Integer -> [Integer]
   conCadena :: Int -> [Integer]

1 2	cadena :: Integer -> [Integer] conCadena :: Int -> [Integer]

tales que

(cadena x) es la cadena de primos a partir de x tal que cada uno es el complemento del anterior. Por ejemplo,

     cadena 8         == []
     cadena 7         == [7]
     cadena 13        == [13,7]
     cadena 643       == [643,557,443]
     cadena 18127     == [18127,1873,127,73,67,53,47]
     cadena 18181213  == [18181213,1818787,181213,18787,1213,787,613,587]

cadena 8 == []

cadena 7 == [7]

cadena 13 == [13,7]

cadena 643 == [643,557,443]

cadena 18127 == [18127,1873,127,73,67,53,47]

cadena 18181213 == [18181213,1818787,181213,18787,1213,787,613,587]

(conCadena n) es la lista de números cuyas cadenas tienen n elementos. Por ejemplo,

     take 6 (conCadena 3)                == [23,31,61,67,103,307]
     [head (conCadena n) | n <- [4..8]]  == [37,43,157,18127,181873]

1 2	take 6 (conCadena 3) == [23,31,61,67,103,307] [head (conCadena n) \| n <- [4..8]] == [37,43,157,18127,181873]

Soluciones

import Data.Numbers.Primes

-- (complemento x) es le complemento de x. Por ejemplo,
--    complemento 1448  == 552
--    complemento  639  == 561
--    complemento    7  == 7
complemento :: Integer -> Integer
complemento x = (div x c)*c - (rem x c)
  where c = 10^(length (show x) - 1)          

cadena :: Integer -> [Integer]
cadena x    
  | x < 10 && isPrime x = [x]
  | otherwise           = takeWhile isPrime (iterate f x)
  where f x | x < 10 && isPrime x = 0
            | otherwise           = complemento x

conCadena :: Int -> [Integer]
conCadena n =
  [y | y <- primes, length (cadena y) == n]

import Data.Numbers.Primes

-- (complemento x) es le complemento de x. Por ejemplo,

-- complemento 1448 == 552

-- complemento 639 == 561

-- complemento 7 == 7

complemento :: Integer -> Integer

complemento x = (div x c)*c - (rem x c)

where c = 10^(length (show x) - 1)

cadena :: Integer -> [Integer]

cadena x

| x < 10 && isPrime x = [x]

| otherwise = takeWhile isPrime (iterate f x)

where f x | x < 10 && isPrime x = 0

| otherwise = complemento x

conCadena :: Int -> [Integer]

conCadena n =

[y | y <- primes, length (cadena y) == n]

Cadenas de divisores

PorJosé A. Alonso 14-mayo-202021-mayo-2020

Una cadena de divisores de un número n es una lista donde cada elemento es un divisor de su siguiente elemento en la lista. Por ejemplo, las cadenas de divisores de 12 son [2,4,12], [2,6,12], [2,12], [3,6,12], [3,12], [4,12], [6,12] y [12].

Definir la función

   cadenasDivisores :: Int -> [[Int]]

1	cadenasDivisores :: Int -> [[Int]]

tal que (cadenasDivisores n) es la lista de las cadenas de divisores de n. Por ejemplo,

   λ> cadenasDivisores 12
   [[2,4,12],[2,6,12],[2,12],[3,6,12],[3,12],[4,12],[6,12],[12]]
   λ> length (cadenaDivisores 48)
   48
   λ> length (cadenaDivisores 120)
   132

λ> cadenasDivisores 12

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

λ> length (cadenaDivisores 48)

λ> length (cadenaDivisores 120)

132

Soluciones

import Data.List (sort)
import Data.Numbers.Primes (isPrime)

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

cadenasDivisores :: Int -> [[Int]]
cadenasDivisores n = sort (extiendeLista [[n]])
    where extiendeLista []           = []
          extiendeLista ((1:xs):yss) = xs : extiendeLista yss
          extiendeLista ((x:xs):yss) =
              extiendeLista ([y:x:xs | y <- divisores x] ++ yss)

-- (divisores x) es la lista decreciente de los divisores de x distintos
-- de x. Por ejemplo,
--    divisores 12  ==  [6,4,3,2,1]
divisores :: Int -> [Int]
divisores x = 
    [y | y <- [a,a-1..1], x `mod` y == 0]
    where a = x `div` 2

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

cadenasDivisores2 :: Int -> [[Int]]
cadenasDivisores2 = sort . aux
    where aux 1 = [[]]
          aux n = [xs ++ [n] | xs <- concatMap aux (divisores n)]

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

cadenasDivisores3 :: Int -> [[Int]]
cadenasDivisores3 = sort . map reverse . aux
    where aux 1 = [[]]
          aux n = map (n:) (concatMap aux (divisores3 n))

-- (divisores3 x) es la lista creciente de los divisores de x distintos
-- de x. Por ejemplo,
--    divisores3 12  ==  [1,2,3,4,6]
divisores3 :: Int -> [Int]
divisores3 x = 
    [y | y <- [1..a], x `mod` y == 0]
    where a = x `div` 2

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

nCadenasDivisores1 :: Int -> Int
nCadenasDivisores1 = length . cadenasDivisores

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

nCadenasDivisores2 :: Int -> Int
nCadenasDivisores2 1 = 1
nCadenasDivisores2 n = 
    sum [nCadenasDivisores2 x | x <- divisores n]

import Data.List (sort)

import Data.Numbers.Primes (isPrime)

-- 1ª definición

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

cadenasDivisores :: Int -> [[Int]]

cadenasDivisores n = sort (extiendeLista [[n]])

where extiendeLista [] = []

extiendeLista ((1:xs):yss) = xs : extiendeLista yss

extiendeLista ((x:xs):yss) =

extiendeLista ([y:x:xs | y <- divisores x] ++ yss)

-- (divisores x) es la lista decreciente de los divisores de x distintos

-- de x. Por ejemplo,

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

divisores :: Int -> [Int]

divisores x =

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

where a = x `div` 2

-- 2ª definición

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

cadenasDivisores2 :: Int -> [[Int]]

cadenasDivisores2 = sort . aux

where aux 1 = [[]]

aux n = [xs ++ [n] | xs <- concatMap aux (divisores n)]

-- 3ª definición

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

cadenasDivisores3 :: Int -> [[Int]]

cadenasDivisores3 = sort . map reverse . aux

where aux 1 = [[]]

aux n = map (n:) (concatMap aux (divisores3 n))

-- (divisores3 x) es la lista creciente de los divisores de x distintos

-- de x. Por ejemplo,

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

divisores3 :: Int -> [Int]

divisores3 x =

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

where a = x `div` 2

-- 1ª definición de nCadenasDivisores

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

nCadenasDivisores1 :: Int -> Int

nCadenasDivisores1 = length . cadenasDivisores

-- 2ª definición de nCadenasDivisores

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

nCadenasDivisores2 :: Int -> Int

nCadenasDivisores2 1 = 1

nCadenasDivisores2 n =

sum [nCadenasDivisores2 x | x <- divisores n]

Sucesión fractal

PorJosé A. Alonso 13-mayo-202020-mayo-2020

La sucesión fractal

   0, 0, 1, 0, 2, 1, 3, 0, 4, 2, 5, 1, 6, 3, 7, 0, 8, 4, 9, 2, 
   10, 5, 11, 1, 12, 6, 13, 3, 14, 7, 15, ...

1 2	0, 0, 1, 0, 2, 1, 3, 0, 4, 2, 5, 1, 6, 3, 7, 0, 8, 4, 9, 2, 10, 5, 11, 1, 12, 6, 13, 3, 14, 7, 15, ...

está construida de la siguiente forma:

los términos pares forman la sucesión de los números naturales

     0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ...

1	0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ...

los términos impares forman la misma sucesión original

     0, 0, 1, 0, 2, 1, 3, 0, 4, 2, 5, 1, 6, 3, 7, ...

1	0, 0, 1, 0, 2, 1, 3, 0, 4, 2, 5, 1, 6, 3, 7, ...

Definir las funciones

   sucFractal     :: [Integer]
   sumaSucFractal :: Integer -> Integer

1 2	sucFractal :: [Integer] sumaSucFractal :: Integer -> Integer

tales que

sucFractal es la lista de los términos de la sucesión fractal. Por ejemplo,

     take 20 sucFractal   == [0,0,1,0,2,1,3,0,4,2,5,1,6,3,7,0,8,4,9,2]
     sucFractal !! 30     == 15
     sucFractal !! (10^7) == 5000000

take 20 sucFractal == [0,0,1,0,2,1,3,0,4,2,5,1,6,3,7,0,8,4,9,2]

sucFractal !! 30 == 15

sucFractal !! (10^7) == 5000000

(sumaSucFractal n) es la suma de los n primeros términos de la sucesión fractal. Por ejemplo,

     sumaSucFractal 10      == 13
     sumaSucFractal (10^5)  == 1666617368
     sumaSucFractal (10^10) == 16666666661668691669
     sumaSucFractal (10^15) == 166666666666666166673722792954
     sumaSucFractal (10^20) == 1666666666666666666616666684103392376198
     length (show (sumaSucFractal (10^15000))) == 30000
     sumaSucFractal (10^15000) `mod` (10^9)    == 455972157

sumaSucFractal 10 == 13

sumaSucFractal (10^5) == 1666617368

sumaSucFractal (10^10) == 16666666661668691669

sumaSucFractal (10^15) == 166666666666666166673722792954

sumaSucFractal (10^20) == 1666666666666666666616666684103392376198

length (show (sumaSucFractal (10^15000))) == 30000

sumaSucFractal (10^15000) `mod` (10^9) == 455972157

Soluciones

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

sucFractal1 :: [Integer]
sucFractal1 = 
  map termino [0..]

-- (termino n) es el término n de la secuencia anterior. Por ejemplo,
--   termino 0            ==  0
--   termino 1            ==  0
--   map termino [0..10]  ==  [0,0,1,0,2,1,3,0,4,2,5]
termino :: Integer -> Integer
termino 0 = 0
termino n 
  | even n    = n `div` 2
  | otherwise = termino (n `div` 2)

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

sucFractal2 :: [Integer]
sucFractal2 =
  0 : 0 : mezcla [1..] (tail sucFractal2)

-- (mezcla xs ys) es la lista obtenida intercalando las listas infinitas
-- xs e ys. Por ejemplo,
--    take 10 (mezcla [0,2..] [0,-2..])  ==  [0,0,2,-2,4,-4,6,-6,8,-8]
mezcla :: [Integer] -> [Integer] -> [Integer]
mezcla (x:xs) (y:ys) =
  x : y : mezcla xs ys

-- Comparación de eficiencia de definiciones de sucFractal
-- =======================================================

--    λ> sum (take (10^6) sucFractal1)
--    166666169612
--    (5.56 secs, 842,863,264 bytes)
--    λ> sum (take (10^6) sucFractal2)
--    166666169612
--    (1.81 secs, 306,262,616 bytes)

-- En lo que sigue usaremos la 2ª definición
sucFractal :: [Integer]
sucFractal = sucFractal2

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

sumaSucFractal1 :: Integer -> Integer
sumaSucFractal1 n =
  sum (map termino [0..n-1])

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

sumaSucFractal2 :: Integer -> Integer
sumaSucFractal2 n =
  sum (take (fromIntegral n) sucFractal)

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

sumaSucFractal3 :: Integer -> Integer
sumaSucFractal3 0 = 0
sumaSucFractal3 1 = 0
sumaSucFractal3 n
  | even n    = sumaN (n `div` 2) + sumaSucFractal3 (n `div` 2)
  | otherwise = sumaN ((n+1) `div` 2) + sumaSucFractal3 (n `div` 2)
  where sumaN n = (n*(n-1)) `div` 2

-- Comparación de eficiencia de definiciones de sumaSucFractal
-- ===========================================================

--    λ> sumaSucFractal1 (10^6)
--    166666169612
--    (5.25 secs, 810,622,504 bytes)
--    λ> sumaSucFractal2 (10^6)
--    166666169612
--    (1.72 secs, 286,444,048 bytes)
--    λ> sumaSucFractal3 (10^6)
--    166666169612
--    (0.01 secs, 0 bytes)
--    
--    λ> sumaSucFractal2 (10^7)
--    16666661685034
--    (17.49 secs, 3,021,580,920 bytes)
--    λ> sumaSucFractal3 (10^7)
--    16666661685034
--    (0.01 secs, 0 bytes)

-- 1ª definición de sucFractal

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

sucFractal1 :: [Integer]

sucFractal1 =

map termino [0..]

-- (termino n) es el término n de la secuencia anterior. Por ejemplo,

-- termino 0 == 0

-- termino 1 == 0

-- map termino [0..10] == [0,0,1,0,2,1,3,0,4,2,5]

termino :: Integer -> Integer

termino 0 = 0

termino n

| even n = n `div` 2

| otherwise = termino (n `div` 2)

-- 2ª definición de sucFractal

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

sucFractal2 :: [Integer]

sucFractal2 =

0 : 0 : mezcla [1..] (tail sucFractal2)

-- (mezcla xs ys) es la lista obtenida intercalando las listas infinitas

-- xs e ys. Por ejemplo,

-- take 10 (mezcla [0,2..] [0,-2..]) == [0,0,2,-2,4,-4,6,-6,8,-8]

mezcla :: [Integer] -> [Integer] -> [Integer]

mezcla (x:xs) (y:ys) =

x : y : mezcla xs ys

-- Comparación de eficiencia de definiciones de sucFractal

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

-- λ> sum (take (10^6) sucFractal1)

-- 166666169612

-- (5.56 secs, 842,863,264 bytes)

-- λ> sum (take (10^6) sucFractal2)

-- 166666169612

-- (1.81 secs, 306,262,616 bytes)

-- En lo que sigue usaremos la 2ª definición

sucFractal :: [Integer]

sucFractal = sucFractal2

-- 1ª definición de sumaSucFractal

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

sumaSucFractal1 :: Integer -> Integer

sumaSucFractal1 n =

sum (map termino [0..n-1])

-- 2ª definición de sumaSucFractal

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

sumaSucFractal2 :: Integer -> Integer

sumaSucFractal2 n =

sum (take (fromIntegral n) sucFractal)

-- 3ª definición de sumaSucFractal

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

sumaSucFractal3 :: Integer -> Integer

sumaSucFractal3 0 = 0

sumaSucFractal3 1 = 0

sumaSucFractal3 n

| even n = sumaN (n `div` 2) + sumaSucFractal3 (n `div` 2)

| otherwise = sumaN ((n+1) `div` 2) + sumaSucFractal3 (n `div` 2)

where sumaN n = (n*(n-1)) `div` 2

-- Comparación de eficiencia de definiciones de sumaSucFractal

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

-- λ> sumaSucFractal1 (10^6)

-- 166666169612

-- (5.25 secs, 810,622,504 bytes)

-- λ> sumaSucFractal2 (10^6)

-- 166666169612

-- (1.72 secs, 286,444,048 bytes)

-- λ> sumaSucFractal3 (10^6)

-- 166666169612

-- (0.01 secs, 0 bytes)

-- λ> sumaSucFractal2 (10^7)

-- 16666661685034

-- (17.49 secs, 3,021,580,920 bytes)

-- λ> sumaSucFractal3 (10^7)

-- 16666661685034

-- (0.01 secs, 0 bytes)

Mayor capicúa producto de dos números de n cifras

PorJosé A. Alonso 29-abril-202012-mayo-2020

Un capicúa es un número que es igual leído de izquierda a derecha que de derecha a izquierda.

Definir la función

   mayorCapicuaP :: Integer -> Integer

1	mayorCapicuaP :: Integer -> Integer

tal que (mayorCapicuaP n) es el mayor capicúa que es el producto de dos números de n cifras. Por ejemplo,

   mayorCapicuaP 2  ==  9009
   mayorCapicuaP 3  ==  906609
   mayorCapicuaP 4  ==  99000099
   mayorCapicuaP 5  ==  9966006699
   mayorCapicuaP 6  ==  999000000999
   mayorCapicuaP 7  ==  99956644665999

mayorCapicuaP 2 == 9009

mayorCapicuaP 3 == 906609

mayorCapicuaP 4 == 99000099

mayorCapicuaP 5 == 9966006699

mayorCapicuaP 6 == 999000000999

mayorCapicuaP 7 == 99956644665999

Soluciones

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

mayorCapicuaP1 :: Integer -> Integer
mayorCapicuaP1 n = head (capicuasP n)

-- (capicuasP n) es la lista de las capicúas de 2*n cifras que
-- pueden escribirse como productos de dos números de n cifras. Por
-- ejemplo, Por ejemplo,
--    ghci> capicuasP 2
--    [9009,8448,8118,8008,7227,7007,6776,6336,6006,5775,5445,5335,
--     5225,5115,5005,4884,4774,4664,4554,4224,4004,3773,3663,3003,
--     2992,2772,2552,2442,2332,2112,2002,1881,1771,1551,1221,1001]
capicuasP n = [x | x <- capicuas n,
                        not (null (productosDosNumerosCifras n x))]

-- (capicuas n) es la lista de las capicúas de 2*n cifras de mayor a
-- menor. Por ejemplo, 
--    capicuas 1           ==  [99,88,77,66,55,44,33,22,11]
--    take 7 (capicuas 2)  ==  [9999,9889,9779,9669,9559,9449,9339]
capicuas :: Integer -> [Integer]
capicuas n = [capicua x | x <- numerosCifras n]

-- (numerosCifras n) es la lista de los números de n cifras de mayor a
-- menor. Por ejemplo,
--    numerosCifras 1           ==  [9,8,7,6,5,4,3,2,1]
--    take 7 (numerosCifras 2)  ==  [99,98,97,96,95,94,93]
--    take 7 (numerosCifras 3)  ==  [999,998,997,996,995,994,993]
numerosCifras :: Integer -> [Integer]
numerosCifras n = [a,a-1..b]
  where a = 10^n-1
        b = 10^(n-1) 

-- (capicua n) es la capicúa formada añadiendo el inverso de n a
--  continuación de n. Por ejemplo,
--    capicua 93  ==  9339
capicua :: Integer -> Integer
capicua n = read (xs ++ (reverse xs))
  where xs = show n

-- (productosDosNumerosCifras n x) es la lista de los números y de n
-- cifras tales que existe un z de n cifras y x es el producto de y por
-- z. Por ejemplo, 
--    productosDosNumerosCifras 2 9009  ==  [99,91]
productosDosNumerosCifras n x = [y | y <- numeros,
                                     mod x y == 0,
                                     div x y `elem` numeros]
  where numeros = numerosCifras n

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

mayorCapicuaP2 :: Integer -> Integer
mayorCapicuaP2 n = maximum [x*y | x <- [a,a-1..b],
                                  y <- [a,a-1..b],
                                  esCapicua (x*y)] 
  where a = 10^n-1
        b = 10^(n-1)

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,
--    esCapicua 353  ==  True
--    esCapicua 357  ==  False
esCapicua :: Integer -> Bool
esCapicua n = xs == reverse xs
  where xs = show n

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

mayorCapicuaP3 :: Integer -> Integer
mayorCapicuaP3 n = maximum [x*y | (x,y) <- pares a b, 
                                  esCapicua (x*y)] 
  where a = 10^n-1
        b = 10^(n-1)

-- (pares a b) es la lista de los pares de números entre a y b de forma
-- que su suma es decreciente. Por ejemplo,
--    pares 9 7  ==  [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]
pares a b = [(x,z-x) | z <- [a1,a1-1..b1],
                       x <- [a,a-1..b],
                       x <= z-x, z-x <= a]
  where a1 = 2*a
        b1 = 2*b

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

mayorCapicuaP4 :: Integer -> Integer
mayorCapicuaP4 n = maximum [x | y <- [a..b],
                                z <- [y..b],
                                let x = y * z,
                                let s = show x,
                                s == reverse s]
  where a = 10^(n-1)
        b = 10^n-1
     
-- 5ª solución
-- ===========

mayorCapicuaP5 :: Integer -> Integer
mayorCapicuaP5 n = maximum [x*y | (x,y) <- pares2 b a, esCapicua (x*y)]
  where a = 10^(n-1)
        b = 10^n-1
                       
-- (pares2 a b) es la lista de los pares de números entre a y b de forma
-- que su suma es decreciente. Por ejemplo,
--    pares2 9 7  ==  [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]
pares2 a b = [(x,y) | x <- [a,a-1..b], y <- [a,a-1..x]]

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

mayorCapicuaP6 :: Integer -> Integer
mayorCapicuaP6 n = maximum [x*y | x <- [a..b], 
                                  y <- [x..b] , 
                                  esCapicua (x*y)]
  where a = 10^(n-1)
        b = 10^n-1
 
-- (cifras n) es la lista de las cifras de n en orden inverso. Por
-- ejemplo,  
--    cifras 325  == [5,2,3]
cifras :: Integer -> [Integer]
cifras n 
    | n < 10    = [n]
    | otherwise = (ultima n) : (cifras (quitarUltima n))

-- (ultima n) es la última cifra de n. Por ejemplo,
--    ultima 325  ==  5
ultima  :: Integer -> Integer
ultima n =  n - (n `div` 10)*10

-- (quitarUltima n) es el número obtenido al quitarle a n su última
-- cifra. Por ejemplo,
--    quitarUltima 325  =>  32 
quitarUltima :: Integer -> Integer
quitarUltima n = (n - (ultima n)) `div` 10

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

mayorCapicuaP7 :: Integer -> Integer
mayorCapicuaP7 n = head [x | x <- capicuas n, esFactorizable x n]

-- (esFactorizable x n) se verifica si x se puede escribir como producto
-- de dos números de n dígitos. Por ejemplo,
--    esFactorizable 1219 2  ==  True
--    esFactorizable 1217 2  ==  False
esFactorizable x n = aux i x
  where b = 10^n-1
        i = floor (sqrt (fromIntegral x))
        aux i x | i > b          = False
                | x `mod` i == 0 = x `div` i < b 
                | otherwise      = aux (i+1) x

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

--    λ> mayorCapicuaP1 3
--    906609
--    (0.07 secs, 18,248,224 bytes)
--    λ> mayorCapicuaP2 3
--    906609
--    (0.51 secs, 555,695,720 bytes)
--    λ> mayorCapicuaP3 3
--    906609
--    (0.96 secs, 780,794,768 bytes)
--    λ> mayorCapicuaP4 3
--    906609
--    (0.24 secs, 255,445,448 bytes)
--    λ> mayorCapicuaP5 3
--    906609
--    (0.33 secs, 317,304,080 bytes)
--    λ> mayorCapicuaP6 3
--    906609
--    (0.26 secs, 274,987,472 bytes)
--    λ> mayorCapicuaP7 3
--    906609
--    (0.02 secs, 1,807,720 bytes)
--    
--    λ> mayorCapicuaP1 5
--    9966006699
--    (9.90 secs, 6,349,454,544 bytes)
--    λ> mayorCapicuaP7 5
--    9966006699
--    (0.06 secs, 15,958,616 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

-- 1ª solución

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

mayorCapicuaP1 :: Integer -> Integer

mayorCapicuaP1 n = head (capicuasP n)

-- (capicuasP n) es la lista de las capicúas de 2*n cifras que

-- pueden escribirse como productos de dos números de n cifras. Por

-- ejemplo, Por ejemplo,

-- ghci> capicuasP 2

-- [9009,8448,8118,8008,7227,7007,6776,6336,6006,5775,5445,5335,

-- 5225,5115,5005,4884,4774,4664,4554,4224,4004,3773,3663,3003,

-- 2992,2772,2552,2442,2332,2112,2002,1881,1771,1551,1221,1001]

capicuasP n = [x | x <- capicuas n,

not (null (productosDosNumerosCifras n x))]

-- (capicuas n) es la lista de las capicúas de 2*n cifras de mayor a

-- menor. Por ejemplo,

-- capicuas 1 == [99,88,77,66,55,44,33,22,11]

-- take 7 (capicuas 2) == [9999,9889,9779,9669,9559,9449,9339]

capicuas :: Integer -> [Integer]

capicuas n = [capicua x | x <- numerosCifras n]

-- (numerosCifras n) es la lista de los números de n cifras de mayor a

-- menor. Por ejemplo,

-- numerosCifras 1 == [9,8,7,6,5,4,3,2,1]

-- take 7 (numerosCifras 2) == [99,98,97,96,95,94,93]

-- take 7 (numerosCifras 3) == [999,998,997,996,995,994,993]

numerosCifras :: Integer -> [Integer]

numerosCifras n = [a,a-1..b]

where a = 10^n-1

b = 10^(n-1)

-- (capicua n) es la capicúa formada añadiendo el inverso de n a

-- continuación de n. Por ejemplo,

-- capicua 93 == 9339

capicua :: Integer -> Integer

capicua n = read (xs ++ (reverse xs))

where xs = show n

-- (productosDosNumerosCifras n x) es la lista de los números y de n

-- cifras tales que existe un z de n cifras y x es el producto de y por

-- z. Por ejemplo,

-- productosDosNumerosCifras 2 9009 == [99,91]

productosDosNumerosCifras n x = [y | y <- numeros,

mod x y == 0,

div x y `elem` numeros]

where numeros = numerosCifras n

-- 2ª solución

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

mayorCapicuaP2 :: Integer -> Integer

mayorCapicuaP2 n = maximum [x*y | x <- [a,a-1..b],

y <- [a,a-1..b],

esCapicua (x*y)]

where a = 10^n-1

b = 10^(n-1)

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,

-- esCapicua 353 == True

-- esCapicua 357 == False

esCapicua :: Integer -> Bool

esCapicua n = xs == reverse xs

where xs = show n

-- 3ª solución

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

mayorCapicuaP3 :: Integer -> Integer

mayorCapicuaP3 n = maximum [x*y | (x,y) <- pares a b,

esCapicua (x*y)]

where a = 10^n-1

b = 10^(n-1)

-- (pares a b) es la lista de los pares de números entre a y b de forma

-- que su suma es decreciente. Por ejemplo,

-- pares 9 7 == [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]

pares a b = [(x,z-x) | z <- [a1,a1-1..b1],

x <- [a,a-1..b],

x <= z-x, z-x <= a]

where a1 = 2*a

b1 = 2*b

-- 4ª solución

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

mayorCapicuaP4 :: Integer -> Integer

mayorCapicuaP4 n = maximum [x | y <- [a..b],

z <- [y..b],

let x = y * z,

let s = show x,

s == reverse s]

where a = 10^(n-1)

b = 10^n-1

-- 5ª solución

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

mayorCapicuaP5 :: Integer -> Integer

mayorCapicuaP5 n = maximum [x*y | (x,y) <- pares2 b a, esCapicua (x*y)]

where a = 10^(n-1)

b = 10^n-1

-- (pares2 a b) es la lista de los pares de números entre a y b de forma

-- que su suma es decreciente. Por ejemplo,

-- pares2 9 7 == [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]

pares2 a b = [(x,y) | x <- [a,a-1..b], y <- [a,a-1..x]]

-- 6ª solución

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

mayorCapicuaP6 :: Integer -> Integer

mayorCapicuaP6 n = maximum [x*y | x <- [a..b],

y <- [x..b] ,

esCapicua (x*y)]

where a = 10^(n-1)

b = 10^n-1

-- (cifras n) es la lista de las cifras de n en orden inverso. Por

-- ejemplo,

-- cifras 325 == [5,2,3]

cifras :: Integer -> [Integer]

cifras n

| n < 10 = [n]

| otherwise = (ultima n) : (cifras (quitarUltima n))

-- (ultima n) es la última cifra de n. Por ejemplo,

-- ultima 325 == 5

ultima :: Integer -> Integer

ultima n = n - (n `div` 10)*10

-- (quitarUltima n) es el número obtenido al quitarle a n su última

-- cifra. Por ejemplo,

-- quitarUltima 325 => 32

quitarUltima :: Integer -> Integer

quitarUltima n = (n - (ultima n)) `div` 10

-- 7ª solución

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

mayorCapicuaP7 :: Integer -> Integer

mayorCapicuaP7 n = head [x | x <- capicuas n, esFactorizable x n]

-- (esFactorizable x n) se verifica si x se puede escribir como producto

-- de dos números de n dígitos. Por ejemplo,

-- esFactorizable 1219 2 == True

-- esFactorizable 1217 2 == False

esFactorizable x n = aux i x

where b = 10^n-1

i = floor (sqrt (fromIntegral x))

aux i x | i > b = False

| x `mod` i == 0 = x `div` i < b

| otherwise = aux (i+1) x

-- Comparación de eficiencia

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

-- λ> mayorCapicuaP1 3

-- 906609

-- (0.07 secs, 18,248,224 bytes)

-- λ> mayorCapicuaP2 3

-- 906609

-- (0.51 secs, 555,695,720 bytes)

-- λ> mayorCapicuaP3 3

-- 906609

-- (0.96 secs, 780,794,768 bytes)

-- λ> mayorCapicuaP4 3

-- 906609

-- (0.24 secs, 255,445,448 bytes)

-- λ> mayorCapicuaP5 3

-- 906609

-- (0.33 secs, 317,304,080 bytes)

-- λ> mayorCapicuaP6 3

-- 906609

-- (0.26 secs, 274,987,472 bytes)

-- λ> mayorCapicuaP7 3

-- 906609

-- (0.02 secs, 1,807,720 bytes)

-- λ> mayorCapicuaP1 5

-- 9966006699

-- (9.90 secs, 6,349,454,544 bytes)

-- λ> mayorCapicuaP7 5

-- 9966006699

-- (0.06 secs, 15,958,616 bytes)

Reparto de escaños por la ley d’Hont

PorJosé A. Alonso 27-abril-20205-mayo-2020

El sistema D’Hondt es una fórmula creada por Victor d’Hondt, que permite obtener el número de cargos electos asignados a las candidaturas, en proporción a los votos conseguidos.

Tras el recuento de los votos, se calcula una serie de divisores para cada partido. La fórmula de los divisores es V/N, donde V representa el número total de votos recibidos por el partido, y N representa cada uno de los números enteros desde 1 hasta el número de cargos electos de la circunscripción objeto de escrutinio. Una vez realizadas las divisiones de los votos de cada partido por cada uno de los divisores desde 1 hasta N, la asignación de cargos electos se hace ordenando los cocientes de las divisiones de mayor a menor y asignando a cada uno un escaño hasta que éstos se agoten

Definir la función

   reparto :: Int -> [Int] -> [(Int,Int)]

1	reparto :: Int -> [Int] -> [(Int,Int)]

tal que (reparto n vs) es la lista de los pares formados por los números de los partidos y el número de escaño que les corresponden al repartir n escaños en función de la lista de sus votos. Por ejemplo,

   ghci> reparto 7 [340000,280000,160000,60000,15000]
   [(1,3),(2,3),(3,1)]
   ghci> reparto 21 [391000,311000,184000,73000,27000,12000,2000]
   [(1,9),(2,7),(3,4),(4,1)]

ghci> reparto 7 [340000,280000,160000,60000,15000]

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

ghci> reparto 21 [391000,311000,184000,73000,27000,12000,2000]

[(1,9),(2,7),(3,4),(4,1)]

es decir, en el primer ejemplo,

al 1º partido (que obtuvo 340000 votos) le corresponden 3 escaños,
al 2º partido (que obtuvo 280000 votos) le corresponden 3 escaños,
al 3º partido (que obtuvo 160000 votos) le corresponden 1 escaño.

Soluciones

import Data.List (sort, group)

-- Para los ejemplos que siguen, se usará la siguiente ditribución de
-- votos entre 5 partidos.
ejVotos :: [Int]
ejVotos = [340000,280000,160000,60000,15000]

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

reparto :: Int -> [Int] -> [(Int,Int)]
reparto n vs = 
  [(x,1 + length xs) | (x:xs) <- group (sort (repartoAux n vs))] 

-- (repartoAux n vs) es el número de los partidos, cuyos votos son vs, que
-- obtienen los n escaños. Por ejemplo,
--    ghci> repartoAux 7 ejVotos
--    [1,2,1,3,2,1,2]
repartoAux :: Int -> [Int] -> [Int]
repartoAux n vs = map snd (repartoAux' n vs)

-- (repartoAux' n vs) es la lista formada por los n restos mayores
-- correspondientes a la lista de votos vs. Por ejemplo,
--    ghci> repartoAux' 7 ejVotos
--    [(340000,1),(280000,2),(170000,1),(160000,3),(140000,2),(113333,1),
--     (93333,2)]
repartoAux' :: Int -> [Int] -> [(Int,Int)]
repartoAux' n vs = 
  take n (reverse (sort (concatMap (restos n) (votosPartidos vs))))

-- (votosPartidos vs) es la lista con los pares formados por los votos y
-- el número de cada partido. Por ejemplo, 
--    ghci> votosPartidos ejVotos
--    [(340000,1),(280000,2),(160000,3),(60000,4),(15000,5)]
votosPartidos :: [Int] -> [(Int,Int)]
votosPartidos vs = zip vs [1..]

-- (restos n (x,i)) es la lista obtenidas dividiendo n entre 1, 2,..., n.
-- Por ejemplo, 
--    ghci> restos 5 (340000,1)
--    [(340000,1),(170000,1),(113333,1),(85000,1),(68000,1)]
restos :: Int -> (Int,Int) -> [(Int,Int)]
restos n (x,i) = [(x `div` k,i) | k <- [1..n]]

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

reparto2 :: Int -> [Int] -> [(Int,Int)]
reparto2 n xs = 
  ( map (\x -> (head x, length x))  
  . group  
  . sort  
  . map snd  
  . take n  
  . reverse  
  . sort
  ) [(x `div` i, p) | (x,p) <- zip xs [1..], i <- [1..n]]

import Data.List (sort, group)

-- Para los ejemplos que siguen, se usará la siguiente ditribución de

-- votos entre 5 partidos.

ejVotos :: [Int]

ejVotos = [340000,280000,160000,60000,15000]

-- 1ª solución

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

reparto :: Int -> [Int] -> [(Int,Int)]

reparto n vs =

[(x,1 + length xs) | (x:xs) <- group (sort (repartoAux n vs))]

-- (repartoAux n vs) es el número de los partidos, cuyos votos son vs, que

-- obtienen los n escaños. Por ejemplo,

-- ghci> repartoAux 7 ejVotos

-- [1,2,1,3,2,1,2]

repartoAux :: Int -> [Int] -> [Int]

repartoAux n vs = map snd (repartoAux' n vs)

-- (repartoAux' n vs) es la lista formada por los n restos mayores

-- correspondientes a la lista de votos vs. Por ejemplo,

-- ghci> repartoAux' 7 ejVotos

-- [(340000,1),(280000,2),(170000,1),(160000,3),(140000,2),(113333,1),

-- (93333,2)]

repartoAux' :: Int -> [Int] -> [(Int,Int)]

repartoAux' n vs =

take n (reverse (sort (concatMap (restos n) (votosPartidos vs))))

-- (votosPartidos vs) es la lista con los pares formados por los votos y

-- el número de cada partido. Por ejemplo,

-- ghci> votosPartidos ejVotos

-- [(340000,1),(280000,2),(160000,3),(60000,4),(15000,5)]

votosPartidos :: [Int] -> [(Int,Int)]

votosPartidos vs = zip vs [1..]

-- (restos n (x,i)) es la lista obtenidas dividiendo n entre 1, 2,..., n.

-- Por ejemplo,

-- ghci> restos 5 (340000,1)

-- [(340000,1),(170000,1),(113333,1),(85000,1),(68000,1)]

restos :: Int -> (Int,Int) -> [(Int,Int)]

restos n (x,i) = [(x `div` k,i) | k <- [1..n]]

-- 2ª solución

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

reparto2 :: Int -> [Int] -> [(Int,Int)]

reparto2 n xs =

( map (\x -> (head x, length x))

. group

. sort

. map snd

. take n

. reverse

. sort

) [(x `div` i, p) | (x,p) <- zip xs [1..], i <- [1..n]]

Otras soluciones

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

Conjetura de las familias estables por uniones

PorJosé A. Alonso 24-abril-20201-mayo-2020

La conjetura de las familias estables por uniones fue planteada por Péter Frankl en 1979 y aún sigue abierta.

Una familia de conjuntos es estable por uniones si la unión de dos conjuntos cualesquiera de la familia pertenece a la familia. Por ejemplo, {∅, {1}, {2}, {1,2}, {1,3}, {1,2,3}} es estable por uniones; pero {{1}, {2}, {1,3}, {1,2,3}} no lo es.

La conjetura afirma que toda familia no vacía estable por uniones y distinta de {∅} posee algún elemento que pertenece al menos a la mitad de los conjuntos de la familia.

Definir las funciones

   esEstable :: Ord a => Set (Set a) -> Bool
   familiasEstables :: Ord a => Set a -> Set (Set (Set a))
   mayoritarios :: Ord a => Set (Set a) -> [a]
   conjeturaFrankl :: Int -> Bool

esEstable :: Ord a => Set (Set a) -> Bool

familiasEstables :: Ord a => Set a -> Set (Set (Set a))

mayoritarios :: Ord a => Set (Set a) -> [a]

conjeturaFrankl :: Int -> Bool

tales que

(esEstable f) se verifica si la familia f es estable por uniones. Por ejemplo,

     λ> esEstable (fromList [empty, fromList [1,2], fromList [1..5]])
     True
     λ> esEstable (fromList [empty, fromList [1,7], fromList [1..5]])
     False
     λ> esEstable (fromList [fromList [1,2], singleton 3, fromList [1..3]])
     True

λ> esEstable (fromList [empty, fromList [1,2], fromList [1..5]])

True

λ> esEstable (fromList [empty, fromList [1,7], fromList [1..5]])

False

λ> esEstable (fromList [fromList [1,2], singleton 3, fromList [1..3]])

True

(familiasEstables c) es el conjunto de las familias estables por uniones formadas por elementos del conjunto c. Por ejemplo,

     λ> familiasEstables (fromList [1..2])
     fromList
       [ fromList []
       , fromList [fromList []]
       , fromList [fromList [],fromList [1]]
       , fromList [fromList [],fromList [1],fromList [1,2]],
         fromList [fromList [],fromList [1],fromList [1,2],fromList [2]]
       , fromList [fromList [],fromList [1,2]]
       , fromList [fromList [],fromList [1,2],fromList [2]]
       , fromList [fromList [],fromList [2]]
       , fromList [fromList [1]]
       , fromList [fromList [1],fromList [1,2]]
       , fromList [fromList [1],fromList [1,2],fromList [2]]
       , fromList [fromList [1,2]]
       , fromList [fromList [1,2],fromList [2]]
       , fromList [fromList [2]]]
     λ> size (familiasEstables (fromList [1,2]))
     14
     λ> size (familiasEstables (fromList [1..3]))
     122
     λ> size (familiasEstables (fromList [1..4]))
     4960

λ> familiasEstables (fromList [1..2])

fromList

[ fromList []

, fromList [fromList []]

, fromList [fromList [],fromList [1]]

, fromList [fromList [],fromList [1],fromList [1,2]],

fromList [fromList [],fromList [1],fromList [1,2],fromList [2]]

, fromList [fromList [],fromList [1,2]]

, fromList [fromList [],fromList [1,2],fromList [2]]

, fromList [fromList [],fromList [2]]

, fromList [fromList [1]]

, fromList [fromList [1],fromList [1,2]]

, fromList [fromList [1],fromList [1,2],fromList [2]]

, fromList [fromList [1,2]]

, fromList [fromList [1,2],fromList [2]]

, fromList [fromList [2]]]

λ> size (familiasEstables (fromList [1,2]))

λ> size (familiasEstables (fromList [1..3]))

122

λ> size (familiasEstables (fromList [1..4]))

4960

(mayoritarios f) es la lista de elementos que pertenecen al menos a la mitad de los conjuntos de la familia f. Por ejemplo,

     mayoritarios (fromList [empty, fromList [1,3], fromList [3,5]]) == [3]
     mayoritarios (fromList [empty, fromList [1,3], fromList [4,5]]) == []

1 2	mayoritarios (fromList [empty, fromList [1,3], fromList [3,5]]) == [3] mayoritarios (fromList [empty, fromList [1,3], fromList [4,5]]) == []

(conjeturaFrankl n) se verifica si para toda familia f formada por elementos del conjunto {1,2,…,n} no vacía, estable por uniones y distinta de {∅} posee algún elemento que pertenece al menos a la mitad de los conjuntos de f. Por ejemplo.

     conjeturaFrankl 2  ==  True
     conjeturaFrankl 3  ==  True
     conjeturaFrankl 4  ==  True

conjeturaFrankl 2 == True

conjeturaFrankl 3 == True

conjeturaFrankl 4 == True

Soluciones

import Data.Set  as S ( Set
                      , delete
                      , deleteFindMin
                      , empty
                      , filter
                      , fromList
                      , insert
                      , map
                      , member
                      , null
                      , singleton
                      , size
                      , toList
                      , union
                      , unions
                      )
import Data.List as L ( filter
                      , null
                      )

esEstable :: Ord a => Set (Set a) -> Bool
esEstable xss =
  and [ys `S.union` zs `member` xss | (ys,yss) <- selecciones xss
                                    , zs <- toList yss]

-- (seleccciones xs) es la lista de los pares formada por un elemento de
-- xs y los restantes elementos. Por ejemplo,
--    λ> selecciones (fromList [3,2,5])
--    [(2,fromList [3,5]),(3,fromList [2,5]),(5,fromList [2,3])]
selecciones :: Ord a => Set a -> [(a,Set a)]
selecciones xs =
  [(x,delete x xs) | x <- toList xs] 

familiasEstables :: Ord a => Set a -> Set (Set (Set a))
familiasEstables xss =
  S.filter esEstable (familias xss)

-- (familias c) es la familia formadas con elementos de c. Por ejemplo,
--    λ> mapM_ print (familias (fromList [1,2]))
--    fromList []
--    fromList [fromList []]
--    fromList [fromList [],fromList [1]]
--    fromList [fromList [],fromList [1],fromList [1,2]]
--    fromList [fromList [],fromList [1],fromList [1,2],fromList [2]]
--    fromList [fromList [],fromList [1],fromList [2]]
--    fromList [fromList [],fromList [1,2]]
--    fromList [fromList [],fromList [1,2],fromList [2]]
--    fromList [fromList [],fromList [2]]
--    fromList [fromList [1]]
--    fromList [fromList [1],fromList [1,2]]
--    fromList [fromList [1],fromList [1,2],fromList [2]]
--    fromList [fromList [1],fromList [2]]
--    fromList [fromList [1,2]]
--    fromList [fromList [1,2],fromList [2]]
--    fromList [fromList [2]]
--    λ> size (familias (fromList [1,2]))
--    16
--    λ> size (familias (fromList [1,2,3]))
--    256
--    λ> size (familias (fromList [1,2,3,4]))
--    65536
familias :: Ord a => Set a -> Set (Set (Set a))
familias c =
  subconjuntos (subconjuntos c)

-- (subconjuntos c) es el conjunto de los subconjuntos de c. Por ejemplo,
--    λ> mapM_ print (subconjuntos (fromList [1,2,3]))
--    fromList []
--    fromList [1]
--    fromList [1,2]
--    fromList [1,2,3]
--    fromList [1,3]
--    fromList [2]
--    fromList [2,3]
--    fromList [3]
subconjuntos :: Ord a => Set a -> Set (Set a)
subconjuntos c
  | S.null c  = singleton empty
  | otherwise = S.map (insert x) sr `union` sr
  where (x,rc) = deleteFindMin c
        sr     = subconjuntos rc

-- (elementosFamilia f) es el conjunto de los elementos de los elementos
-- de la familia f. Por ejemplo, 
--    λ> elementosFamilia (fromList [empty, fromList [1,2], fromList [2,5]])
--    fromList [1,2,5]
elementosFamilia :: Ord a => Set (Set a) -> Set a
elementosFamilia = unions . toList

-- (nOcurrencias f x) es el número de conjuntos de la familia f a los
-- que pertenece el elemento x. Por ejemplo,
--    nOcurrencias (fromList [empty, fromList [1,3], fromList [3,5]]) 3 == 2
--    nOcurrencias (fromList [empty, fromList [1,3], fromList [3,5]]) 4 == 0
--    nOcurrencias (fromList [empty, fromList [1,3], fromList [3,5]]) 5 == 1
nOcurrencias :: Ord a => Set (Set a) -> a -> Int
nOcurrencias f x =
  length (L.filter (x `member`) (toList f))

mayoritarios :: Ord a => Set (Set a) -> [a]
mayoritarios f =
  [x | x <- toList (elementosFamilia f)
     , nOcurrencias f x >= n]
  where n = (1 + size f) `div` 2

conjeturaFrankl :: Int -> Bool
conjeturaFrankl n =
  and [ not (L.null (mayoritarios f))
      | f <- fs
      , f /= fromList []
      , f /= fromList [empty]]
  where fs = toList (familiasEstables (fromList [1..n]))


-- conjeturaFrankl' :: Int -> Bool
conjeturaFrankl' n =
  [f | f <- fs
     , L.null (mayoritarios f)
     , f /= fromList []
     , f /= fromList [empty]]
  where fs = toList (familiasEstables (fromList [1..n]))

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

import Data.Set as S ( Set

, delete

, deleteFindMin

, empty

, filter

, fromList

, insert

, map

, member

, null

, singleton

, size

, toList

, union

, unions

)

import Data.List as L ( filter

, null

)

esEstable :: Ord a => Set (Set a) -> Bool

esEstable xss =

and [ys `S.union` zs `member` xss | (ys,yss) <- selecciones xss

, zs <- toList yss]

-- (seleccciones xs) es la lista de los pares formada por un elemento de

-- xs y los restantes elementos. Por ejemplo,

-- λ> selecciones (fromList [3,2,5])

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

selecciones :: Ord a => Set a -> [(a,Set a)]

selecciones xs =

[(x,delete x xs) | x <- toList xs]

familiasEstables :: Ord a => Set a -> Set (Set (Set a))

familiasEstables xss =

S.filter esEstable (familias xss)

-- (familias c) es la familia formadas con elementos de c. Por ejemplo,

-- λ> mapM_ print (familias (fromList [1,2]))

-- fromList []

-- fromList [fromList []]

-- fromList [fromList [],fromList [1]]

-- fromList [fromList [],fromList [1],fromList [1,2]]

-- fromList [fromList [],fromList [1],fromList [1,2],fromList [2]]

-- fromList [fromList [],fromList [1],fromList [2]]

-- fromList [fromList [],fromList [1,2]]

-- fromList [fromList [],fromList [1,2],fromList [2]]

-- fromList [fromList [],fromList [2]]

-- fromList [fromList [1]]

-- fromList [fromList [1],fromList [1,2]]

-- fromList [fromList [1],fromList [1,2],fromList [2]]

-- fromList [fromList [1],fromList [2]]

-- fromList [fromList [1,2]]

-- fromList [fromList [1,2],fromList [2]]

-- fromList [fromList [2]]

-- λ> size (familias (fromList [1,2]))

-- 16

-- λ> size (familias (fromList [1,2,3]))

-- 256

-- λ> size (familias (fromList [1,2,3,4]))

-- 65536

familias :: Ord a => Set a -> Set (Set (Set a))

familias c =

subconjuntos (subconjuntos c)

-- (subconjuntos c) es el conjunto de los subconjuntos de c. Por ejemplo,

-- λ> mapM_ print (subconjuntos (fromList [1,2,3]))

-- fromList []

-- fromList [1]

-- fromList [1,2]

-- fromList [1,2,3]

-- fromList [1,3]

-- fromList [2]

-- fromList [2,3]

-- fromList [3]

subconjuntos :: Ord a => Set a -> Set (Set a)

subconjuntos c

| S.null c = singleton empty

| otherwise = S.map (insert x) sr `union` sr

where (x,rc) = deleteFindMin c

sr = subconjuntos rc

-- (elementosFamilia f) es el conjunto de los elementos de los elementos

-- de la familia f. Por ejemplo,

-- λ> elementosFamilia (fromList [empty, fromList [1,2], fromList [2,5]])

-- fromList [1,2,5]

elementosFamilia :: Ord a => Set (Set a) -> Set a

elementosFamilia = unions . toList

-- (nOcurrencias f x) es el número de conjuntos de la familia f a los

-- que pertenece el elemento x. Por ejemplo,

-- nOcurrencias (fromList [empty, fromList [1,3], fromList [3,5]]) 3 == 2

-- nOcurrencias (fromList [empty, fromList [1,3], fromList [3,5]]) 4 == 0

-- nOcurrencias (fromList [empty, fromList [1,3], fromList [3,5]]) 5 == 1

nOcurrencias :: Ord a => Set (Set a) -> a -> Int

nOcurrencias f x =

length (L.filter (x `member`) (toList f))

mayoritarios :: Ord a => Set (Set a) -> [a]

mayoritarios f =

[x | x <- toList (elementosFamilia f)

, nOcurrencias f x >= n]

where n = (1 + size f) `div` 2

conjeturaFrankl :: Int -> Bool

conjeturaFrankl n =

and [ not (L.null (mayoritarios f))

| f <- fs

, f /= fromList []

, f /= fromList [empty]]

where fs = toList (familiasEstables (fromList [1..n]))

-- conjeturaFrankl' :: Int -> Bool

conjeturaFrankl' n =

[f | f <- fs

, L.null (mayoritarios f)

, f /= fromList []

, f /= fromList [empty]]

where fs = toList (familiasEstables (fromList [1..n]))

Otras soluciones

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

Suma de segmentos iniciales

PorJosé A. Alonso 20-abril-20203-mayo-2020

Los segmentos iniciales de [3,1,2,5] son [3], [3,1], [3,1,2] y [3,1,2,5]. Sus sumas son 3, 4, 6 y 9, respectivamente. La suma de dichas sumas es 24.

Definir la función

   sumaSegmentosIniciales :: [Integer] -> Integer

1	sumaSegmentosIniciales :: [Integer] -> Integer

tal que (sumaSegmentosIniciales xs) es la suma de las sumas de los segmentos iniciales de xs. Por ejemplo,

   sumaSegmentosIniciales [3,1,2,5]     ==  24
   sumaSegmentosIniciales [1..3*10^6]  ==  4500004500001000000

1 2	sumaSegmentosIniciales [3,1,2,5] == 24 sumaSegmentosIniciales [1..3*10^6] == 4500004500001000000

Comprobar con QuickCheck que la suma de las sumas de los segmentos iniciales de la lista formada por n veces el número uno es el n-ésimo número triangular; es decir que

   sumaSegmentosIniciales (genericReplicate n 1)

1	sumaSegmentosIniciales (genericReplicate n 1)

es igual a

   n * (n + 1) `div` 2

1	n * (n + 1) `div` 2

Soluciones

import Data.List (genericLength, genericReplicate)
import Test.QuickCheck

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

sumaSegmentosIniciales :: [Integer] -> Integer
sumaSegmentosIniciales xs =
  sum [sum (take k xs) | k <- [1.. length xs]]

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

sumaSegmentosIniciales2 :: [Integer] -> Integer
sumaSegmentosIniciales2 xs =
  sum (zipWith (*) [n,n-1..1] xs)
  where n = genericLength xs

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

sumaSegmentosIniciales3 :: [Integer] -> Integer
sumaSegmentosIniciales3 xs =
  sum (scanl1 (+) xs)

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

-- La propiedad es
prop_sumaSegmentosInicialesEquiv :: [Integer] -> Bool
prop_sumaSegmentosInicialesEquiv xs =
  all (== sumaSegmentosIniciales xs) [f xs | f <- [ sumaSegmentosIniciales2
                                                  , sumaSegmentosIniciales3]]

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

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

--   λ> sumaSegmentosIniciales [1..10^4]
--   166716670000
--   (2.42 secs, 7,377,926,824 bytes)
--   λ> sumaSegmentosIniciales2 [1..10^4]
--   166716670000
--   (0.01 secs, 4,855,176 bytes)
--   
--   λ> sumaSegmentosIniciales2 [1..3*10^6]
--   4500004500001000000
--   (2.68 secs, 1,424,404,168 bytes)
--   λ> sumaSegmentosIniciales3 [1..3*10^6]
--   4500004500001000000
--   (1.54 secs, 943,500,384 bytes)

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

-- La propiedad es
prop_sumaSegmentosIniciales :: Positive Integer -> Bool
prop_sumaSegmentosIniciales (Positive n) =
  sumaSegmentosIniciales3 (genericReplicate n 1) ==
  n * (n + 1) `div` 2

-- La compronación es
--   λ> quickCheck prop_sumaSegmentosIniciales
--   +++ OK, passed 100 tests.

import Data.List (genericLength, genericReplicate)

import Test.QuickCheck

-- 1ª solución

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

sumaSegmentosIniciales :: [Integer] -> Integer

sumaSegmentosIniciales xs =

sum [sum (take k xs) | k <- [1.. length xs]]

-- 2ª solución

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

sumaSegmentosIniciales2 :: [Integer] -> Integer

sumaSegmentosIniciales2 xs =

sum (zipWith (*) [n,n-1..1] xs)

where n = genericLength xs

-- 3ª solución

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

sumaSegmentosIniciales3 :: [Integer] -> Integer

sumaSegmentosIniciales3 xs =

sum (scanl1 (+) xs)

-- Comprobación de la equivalencia

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

-- La propiedad es

prop_sumaSegmentosInicialesEquiv :: [Integer] -> Bool

prop_sumaSegmentosInicialesEquiv xs =

all (== sumaSegmentosIniciales xs) [f xs | f <- [ sumaSegmentosIniciales2

, sumaSegmentosIniciales3]]

-- La comprobación es

-- λ> quickCheck prop_sumaSegmentosInicialesEquiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> sumaSegmentosIniciales [1..10^4]

-- 166716670000

-- (2.42 secs, 7,377,926,824 bytes)

-- λ> sumaSegmentosIniciales2 [1..10^4]

-- 166716670000

-- (0.01 secs, 4,855,176 bytes)

-- λ> sumaSegmentosIniciales2 [1..3*10^6]

-- 4500004500001000000

-- (2.68 secs, 1,424,404,168 bytes)

-- λ> sumaSegmentosIniciales3 [1..3*10^6]

-- 4500004500001000000

-- (1.54 secs, 943,500,384 bytes)

-- Comprobación de la propiedad

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

-- La propiedad es

prop_sumaSegmentosIniciales :: Positive Integer -> Bool

prop_sumaSegmentosIniciales (Positive n) =

sumaSegmentosIniciales3 (genericReplicate n 1) ==

n * (n + 1) `div` 2

-- La compronación es

-- λ> quickCheck prop_sumaSegmentosIniciales

-- +++ OK, passed 100 tests.

Otras soluciones

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

Orden de divisibilidad

PorJosé A. Alonso 14-abril-202021-abril-2020

El orden de divisibilidad de un número x es el mayor n tal que para todo i menor o igual que n, los i primeros dígitos de n es divisible por i. Por ejemplo, el orden de divisibilidad de 74156 es 3 porque

   7       es divisible por 1
   74      es divisible por 2
   741     es divisible por 3
   7415 no es divisible por 4

7 es divisible por 1

74 es divisible por 2

741 es divisible por 3

7415 no es divisible por 4

Definir la función

   ordenDeDivisibilidad :: Integer -> Int

1	ordenDeDivisibilidad :: Integer -> Int

tal que (ordenDeDivisibilidad x) es el orden de divisibilidad de x. Por ejemplo,

   ordenDeDivisibilidad 74156                      ==  3
   ordenDeDivisibilidad 12                         ==  2
   ordenDeDivisibilidad 7                          ==  1
   ordenDeDivisibilidad 3608528850368400786036725  ==  25

ordenDeDivisibilidad 74156 == 3

ordenDeDivisibilidad 12 == 2

ordenDeDivisibilidad 7 == 1

ordenDeDivisibilidad 3608528850368400786036725 == 25

Soluciones

import Data.List (inits)

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

ordenDeDivisibilidad :: Integer -> Int
ordenDeDivisibilidad n = 
  length (takeWhile (\(x,k) -> x `mod` k == 0) (zip (sucDigitos n) [1..]))

-- (sucDigitos x) es la sucesión de los dígitos de x. Por ejemplo,
--    sucDigitos 325    ==  [3,32,325]
--    sucDigitos 32050  ==  [3,32,320,3205,32050]
sucDigitos :: Integer -> [Integer]
sucDigitos n = 
    [n `div` (10^i) | i <- [k-1,k-2..0]]
    where k = length (show n)

-- 2ª definición de sucDigitos
sucDigitos2 :: Integer -> [Integer]
sucDigitos2 n = [read xs | xs <- aux (show n)]
  where aux []     = []
        aux (d:ds) = [d] : map (d:) (aux ds)

-- 3ª definición de sucDigitos
sucDigitos3 :: Integer -> [Integer]
sucDigitos3 n = 
  [read (take k ds) | k <- [1..length ds]]
  where ds = show n

-- 4ª definición de sucDigitos
sucDigitos4 :: Integer -> [Integer]
sucDigitos4 n = [read xs | xs <- tail (inits (show n))]

-- 5ª definición de sucDigitos
sucDigitos5 :: Integer -> [Integer]
sucDigitos5 n = map read (tail (inits (show n)))

-- 6ª definición de sucDigitos
sucDigitos6 :: Integer -> [Integer]
sucDigitos6 = map read . (tail . inits . show)

-- Eficiencia de las definiciones de sucDigitos
--    ghci> length (sucDigitos (10^5000))
--    5001
--    (0.01 secs, 1550688 bytes)
--    ghci> length (sucDigitos2 (10^5000))
--    5001
--    (1.25 secs, 729411872 bytes)
--    ghci> length (sucDigitos3 (10^5000))
--    5001
--    (0.02 secs, 2265120 bytes)
--    ghci> length (sucDigitos4 (10^5000))
--    5001
--    (1.10 secs, 728366872 bytes)
--    ghci> length (sucDigitos5 (10^5000))
--    5001
--    (1.12 secs, 728393864 bytes)
--    ghci> length (sucDigitos6 (10^5000))
--    5001
--    (1.20 secs, 728403052 bytes)
-- 
--    ghci> length (sucDigitos (10^3000000))
--    3000001
--    (2.73 secs, 820042696 bytes)
--    ghci> length (sucDigitos3 (10^3000000))
--    3000001
--    (3.69 secs, 820043688 bytes)

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

ordenDeDivisibilidad2 :: Integer -> Int
ordenDeDivisibilidad2 x =
  length
  $ takeWhile (==0)
  $ zipWith (mod . read) (tail $ inits $ show x) [1..]

import Data.List (inits)

-- 1ª definición de ordenDeDivisibilidad

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

ordenDeDivisibilidad :: Integer -> Int

ordenDeDivisibilidad n =

length (takeWhile (\(x,k) -> x `mod` k == 0) (zip (sucDigitos n) [1..]))

-- (sucDigitos x) es la sucesión de los dígitos de x. Por ejemplo,

-- sucDigitos 325 == [3,32,325]

-- sucDigitos 32050 == [3,32,320,3205,32050]

sucDigitos :: Integer -> [Integer]

sucDigitos n =

[n `div` (10^i) | i <- [k-1,k-2..0]]

where k = length (show n)

-- 2ª definición de sucDigitos

sucDigitos2 :: Integer -> [Integer]

sucDigitos2 n = [read xs | xs <- aux (show n)]

where aux [] = []

aux (d:ds) = [d] : map (d:) (aux ds)

-- 3ª definición de sucDigitos

sucDigitos3 :: Integer -> [Integer]

sucDigitos3 n =

[read (take k ds) | k <- [1..length ds]]

where ds = show n

-- 4ª definición de sucDigitos

sucDigitos4 :: Integer -> [Integer]

sucDigitos4 n = [read xs | xs <- tail (inits (show n))]

-- 5ª definición de sucDigitos

sucDigitos5 :: Integer -> [Integer]

sucDigitos5 n = map read (tail (inits (show n)))

-- 6ª definición de sucDigitos

sucDigitos6 :: Integer -> [Integer]

sucDigitos6 = map read . (tail . inits . show)

-- Eficiencia de las definiciones de sucDigitos

-- ghci> length (sucDigitos (10^5000))

-- 5001

-- (0.01 secs, 1550688 bytes)

-- ghci> length (sucDigitos2 (10^5000))

-- 5001

-- (1.25 secs, 729411872 bytes)

-- ghci> length (sucDigitos3 (10^5000))

-- 5001

-- (0.02 secs, 2265120 bytes)

-- ghci> length (sucDigitos4 (10^5000))

-- 5001

-- (1.10 secs, 728366872 bytes)

-- ghci> length (sucDigitos5 (10^5000))

-- 5001

-- (1.12 secs, 728393864 bytes)

-- ghci> length (sucDigitos6 (10^5000))

-- 5001

-- (1.20 secs, 728403052 bytes)

-- ghci> length (sucDigitos (10^3000000))

-- 3000001

-- (2.73 secs, 820042696 bytes)

-- ghci> length (sucDigitos3 (10^3000000))

-- 3000001

-- (3.69 secs, 820043688 bytes)

-- 2ª definición de ordenDeDivisibilidad

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

ordenDeDivisibilidad2 :: Integer -> Int

ordenDeDivisibilidad2 x =

length

$ takeWhile (==0)

$ zipWith (mod . read) (tail $ inits $ show x) [1..]

Otras soluciones

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

La conjetura de Levy

PorJosé A. Alonso 31-marzo-20208-abril-2020

Hyman Levy observó que

    7 = 3 + 2 x 2
    9 = 3 + 2 x 3 =  5 + 2 x 2
   11 = 5 + 2 x 3 =  7 + 2 x 2
   13 = 3 + 2 x 5 =  7 + 2 x 3
   15 = 3 + 2 x 5 = 11 + 2 x 2
   17 = 3 + 2 x 7 =  7 + 2 x 5 = 11 + 2 x 3 = 13 + 2 x 2
   19 = 5 + 2 x 7 = 13 + 2 x 3

7 = 3 + 2 x 2

9 = 3 + 2 x 3 = 5 + 2 x 2

11 = 5 + 2 x 3 = 7 + 2 x 2

13 = 3 + 2 x 5 = 7 + 2 x 3

15 = 3 + 2 x 5 = 11 + 2 x 2

17 = 3 + 2 x 7 = 7 + 2 x 5 = 11 + 2 x 3 = 13 + 2 x 2

19 = 5 + 2 x 7 = 13 + 2 x 3

y conjeturó que todos los número impares mayores o iguales que 7 se pueden escribir como la suma de un primo y el doble de un primo. El objetivo de los siguientes ejercicios es comprobar la conjetura de Levy.

Definir las siguientes funciones

   descomposicionesLevy :: Integer -> [(Integer,Integer)]
   graficaLevy          :: Integer -> IO ()

1 2	descomposicionesLevy :: Integer -> [(Integer,Integer)] graficaLevy :: Integer -> IO ()

tales que

(descomposicionesLevy x) es la lista de pares de primos (p,q) tales que x = p + 2q. Por ejemplo,

     descomposicionesLevy  7  ==  [(3,2)]
     descomposicionesLevy  9  ==  [(3,3),(5,2)]
     descomposicionesLevy 17  ==  [(3,7),(7,5),(11,3),(13,2)]

descomposicionesLevy 7 == [(3,2)]

descomposicionesLevy 9 == [(3,3),(5,2)]

descomposicionesLevy 17 == [(3,7),(7,5),(11,3),(13,2)]

(graficaLevy n) dibuja los puntos (x,y) tales que x pertenece a [7,9..7+2x(n-1)] e y es el número de descomposiciones de Levy de x. Por ejemplo, (graficaLevy 200) dibuja

Comprobar con QuickCheck la conjetura de Levy.

Soluciones

import Data.Numbers.Primes
import Test.QuickCheck
import Graphics.Gnuplot.Simple

descomposicionesLevy :: Integer -> [(Integer,Integer)]
descomposicionesLevy x =
  [(p,q) | p <- takeWhile (< x) (tail primes)
         , let q = (x - p) `div` 2
         , isPrime q]

graficaLevy :: Integer -> IO ()
graficaLevy n =
  plotList [ Key Nothing
           , XRange (7,fromIntegral (7+2*(n-1)))
           , PNG ("La_conjetura_de_Levy-" ++ show n ++ ".png")
           ]
           [(x, length (descomposicionesLevy x)) | x <- [7,9..7+2*(n-1)]] 

-- La propiedad es
prop_Levy :: Integer -> Bool
prop_Levy x =
  not (null (descomposicionesLevy (7 + 2 * abs x)))

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

import Data.Numbers.Primes

import Test.QuickCheck

import Graphics.Gnuplot.Simple

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

descomposicionesLevy x =

[(p,q) | p <- takeWhile (< x) (tail primes)

, let q = (x - p) `div` 2

, isPrime q]

graficaLevy :: Integer -> IO ()

graficaLevy n =

plotList [ Key Nothing

, XRange (7,fromIntegral (7+2*(n-1)))

, PNG ("La_conjetura_de_Levy-" ++ show n ++ ".png")

]

[(x, length (descomposicionesLevy x)) | x <- [7,9..7+2*(n-1)]]

-- La propiedad es

prop_Levy :: Integer -> Bool

prop_Levy x =

not (null (descomposicionesLevy (7 + 2 * abs x)))

-- La comprobación es

-- λ> quickCheck prop_Levy

-- +++ OK, passed 100 tests.

Otras soluciones

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

Pensamiento

«Dios creó el número natural, y todo el resto es obra del hombre.»

Leopold Kronecker

Conjetura de Lemoine

PorJosé A. Alonso 11-febrero-202026-marzo-2022

La conjetura de Lemoine afirma que

Todos los números impares mayores que 5 se pueden escribir de la forma p + 2q donde p y q son números primos. Por ejemplo, 47 = 13 + 2 x 17

Definir las funciones

   descomposicionesLemoine :: Integer -> [(Integer,Integer)]
   graficaLemoine :: Integer -> IO ()

1 2	descomposicionesLemoine :: Integer -> [(Integer,Integer)] graficaLemoine :: Integer -> IO ()

tales que

(descomposicionesLemoine n) es la lista de pares de primos (p,q) tales que n = p + 2q. Por ejemplo,

     descomposicionesLemoine 5   ==  []
     descomposicionesLemoine 7   ==  [(3,2)]
     descomposicionesLemoine 9   ==  [(5,2),(3,3)]
     descomposicionesLemoine 21  ==  [(17,2),(11,5),(7,7)]
     descomposicionesLemoine 47  ==  [(43,2),(41,3),(37,5),(13,17)]
     descomposicionesLemoine 33  ==  [(29,2),(23,5),(19,7),(11,11),(7,13)]
     length (descomposicionesLemoine 2625)  ==  133

descomposicionesLemoine 5 == []

descomposicionesLemoine 7 == [(3,2)]

descomposicionesLemoine 9 == [(5,2),(3,3)]

descomposicionesLemoine 21 == [(17,2),(11,5),(7,7)]

descomposicionesLemoine 47 == [(43,2),(41,3),(37,5),(13,17)]

descomposicionesLemoine 33 == [(29,2),(23,5),(19,7),(11,11),(7,13)]

length (descomposicionesLemoine 2625) == 133

(graficaLemoine n) dibuja la gráfica de los números de descomposiciones de Lemoine para los números impares menores o iguales que n. Por ejemplo, (graficaLemoine n 400) dibuja

Comprobar con QuickCheck la conjetura de Lemoine.

Nota: Basado en Lemoine’s conjecture

Soluciones

import Data.Numbers.Primes (isPrime, primes)
import Graphics.Gnuplot.Simple
import Test.QuickCheck

descomposicionesLemoine :: Integer -> [(Integer,Integer)]
descomposicionesLemoine n =
  [(p,q) | q <- takeWhile (<=(n-2) `div` 2) primes
         , let p = n - 2 * q
         , isPrime p]

graficaLemoine :: Integer -> IO ()
graficaLemoine n = do
  plotList [ Key Nothing
           , Title "Conjetura de Lemoine"
           , PNG "Conjetura_de_Lemoine.png"
           ]
           [(k,length (descomposicionesLemoine k)) | k <- [1,3..n]]

-- La conjetura es
prop_conjeturaLemoine :: Integer -> Bool
prop_conjeturaLemoine n =
  not (null (descomposicionesLemoine n'))
  where n' = 7 + 2 * abs n

-- Su comprobación es
--    λ> quickCheck prop_conjeturaLemoine
--    +++ OK, passed 100 tests.

import Data.Numbers.Primes (isPrime, primes)

import Graphics.Gnuplot.Simple

import Test.QuickCheck

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

descomposicionesLemoine n =

[(p,q) | q <- takeWhile (<=(n-2) `div` 2) primes

, let p = n - 2 * q

, isPrime p]

graficaLemoine :: Integer -> IO ()

graficaLemoine n = do

plotList [ Key Nothing

, Title "Conjetura de Lemoine"

, PNG "Conjetura_de_Lemoine.png"

]

[(k,length (descomposicionesLemoine k)) | k <- [1,3..n]]

-- La conjetura es

prop_conjeturaLemoine :: Integer -> Bool

prop_conjeturaLemoine n =

not (null (descomposicionesLemoine n'))

where n' = 7 + 2 * abs n

-- Su comprobación es

-- λ> quickCheck prop_conjeturaLemoine

-- +++ OK, passed 100 tests.

Otras soluciones

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

Pensamiento

«Todo el mundo sabe lo que es una curva, hasta que ha estudiado suficientes matemáticas para confundirse a través del incontable número de posibles excepciones.»

Felix Klein.

Conjetura de Collatz generalizada

PorJosé A. Alonso 10-febrero-202017-febrero-2020

Sea p un número primo. Toma un número natural positivo, si es divisible entre un número primo menor que p divídelo entre el menor de dicho divisores, y en otro caso multiplícalo por p y súmale uno; si el resultado no es igual a uno, repite el proceso. Por ejemplo, para p = 7 y empezando en 42 el proceso es

   42
   -> 21   [= 42/2]
   -> 7    [= 21/3]
   -> 50   [= 7*7+1]
   -> 25   [= 50/5]
   -> 5    [= 25/5]
   -> 1    [= 5/5]

-> 21 [= 42/2]

-> 7 [= 21/3]

-> 50 [= 7*7+1]

-> 25 [= 50/5]

-> 5 [= 25/5]

-> 1 [= 5/5]

La conjetura de Collatz generalizada afirma que este proceso siempre acaba en un número finito de pasos.

Definir la función