elem

Teorema de Hilbert-Waring

PorJosé A. Alonso 9-enero-202016-enero-2020

El problema de Waring, propuesto por Edward Waring consiste en déterminar si, para cada número entero k mayor que 1, existe un número n tal que todo entero positivo se puede escribir como una suma de k-potencias de números positivos con n sumandos como máximo.

La respuesta afirmativa al problema, aportada por David Hilbert, se conoce como el teorema de Hilbert-Waring. Su enunciado es

Para cada número entero k, con k ≥ 2, existe un entero positivo g(k) tal que todo entero positivo se puede expresar como una suma de a lo más g(k) k-ésimas potencias.

Definir las funciones

   descomposiciones :: Integer -> Integer -> Integer -> [[Integer]]
   orden :: Integer -> Integer -> Integer

1 2	descomposiciones :: Integer -> Integer -> Integer -> [[Integer]] orden :: Integer -> Integer -> Integer

tales que

(descomposiciones x k n) es la lista de descomposiciones de x como suma de n potencias con exponente k de números enteros positivos.

     descomposiciones 9   2 1  ==  [[9]]
     descomposiciones 9   3 1  ==  []
     descomposiciones 9   3 2  ==  [[1,8]]
     descomposiciones 9   4 9  ==  [[1,1,1,1,1,1,1,1,1]]
     descomposiciones 25  2 2  ==  [[9,16]]
     descomposiciones 133 2 3  ==  [[8,125]]
     descomposiciones 38  3 2  ==  [[1,1,36],[4,9,25]]

descomposiciones 9 2 1 == [[9]]

descomposiciones 9 3 1 == []

descomposiciones 9 3 2 == [[1,8]]

descomposiciones 9 4 9 == [[1,1,1,1,1,1,1,1,1]]

descomposiciones 25 2 2 == [[9,16]]

descomposiciones 133 2 3 == [[8,125]]

descomposiciones 38 3 2 == [[1,1,36],[4,9,25]]

(orden x k) es el menor número de sumandos necesario para expresar x como suma de k-ésimas potencias. Por ejemplo,

     orden 9  2  ==  1
     orden 9  3  ==  2
     orden 9  4  ==  9
     orden 10 2  ==  2
     orden 10 3  ==  3
     orden 10 4  ==  10
     [maximum [orden x k | x <- [1..1000]] | k <- [1..6]] == [1,4,9,19,37,73]

orden 9 2 == 1

orden 9 3 == 2

orden 9 4 == 9

orden 10 2 == 2

orden 10 3 == 3

orden 10 4 == 10

[maximum [orden x k | x <- [1..1000]] | k <- [1..6]] == [1,4,9,19,37,73]

Comprobar el teorema de Hilbert-Waring para k hasta 7; es decir, para todo número x positivo se verifica que

   orden x 2 <= 4   
   orden x 3 <= 9   
   orden x 4 <= 19  
   orden x 5 <= 37  
   orden x 6 <= 73  
   orden x 7 <= 143

orden x 2 <= 4

orden x 3 <= 9

orden x 4 <= 19

orden x 5 <= 37

orden x 6 <= 73

orden x 7 <= 143

y, en general,

   orden x k <= 2^k + floor ((3/2)^k) - 2

1	orden x k <= 2^k + floor ((3/2)^k) - 2

Soluciones

import Test.QuickCheck

descomposiciones :: Integer -> Integer -> Integer -> [[Integer]]
descomposiciones x k n =
  sumas x (takeWhile (<= x) (potencias k)) n

-- (potencias n) es la lista de las potencias de n
--    take 7 (potencias 2)  ==  [1,4,9,16,25,36,49]
--    take 7 (potencias 3)  ==  [1,8,27,64,125,216,343]
potencias :: Integer -> [Integer]
potencias n = map (^n) [1..]

-- (sumas n ys x) es la lista de las descomposiciones de x como
-- sumas de n sumandos de la lista creciente ys. Por ejemplo,
--    sumas 3 [1,2] 2  ==  [[1,2]]
--    sumas 4 [1,2] 2  ==  [[2,2]]
--    sumas 5 [1,2] 2  ==  []
--    sumas 5 [1,2] 3  ==  [[1,2,2]]
--    sumas 6 [1,2] 3  ==  [[2,2,2]]
--    sumas 6 [1,2,5] 2  ==  [[1,5]]
sumas :: Integer -> [Integer] -> Integer -> [[Integer]]
sumas _ [] _                   = []
sumas x ys 1     | x `elem` ys = [[x]]
                 | otherwise   = []
sumas x (y:ys) n | y > x       = []
                 | otherwise   = map (y:) (sumas (x-y) (y:ys) (n-1)) ++
                                 sumas x ys n

orden :: Integer -> Integer -> Integer
orden x k = head [n | n <- [1..]
                    , not (null (descomposiciones x k n))]

-- El teorema es                                 
teorema_Hilbert_Waring :: Integer -> Integer -> Property
teorema_Hilbert_Waring x k =
  x > 0 && k >= 2
  ==>
  orden x 2 <= 4   &&
  orden x 3 <= 9   &&
  orden x 4 <= 19  &&
  orden x 5 <= 37  &&
  orden x 6 <= 73  &&
  orden x 7 <= 143 &&
  orden x k <= 2^k + floor ((3/2)^k) - 2

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

import Test.QuickCheck

descomposiciones :: Integer -> Integer -> Integer -> [[Integer]]

descomposiciones x k n =

sumas x (takeWhile (<= x) (potencias k)) n

-- (potencias n) es la lista de las potencias de n

-- take 7 (potencias 2) == [1,4,9,16,25,36,49]

-- take 7 (potencias 3) == [1,8,27,64,125,216,343]

potencias :: Integer -> [Integer]

potencias n = map (^n) [1..]

-- (sumas n ys x) es la lista de las descomposiciones de x como

-- sumas de n sumandos de la lista creciente ys. Por ejemplo,

-- sumas 3 [1,2] 2 == [[1,2]]

-- sumas 4 [1,2] 2 == [[2,2]]

-- sumas 5 [1,2] 2 == []

-- sumas 5 [1,2] 3 == [[1,2,2]]

-- sumas 6 [1,2] 3 == [[2,2,2]]

-- sumas 6 [1,2,5] 2 == [[1,5]]

sumas :: Integer -> [Integer] -> Integer -> [[Integer]]

sumas _ [] _ = []

sumas x ys 1 | x `elem` ys = [[x]]

| otherwise = []

sumas x (y:ys) n | y > x = []

| otherwise = map (y:) (sumas (x-y) (y:ys) (n-1)) ++

sumas x ys n

orden :: Integer -> Integer -> Integer

orden x k = head [n | n <- [1..]

, not (null (descomposiciones x k n))]

-- El teorema es

teorema_Hilbert_Waring :: Integer -> Integer -> Property

teorema_Hilbert_Waring x k =

x > 0 && k >= 2

==>

orden x 2 <= 4 &&

orden x 3 <= 9 &&

orden x 4 <= 19 &&

orden x 5 <= 37 &&

orden x 6 <= 73 &&

orden x 7 <= 143 &&

orden x k <= 2^k + floor ((3/2)^k) - 2

-- La comprobación es

-- λ> quickCheck teorema_Hilbert_Waring

-- +++ OK, passed 100 tests.

Referencia

Basado en Hilbert-Waring theorem de ProofWiki.

Pensamiento

¡Y en la tersa arena,
cerca de la mar,
tu carne rosa y morena,
súbitamente Guiomar!

Antonio Machado

Múltiplos con ceros y unos

PorJosé A. Alonso 3-diciembre-201925-marzo-2022

Se observa que todos los primeros números naturales tienen al menos un múltiplo no nulo que está formado solamente por ceros y unos. Por ejemplo, 1×10=10, 2×5=10, 3×37=111, 4×25=100, 5×2=10, 6×185=1110; 7×143=1001; 8X125=1000; 9×12345679=111111111.

Definir la función

   multiplosCon1y0 :: Integer -> [Integer]

1	multiplosCon1y0 :: Integer -> [Integer]

tal que (multiplosCon1y0 n) es la lista de los múltiplos de n cuyos dígitos son 1 ó 0. Por ejemplo,

   take 4 (multiplosCon1y0 3)      ==  [111,1011,1101,1110]
   take 3 (multiplosCon1y0 23)     ==  [110101,1011011,1101010]
   head (multiplosCon1y0 1234658)  ==  110101101101000000110

take 4 (multiplosCon1y0 3) == [111,1011,1101,1110]

take 3 (multiplosCon1y0 23) == [110101,1011011,1101010]

head (multiplosCon1y0 1234658) == 110101101101000000110

Comprobar con QuickCheck que todo entero positivo tiene algún múltiplo cuyos dígitos son 1 ó 0.

Soluciones

import Test.QuickCheck

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

multiplosCon1y0 :: Integer -> [Integer]
multiplosCon1y0 n = [x | x <- multiplos n
                       , todos1y0 x]

-- (multiplos n) es la lista de los múltiplos de n. Por ejemplo, 
--    take 12 (multiplos 5)  ==  [5,10,15,20,25,30,35,40,45,50,55,60]
multiplos :: Integer -> [Integer]
multiplos n = [n,2*n..]

-- (todos1y0 n) se verifica si todos los dígitos de n son el 1 o el
-- 0. Por ejmplo,
--    todos1y0 1101110  ==  True
--    todos1y0 1102110  ==  False
todos1y0 :: Integer -> Bool
todos1y0 n = all (`elem` "01") (show n)

-- 2ª definición
-- =============
    
multiplosCon1y0b :: Integer -> [Integer] 
multiplosCon1y0b n = 
    [x | x <- numerosCon1y0
       , x `rem` n == 0] 

-- numerosCon1y0 es la lista de los números cuyos dígitos son 1 ó 0. Por
-- ejemplo,  
--    ghci> take 15 numerosCon1y0
--    [1,10,11,100,101,110,111,1000,1001,1010,1011,1100,1101,1110,1111]
numerosCon1y0 :: [Integer]
numerosCon1y0 = 1 : concat [[10*x,10*x+1] | x <- numerosCon1y0]

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

--    λ> head (multiplosCon1y0 9)
--    111111111
--    (7.70 secs, 10,853,320,456 bytes)
--    λ> head (multiplosCon1y0b 9)
--    111111111
--    (0.01 secs, 167,992 bytes)
                        
-- Comprobación de la propiedad
-- ============================
                        
-- La propiedad es
prop_existe_multiplosCon1y0 :: Integer -> Property
prop_existe_multiplosCon1y0 n = 
    n > 0 ==> (not . null) (multiplosCon1y0b n)

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

import Test.QuickCheck

-- 1ª definición

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

multiplosCon1y0 :: Integer -> [Integer]

multiplosCon1y0 n = [x | x <- multiplos n

, todos1y0 x]

-- (multiplos n) es la lista de los múltiplos de n. Por ejemplo,

-- take 12 (multiplos 5) == [5,10,15,20,25,30,35,40,45,50,55,60]

multiplos :: Integer -> [Integer]

multiplos n = [n,2*n..]

-- (todos1y0 n) se verifica si todos los dígitos de n son el 1 o el

-- 0. Por ejmplo,

-- todos1y0 1101110 == True

-- todos1y0 1102110 == False

todos1y0 :: Integer -> Bool

todos1y0 n = all (`elem` "01") (show n)

-- 2ª definición

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

multiplosCon1y0b :: Integer -> [Integer]

multiplosCon1y0b n =

[x | x <- numerosCon1y0

, x `rem` n == 0]

-- numerosCon1y0 es la lista de los números cuyos dígitos son 1 ó 0. Por

-- ejemplo,

-- ghci> take 15 numerosCon1y0

-- [1,10,11,100,101,110,111,1000,1001,1010,1011,1100,1101,1110,1111]

numerosCon1y0 :: [Integer]

numerosCon1y0 = 1 : concat [[10*x,10*x+1] | x <- numerosCon1y0]

-- Comparación de eficiencia

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

-- λ> head (multiplosCon1y0 9)

-- 111111111

-- (7.70 secs, 10,853,320,456 bytes)

-- λ> head (multiplosCon1y0b 9)

-- 111111111

-- (0.01 secs, 167,992 bytes)

-- Comprobación de la propiedad

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

-- La propiedad es

prop_existe_multiplosCon1y0 :: Integer -> Property

prop_existe_multiplosCon1y0 n =

n > 0 ==> (not . null) (multiplosCon1y0b n)

-- La comprobación es

-- λ> quickCheck prop_existe_multiplosCon1y0

-- +++ OK, passed 100 tests.

Pensamiento

Huye del triste amor, amor pacato,
sin peligro, sin venda ni aventura,
que espera del amor prenda segura,
porque en amor locura es lo sensato.

Antonio Machado

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

PorJosé A. Alonso 25-abril-201925-abril-2021

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 2 == 9009

mayorCapicuaP 3 == 906609

mayorCapicuaP 4 == 99000099

mayorCapicuaP 5 == 9966006699

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 soluciones                                          --
-- ---------------------------------------------------------------------

-- El tiempo de cálculo de (mayorCapicuaP n) para las 7 definiciones es
--    +------+------+------+------+
--    | Def. | 2    | 3    | 4    |
--    |------+------+------+------|
--    |    1 | 0.01 | 0.13 | 1.39 |
--    |    2 | 0.03 | 2.07 |      |
--    |    3 | 0.05 | 3.86 |      |
--    |    4 | 0.01 | 0.89 |      |
--    |    5 | 0.03 | 1.23 |      |
--    |    6 | 0.02 | 1.03 |      |
--    |    7 | 0.01 | 0.02 | 0.02 |
--    +------+------+------+------+

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

-- 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 soluciones --

-- ---------------------------------------------------------------------

-- El tiempo de cálculo de (mayorCapicuaP n) para las 7 definiciones es

-- +------+------+------+------+

-- | Def. | 2 | 3 | 4 |

-- |------+------+------+------|

-- | 1 | 0.01 | 0.13 | 1.39 |

-- | 2 | 0.03 | 2.07 | |

-- | 3 | 0.05 | 3.86 | |

-- | 4 | 0.01 | 0.89 | |

-- | 5 | 0.03 | 1.23 | |

-- | 6 | 0.02 | 1.03 | |

-- | 7 | 0.01 | 0.02 | 0.02 |

-- +------+------+------+------+

Pensamiento

Mi corazón está donde ha nacido,
no a la vida, al amor, cerca del Duero.

Antonio Machado

Elementos no repetidos

PorJosé A. Alonso 22-abril-20191-mayo-2019

Definir la función

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

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

tal que (noRepetidos xs) es la lista de los elementos no repetidos de la lista xs. Por ejemplo,

   noRepetidos [3,2,5,2,4,7,3]  ==  [5,4,7]
   noRepetidos "noRepetidos"    ==  "nRptids"
   noRepetidos "Roma"           ==  "Roma"

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

noRepetidos "noRepetidos" == "nRptids"

noRepetidos "Roma" == "Roma"

Soluciones

import Test.QuickCheck

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

noRepetidos :: Eq a => [a] -> [a]
noRepetidos xs = 
  [x | x <- xs, ocurrencias x xs == 1]
  
-- (ocurrencias x ys) es el número de ocurrencias de x en ys. Por
-- ejemplo,
--    ocurrencias 3 [3,2,5,2,4,7,3]  ==  2
--    ocurrencias 5 [3,2,5,2,4,7,3]  ==  1
ocurrencias :: Eq a => a -> [a] -> Int
ocurrencias x ys = 
  length [y | y <- ys, y == x]

-- 2ª solución
-- ===========
noRepetidos2 :: Eq a => [a] -> [a]
noRepetidos2 [] = []
noRepetidos2 (x:xs) | elem x xs = noRepetidos2 [y | y <- xs, y /= x]
                    | otherwise = x : noRepetidos2 xs

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

-- La propiedad de equivalencia es
prop_equivalencia :: [Int] -> Bool
prop_equivalencia xs =
  noRepetidos xs == noRepetidos2 xs

-- La comprobación es
--    ghci> quickCheck prop_equivalencia
--    +++ OK, passed 100 tests.

import Test.QuickCheck

-- 1ª solución

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

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

noRepetidos xs =

[x | x <- xs, ocurrencias x xs == 1]

-- (ocurrencias x ys) es el número de ocurrencias de x en ys. Por

-- ejemplo,

-- ocurrencias 3 [3,2,5,2,4,7,3] == 2

-- ocurrencias 5 [3,2,5,2,4,7,3] == 1

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

ocurrencias x ys =

length [y | y <- ys, y == x]

-- 2ª solución

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

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

noRepetidos2 [] = []

noRepetidos2 (x:xs) | elem x xs = noRepetidos2 [y | y <- xs, y /= x]

| otherwise = x : noRepetidos2 xs

-- Equivalencia

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

-- La propiedad de equivalencia es

prop_equivalencia :: [Int] -> Bool

prop_equivalencia xs =

noRepetidos xs == noRepetidos2 xs

-- La comprobación es

-- ghci> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

Pensamiento

Y en perfecto rimo
— así a la vera del agua
el doble chopo del río.

Antonio Machado

La conjetura de Collatz

PorJosé A. Alonso 9-abril-201926-marzo-2022

La conjetura de Collatz, conocida también como conjetura 3n+1, fue enunciada por Lothar Collatz en 1937 y, hasta la fecha, no se ha resuelto.

La conjetura hace referencia a una propiedad de las sucesiones de Siracusa. La sucesión de Siracusa de un número entero positivo x es la sucesión cuyo primer término es x y el siguiente de un término se obtiene dividiéndolo entre 2, si es par o multiplicándolo por 3 y sumándole 1, si es impar. Por ejemplo, la sucesión de Siracusa de 12 es

   12, 6, 3, 10, 5, 16, 8, 4, 2, 1, 4, 2, 1, 4, 2, 1, 4, 2, 1, 4, ....

1	12, 6, 3, 10, 5, 16, 8, 4, 2, 1, 4, 2, 1, 4, 2, 1, 4, 2, 1, 4, ....

La conjetura de Collatz afirma que para todo número entero positivo x, el 1 pertenece a la sucesión de Siracusa de x.

Definir las funciones

   siracusa        :: Integer -> [Integer]
   graficaSiracusa :: Int -> [Integer] -> IO ()

1 2	siracusa :: Integer -> [Integer] graficaSiracusa :: Int -> [Integer] -> IO ()

tales que

(siracusa x) es la sucesión de Siracusa de x. Por ejemplo,

     λ> take 20 (siracusa 12)
     [12,6,3,10,5,16,8,4,2,1,4,2,1,4,2,1,4,2,1,4]
     λ> take 20 (siracusa 22)
     [22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1,4,2,1,4]

λ> take 20 (siracusa 12)

[12,6,3,10,5,16,8,4,2,1,4,2,1,4,2,1,4,2,1,4]

λ> take 20 (siracusa 22)

[22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1,4,2,1,4]

(graficaSiracusa n xs) dibuja los n primeros términos de las sucesiones de Siracusas de los elementos de xs. Por ejemplo, (graficaSiracusa 100 [27]) dibuja

y (graficaSiracusa 150 [1..1000]) dibuja

Comprobar con QuickCheck la conjetura de Collatz.

Soluciones

import Test.QuickCheck
import Graphics.Gnuplot.Simple

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

siracusa :: Integer -> [Integer]
siracusa n | even n    = n : siracusa (n `div` 2)
           | otherwise = n : siracusa (3*n+1)

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

siracusa2 :: Integer -> [Integer]
siracusa2 = iterate siguiente 
  where siguiente x | even x    = x `div` 2
                    | otherwise = 3*x+1

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

-- La comparación es
--    λ> siracusa 12 !! (10^6)
--    4
--    (0.55 secs, 362,791,008 bytes)
--    λ> siracusa 12 !! (2*10^6)
--    2
--    (1.05 secs, 725,456,376 bytes)
--    λ> siracusa2 12 !! (10^6)
--    4
--    (1.66 secs, 647,189,664 bytes)
--    λ> siracusa2 12 !! (2*10^6)
--    2
--    (3.11 secs, 1,294,286,792 bytes)

-- Definición de graficaSiracusa
-- =============================

graficaSiracusa :: Int -> [Integer] -> IO ()
graficaSiracusa n xs =
  plotLists [ Key Nothing
            , PNG "La_conjetura_de_Collatz.png"
            ]
            [take n (siracusa x) | x <- xs]

-- Comprobación de la conjetura
-- ============================

-- La conjetura es
conjeturaCollatz :: Positive Integer -> Bool
conjeturaCollatz (Positive n) =
  1 `elem` siracusa n

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

import Test.QuickCheck

import Graphics.Gnuplot.Simple

-- 1ª definición de siracusa

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

siracusa :: Integer -> [Integer]

siracusa n | even n = n : siracusa (n `div` 2)

| otherwise = n : siracusa (3*n+1)

-- 2ª definición de siracusa

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

siracusa2 :: Integer -> [Integer]

siracusa2 = iterate siguiente

where siguiente x | even x = x `div` 2

| otherwise = 3*x+1

-- Comparación de eficiencia

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

-- La comparación es

-- λ> siracusa 12 !! (10^6)

-- 4

-- (0.55 secs, 362,791,008 bytes)

-- λ> siracusa 12 !! (2*10^6)

-- 2

-- (1.05 secs, 725,456,376 bytes)

-- λ> siracusa2 12 !! (10^6)

-- 4

-- (1.66 secs, 647,189,664 bytes)

-- λ> siracusa2 12 !! (2*10^6)

-- 2

-- (3.11 secs, 1,294,286,792 bytes)

-- Definición de graficaSiracusa

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

graficaSiracusa :: Int -> [Integer] -> IO ()

graficaSiracusa n xs =

plotLists [ Key Nothing

, PNG "La_conjetura_de_Collatz.png"

]

[take n (siracusa x) | x <- xs]

-- Comprobación de la conjetura

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

-- La conjetura es

conjeturaCollatz :: Positive Integer -> Bool

conjeturaCollatz (Positive n) =

1 `elem` siracusa n

-- La comprobación es

-- λ> quickCheck conjeturaCollatz

-- +++ OK, passed 100 tests.

Pensamiento

Que el caminante es suma del camino …

Antonio Machado

Teorema de Hilbert-Waring

Soluciones

Referencia

Pensamiento

Múltiplos con ceros y unos

Soluciones

Pensamiento

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

Soluciones

Pensamiento

Elementos no repetidos

Soluciones

Pensamiento

La conjetura de Collatz

Soluciones

Pensamiento

Entradas recientes

Buscar

Correo electrónico