Menu Close

Categoría: Ejercicio

El cociente por 11 es igual a la suma de los cuadrados de sus cifras

El enunciado del problema 1 de la Olimpiada Internacional de Matemáticas de 1960 es el siguiente

Encontrar todos los números de tres cifras para los que al dividir el número entre 11 se obtiene la suma de los cuadrados de las cifras del número inicial.

Diremos que un número x es especial si al dividir x entre 11 se obtiene la suma de los cuadrados de las cifras de x.

Definir la función

   esEspecial :: Integer -> Bool

tal que (esEspecial x) se verifica si x es especial. Por ejemplo,

   esEspecial 550          ==  True
   esEspecial 22           ==  False
   esEspecial 241          ==  False
   esEspecial (11^(10^8))  ==  False

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

Calculando los números especiales menores que 10⁶, conjeturar que el conjunto de los números especiales es finito y comprobar la conjetura con QuickCheck.

Soluciones

import Test.QuickCheck (Positive(..), quickCheck)
 
-- 1ª solución
-- ===========
 
esEspecial :: Integer -> Bool
esEspecial x =
  x `mod` 11 == 0 &&
  x `div` 11 == sum (map (^2) (digitos x))
 
-- head especiales  ==  550
especiales :: [Integer]
especiales = filter esEspecial [11,22..]
 
-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 325 == [3,2,5]
digitos :: Integer -> [Integer]
digitos a = [read [c] | c <-show a]
 
-- Cálculo de la respuesta
-- =======================
 
-- El cálculo es
--    λ> filter esEspecial [100..999]
--    [550,803]
-- Por tanto, los números buscados son 550 y 803.
 
-- Propiedad
-- =========
 
-- Observando el siguiente cálculo
--    λ> filter esEspecial [11,22..10^6]
--    [550,803]
-- se puede conjeturar que los únicos números especiales son 550 y
-- 803. Lo vamos a comprobar con QuickCheck.
 
-- La propiedad es
prop_especiales :: Positive Integer -> Bool
prop_especiales (Positive x) =
  x `elem` [550,803] || not (esEspecial x)
 
-- La comprobación es
--    λ> quickCheck prop_especiales
--    +++ OK, passed 100 tests.
 
-- 2ª solución
-- ===========
 
esEspecial2 :: Integer -> Bool
esEspecial2 x = x `elem` [550,803]
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> esEspecial (11^(10^6))
--    False
--    (2.22 secs, 4,675,669,056 bytes)
--    λ> esEspecial2 (11^(10^6))
--    False
--    (0.08 secs, 1,334,408 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>

Últimos dígitos de una sucesión

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

Considérese la sucesión definida como a(1) = 3, y a(n+1) = a(n) + a(n)². Determínense las dos últimas cifras de a(2000).

Definir las sucesiones

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

tales que

  • sucesionA es la lista de los términos de la sucesión a(n). Por ejemplo,
     take 4 sucesionA  ==  [3,12,156,24492]
  • sucesionB es la lista de los dos últimos dígitos de los término de la sucesión a(n). Por ejemplo,
     take 4 sucesionB     ==  [3,12,56,92]
     sucesionB !! (10^6)  ==  56

Usando la sucesionB, calcular la respuesta a la pregunta del problema de la Olimpiada.

Soluciones

[schedule on=’2021-05-28′ at=”06:00″]
-- 1ª definición de sucesionA
-- ==========================
 
sucesionA :: [Integer]
sucesionA = map a [1..]
  where a 1 = 3
        a n = b + b^2
          where b = a (n-1)
 
-- 2ª definición de sucesionA
-- ==========================
 
sucesionA2 :: [Integer]
sucesionA2 = iterate (\x -> x + x^2) 3
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> length (show (maximum (take 26 sucesionA)))
--    18408940
--    (3.90 secs, 1,213,573,208 bytes)
--    λ> length (show (maximum (take 26 sucesionA2)))
--    18408940
--    (3.91 secs, 1,182,719,984 bytes)
 
-- 1ª definición de sucesionB
-- ==========================
 
sucesionB :: [Integer]
sucesionB = map (`mod` 100) sucesionA
 
-- 2ª definición de sucesionB
-- ==========================
 
-- Observando el siguiente cálculo
--    λ> take 20 sucesionB
--    [3,12,56,92,56,92,56,92,56,92,56,92,56,92,56,92,56,92,56,92]
 
sucesionB2 :: [Integer]
sucesionB2 =
  3 : 12 : cycle [56,92]
 
-- Comprobación de equivalencia
-- ============================
 
-- La comprobación es
--    λ> take 25 sucesionB == take 25 sucesionB2
--    True
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> sucesionB !! 30
--    56
--    (10.09 secs, 978,586,056 bytes)
--    λ> sucesionB2 !! 30
--    56
--    (0.01 secs, 98,568 bytes)
 
-- Cálculo de la respuesta
-- =======================
 
-- El cálculo dela respuesta es
--    λ> sucesionB2 !! 1999
--    92
-- Por tanto a(2000) termina en 92.

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>

Sumas y productos de dígitos

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

¿Cuántos números, comprendidos entre 1.000 y 9.999, verifican que la suma de sus cuatro dígitos es mayor o igual que el producto de los mismos? ¿Para cuántos de ellos se verifica la igualdad?

Definir las funciones

   conMayorSumaQueProducto :: Int -> Int -> [Int]
   conIgualSumaQueProducto :: Int -> Int -> [Int]

tales que

  • (conMayorSumaQueProducto a b) es la lista de los números del intervalo [a,b] tales que la suma de sus dígitos es mayor que el producto de los mismos. Por ejemplo,
     λ> conMayorSumaQueProducto 20 99
     [20,21,30,31,40,41,50,51,60,61,70,71,80,81,90,91]
     λ> conMayorSumaQueProducto 120 199
     [120,121,122,130,131,140,141,150,151,160,161,170,171,180,181,190,191]
     λ> conMayorSumaQueProducto 220 299
     [220,221,230,240,250,260,270,280,290]
  • (conIgualSumaQueProducto a b) es la lista de los números del intervalo [a,b] tales que la suma de sus dígitos es igual que el producto de los mismos. Por ejemplo,
     λ> conIgualSumaQueProducto 10 99
     [22]
     λ> conIgualSumaQueProducto 100 999
     [123,132,213,231,312,321]

Usando las funciones anteriores, calcular las respuestas a las preguntas del problema de la Olimpiada.

Soluciones

[schedule on=’2021-05-27′ at=”06:00″]
conMayorSumaQueProducto :: Int -> Int -> [Int]
conMayorSumaQueProducto a b =
  [x | x <- [a..b],
       let xs = digitos x,
       sum xs > product xs]
 
conIgualSumaQueProducto :: Int -> Int -> [Int]
conIgualSumaQueProducto a b =
  [x | x <- [a..b],
       let xs = digitos x,
       sum xs == product xs]
 
-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 325 == [3,2,5]
digitos :: Int -> [Int]
digitos a = [read [c] | c <-show a]
 
-- Cálculo de las respuestas
-- =========================
 
-- La cantidad de números, comprendidos entre 1.000 y 9.999, tales
-- que la suma de sus cuatro dígitos es mayor o igual que el producto de
-- los mismos se calcula con
--    λ> length (conMayorSumaQueProducto 1000 9999 ++ conIgualSumaQueProducto 1000 9999)
--    2502
-- Por tanto, hay 2502 números que cumplen la primera condición.
 
-- La cantidad de números, comprendidos entre 1.000 y 9.999, tales
-- que la suma de sus cuatro dígitos es igual que el producto de los
-- mismos se calcula con
--    λ> length (conIgualSumaQueProducto 1000 9999)
--    12
-- Por tanto, hay 12 números que cumplen la segunda condición. La lista
-- de dichos números se puede calcular con
--    λ> conIgualSumaQueProducto 1000 9999
--    [1124,1142,1214,1241,1412,1421,2114,2141,2411,4112,4121,4211]

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 suma de dos cuadrados

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

Hallad todas las posibles formas de escribir 2003 como suma de dos cuadrados de números enteros positivos.

Definir la sucesión

   sonSumaDosCuadrados :: [Integer]

cuyos elementos son los números que se pueden expresar como suma de los cuadrados de dos números naturales. Por ejemplo,

   take 6 sonSumaDosCuadrados      ==  [0,1,2,4,5,8]
   sonSumaDosCuadrados !! (10^4)   ==  39593

Comprobar con QuickCheck las siguientes propiedades:

  • La sucesión sonSumaDosCuadrados es infinita.
  • Los elementos de sonSumaDosCuadrados no son congruentes con 3 módulo 4 (es decir, sus restos al dividirlo por 4 son distintos de 3).

Usando sonSumaDosCuadrados, resolver el problema propuesto; es decir, calcular todas las posibles formas de escribir 2003 como suma de dos cuadrados de números enteros positivos.

Soluciones

<

pre lang=”haskell”>
import Test.QuickCheck (Property, (==>), quickCheck)

— 1ª solución
— ===========

sonSumaDosCuadrados :: [Integer] sonSumaDosCuadrados =
filter esSumaDeDosCuadrados [0..]

— (esSumaDeDosCuadrados) se verifica si n se puede escribir como la
— suma de los cuadrados de dos números naturales. Por ejemplo,
— esSumaDeDosCuadrados 5 == True
— esSumaDeDosCuadrados 3 == False
esSumaDeDosCuadrados :: Integer -> Bool
esSumaDeDosCuadrados = not . null . descomposicionesSumaDosCuadrados

— (descomposicionesSumaDosCuadrados n) es la lista de pares de
— cuadrados de números naturales (con la primera componente menor o
— igual que la segunda) cuya suma es n. Por ejmplo,
— descomposicionesSumaDosCuadrados 3 == [] — descomposicionesSumaDosCuadrados 4 == [(0,4)] — descomposicionesSumaDosCuadrados 5 == [(1,4)] — descomposicionesSumaDosCuadrados 25 == [(0,25),(9,16)] — descomposicionesSumaDosCuadrados 325 == [(1,324),(36,289),(100,225)] — descomposicionesSumaDosCuadrados 1105 == [(16,1089),(81,1024),(144,961),(529,576)] descomposicionesSumaDosCuadrados :: Integer -> [(Integer,Integer)] descomposicionesSumaDosCuadrados n =
[(a,b) | a <- xs,
let b = n – a,
b elem xs,
a <= b] where xs = takeWhile (<= n) cuadrados

— cuadrados es la lista de los cuadrados. Por ejemplo,
— take 10 cuadrados == [0,1,4,9,16,25,36,49,64,81] cuadrados :: [Integer] cuadrados = map (^2) [0..]

— 2ª solución
— ===========

sonSumaDosCuadrados2 :: [Integer] sonSumaDosCuadrados2 =
filter esSumaDeDosCuadrados2 [0..]

esSumaDeDosCuadrados2 :: Integer -> Bool
esSumaDeDosCuadrados2 = not . null . descomposicionesSumaDosCuadrados2

descomposicionesSumaDosCuadrados2 :: Integer -> [(Integer,Integer)] descomposicionesSumaDosCuadrados2 n =
[(a,b) | a <- ys,
let b = n – a,
b elem m : zs] where m = n div 2
xs = takeWhile (<= n) cuadrados
(ys,zs) = span (<= m) xs

— 3ª solución
— ==========

sonSumaDosCuadrados3 :: [Integer] sonSumaDosCuadrados3 =
mezclaTodas [[n^2+k^2 | k <- [n..]] | n <- [0..]]

— (mezclaTodas xss) es la mezcla ordenada de xss, donde tanto xss como
— sus elementos son listas infinitas ordenadas. Por ejemplo,
— λ> take 10 (mezclaTodas [[n,2n..] | n <- [2..]]) -- [2,3,4,5,6,7,8,9,10,11] -- λ> take 10 (mezclaTodas [[n,2n..] | 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 mezcla de las listas infinitas ordenadas xs es
— ys. Por ejemplo,
— take 10 (mezcla [1,3..] [4,8..]) == [1,3,4,5,7,8,9,11,12,13] 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

— Comprobación de equivalencia
— ============================

— La comprobación es
— λ> take 1000 sonSumaDosCuadrados == take 1000 sonSumaDosCuadrados2
— True
— λ> take 1000 sonSumaDosCuadrados2 == take 1000 sonSumaDosCuadrados3
— True

— Comparación de eficiencia
— =========================

— La comparación es
— λ> sonSumaDosCuadrados !! (510^3)
— 18973
— (2.29 secs, 266,485,976 bytes)
— λ> sonSumaDosCuadrados2 !! (5
10^3)
— 18973
— (1.01 secs, 473,019,976 bytes)
— λ> sonSumaDosCuadrados3 !! (5*10^3)
— 18973

— (0.17 secs, 103,957,288 bytes)

— λ> sonSumaDosCuadrados2 !! (510^4)
— 216090
— (78.14 secs, 17,856,157,080 bytes)
— λ> sonSumaDosCuadrados3 !! (5
10^4)
— 216090
— (4.23 secs, 3,325,056,480 bytes)

— Propiedades
— ===========

— La primera propiedad es
prop_infinitud :: Integer -> Bool
prop_infinitud n =
(not . null) (dropWhile (<= n) sonSumaDosCuadrados3)

— Su comprobación es
— λ> quickCheck prop_infinitud
— +++ OK, passed 100 tests.

— La segunda propiedad es
prop_modulo4 :: Int -> Property
prop_modulo4 k =
k >= 0 ==>
(sonSumaDosCuadrados3 !! k) mod 4 /= 3

— Su comprobación es
— λ> quickCheck prop_modulo4
— +++ OK, passed 100 tests.

— 4ª solución
— ===========

— Basada en la 2ª propiedad.

sonSumaDosCuadrados4 :: [Integer] sonSumaDosCuadrados4 =
filter esSumaDeDosCuadrados4 [0..]

esSumaDeDosCuadrados4 :: Integer -> Bool
esSumaDeDosCuadrados4 = not . null . descomposicionesSumaDosCuadrados4

descomposicionesSumaDosCuadrados4 :: Integer -> [(Integer,Integer)] descomposicionesSumaDosCuadrados4 n
| n mod 4 == 3 = [] | otherwise = [(a,b) | a <- ys,
let b = n – a,
b elem m : zs] where m = n div 2
xs = takeWhile (<= n) cuadrados
(ys,zs) = span (<= m) xs

— Comprobación de equivalencia
— ============================

— La comprobación es
— λ> take 1000 sonSumaDosCuadrados3 == take 1000 sonSumaDosCuadrados4
— True

— Comparación de eficiencia
— =========================

— La comparación es
— λ> sonSumaDosCuadrados2 !! (10^4)
— 39593
— (3.60 secs, 1,413,851,720 bytes)
— λ> sonSumaDosCuadrados3 !! (10^4)
— 39593
— (0.42 secs, 284,603,104 bytes)
— λ> sonSumaDosCuadrados4 !! (10^4)
— 39593
— (2.58 secs, 1,043,995,480 bytes)

— Cálculo para resolver el problema
— =================================

— El cálculo es
— λ> 2003 == head (dropWhile (<2003) sonSumaDosCuadrados3)
— False
— Por tanto, no es posible escribir 2003 como suma de dos cuadrados de
— números enteros positivos.

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>

Ternas aditivas

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

Decimos que tres números naturales distintos forman una terna aditiva si la suma de los dos primeros de ellos es igual al tercero. Hallar, razonadamente, el máximo número de ternas aditivas que puede haber en un conjunto dado de 20 números naturales.

Definir las funciones

   ternasAditivas  :: Integer -> [(Integer,Integer,Integer)]
   nTernasAditivas :: Integer -> Integer

tales que

  • (ternasAditivas n) es la lista de las ternas aditivas crecientes que se pueden formar con los n primeros números enteros positivos. Por ejemplo,
     λ> ternasAditivas 7
     [(1,2,3),(1,3,4),(1,4,5),(1,5,6),(1,6,7),(2,3,5),(2,4,6),(2,5,7),(3,4,7)]
     λ> length (ternasAditivas (10^4))
     24995000
  • (nTernasAditivas n) es el número de ternas aditivas crecientes que se pueden formar con los n primeros números enteros positivos. Por ejemplo,
     nTernasAditivas 7                            ==  9
     length (show (nTernasAditivas (10^(10^5))))  ==  200000
     length (show (nTernasAditivas (10^(10^6))))  ==  2000000
     length (show (nTernasAditivas (10^(10^7))))  ==  20000000

Soluciones

import Data.List (genericLength)
 
-- 1ª definición de ternasAditivas
-- ===============================
 
ternasAditivas :: Integer -> [(Integer,Integer,Integer)]
ternasAditivas n =
  [(a,b,c) | a <- [1..n],
             b <- [a+1..n],
             let c = a+b,
             c <= n]
 
-- 2ª definición de ternasAditivas
-- ===============================
 
ternasAditivas2 :: Integer -> [(Integer,Integer,Integer)]
ternasAditivas2 n =
  [(a,b,a+b) | a <- [1..n],
               b <- [a+1..n-a]]
 
-- Comprobación de equivalencia
-- ============================
 
-- La comprobación es
--    λ> and [ternasAditivas n == ternasAditivas2 n | n <- [1..300]]
--    True
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> length (ternasAditivas (5*10^3))
--    6247500
--    (4.02 secs, 2,950,741,752 bytes)
--    λ> length (ternasAditivas2 (5*10^3))
--    6247500
--    (1.15 secs, 1,401,184,264 bytes)
 
-- 1ª definición de nTernasAditivas
-- ================================
 
nTernasAditivas :: Integer -> Integer
nTernasAditivas = genericLength . ternasAditivas
 
-- 2ª definición de nTernasAditivas
-- ================================
 
-- Observando los siguientes cálculos
--    λ> [nTernasAditivas n | n <- [1..20]]
--    [0,0,1,2,4,6,9,12,16,20,25,30,36,42,49,56,64,72,81,90]
--    λ> [(n-1)^2 `div` 4 | n <- [1..20]]
--    [0,0,1,2,4,6,9,12,16,20,25,30,36,42,49,56,64,72,81,90]
 
nTernasAditivas2 :: Integer -> Integer
nTernasAditivas2 n = (n-1)^2 `div` 4
 
-- 3ª definición de nTernasAditivas
-- ================================
 
nTernasAditivas3 :: Integer -> Integer
nTernasAditivas3 = (`div` 4) . (^ 2) . pred
 
-- Comprobación de equivalencia
-- ============================
 
-- La comprobación es
--    λ> and [nTernasAditivas n == nTernasAditivas2 n | n <- [1..200]]
--    True
--    λ> and [nTernasAditivas2 n == nTernasAditivas3 n | n <- [1..200]]
--    True
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> nTernasAditivas (5*10^3)
--    6247500
--    (5.66 secs, 3,663,331,112 bytes)
--    λ> nTernasAditivas2 (5*10^3)
--    6247500
--    (0.02 secs, 106,752 bytes)
--    λ> nTernasAditivas3 (5*10^3)
--    6247500
--    (0.02 secs, 106,568 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>