Ejercicio

Sucesiones conteniendo al producto de consecutivos

PorJosé A. Alonso 24-junio-202126-enero-2022

El enunciado de un problema para la IMO (Olimpiada Internacional de Matemáticas) de 1984 es

Sea c un entero positivo. La sucesión f(n) está definida por

f(1) = 1, f(2) = c, f(n+1) = 2f(n) – f(n-1) + 2 (n ≥ 2).

Demostrar que para cada k ∈ N exist un r ∈ N tal que f(k)f(k+1) = f(r).

Definir la función

   sucesion :: Integer -> [Integer]

1	sucesion :: Integer -> [Integer]

tal que los elementos de (sucesion c) son los términos de la suceción f(n) definida en el enunciado del problema. Por ejemplo,

   take 7 (sucesion 2)   ==  [1,2,5,10,17,26,37]
   take 7 (sucesion 3)   ==  [1,3,7,13,21,31,43]
   take 7 (sucesion 4)   ==  [1,4,9,16,25,36,49]
   sucesion 2 !! 30      ==  901
   sucesion 3 !! 30      ==  931
   sucesion 4 !! 30      ==  961
   sucesion 2 !! (10^2)  ==  10001
   sucesion 2 !! (10^3)  ==  1000001
   sucesion 2 !! (10^4)  ==  100000001
   sucesion 2 !! (10^5)  ==  10000000001
   sucesion 2 !! (10^6)  ==  1000000000001
   sucesion 2 !! (10^7)  ==  100000000000001
   sucesion 3 !! (10^7)  ==  100000010000001
   sucesion 4 !! (10^7)  ==  100000020000001
   sucesion 2 !! (10^8)  ==  10000000000000001
   sucesion 3 !! (10^8)  ==  10000000100000001
   sucesion 4 !! (10^8)  ==  10000000200000001
   sucesion 2 !! (10^9)  ==  1000000000000000001

take 7 (sucesion 2) == [1,2,5,10,17,26,37]

take 7 (sucesion 3) == [1,3,7,13,21,31,43]

take 7 (sucesion 4) == [1,4,9,16,25,36,49]

sucesion 2 !! 30 == 901

sucesion 3 !! 30 == 931

sucesion 4 !! 30 == 961

sucesion 2 !! (10^2) == 10001

sucesion 2 !! (10^3) == 1000001

sucesion 2 !! (10^4) == 100000001

sucesion 2 !! (10^5) == 10000000001

sucesion 2 !! (10^6) == 1000000000001

sucesion 2 !! (10^7) == 100000000000001

sucesion 3 !! (10^7) == 100000010000001

sucesion 4 !! (10^7) == 100000020000001

sucesion 2 !! (10^8) == 10000000000000001

sucesion 3 !! (10^8) == 10000000100000001

sucesion 4 !! (10^8) == 10000000200000001

sucesion 2 !! (10^9) == 1000000000000000001

Comprobar con QuickCheck que para cada k ∈ N existe un r ∈ N tal que f(k)f(k+1) = f(r).

Soluciones

import Test.QuickCheck (Property, (==>), quickCheck)

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

sucesion :: Integer -> [Integer]
sucesion c =
  map (termino c) [1..]

termino :: Integer -> Integer -> Integer
termino c 1 = 1
termino c 2 = c
termino c n = 2 * termino c (n-1) - termino c (n-2) + 2

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

sucesion2 :: Integer -> [Integer]
sucesion2 c =
  1 : c : [2*y-x+2 | (x,y) <- zip (sucesion3 c) (tail (sucesion3 c))]

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

sucesion3 :: Integer -> [Integer]
sucesion3 c =
  map (termino3 c) [1..]

termino3 :: Integer -> Integer -> Integer
termino3 c 1 = 1
termino3 c 2 = c
termino3 c n = n^2 + b*n - b
  where b = c - 4

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

-- La comparación es
--    λ> sucesion 2 !! 32
--    1025
--    (3.95 secs, 1,991,299,256 bytes)
--    λ> sucesion2 2 !! 32
--    1025
--    (0.01 secs, 119,856 bytes)
--    λ> sucesion3 2 !! 32
--    1025
--    (0.01 secs, 111,176 bytes)
--
--    λ> sucesion2 2 !! (10^7)
--    100000000000001
--    (2.26 secs, 5,200,111,128 bytes)
--    λ> sucesion3 2 !! (10^7)
--    100000000000001
--    (0.27 secs, 1,600,111,568 bytes)

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

-- La propiedad es
prop_equivalencia :: Integer -> Int -> Property
prop_equivalencia c k =
  c > 0 && k >= 0 ==>
  take 20 (sucesion c) == take 20 (sucesion2 c) &&
  sucesion2 c !! k == sucesion3 c !! k

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

-- Propiedad
-- =========

-- La propiedad es
prop_sucesion :: Integer -> Int -> Property
prop_sucesion c k =
  c > 0 && k >= 0 ==>
  (ys !! k) `elem` xs
  where xs = sucesion2 c
        ys = zipWith (*) xs (tail xs)

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

import Test.QuickCheck (Property, (==>), quickCheck)

-- 1ª solución

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

sucesion :: Integer -> [Integer]

sucesion c =

map (termino c) [1..]

termino :: Integer -> Integer -> Integer

termino c 1 = 1

termino c 2 = c

termino c n = 2 * termino c (n-1) - termino c (n-2) + 2

-- 2ª solución

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

sucesion2 :: Integer -> [Integer]

sucesion2 c =

1 : c : [2*y-x+2 | (x,y) <- zip (sucesion3 c) (tail (sucesion3 c))]

-- 2ª solución

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

sucesion3 :: Integer -> [Integer]

sucesion3 c =

map (termino3 c) [1..]

termino3 :: Integer -> Integer -> Integer

termino3 c 1 = 1

termino3 c 2 = c

termino3 c n = n^2 + b*n - b

where b = c - 4

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sucesion 2 !! 32

-- 1025

-- (3.95 secs, 1,991,299,256 bytes)

-- λ> sucesion2 2 !! 32

-- 1025

-- (0.01 secs, 119,856 bytes)

-- λ> sucesion3 2 !! 32

-- 1025

-- (0.01 secs, 111,176 bytes)

-- λ> sucesion2 2 !! (10^7)

-- 100000000000001

-- (2.26 secs, 5,200,111,128 bytes)

-- λ> sucesion3 2 !! (10^7)

-- 100000000000001

-- (0.27 secs, 1,600,111,568 bytes)

-- Comprobación de equivalencia

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

-- La propiedad es

prop_equivalencia :: Integer -> Int -> Property

prop_equivalencia c k =

c > 0 && k >= 0 ==>

take 20 (sucesion c) == take 20 (sucesion2 c) &&

sucesion2 c !! k == sucesion3 c !! k

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

-- Propiedad

-- =========

-- La propiedad es

prop_sucesion :: Integer -> Int -> Property

prop_sucesion c k =

c > 0 && k >= 0 ==>

(ys !! k) `elem` xs

where xs = sucesion2 c

ys = zipWith (*) xs (tail xs)

-- La comprobación es

-- λ> quickCheck prop_sucesion

-- +++ OK, passed 100 tests.

En los comentarios se pueden escribir otras soluciones, escribiendo el código entre una línea con <pre lang="haskell"> y otra con </pre>

Números superabundantes

PorJosé A. Alonso 22-junio-202126-enero-2022

El enunciado de un problema para la IMO (Olimpiada Internacional de Matemáticas) de 1983 es

Sea n un número entero positivo. Sea σ(n) la suma de los divisores positivos de n (incluyendo al 1 y al n). Se dice que un entero m ≥ 1 es superabundante (P. Erdös, 1944) si ∀k ∈ {1, 2, …, m-1}, σ(m)/m > σ(k)/k. Demostrar que esisten infinitos números superabundantes.

Definir la lista

   superabundantes :: [Integer]

1	superabundantes :: [Integer]

cuyos elementos son los números superabundantes. Por ejemplo,

   take 7 superabundantes == [1,2,4,6,12,24,36]
   superabundantes !! 25  ==  166320

1 2	take 7 superabundantes == [1,2,4,6,12,24,36] superabundantes !! 25 == 166320

Soluciones

import Data.Numbers.Primes (primeFactors)
import Data.List (genericLength, group)
import Data.Ratio ((%))

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

superabundantes :: [Integer]
superabundantes =
  filter esSuperabundante [1..]

-- (esSuperabundante n) se verifica si n es superabundante. Por ejemplo,
--    esSuperabundante 4  ==  True
--    esSuperabundante 5  ==  False
--    esSuperabundante 6  ==  True
esSuperabundante :: Integer -> Bool
esSuperabundante n =
  and [k * n' > n * sumaDivisores k | k <- [1..n-1]]
  where n' = sumaDivisores n

-- (sumaDivisores n) es la suma de los divisores de n. Por ejemplo.
--      sumaDivisores 35  ==  48
sumaDivisores :: Integer -> Integer
sumaDivisores 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)
primeroYlongitud _      = error "No tiene elementos"

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

superabundantes2 :: [Integer]
superabundantes2 =
  [n | (n,a,b) <- zip3 [1..] cocientes maximosCocientes,
        a == b]
-- cocientes es la lista de los cocientes σ(k)/k. Por ejemplo,
--    λ> take 7 cocientes
--    [1 % 1,3 % 2,4 % 3,7 % 4,6 % 5,2 % 1,8 % 7]
cocientes :: [Rational]
cocientes =
  [sumaDivisores n % n | n <- [1..]]

-- maximosCocientes es la lista de los máximos de los cocientes
-- σ(k)/k. Por ejemplo,
--    λ> take 7 maximosCocientes
--    [1 % 1,3 % 2,3 % 2,7 % 4,7 % 4,2 % 1,2 % 1]
maximosCocientes :: [Rational]
maximosCocientes = scanl1 max cocientes

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

-- La comparación es
--    λ> superabundantes !! 22
--    27720
--    (6.72 secs, 11,453,705,704 bytes)
--    λ> superabundantes2 !! 22
--    27720
--    (0.54 secs, 902,054,096 bytes)

import Data.Numbers.Primes (primeFactors)

import Data.List (genericLength, group)

import Data.Ratio ((%))

-- 1ª solución

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

superabundantes :: [Integer]

superabundantes =

filter esSuperabundante [1..]

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

-- esSuperabundante 4 == True

-- esSuperabundante 5 == False

-- esSuperabundante 6 == True

esSuperabundante :: Integer -> Bool

esSuperabundante n =

and [k * n' > n * sumaDivisores k | k <- [1..n-1]]

where n' = sumaDivisores n

-- (sumaDivisores n) es la suma de los divisores de n. Por ejemplo.

-- sumaDivisores 35 == 48

sumaDivisores :: Integer -> Integer

sumaDivisores 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)

primeroYlongitud _ = error "No tiene elementos"

-- 2ª solución

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

superabundantes2 :: [Integer]

superabundantes2 =

[n | (n,a,b) <- zip3 [1..] cocientes maximosCocientes,

a == b]

-- cocientes es la lista de los cocientes σ(k)/k. Por ejemplo,

-- λ> take 7 cocientes

-- [1 % 1,3 % 2,4 % 3,7 % 4,6 % 5,2 % 1,8 % 7]

cocientes :: [Rational]

cocientes =

[sumaDivisores n % n | n <- [1..]]

-- maximosCocientes es la lista de los máximos de los cocientes

-- σ(k)/k. Por ejemplo,

-- λ> take 7 maximosCocientes

-- [1 % 1,3 % 2,3 % 2,7 % 4,7 % 4,2 % 1,2 % 1]

maximosCocientes :: [Rational]

maximosCocientes = scanl1 max cocientes

-- Comparación de eficiencia

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

-- La comparación es

-- λ> superabundantes !! 22

-- 27720

-- (6.72 secs, 11,453,705,704 bytes)

-- λ> superabundantes2 !! 22

-- 27720

-- (0.54 secs, 902,054,096 bytes)

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>

Máximo valor de permutaciones

PorJosé A. Alonso 17-junio-202126-enero-2022

El enunciado de un problema para la IMO (Olimpiada Internacional de Matemáticas) de 1982 es

Calcular una permutación (a(1),…,a(n)) de {1,2,…,n} que maximice el valor de

a(1)a(2) + a(2)a(3) + ··· + a(n)a(1)

Definir la función

   maximoValorPermutaciones :: Integer -> Integer

1	maximoValorPermutaciones :: Integer -> Integer

tal que (maximoValorPermutaciones n) es el máximo valor de

   a(1)a(2) + a(2)a(3) + ··· + a(n)a(1)

1	a(1)a(2) + a(2)a(3) + ··· + a(n)a(1)

para todas las permutaciones (a(1),…,a(n)) de {1,2,…,n}. Por ejemplo,

   maximoValorPermutaciones 4       ==  25
   maximoValorPermutaciones (10^7)  ==  333333383333315000003
   maximoValorPermutaciones (10^8)  ==  333333338333333150000003
   maximoValorPermutaciones (10^9)  ==  333333333833333331500000003
   length (show (maximoValorPermutaciones (10^1000)))  ==  3000
   length (show (maximoValorPermutaciones (10^2000)))  ==  6000
   length (show (maximoValorPermutaciones (10^3000)))  ==  9000

maximoValorPermutaciones 4 == 25

maximoValorPermutaciones (10^7) == 333333383333315000003

maximoValorPermutaciones (10^8) == 333333338333333150000003

maximoValorPermutaciones (10^9) == 333333333833333331500000003

length (show (maximoValorPermutaciones (10^1000))) == 3000

length (show (maximoValorPermutaciones (10^2000))) == 6000

length (show (maximoValorPermutaciones (10^3000))) == 9000

Comprobar con QuickCheck que, para todo entero positivo n y toda permutación (a(1),…,a(n)) de {1,2,…,n},

   maximoValorPermutaciones n >= a(1)a(2) + a(2)a(3) + ··· + a(n)a(1)

1	maximoValorPermutaciones n >= a(1)a(2) + a(2)a(3) + ··· + a(n)a(1)

Soluciones

import Data.List (permutations)
import Test.QuickCheck

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

maximoValorPermutaciones :: Integer -> Integer
maximoValorPermutaciones n =
  maximum (map valor (permutations [1..n]))

valor :: [Integer] -> Integer
valor xs = sum [a * b | (a,b) <- zip xs (tail xs ++ take 1 xs)]

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

maximoValorPermutaciones2 :: Integer -> Integer
maximoValorPermutaciones2 n =
  valor (head (permutacionesMaximizadoras n))

-- (permutacionesMaximizadoras n) es la lista de las permutaciones
-- (a(1),...,a(n)) de {1,2,...,n} para las que el valor de
--       a(1)a(2) + a(2)a(3) + ··· + a(n)a(1)
-- es máximo. Por ejemplo,
--    λ> permutacionesMaximizadoras 5
--    [[3,1,2,4,5],[4,2,1,3,5],[3,5,4,2,1],[2,4,5,3,1],[2,1,3,5,4],
--     [5,3,1,2,4],[4,5,3,1,2],[1,3,5,4,2],[5,4,2,1,3],[1,2,4,5,3]]
permutacionesMaximizadoras :: Integer -> [[Integer]]
permutacionesMaximizadoras n =
  [xs | xs <- xss, valor xs == m]
  where xss = permutations [1..n]
        m   = maximum (map valor xss)

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

maximoValorPermutaciones3 :: Integer -> Integer
maximoValorPermutaciones3 =
  valor . menorPermutacionMaximizadora

-- (menorPermutacionMaximizadora n) es la menor de las permutaciones
-- (a(1),...,a(n)) de {1,2,...,n} para las que el valor de
--       a(1)a(2) + a(2)a(3) + ··· + a(n)a(1)
-- es máximo. Por ejemplo,
--    menorPermutacionMaximizadora 5  ==  [1,2,4,5,3]
menorPermutacionMaximizadora :: Integer -> [Integer]
menorPermutacionMaximizadora n =
  minimum [xs | xs <- xss, valor xs == m]
  where xss = permutations [1..n]
        m   = maximum (map valor xss)

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

maximoValorPermutaciones4 :: Integer -> Integer
maximoValorPermutaciones4 =
  valor . menorPermutacionMaximizadora2

-- Redefinición de menorPermutacionMaximizadora observando que
--    menorPermutacionMaximizadora 2  ==  [1,2]
--    menorPermutacionMaximizadora 3  ==  [1,2,3]
--    menorPermutacionMaximizadora 4  ==  [1,2,4,3]
--    menorPermutacionMaximizadora 5  ==  [1,2,4,5,3]
--    menorPermutacionMaximizadora 6  ==  [1,2,4,6,5,3]
--    menorPermutacionMaximizadora 7  ==  [1,2,4,6,7,5,3]
--    menorPermutacionMaximizadora 8  ==  [1,2,4,6,8,7,5,3]
--    menorPermutacionMaximizadora 9  ==  [1,2,4,6,8,9,7,5,3]
menorPermutacionMaximizadora2 :: Integer -> [Integer]
menorPermutacionMaximizadora2 n
  | even n    = 1 : [2,4..n] ++ [n-1,n-3..3]
  | otherwise = 1 : [2,4..n] ++ [n,n-2..3]

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

maximoValorPermutaciones5 :: Integer -> Integer
maximoValorPermutaciones5 n
  | even n    = valor (1 : [2,4..n] ++ [n-1,n-3..3])
  | otherwise = valor (1 : [2,4..n] ++ [n,n-2..3])

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

maximoValorPermutaciones6 :: Integer -> Integer
maximoValorPermutaciones6 1 = 1
maximoValorPermutaciones6 n = (2*n^3+3*n^2-11*n+18) `div` 6

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

-- La propiedad, para pequeños valores, es
prop_equivalencia1 :: Integer -> Bool
prop_equivalencia1 n =
  and [maximoValorPermutaciones k == f k | k <- [2..n],
                                           f <- [maximoValorPermutaciones2,
                                                 maximoValorPermutaciones3,
                                                 maximoValorPermutaciones4,
                                                 maximoValorPermutaciones5,
                                                 maximoValorPermutaciones6]]

-- La comprobación es
--    λ> prop_equivalencia1 9
--    True

-- La propiedad, para grandes valores, es
prop_equivalencia2 :: Integer -> Property
prop_equivalencia2 n =
  n > 0 ==>
  maximoValorPermutaciones5 n == maximoValorPermutaciones6 n

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

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

-- La comparación es
--    λ> maximoValorPermutaciones 10
--    368
--    (15.33 secs, 15,147,056,648 bytes)
--    λ> maximoValorPermutaciones2 10
--    368
--    (15.00 secs, 15,193,414,656 bytes)
--    λ> maximoValorPermutaciones3 10
--    368
--    (31.86 secs, 28,297,837,624 bytes)
--    λ> maximoValorPermutaciones4 10
--    368
--    (0.01 secs, 104,120 bytes)
--    λ> maximoValorPermutaciones5 10
--    368
--    (0.01 secs, 104,264 bytes)
--    λ> maximoValorPermutaciones6 10
--    368
--    (0.01 secs, 102,712 bytes)
--
--    λ> maximoValorPermutaciones4 (4*10^6)
--    21333341333326000003
--    (2.77 secs, 1,972,797,144 bytes)
--    λ> maximoValorPermutaciones5 (4*10^6)
--    21333341333326000003
--    (2.66 secs, 1,972,797,440 bytes)
--    λ> maximoValorPermutaciones6 (4*10^6)
--    21333341333326000003
--    (0.03 secs, 119,592 bytes)

-- Propiedad
-- =========

-- La propiedad es
prop_maximizadora :: Integer -> Property
prop_maximizadora n =
  n > 0 ==>
  do xs <- shuffle [1..n]
     return (maximoValorPermutaciones6 n >= valor xs)

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

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

import Data.List (permutations)

import Test.QuickCheck

-- 1ª solución

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

maximoValorPermutaciones :: Integer -> Integer

maximoValorPermutaciones n =

maximum (map valor (permutations [1..n]))

valor :: [Integer] -> Integer

valor xs = sum [a * b | (a,b) <- zip xs (tail xs ++ take 1 xs)]

-- 2ª solución

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

maximoValorPermutaciones2 :: Integer -> Integer

maximoValorPermutaciones2 n =

valor (head (permutacionesMaximizadoras n))

-- (permutacionesMaximizadoras n) es la lista de las permutaciones

-- (a(1),...,a(n)) de {1,2,...,n} para las que el valor de

-- a(1)a(2) + a(2)a(3) + ··· + a(n)a(1)

-- es máximo. Por ejemplo,

-- λ> permutacionesMaximizadoras 5

-- [[3,1,2,4,5],[4,2,1,3,5],[3,5,4,2,1],[2,4,5,3,1],[2,1,3,5,4],

-- [5,3,1,2,4],[4,5,3,1,2],[1,3,5,4,2],[5,4,2,1,3],[1,2,4,5,3]]

permutacionesMaximizadoras :: Integer -> [[Integer]]

permutacionesMaximizadoras n =

[xs | xs <- xss, valor xs == m]

where xss = permutations [1..n]

m = maximum (map valor xss)

-- 3ª solución

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

maximoValorPermutaciones3 :: Integer -> Integer

maximoValorPermutaciones3 =

valor . menorPermutacionMaximizadora

-- (menorPermutacionMaximizadora n) es la menor de las permutaciones

-- (a(1),...,a(n)) de {1,2,...,n} para las que el valor de

-- a(1)a(2) + a(2)a(3) + ··· + a(n)a(1)

-- es máximo. Por ejemplo,

-- menorPermutacionMaximizadora 5 == [1,2,4,5,3]

menorPermutacionMaximizadora :: Integer -> [Integer]

menorPermutacionMaximizadora n =

minimum [xs | xs <- xss, valor xs == m]

where xss = permutations [1..n]

m = maximum (map valor xss)

-- 4ª solución

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

maximoValorPermutaciones4 :: Integer -> Integer

maximoValorPermutaciones4 =

valor . menorPermutacionMaximizadora2

-- Redefinición de menorPermutacionMaximizadora observando que

-- menorPermutacionMaximizadora 2 == [1,2]

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

-- menorPermutacionMaximizadora 4 == [1,2,4,3]

-- menorPermutacionMaximizadora 5 == [1,2,4,5,3]

-- menorPermutacionMaximizadora 6 == [1,2,4,6,5,3]

-- menorPermutacionMaximizadora 7 == [1,2,4,6,7,5,3]

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

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

menorPermutacionMaximizadora2 :: Integer -> [Integer]

menorPermutacionMaximizadora2 n

| even n = 1 : [2,4..n] ++ [n-1,n-3..3]

| otherwise = 1 : [2,4..n] ++ [n,n-2..3]

-- 5ª solución

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

maximoValorPermutaciones5 :: Integer -> Integer

maximoValorPermutaciones5 n

| even n = valor (1 : [2,4..n] ++ [n-1,n-3..3])

| otherwise = valor (1 : [2,4..n] ++ [n,n-2..3])

-- 6ª solución

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

maximoValorPermutaciones6 :: Integer -> Integer

maximoValorPermutaciones6 1 = 1

maximoValorPermutaciones6 n = (2*n^3+3*n^2-11*n+18) `div` 6

-- Comprobación de la equivalencia

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

-- La propiedad, para pequeños valores, es

prop_equivalencia1 :: Integer -> Bool

prop_equivalencia1 n =

and [maximoValorPermutaciones k == f k | k <- [2..n],

f <- [maximoValorPermutaciones2,

maximoValorPermutaciones3,

maximoValorPermutaciones4,

maximoValorPermutaciones5,

maximoValorPermutaciones6]]

-- La comprobación es

-- λ> prop_equivalencia1 9

-- True

-- La propiedad, para grandes valores, es

prop_equivalencia2 :: Integer -> Property

prop_equivalencia2 n =

n > 0 ==>

maximoValorPermutaciones5 n == maximoValorPermutaciones6 n

-- La comprobación es

-- λ> quickCheck prop_equivalencia2

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> maximoValorPermutaciones 10

-- 368

-- (15.33 secs, 15,147,056,648 bytes)

-- λ> maximoValorPermutaciones2 10

-- 368

-- (15.00 secs, 15,193,414,656 bytes)

-- λ> maximoValorPermutaciones3 10

-- 368

-- (31.86 secs, 28,297,837,624 bytes)

-- λ> maximoValorPermutaciones4 10

-- 368

-- (0.01 secs, 104,120 bytes)

-- λ> maximoValorPermutaciones5 10

-- 368

-- (0.01 secs, 104,264 bytes)

-- λ> maximoValorPermutaciones6 10

-- 368

-- (0.01 secs, 102,712 bytes)

-- λ> maximoValorPermutaciones4 (4*10^6)

-- 21333341333326000003

-- (2.77 secs, 1,972,797,144 bytes)

-- λ> maximoValorPermutaciones5 (4*10^6)

-- 21333341333326000003

-- (2.66 secs, 1,972,797,440 bytes)

-- λ> maximoValorPermutaciones6 (4*10^6)

-- 21333341333326000003

-- (0.03 secs, 119,592 bytes)

-- Propiedad

-- =========

-- La propiedad es

prop_maximizadora :: Integer -> Property

prop_maximizadora n =

n > 0 ==>

do xs <- shuffle [1..n]

return (maximoValorPermutaciones6 n >= valor xs)

-- La comprobación es

-- λ> quickCheck prop_maximizadora

-- +++ OK, passed 100 tests.

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>

Máxima suma de dos cuadrados condicionados

PorJosé A. Alonso 15-junio-202126-enero-2022

El enunciado del problema 3 de la IMO (Olimpiada Internacional de Matemáticas) de 1981 es

Calcular el máximo valor de m² + n² donde m y n son números enteros tales que m, n ∈ {1, 2, …, 1981} y (n² – mn – m²)² = 1.

Definir la función

   maximoValor :: Integer -> Integer

1	maximoValor :: Integer -> Integer

tal que (maximoValor k) es el máximo valor de m² + n² donde m y n son números enteros tales que m, n ∈ {1, 2, …, k} y (n² – mn – m²)² = 1. Por ejemplo,

   maximoValor 10       ==  89
   maximoValor (10^20)  ==  9663391306290450775010025392525829059713
   length (show (maximoValor5 (10^(4*10^4))))  ==  80000

maximoValor 10 == 89

maximoValor (10^20) == 9663391306290450775010025392525829059713

length (show (maximoValor5 (10^(4*10^4)))) == 80000

Usando la función maximoValor, calcular la respuesta del problema.

Soluciones

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

maximoValor :: Integer -> Integer
maximoValor k =
  maximum [m^2 + n^2 | m <- [1..k],
                       n <- [m..k],
                       (n^2 - m*n - m^2)^2 == 1]

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

maximoValor2 :: Integer -> Integer
maximoValor2 k =
  maximum [m^2 + n^2 | (m, n) <- soluciones k]

-- (soluciones k) es la lista de los pares (m,n) tales que
-- m, n ∈ {1, 2,..., k}, m <= n y (n² - mn - m²)² = 1.
-- Por ejemplo,
--    λ> soluciones 50
--    [(1,1),(1,2),(2,3),(3,5),(5,8),(8,13),(13,21),(21,34)]
soluciones :: Integer -> [(Integer,Integer)]
soluciones k =
  [(m, n) | m <- [1..k],
            n <- [m..k],
            (n^2 - m*n - m^2)^2 == 1]

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

maximoValor3 :: Integer -> Integer
maximoValor3 k = m^2 + n^2
  where (m, n) = last (soluciones k)

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

maximoValor4 :: Integer -> Integer
maximoValor4 k = m^2 + n^2
  where (m, n) = head [(m, n) | m <- [k,k-1..1],
                                n <- [k,k-1..m],
                                (n^2 - m*n - m^2)^2 == 1]

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

-- Con el siguiente cálculo
--    λ> soluciones 50
--    [(1,1),(1,2),(2,3),(3,5),(5,8),(8,13),(13,21),(21,34)]
-- se observa que las soluciones son pares de términos consecutivos de
-- la sucessión de Fibonacci.

maximoValor5 :: Integer -> Integer
maximoValor5 k = m^2 + n^2
  where [m,n] = take 2 (reverse (takeWhile (<= k) fibs))

-- fibs es la la sucesión de los números de Fibonacci. Por ejemplo,
--    take 14 fibs  == [1,1,2,3,5,8,13,21,34,55,89,144,233,377]
fibs :: [Integer]
fibs = 1 : scanl (+) 1 fibs

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

-- La comparación es
--    λ> maximoValor 1500
--    1346269
--    (1.94 secs, 2,188,819,744 bytes)
--    λ> maximoValor2 1500
--    1346269
--    (1.93 secs, 2,188,821,752 bytes)
--    λ> maximoValor3 1500
--    1346269
--    (1.95 secs, 2,188,803,312 bytes)
--    λ> maximoValor4 1500
--    1346269
--    (0.71 secs, 775,331,376 bytes)
--    λ> maximoValor5 1500
--    1346269
--    (0.01 secs, 106,952 bytes)
--
--    λ> maximoValor4 4000
--    9227465
--    (5.00 secs, 5,641,750,992 bytes)
--    λ> maximoValor5 4000
--    9227465
--    (0.01 secs, 107,104 bytes)

-- Cálculo de la respuesta
-- =======================

-- El cálculo es
--    λ> maximoValor5 1981
--    3524578

-- 1ª solución

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

maximoValor :: Integer -> Integer

maximoValor k =

maximum [m^2 + n^2 | m <- [1..k],

n <- [m..k],

(n^2 - m*n - m^2)^2 == 1]

-- 2ª solución

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

maximoValor2 :: Integer -> Integer

maximoValor2 k =

maximum [m^2 + n^2 | (m, n) <- soluciones k]

-- (soluciones k) es la lista de los pares (m,n) tales que

-- m, n ∈ {1, 2,..., k}, m <= n y (n² - mn - m²)² = 1.

-- Por ejemplo,

-- λ> soluciones 50

-- [(1,1),(1,2),(2,3),(3,5),(5,8),(8,13),(13,21),(21,34)]

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

soluciones k =

[(m, n) | m <- [1..k],

n <- [m..k],

(n^2 - m*n - m^2)^2 == 1]

-- 3ª solución

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

maximoValor3 :: Integer -> Integer

maximoValor3 k = m^2 + n^2

where (m, n) = last (soluciones k)

-- 4ª solución

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

maximoValor4 :: Integer -> Integer

maximoValor4 k = m^2 + n^2

where (m, n) = head [(m, n) | m <- [k,k-1..1],

n <- [k,k-1..m],

(n^2 - m*n - m^2)^2 == 1]

-- 5ª solución

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

-- Con el siguiente cálculo

-- λ> soluciones 50

-- [(1,1),(1,2),(2,3),(3,5),(5,8),(8,13),(13,21),(21,34)]

-- se observa que las soluciones son pares de términos consecutivos de

-- la sucessión de Fibonacci.

maximoValor5 :: Integer -> Integer

maximoValor5 k = m^2 + n^2

where [m,n] = take 2 (reverse (takeWhile (<= k) fibs))

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

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

fibs :: [Integer]

fibs = 1 : scanl (+) 1 fibs

-- Comparación de eficiencia

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

-- La comparación es

-- λ> maximoValor 1500

-- 1346269

-- (1.94 secs, 2,188,819,744 bytes)

-- λ> maximoValor2 1500

-- 1346269

-- (1.93 secs, 2,188,821,752 bytes)

-- λ> maximoValor3 1500

-- 1346269

-- (1.95 secs, 2,188,803,312 bytes)

-- λ> maximoValor4 1500

-- 1346269

-- (0.71 secs, 775,331,376 bytes)

-- λ> maximoValor5 1500

-- 1346269

-- (0.01 secs, 106,952 bytes)

-- λ> maximoValor4 4000

-- 9227465

-- (5.00 secs, 5,641,750,992 bytes)

-- λ> maximoValor5 4000

-- 9227465

-- (0.01 secs, 107,104 bytes)

-- Cálculo de la respuesta

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

-- El cálculo es

-- λ> maximoValor5 1981

-- 3524578

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>

Productos de sumas de progresiones aritméticas

PorJosé A. Alonso 10-junio-202126-enero-2022

El enunciado de un problema para la IMO (Olimpiada Internacional de Matemáticas) de 1978 es

Para cada número entero d ≥ 1, sea M(d) el conjunto de todos enteros positivos que no se pueden escribir como una suma de una progresión aritmética de diferencia d, teniendo al menos dos sumandos y formadas por enteros positivos. Sean A = M(1), B = M(2)-{2} y C = M(3). Demostrar que todo c ∈ C se puede escribir de una única manera como c = ab con a ∈ A, b ∈ B.

Definir las funciones

   conjuntoA   :: [Integer]
   conjuntoB   :: [Integer]
   conjuntoC   :: [Integer]
   productosAB :: Integer -> [(Integer,Integer)]

conjuntoA :: [Integer]

conjuntoB :: [Integer]

conjuntoC :: [Integer]

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

tales que

conjuntoA es la lista de los elementos del conjunto A; es decir, de los números que no se pueden escribir como sumas de progresiones aritméticas de diferencia uno, con al menos dos términos, de números enteros positivos. Por ejemplo,

     conjuntoA !! 2                      ==  4
     length (show (conjuntoA !! (10^7))) == 3010300

1 2	conjuntoA !! 2 == 4 length (show (conjuntoA !! (10^7))) == 3010300

conjuntoB es la lista de los elementos del conjunto B; es decir, los números (distintos de dos) que no se pueden escribir como sumas de progresiones aritméticas de diferencia dos, con al menos dos términos, de números enteros positivos. Por ejemplo,

     conjuntoB !! 3       ==  5
     conjuntoB !! (10^6)  ==  15485863

1 2	conjuntoB !! 3 == 5 conjuntoB !! (10^6) == 15485863

conjuntoC es la lista de los elementos del conjunto C; es decir, los números que no se pueden escribir como sumas de progresiones aritméticas de diferencia tres, con al menos dos términos, de números enteros positivos. Por ejemplo,

     conjuntoC !! 4  ==  6

1	conjuntoC !! 4 == 6

(productosAB x) es la lista de los pares (a,b) tales que a es un elementos del conjunto A, b es un elemento del conjunto B y su producto es x. Por ejemplo,

     productosAB 10  ==  [(2,5)]
     productosAB 15  ==  []

1 2	productosAB 10 == [(2,5)] productosAB 15 == []

Comprobar con QuickCheck la propiedad del problema de la Olimpiada; es decir, para todo c ∈ C la lista (productosAB c) tiene exactamente un elemento.

Soluciones

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

-- Nota: Se usarán las funciones definidas en los ejercicios
-- anteriores.

conjuntoA :: [Integer]
conjuntoA = [2^k | k <- [0..]]

conjuntoB :: [Integer]
conjuntoB = 1 : tail primes

conjuntoC :: [Integer]
conjuntoC = noSonSumasDePADeDiferencia 3

noSonSumasDePADeDiferencia :: Integer -> [Integer]
noSonSumasDePADeDiferencia d =
  diferencia [1..] (sonSumasDePADeDiferencia d)

sonSumasDePADeDiferencia :: Integer -> [Integer]
sonSumasDePADeDiferencia d =
  mezclaTodas [sumasDePADeDiferencia d a | a <- [1..]]

sumasDePADeDiferencia :: Integer -> Integer -> [Integer]
sumasDePADeDiferencia d a =
  tail (scanl1 (+) [a,a+d..])

mezclaTodas :: Ord a => [[a]] -> [a]
mezclaTodas = foldr1 xmezcla
  where xmezcla (x:xs) ys = x : mezcla xs ys

mezcla :: Ord a => [a] -> [a] -> [a]
mezcla (x:xs) (y:ys) | x < y  = x : mezcla xs (y:ys)
                     | x == y = x : mezcla xs ys
                     | x > y  = y : mezcla (x:xs) ys

diferencia :: [Integer] -> [Integer] -> [Integer]
diferencia (x:xs) (y:ys)
  | x == y    = diferencia xs ys
  | otherwise = x : diferencia xs (y:ys)

productosAB :: Integer -> [(Integer,Integer)]
productosAB c =
  [(a,b) | a <- takeWhile (<= c) conjuntoA,
           c `mod` a == 0,
           let b = c `div` a,
           b `pertenece` conjuntoB]

pertenece :: Integer -> [Integer] -> Bool
pertenece x ys =
  x == head (dropWhile (< x) ys)

-- La propiedad es
prop_productosAB :: Int -> Property
prop_productosAB k =
  k >= 0 ==>
  length (productosAB (conjuntoC !! k)) == 1

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

import Data.List (foldr1)

import Data.Numbers.Primes (primes,primeFactors)

import Test.QuickCheck

-- Nota: Se usarán las funciones definidas en los ejercicios

-- anteriores.

conjuntoA :: [Integer]

conjuntoA = [2^k | k <- [0..]]

conjuntoB :: [Integer]

conjuntoB = 1 : tail primes

conjuntoC :: [Integer]

conjuntoC = noSonSumasDePADeDiferencia 3

noSonSumasDePADeDiferencia :: Integer -> [Integer]

noSonSumasDePADeDiferencia d =

diferencia [1..] (sonSumasDePADeDiferencia d)

sonSumasDePADeDiferencia :: Integer -> [Integer]

sonSumasDePADeDiferencia d =

mezclaTodas [sumasDePADeDiferencia d a | a <- [1..]]

sumasDePADeDiferencia :: Integer -> Integer -> [Integer]

sumasDePADeDiferencia d a =

tail (scanl1 (+) [a,a+d..])

mezclaTodas :: Ord a => [[a]] -> [a]

mezclaTodas = foldr1 xmezcla

where xmezcla (x:xs) ys = x : mezcla xs ys

mezcla :: Ord a => [a] -> [a] -> [a]

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

| x == y = x : mezcla xs ys

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

diferencia :: [Integer] -> [Integer] -> [Integer]

diferencia (x:xs) (y:ys)

| x == y = diferencia xs ys

| otherwise = x : diferencia xs (y:ys)

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

productosAB c =

[(a,b) | a <- takeWhile (<= c) conjuntoA,

c `mod` a == 0,

let b = c `div` a,

b `pertenece` conjuntoB]

pertenece :: Integer -> [Integer] -> Bool

pertenece x ys =

x == head (dropWhile (< x) ys)

-- La propiedad es

prop_productosAB :: Int -> Property

prop_productosAB k =

k >= 0 ==>

length (productosAB (conjuntoC !! k)) == 1

-- La comprobación es

-- λ> quickCheck prop_productosAB

-- +++ OK, passed 100 tests.

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>

Sucesiones conteniendo al producto de consecutivos

Soluciones

Números superabundantes

Soluciones

Nuevas soluciones

Máximo valor de permutaciones

Soluciones

Nuevas soluciones

Máxima suma de dos cuadrados condicionados

Soluciones

Nuevas soluciones

Productos de sumas de progresiones aritméticas

Soluciones

Nuevas soluciones

Entradas recientes

Buscar

Correo electrónico