Menu Close

Mes: junio 2021

Sucesiones conteniendo al producto de consecutivos

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>

Números superabundantes

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]

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)

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

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.

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

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

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

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

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>

Números que no son sumas de progresiones aritméticas de diferencia dada

El número 5 es la suma de números enteros positivos en progresión aritmética de diferencia tres (ya que es 1+4) y también lo es el 7 (ya que es 2+5) y el 12 (ya que es (1+4+7), pero el 6 no lo es.

Definir la función

   noSonSumasDePADeDiferencia :: Integer -> [Integer]

tal que (noSonSumasDePADeDiferencia d) es la lista de los números no se pueden escribir como sumas de progresiones aritméticas de diferencia d, con al menos términos, de números enteros positivos. Por ejemplo,

   (noSonSumasDePADeDiferencia 3) !! 4    ==  6
   (noSonSumasDePADeDiferencia 3) !! 100  ==  6848
   (noSonSumasDePADeDiferencia 9) !! 200  ==  6752

Soluciones

import Data.List (foldr1)
 
-- 1ª solución
-- ===========
 
noSonSumasDePADeDiferencia :: Integer -> [Integer]
noSonSumasDePADeDiferencia d =
  diferencia [1..] (sonSumasDePADeDiferencia d)
 
-- (sonSumasDePADeDiferencia d) es la lista de los números que se pueden
-- escribir como sumas de progresiones aritméticas de diferencia d,
-- con al menos dos términos, de números enteros positivos. Por ejemplo,
--    λ> take 15 (sonSumasDePADeDiferencia 3)
--    [5,7,9,11,12,13,15,17,18,19,21,22,23,24,25]
sonSumasDePADeDiferencia :: Integer -> [Integer]
sonSumasDePADeDiferencia d =
  mezclaTodas [sumasDePADeDiferencia d a | a <- [1..]]
 
-- (sumasDePADeDiferencia a) es la lista de las sumas de la
-- progresión aritmética de término inicial a y diferencia . Por
-- ejemplo,
--    take 7 (sumasDePADeDiferencia 3 1)  ==  [5,12,22,35,51,70,92]
--    take 7 (sumasDePADeDiferencia 3 2)  ==  [7,15,26,40,57,77,100]
--    take 7 (sumasDePADeDiferencia 3 3)  ==  [9,18,30,45,63,84,108]
sumasDePADeDiferencia :: Integer -> Integer -> [Integer]
sumasDePADeDiferencia d a =
  tail (scanl1 (+) [a,a+d..])
 
-- (mezclaTodas xss) es la mezcla ordenada de xss, donde tanto xss como
-- sus elementos son listas infinitas ordenadas. Por ejemplo,
--    λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2..]])
--    [2,3,4,5,6,7,8,9,10,11]
--    λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2,9..]])
--    [2,4,6,8,9,10,12,14,16,18]
mezclaTodas :: Ord a => [[a]] -> [a]
mezclaTodas = foldr1 xmezcla
  where xmezcla (x:xs) ys = x : mezcla xs ys
 
-- (mezcla xs ys) es la lista obtenida mezclando las  lista infinitas
-- ordenadas crecientes xs e ys. Por ejemplo,
--    λ> take 20 (mezcla [1,3..] [2,5..])
--    [1,2,3,5,7,8,9,11,13,14,15,17,19,20,21,23,25,26,27,29]
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 xs ys) es la diferencia las listas infinitas ordenadas
-- crecientes xs e ys. Por ejemplo,
--    λ> take 8 (diferencia [1..] [2,4..])
--    [1,3,5,7,9,11,13,15]
diferencia :: [Integer] -> [Integer] -> [Integer]
diferencia (x:xs) (y:ys)
  | x == y    = diferencia xs ys
  | otherwise = x : diferencia xs (y:ys)

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 que no son sumas de progresiones aritméticas de diferencia dos

El número 4 es la suma de números enteros positivos en progresión aritmética de diferencia dos (ya que es 1+3) y también lo es el 6 (ya que es 2+4) y el 9 (ya que es (1+3+5), pero el 5 no lo es.

Definir la función

   noSonSumasDePADeDiferenciaDos :: [Integer]

cuyos elementos son los números 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,

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

Soluciones

import Data.List (foldr1)
import Data.Numbers.Primes (primes)
 
-- 1ª solución
-- ===========
 
noSonSumasDePADeDiferenciaDos :: [Integer]
noSonSumasDePADeDiferenciaDos =
  diferencia [1..] sonSumasDePADeDiferenciaDos
 
-- sonSumasDePADeDiferenciaDos es la lista de los números que 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,
--    λ> take 10 sonSumasDePADeDiferenciaDos
--    [4,6,8,9,10,12,14,15,16,18]
sonSumasDePADeDiferenciaDos :: [Integer]
sonSumasDePADeDiferenciaDos =
  mezclaTodas [sumasDePADeDiferenciaDos a | a <- [1..]]
 
-- (sumasDePADeDiferenciaDos a) es la lista de las sumas de la
-- progresión aritmética de término inicial a y diferencia dos. Por
-- ejemplo,
--    take 7 (sumasDePADeDiferenciaDos 1)  ==  [4,9,16,25,36,49,64]
--    take 7 (sumasDePADeDiferenciaDos 2)  ==  [6,12,20,30,42,56,72]
--    take 7 (sumasDePADeDiferenciaDos 3)  ==  [8,15,24,35,48,63,80]
sumasDePADeDiferenciaDos :: Integer -> [Integer]
sumasDePADeDiferenciaDos a =
  tail (scanl1 (+) [a,a+2..])
 
-- (mezclaTodas xss) es la mezcla ordenada de xss, donde tanto xss como
-- sus elementos son listas infinitas ordenadas. Por ejemplo,
--    λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2..]])
--    [2,3,4,5,6,7,8,9,10,11]
--    λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2,9..]])
--    [2,4,6,8,9,10,12,14,16,18]
mezclaTodas :: Ord a => [[a]] -> [a]
mezclaTodas = foldr1 xmezcla
  where xmezcla (x:xs) ys = x : mezcla xs ys
 
-- (mezcla xs ys) es la lista obtenida mezclando las dos lista infinitas
-- ordenadas crecientes xs e ys. Por ejemplo,
--    λ> take 20 (mezcla [1,3..] [2,5..])
--    [1,2,3,5,7,8,9,11,13,14,15,17,19,20,21,23,25,26,27,29]
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 xs ys) es la diferencia las listas infinitas ordenadas
-- crecientes xs e ys. Por ejemplo,
--    λ> take 8 (diferencia [1..] [2,4..])
--    [1,3,5,7,9,11,13,15]
diferencia :: [Integer] -> [Integer] -> [Integer]
diferencia (x:xs) (y:ys)
  | x == y    = diferencia xs ys
  | otherwise = x : diferencia xs (y:ys)
 
-- 2ª solución
-- ===========
 
-- Observando el siguiente cálculo
--    λ> take 15 noSonSumasDePADeDiferenciaDos
--    [1,2,3,5,7,11,13,17,19,23,29,31,37,41,43]
noSonSumasDePADeDiferenciaDos2 :: [Integer]
noSonSumasDePADeDiferenciaDos2 = 1 : primes
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> noSonSumasDePADeDiferenciaDos !! 1000
--    7919
--    (3.58 secs, 3,304,841,840 bytes)
--    λ> noSonSumasDePADeDiferenciaDos2 !! 1000
--    7919
--    (0.01 secs, 2,316,896 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>

Números que no son sumas de progresiones aritméticas de diferencia uno

El número 3 es la suma de números enteros positivos en progresión aritmética de diferencia uno (ya que es 1+2) y también lo es el 5 (ya que es 2+3) y el 6 (ya que es (1+2+3), pero el 4 no lo es.

Definir la función

   noSonSumasDePADeDiferenciaUno :: [Integer]

cuyos elementos son los números que no se pueden escribir como de progresiones aritméticas de diferencia uno, con al menos dos términos, de números enteros positivos. Por ejemplo,

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

Soluciones

import Data.List (foldr1)
 
-- 1ª solución
-- ===========
 
noSonSumasDePADeDiferenciaUno :: [Integer]
noSonSumasDePADeDiferenciaUno =
  diferencia [1..] sonSumasDePADeDiferenciaUno
 
-- sonSumasDePADeDiferenciaUno es la lista de los números que 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,
--    λ> take 10 sonSumasDePADeDiferenciaUno
--    [3,5,6,7,9,10,11,12,13,14]
sonSumasDePADeDiferenciaUno :: [Integer]
sonSumasDePADeDiferenciaUno =
  mezclaTodas [sumasDePADeDiferenciaUno a | a <- [1..]]
 
-- (sumasDePADeDiferenciaUno a) es la lista de las sumas de la
-- progresión aritmética de término inicial a y diferencia uno. Por
-- ejemplo,
--    take 7 (sumasDePADeDiferenciaUno 1)  ==  [3,6,10,15,21,28,36]
--    take 7 (sumasDePADeDiferenciaUno 2)  ==  [5,9,14,20,27,35,44]
--    take 7 (sumasDePADeDiferenciaUno 3)  ==  [7,12,18,25,33,42,52]
sumasDePADeDiferenciaUno :: Integer -> [Integer]
sumasDePADeDiferenciaUno a =
  tail (scanl1 (+) [a,a+1..])
 
-- (mezclaTodas xss) es la mezcla ordenada de xss, donde tanto xss como
-- sus elementos son listas infinitas ordenadas. Por ejemplo,
--    λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2..]])
--    [2,3,4,5,6,7,8,9,10,11]
--    λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2,9..]])
--    [2,4,6,8,9,10,12,14,16,18]
mezclaTodas :: Ord a => [[a]] -> [a]
mezclaTodas = foldr1 xmezcla
  where xmezcla (x:xs) ys = x : mezcla xs ys
 
-- (mezcla xs ys) es la lista obtenida mezclando las dos lista infinitas
-- ordenadas crecientes xs e ys. Por ejemplo,
--    λ> take 20 (mezcla [1,3..] [2,5..])
--    [1,2,3,5,7,8,9,11,13,14,15,17,19,20,21,23,25,26,27,29]
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 xs ys) es la diferencia las listas infinitas ordenadas
-- crecientes xs e ys. Por ejemplo,
--    λ> take 8 (diferencia [1..] [2,4..])
--    [1,3,5,7,9,11,13,15]
diferencia :: [Integer] -> [Integer] -> [Integer]
diferencia (x:xs) (y:ys)
  | x == y    = diferencia xs ys
  | otherwise = x : diferencia xs (y:ys)
 
-- 2ª solución
-- ===========
 
-- Observando el siguiente cálculo
--    λ> take 10 noSonSumasDePADeDiferenciaUno
--    [1,2,4,8,16,32,64,128,256,512]
noSonSumasDePADeDiferenciaUno2 :: [Integer]
noSonSumasDePADeDiferenciaUno2 = [2^k | k <- [0..]]
 
-- 3ª solución
-- ===========
 
noSonSumasDePADeDiferenciaUno3 :: [Integer]
noSonSumasDePADeDiferenciaUno3 =
  iterate (*2) 1
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> noSonSumasDePADeDiferenciaUno !! 14
--    16384
--    (36.00 secs, 28,609,441,984 bytes)
--    λ> noSonSumasDePADeDiferenciaUno2 !! 14
--    16384
--    (0.01 secs, 102,712 bytes)
--    λ> noSonSumasDePADeDiferenciaUno3 !! 14
--    16384
--    (0.00 secs, 102,432 bytes)
--
--    λ> length (show (noSonSumasDePADeDiferenciaUno3 !! (3*10^5)))
--    90309
--    (2.78 secs, 5,770,583,328 bytes)
--    λ> length (show (noSonSumasDePADeDiferenciaUno2 !! (3*10^5)))
--    90309
--    (0.09 secs, 60,840,304 bytes)
--
--    λ> length (show (noSonSumasDePADeDiferenciaUno2 !! (10^7)))
--    3010300
--    (3.55 secs, 2,030,646,392 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>

Productos de elementos de dos conjuntos

Definir la función

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

tal que (productos as bs c) es la lista de pares (a,b) tales que a un elementos de as, b es un elemento de bs y su producto es x, donde as y bs son listas (posiblemente infinitas) ordenadas crecientes. Por ejemplo,

   productos [3,5..] [2,4..] 2000  ==  [(5,400),(25,80),(125,16)]
   productos [3,5..] [2,4..] 2001  ==  []
   length (productos [3,5..] [2,4..] (product [1..11]))  ==  59

Soluciones

import Data.List (group, inits, nub, sort, subsequences)
import Data.Numbers.Primes (primeFactors)
 
-- 1ª solución
-- ===========
 
productos :: [Integer] -> [Integer] -> Integer -> [(Integer,Integer)]
productos as bs c =
  [(a,b) | a <- takeWhile (<= c) as,
           c `mod` a == 0,
           let b = c `div` a,
           b `pertenece` bs]
 
-- (pertenece x ys) se verifica si x pertenece a la lista ordenada
-- creciente ys. Por ejemplo,
--    pertenece 15 [1,3..]  ==  True
--    pertenece 16 [1,3..]  ==  False
pertenece :: Integer -> [Integer] -> Bool
pertenece x ys =
  x == head (dropWhile (< x) ys)
 
-- 2ª solución
-- ===========
 
productos2 :: [Integer] -> [Integer] -> Integer -> [(Integer,Integer)]
productos2 as bs c =
  [(a,b) | a <- as',
           let b = c `div` a,
           b `pertenece` bs']
  where cs  = divisores c
        as' = interseccion cs (takeWhile (<=c) as)
        bs' = interseccion cs (takeWhile (<=c) bs)
 
-- (divisores x) es el conjunto de divisores de los x. Por ejemplo,
--   divisores 30  ==  [1,2,3,5,6,10,15,30]
divisores :: Integer -> [Integer]
divisores = sort
          . map (product . concat)
          . sequence
          . map inits
          . group
          . primeFactors
 
-- (interseccion xs ys) es la intersección entre las listas ordenadas
-- crecientes xs e ys. Por ejemplo,
--    λ> take 10 (interseccion [1,3..] [2,5..])
--    [5,11,17,23,29,35,41,47,53,59]
interseccion :: Ord a => [a] -> [a] -> [a]
interseccion = aux
  where aux as@(x:xs) bs@(y:ys) = case compare x y of
                                    LT ->     aux xs bs
                                    EQ -> x : aux xs ys
                                    GT ->     aux as ys
        aux _         _         = []
 
-- 2ª solución
-- ===========
 
productos3 :: [Integer] -> [Integer] -> Integer -> [(Integer,Integer)]
productos3 as bs c = aux as' bs'
  where aux (x:xs) (y:ys) | x * y == c = (x,y) : aux xs ys
                          | x * y >  c = aux (x:xs) ys
                          | otherwise  = aux xs (y:ys)
        aux _ _           = []
        cs  = divisores c
        as' = interseccion cs (takeWhile (<=c) as)
        bs' = reverse (interseccion cs (takeWhile (<=c) bs))
 
-- Comparación de eficiencia
-- =========================
 
-- La compactación es
--    λ> length (productos [3,5..] [2,4..] (product [1..11]))
--    59
--    (9.83 secs, 5,588,474,408 bytes)
--    λ> length (productos2 [3,5..] [2,4..] (product [1..11]))
--    59
--    (10.48 secs, 8,942,746,480 bytes)
--    λ> length (productos3 [3,5..] [2,4..] (product [1..11]))
--    59
--    (17.39 secs, 13,413,570,800 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>

Potencias con mismos finales

El enunciado del primer problema de la IMO (Olimpiada Internacional de Matemáticas) de 1978 es

Sean n > m ≥ 1 números naturales tales que los 3 últimos dígitos de 1978^m y 1978^n coinciden. Calcular el par (m,n) de dichos pares para el que m+n es mínimo.

Definir la función

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

tal que (potenciasMismoFinales x) es la lista de los pares de naturales (m,n) tales que n > m ≥ 1 y los 3 últimos dígitos de x^m y x^n coinciden (además, la lista está ordenada por la suma de las componentes de sus elementos). Por ejemplo,

   take 3 (potenciasMismoFinales 1001) == [(1,2),(1,3),(1,4)]
   take 3 (potenciasMismoFinales 1002) == [(3,103),(4,104),(5,105)]
   take 3 (potenciasMismoFinales 1003) == [(1,101),(2,102),(3,103)]
   take 3 (potenciasMismoFinales 1004) == [(2,52),(3,53),(4,54)]
   take 3 (potenciasMismoFinales 1005) == [(3,5),(3,7),(4,6)]
   take 3 (potenciasMismoFinales 1006) == [(3,28),(4,29),(5,30)]
   take 3 (potenciasMismoFinales 1007) == [(1,21),(2,22),(3,23)]
   take 3 (potenciasMismoFinales 1008) == [(1,101),(2,102),(3,103)]
   take 3 (potenciasMismoFinales 1009) == [(1,51),(2,52),(3,53)]

Usando la función potenciasMismoFinales, calcular la respuesta al problema de la Olimpiada.

Soluciones

potenciasMismoFinales :: Integer -> [(Integer,Integer)]
potenciasMismoFinales x =
   [(m,n) | (m,n) <- pares,
            x^m `mod` 1000 == x^n `mod` 1000]
 
-- pares el lista de pares de enteros positivos, con el primero menor que
-- el segundo, ordenados por su suma y primer elemento. Por ejemplo,
--    λ> take 10 pares
--    [(1,2),(1,3),(1,4),(2,3),(1,5),(2,4),(1,6),(2,5),(3,4),(1,7)]
pares :: [(Integer,Integer)]
pares = [(m,n) | x <- [1..],
                 m <- [1..x],
                 let n = x-m,
                 n > m]
 
-- Cálculo de la respuesta
-- =======================
 
-- El cálculo es
--    λ> head (potenciasMismoFinales 1978)
--    (3,103)

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>