Menu Close

Mes: mayo 2021

Cuadrado más primo

El enunciado del problema C2 de la Fase Local de la Olimpiada Matemática Española del 2006 es

¿Existe un conjunto infinito de números naturales que NO se pueden representar en la forma n²+p, siendo n natural y p primo? Razónese la contestación.

Definir la lista

   noSonCuadradoMasPrimo :: [Integer]

cuyos elementos son los números que no se pueden escribir como un cuadrado más un primo. Por ejemplo,

   λ> take 15 noSonCuadradoMasPrimo
   [1,10,25,34,58,64,85,91,121,130,169,196,214,226,289]
   λ> noSonCuadradoMasPrimo2 !! 200
   78961

En la lista no está el 2 (porque 2 = 0²+2), el 3 (porque 3 = 1²+2), el 4 (porque 4 = 0²+4) ni el 11 (porque 11 = 3²+2).

Comprobar con QuickCheck que noSonCuadradoMasPrimo es infinita.

Soluciones

import Data.Numbers.Primes (primes, isPrime)
import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
noSonCuadradoMasPrimo :: [Integer]
noSonCuadradoMasPrimo =
  filter (not . esCuadradoMasPrimo) [1..]
 
-- (esCuadradoMasPrimo n) se verifica si n se puede escribir como un
-- cuadrado más un primo. Por ejemplo,
--    esCuadradoMasPrimo 11  ==  True
--    esCuadradoMasPrimo 10  ==  False
esCuadradoMasPrimo :: Integer -> Bool
esCuadradoMasPrimo n =
  or [esCuadrado (n - p) | p <- takeWhile (<= n) primes]
 
-- (esCuadrado x) se verifica si x es un cuadrado perfecto. Por
-- ejemplo,
--    esCuadrado 16  ==  True
--    esCuadrado 27  ==  False
esCuadrado :: Integer -> Bool
esCuadrado x =
  (raizEntera x)^2 == x
 
-- (raizEntera x) es el mayor entero cuyo cuadrado es menor o igual que
-- x. Por ejemplo,
--    raizEntera 16  ==  4
--    raizEntera 27  ==  5
raizEntera :: Integer -> Integer
raizEntera x = aux (1,x)
    where aux (a,b) | d == x    = c
                    | c == a    = c
                    | d < x     = aux (c,b)
                    | otherwise = aux (a,c)
              where c = (a+b) `div` 2
                    d = c^2
 
-- 2ª solución
-- ===========
 
noSonCuadradoMasPrimo2 :: [Integer]
noSonCuadradoMasPrimo2 =
  filter (not . esCuadradoMasPrimo2) [1..]
 
-- (esCuadradoMasPrimo2 n) se verifica si n se puede escribir como un
-- cuadrado más un primo. Por ejemplo,
--    esCuadradoMasPrimo2 11  ==  True
--    esCuadradoMasPrimo2 10  ==  False
esCuadradoMasPrimo2 :: Integer -> Bool
esCuadradoMasPrimo2 n =
  or [isPrime (n - m) | m <- takeWhile (<= n) cuadrados]
 
-- cuadrados es la lista de los cuadrados de los números naturales. Por
-- ejemplo,
--    take 10 cuadrados  ==  [0,1,4,9,16,25,36,49,64,81]
cuadrados :: [Integer]
cuadrados = map (^2) [0..]
 
-- Comprobación de equivalencia
-- ============================
 
-- La comprobación es
--    λ> take 50 noSonCuadradoMasPrimo == take 50 noSonCuadradoMasPrimo2
--    True
 
-- Comparación de eficiencia
-- =========================
 
--    λ> noSonCuadradoMasPrimo !! 70
--    8649
--    (12.42 secs, 13,289,896,304 bytes)
--    λ> noSonCuadradoMasPrimo2 !! 70
--    8649
--    (0.23 secs, 650,843,816 bytes)
 
-- Propiedad
-- =========
 
-- La propiedad es
prop_infinitud :: Integer -> Bool
prop_infinitud n =
  not (null (dropWhile (<= n) noSonCuadradoMasPrimo2))
 
-- La comprobación es
--    λ> quickCheck prop_infinitud
--    +++ 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 consecutivos con factorización con exponentes impares

El enunciado del problema B.5 de la Fase Local de la Olimpiada Matemática Española del 2006 es

Los números naturales 22, 23, y 24 tienen la siguiente propiedad: los exponentes de los factores primos de su descomposición son todos impares (22 = 2¹·11¹, 23 = 23¹, 24 = 2³·3¹)

¿Cuál es el mayor número de naturales consecutivos que pueden tener esa propiedad?. Razónese la contestación.

Definir la lista

   consecutivosExponentesImpares :: [[Integer]]

cuyos elementos sean las sucesiones maximales de números enteros positivos tales que los exponentes de los factores primos de su descomposición son todos impares. Por ejemplo,

   λ> take 7 consecutivosExponentesImpares
   [[1,2,3],[5,6,7,8],[10,11],[13,14,15],[17],[19],[21,22,23,24]]
   λ> consecutivosExponentesImpares !! (10^4)
   [43030,43031,43032,43033,43034,43035]

Usando la función consecutivosExponentesImpares conjeturar la respuesta a la pregunta del problema y comprobarla con QuickCheck.

Soluciones

import Data.List (group)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck (Property, (==>), quickCheck)
 
-- 1ª solución
-- ===========
 
consecutivosExponentesImpares :: [[Integer]]
consecutivosExponentesImpares =
  consecutivosExponentesImparesDesde 1 :
  [consecutivosExponentesImparesDesde n | n <- [1..],
                                          not (exponentesImpares (n-1)),
                                          exponentesImpares n]
 
-- (consecutivosExponentesImparesDesde n) es la sucesión maximal de
-- números enteros positivos a partir de n tales que los exponentes de
-- los factores primos de su descomposición son todos impares. Por
-- ejemplo,
--    consecutivosExponentesImparesDesde 1  ==  [1,2,3]
--    consecutivosExponentesImparesDesde 4  ==  []
--    consecutivosExponentesImparesDesde 5  ==  [5,6,7,8]
consecutivosExponentesImparesDesde :: Integer -> [Integer]
consecutivosExponentesImparesDesde n
  | exponentesImpares n = n : consecutivosExponentesImparesDesde (n+1)
  | otherwise           = []
 
-- (exponentesImpares n) se verifica si los exponentes de los factores
-- primos de su descomposición son todos impares. Por ejemplo,
--    exponentesImpares 4  ==  False
--    exponentesImpares 6  ==  True
exponentesImpares :: Integer -> Bool
exponentesImpares n = all odd (exponentes n)
 
-- (exponentes n) es la lista de los exponentes de la factorización
-- prima de n. Por ejemplo,
--    exponentes 4  ==  [2]
--    exponentes 6  ==  [1,1]
--    exponentes 1200  ==  [4,1,2]
exponentes :: Integer -> [Int]
exponentes n = map length (group (primeFactors n))
 
-- 2ª solución
-- ===========
 
consecutivosExponentesImpares2 :: [[Integer]]
consecutivosExponentesImpares2 = aux 1
  where aux n | exponentesImpares n = xs : aux (1 + last xs)
              | otherwise           = aux (n+1)
          where xs = consecutivosExponentesImparesDesde n
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_consecutivosExponentesImpares :: Int -> Property
prop_consecutivosExponentesImpares n =
  n > 0 ==>
  consecutivosExponentesImpares !! n == consecutivosExponentesImpares2 !! n
 
-- La comprobación es
--    λ> quickCheck prop_consecutivosExponentesImpares
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> consecutivosExponentesImpares !! (5*10^4)
--    [214917,214918,214919,214920,214921,214922,214923]
--    (4.95 secs, 14,329,413,944 bytes)
--    λ> consecutivosExponentesImpares2 !! (5*10^4)
--    [214917,214918,214919,214920,214921,214922,214923]
--    (5.29 secs, 15,103,460,488 bytes)
 
-- Respuesta a la pregunta del problema
-- ====================================
 
-- A partir del siguiente cálculo
--    λ> maximum [length xs | xs <- take (10^4) consecutivosExponentesImpares]
--    7
-- se puede conjeturar que el mayor número de naturales consecutivos que pueden
-- tener la propiedad es 7. Por el cálculo, se sabe que es mayor o igual
-- que 7. Falta por comprobar que es menor o igual que 7; es decir,
prop_maximoConsecutivosExponentesImpares :: Int -> Property
prop_maximoConsecutivosExponentesImpares n =
  n >= 0 ==>
  length (consecutivosExponentesImpares !! n) <= 7
 
-- La comprobación es
--    λ> quickCheck prop_maximoConsecutivosExponentesImpares
--    +++ 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>

Sucesión de mcd de consecutivos

El enunciado del problema B3 de la Fase Local de la Olimpiada Matemática Española del 2007 es

Sea a(n) = 1 + n³ la sucesión {2,9,28,65,…} y b(n) = mcd(a(n),a(n+1)). Hallar el máximo valor que puede tomar b(n).

Definir las listas

   sucesionA :: [Integer]
   sucesionB :: [Integer]

tales que

  • los elementos de sucesionA son los términos de la sucesión a(n). Por ejemplo,
     take 12 sucesionA  ==  [2,9,28,65,126,217,344,513,730,1001,1332,1729]
  • los elementos de sucesionAB son los términos de la sucesión b(n). Por ejemplo,
   sucesionB !! 0       ==  1
   sucesionB !! 4       ==  7
   sucesionB !! (10^9)  ==  1

Usando sucesionB, conjeturar la respuesta del problema y comprobarla con QuickCheck.

Soluciones

import Data.List (cycle)
import Test.QuickCheck (Property, (==>), quickCheck)
 
sucesionA :: [Integer]
sucesionA = [1+n^3 | n <- [1..]]
 
-- 1ª definición de sucesionB
-- ==========================
 
sucesionB :: [Integer]
sucesionB =
  zipWith gcd sucesionA (tail sucesionA)
 
-- 2ª definición de sucesionB
-- ==========================
 
-- Observando  los siguientes cálculos
--    λ> take 30 sucesionB
--    [1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1]
--    λ> take 10 [n | (n,x) <- zip [1..] sucesionB, x == 7]
--    [5,12,19,26,33,40,47,54,61,68]
 
sucesionB2 :: [Integer]
sucesionB2 = cycle [1,1,1,1,7,1,1]
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_sucesionB :: Int -> Property
prop_sucesionB n =
  n >= 0 ==>
  sucesionB !! n == sucesionB2 !! n
 
-- La comprobación es
--    λ> quickCheck prop_sucesionB
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> sucesionB !! (10^7)
--    1
--    (5.23 secs, 2,880,105,504 bytes)
--    λ> sucesionB2 !! (10^7)
--    1
--    (0.06 secs, 98,600 bytes)
 
-- Cálculo de la respuesta
-- =======================
 
-- Observando los cálculos
--    λ> take 30 sucesionB
--    [1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1]
--    λ> take 30 ([1,1,1,1] ++ cycle (7 : replicate 6 1))
--    [1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1]
--    λ> take 100 sucesionB == take 100 ([1,1,1,1] ++ cycle (7 : replicate 6 1))
--    True
-- La conjetura es que el máximo es 7. Su expresión es
 
prop_maximo :: Int -> Property
prop_maximo n =
  n > 4 ==>
  maximum (take n sucesionB) == 7
 
-- La comprobación es
--    λ> quickCheck prop_maximo
--    +++ 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>

Biparticiones con la misma suma

El enunciado del problema 1 de la Fase Local de la Olimpiada Matemática Española del 2010 es

Sea I(n) el conjunto de los n primeros números naturales impares. Por ejemplo: I(3) = {1,3,5}, I(6) = {1,3,5,7,9,11}, etc.

¿Para qué números n el conjunto I(n) se puede descomponer en dos partes (disjuntas) de forma que coincidan las sumas de los números en cada una de ellas?

Definir las funciones

   biparticiones :: Integer -> [([Integer],[Integer])]
   tieneBiparticiones :: Integer -> Bool
   biparticionD :: Integer -> Maybe ([Integer],[Integer])

tales que

  • (biparticiones n) es la lista de las biparticiones de I(n) con igual suma; es decir, la lista de los pares (xs,ys) tales que xs e ys son subconjuntos disjuntos de I(n) cuya unión es I(n) y la suma de los elementos de xs es igual que la de los de ys. Por ejemplo,
     λ> biparticiones 4
     [([1,7],[3,5])]
     λ> biparticiones 5
     []
     λ> biparticiones 8
     [([1,3,13,15],[5,7,9,11]),([1,5,11,15],[3,7,9,13]),([1,7,9,15],[3,5,11,13]),([1,7,11,13],[3,5,9,15])]
  • (tieneBiparticiones n) se verifica si I(n) tiene alguna bipartición con igual suma. Por ejemplo,
     tieneBiparticiones 4  ==  True
     tieneBiparticiones 5  ==  False
     tieneBiparticiones (10^(10^7))  ==  True
  • (biparticionD n) es una de las biparticiones de I(n) con igual suma, si tiene alguna y Nothing, en caso contrario. Por ejemplo,
     λ> biparticionD 6
     Just ([7,11],[1,3,5,9])
     λ> biparticionD 7
     Nothing
     λ> biparticionD 8
     Just ([1,7,9,15],[3,5,11,13])
     λ> biparticionD 10
     Just ([7,11,13,19],[1,3,5,9,15,17])
     λ> biparticionD 12
     Just ([1,7,9,15,17,23],[3,5,11,13,19,21])
     λ> biparticionD 30
     Just ([7,11,13,19,21,27,29,35,37,43,45,51,53,59],[1,3,5,9,15,17,23,25,31,33,39,41,47,49,55,57])
     λ> length (show (biparticionD (2*10^4)))
     114455

Usando tieneBiparticiones calcular los 10 primeros valores buscados (es decir, los 10 valores de n para los que I(n) se puede descomponer en dos partes (disjuntas) de forma que coincidan las sumas de los números en cada una de ellas) y generalizar.

Soluciones

import Data.List ((\\), delete, genericTake, sort, subsequences)
import Data.Maybe (listToMaybe)
import Test.QuickCheck (Property, (==>), quickCheck)
 
-- 1ª definición de biparticiones
-- =================================
 
biparticiones :: Integer -> [([Integer],[Integer])]
biparticiones n =
  ordena [(bs \\ as,as) | as <- genericTake (2^(n-1)) (subsequences bs),
                          2 * sum as == m]
  where bs = genericTake n impares
        m  = sum bs
 
-- impares es la lista de los números impares. Por ejemplo,
--    take 9 impares  ==  [1,3,5,7,9,11,13,15,17]
impares :: [Integer]
impares = [1,3..]
 
-- (ordena ps) es lista obtenida poniendo en primer lugar la menor de
-- las componentes de los pares de ps y ordenando el resultado. Por
-- ejemplo,
--    ordena [(5,3),(1,7),(4,2)]  ==  [(1,7),(2,4),(3,5)]
ordena :: Ord a => [(a,a)] -> [(a,a)]
ordena ps = sort (map aux ps)
  where aux (xs,ys) | xs < ys   = (xs,ys)
                    | otherwise = (ys,xs)
 
-- 2ª definición de biparticiones
-- =================================
 
biparticiones2 :: Integer -> [([Integer],[Integer])]
biparticiones2 n = sort (aux ([([a], delete a bs) | a <- bs]))
  where bs = genericTake n impares
        m  = sum bs
        aux [] = []
        aux ((_,[]):ps) = aux ps
        aux ((xs,ys):ps)
          | sum xs == sum ys = if xs < ys then (xs,ys) : aux ps
                               else aux ps
          | sum xs <  sum ys = aux ([(a:xs, delete a ys) | a <- ys, a < head xs] ++ ps)
          | otherwise        = aux ps
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_biparticiones :: Integer -> Bool
prop_biparticiones n =
  and [biparticiones k == biparticiones2 k | k <- [1..n]]
 
-- La comprobación es
--    λ> prop_biparticiones 20
--    True
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> length (biparticiones 20)
--    3965
--    (0.36 secs, 568,151,296 bytes)
--    λ> length (biparticiones2 20)
--    3965
--    (2.51 secs, 2,490,876,672 bytes)
--    λ> head (biparticiones 20)
--    ([1,3,5,7,9,11,13,15,17,19,21,23,25,31],[27,29,33,35,37,39])
--    (0.37 secs, 562,477,968 bytes)
--    λ> head (biparticiones2 20)
--    ([1,3,5,7,9,11,13,15,17,19,21,23,25,31],[27,29,33,35,37,39])
--    (2.33 secs, 2,488,098,776 bytes)
 
-- 1ª definición de tieneBiparticiones
-- ======================================
 
tieneBiparticiones :: Integer -> Bool
tieneBiparticiones = not . null . biparticiones
 
-- 2ª definición de tieneBiparticiones
-- ======================================
 
-- Observando el siguiente cálculo
--    λ> [n | n <- [1..20], tieneBiparticiones n]
--    [4,6,8,10,12,14,16,18,20]
 
tieneBiparticiones2 :: Integer -> Bool
tieneBiparticiones2 n = n > 3 && even n
 
-- 1ª definición de biparticionD
-- ================================
 
biparticionD :: Integer -> Maybe ([Integer],[Integer])
biparticionD = listToMaybe . biparticiones
 
-- 2ª definición de biparticionD
-- ================================
 
biparticionD2 :: Integer -> Maybe ([Integer],[Integer])
biparticionD2 x
  | x < 4 || odd x = Nothing
  | otherwise      = Just (aux x)
  where
    aux 4 = ([1,7],[3,5])
    aux 6 = ([7,11],[1,3,5,9])
    aux n = (xs ++ [m+1,m+7], ys ++ [m+3,m+5])
      where (xs,ys) = aux (n-4)
            m       = 2*(n-4)
 
-- Cálculo de la respuesta
-- =======================
 
-- El cálculo es
--    λ> take 10 [n | n <- [1..], tieneBiparticiones n]
--    [4,6,8,10,12,14,16,18,20,22]
-- cuyos valores son los números pares mayores que 3.

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>

Diferencias de potencias congruentes con 5 módulo 7

El enunciado de un problema 5 de la Fase Local de la Olimpiada Matemática Española del 2012 es

Consideremos el número entero positivo n = 2^r - 16^s, donde r y s son también enteros positivos. Hallar las condiciones que deben cumplir r y s para que el resto de la división de n por 7 sea 5. Hallar el menor número que cumple esta condición.

Definir la lista

   exponentes :: [(Integer,Integer)]

tal que sus elementos son los pares de enteros positivos (r,s) tales que 2^r - 16^s es un número entero positivo cuyo resto al dividirlo por 7 es 5. Por ejemplo,

   head exponentes       ==  (10,2)
   exponentes !! 23      ==  (43,8)
   exponentes !! (10^7)  ==  (26836,1826)

Usando la función exponentes, calcular la respuesta a la pregunta del problema; es decir, hallar el menor número que cumple la condición.

Soluciones

import Test.QuickCheck (Property, (==>), quickCheck)
 
-- 1ª solución
-- ===========
 
exponentes :: [(Integer,Integer)]
exponentes =
  [(r,s) | (r,s) <- pares,
           let n = 2^r - 16^s,
           n > 0,
           n `mod` 7 == 5]
 
-- pares el lista de pares de enteros positivos con el primero mayor que
-- el segundo. Por ejemplo,
--    λ> take 10 pares
--    [(2,1),(3,1),(3,2),(4,1),(4,2),(4,3),(5,1),(5,2),(5,3),(5,4)]
pares :: [(Integer,Integer)]
pares = [(a,b) | a <- [1..]
               , b <- [1..a-1]]
 
-- 2ª solución
-- ===========
 
-- Observando los siguientes cálculos
--    λ> take 28 exponentes
--    [(10,2),(13,2),(16,2),(19,2),(22,2),(22,5),(25,2),(25,5),(28,2),
--     (28,5),(31,2),(31,5),(34,2),(34,5),(34,8),(37,2),(37,5),(37,8),
--     (40,2),(40,5),(40,8),(43,2),(43,5),(43,8),(46,2),(46,5),(46,8),
--     (46,11)]
--    λ> [((x-1) `div` 3, (y-2) `div` 3) | (x,y) <- it]
--    [(3,0),(4,0),(5,0),(6,0),(7,0),(7,1),(8,0),(8,1),(9,0),(9,1),
--     (10,0),(10,1),(11,0),(11,1),(11,2),(12,0),(12,1),(12,2),(13,0),
--     (13,1),(13,2),(14,0),(14,1),(14,2),(15,0),(15,1),(15,2),(15,3)]
 
exponentes2 :: [(Integer,Integer)]
exponentes2 =
  concat [[(r,s) | s <- takeWhile (<= (r `div` 4)) ys] | r <- xs]
  where xs = [10,13..]
        ys = [2,5..]
 
-- 3ª solución
-- ===========
 
exponentes3 :: [(Integer,Integer)]
exponentes3 = [(r,s) | r <- [1,4..], s <- [2,5..r `div` 4]]
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_exponentes :: Int -> Property
prop_exponentes n =
  n >= 0 ==>
  all (== (exponentes !! n))
      [exponentes2 !! n,
       exponentes3 !! n]
 
-- La comprobación es
--    λ> quickCheck prop_exponentes
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> exponentes !! (3*10^4)
--    (1471,332)
--    (5.21 secs, 7,844,582,216 bytes)
--    λ> exponentes2 !! (3*10^4)
--    (1471,332)
--    (0.04 secs, 6,551,432 bytes)
--    λ> exponentes3 !! (3*10^4)
--    (1471,332)
--    (0.01 secs, 5,512,056 bytes)
--
--    λ> exponentes2 !! (10^7)
--    (26836,1826)
--    (3.25 secs, 2,083,815,616 bytes)
--    λ> exponentes3 !! (10^7)
--    (26836,1826)
--    (2.57 secs, 1,757,467,216 bytes)
 
-- Cálculo de la respuesta
-- =======================
 
-- El cálculo es
--    λ> (r,s) = head exponentes
--    λ> 2^r - 16^s
--    768
-- Por tanto, el número pedido es el 768.

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>