Menu Close

Autor: José A. Alonso

Sucesiones conteniendo al producto de consecutivos

José A. Alonso---0 Comentarios

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]

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

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.

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

Seguir leyendo →

Números superabundantes

José A. Alonso---2 Comentarios

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 existen infinitos números superabundantes.

Definir la lista

   superabundantes :: [Integer]

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

   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)

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

Seguir leyendo →

Máximo valor de permutaciones

José A. Alonso---0 Comentarios

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

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

   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

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

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

Seguir leyendo →

Máxima suma de dos cuadrados condicionados

José A. Alonso---1 Comentario

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

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

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

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

Seguir leyendo →

Productos de sumas de progresiones aritméticas

José A. Alonso---0 Comentarios

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

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
  • 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
  • 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
  • (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  ==  []

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

Seguir leyendo →