mayo 2021 – Página 3

Cuadrado más primo

PorJosé A. Alonso 17-mayo-202124-mayo-2021

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]

1	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

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

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

PorJosé A. Alonso 14-mayo-202121-mayo-2021

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

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

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

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

PorJosé A. Alonso 13-mayo-202120-mayo-2021

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]

1 2	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]

1	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

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.

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

PorJosé A. Alonso 12-mayo-202119-mayo-2021

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

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

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

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

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

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

PorJosé A. Alonso 11-mayo-202118-mayo-2021

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

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

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.

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>

Meses: mayo 2021

Cuadrado más primo

Soluciones

Nuevas soluciones

Números consecutivos con factorización con exponentes impares

Soluciones

Nuevas soluciones

Sucesión de mcd de consecutivos

Soluciones

Nuevas soluciones

Biparticiones con la misma suma

Soluciones

Nuevas soluciones

Diferencias de potencias congruentes con 5 módulo 7

Soluciones

Nuevas soluciones

Entradas recientes

Buscar

Correo electrónico