Menu Close

Mes: abril 2021

Números potencias perfectas de la suma de sus dígitos

El número 2401 es una potencia de la suma de sus dígitos, ya que dicha suma es 7 y 7^4 = 2401.

Definir la lista

   potenciaSumaDigitos :: [Integer]

cuyos elementos son los números que son potencias de las sumas de sus dígitos. Por ejemplo,

   λ> take 17 potenciaSumaDigitos
   [0,1,2,3,4,5,6,7,8,9,81,512,2401,4913,5832,17576,19683]

Soluciones

-- 1ª solución
-- ===========
 
potenciaSumaDigitos :: [Integer]
potenciaSumaDigitos = 0 : filter esPotenciaSumaDigitos [0..]
 
-- (esPotenciaSumaDigitos n) se verifica si n es una potencia de la suma
-- de sus dígitos. Por ejemplo,
--    esPotenciaSumaDigitos 2401  ==  True
--    esPotenciaSumaDigitos 2402  ==  False
esPotenciaSumaDigitos :: Integer -> Bool
esPotenciaSumaDigitos n =
  or [n == x^k | k <- [1..n]]
  where x = sumaDigitos n
 
-- (sumaDigitos n) es la suma de los dígitos de n. Por ejemplo,
--    sumaDigitos 2021  ==  5
sumaDigitos :: Integer -> Integer
sumaDigitos = sum . digitos
 
-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 2021  ==  [2,0,2,1]
digitos :: Integer -> [Integer]
digitos x = [read [c] | c <- show x]
 
-- 2ª solución
-- ===========
 
potenciaSumaDigitos2 :: [Integer]
potenciaSumaDigitos2 = 0 : 1 : filter esPotenciaSumaDigitos2 [2..]
 
-- (esPotenciaSumaDigitos2 n) se verifica si n es una potencia de la suma
-- de sus dígitos. Por ejemplo,
--    esPotenciaSumaDigitos2 2401  ==  True
--    esPotenciaSumaDigitos2 2402  ==  False
esPotenciaSumaDigitos2 :: Integer -> Bool
esPotenciaSumaDigitos2 n =
  n == x^k
  where x = sumaDigitos n
        k = round (logBase (fromIntegral x) (fromIntegral n))

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>

Órbita con raíz entera (OME1997 P4)

El enunciado del problema 4 de la OME (Olimpiada Matemática Española) del 1997 es

Sea p un número primo. Determinar todos los enteros k tales que sqrt(k² – k*p) es natural.

Definir las funciones

   orbita        :: Integer -> [Integer]
   orbitaDePrimo :: Integer -> [Integer]

tales que

  • (orbita n) es la lista de todos los enteros k tales que sqrt(k² – k*n) es natural. Por ejemplo,
     take 4  (orbita 6)   == [0,-2,6,8]
     take 5  (orbita 36)  == [0,-12,36,48,-64]
     take 6  (orbita 9)   == [0,-3,9,12,-16,25]
     take 8  (orbita 27)  == [0,-9,27,36,-48,75,-169,196]
     take 10 (orbita 111) == [0,-37,111,148,-289,400,-972,1083,-3025,3136]
  • (orbitaDePrimo p) es la lista de todos los enteros k tales que sqrt(k² – k*p) es natural, suponiendo que p es un número primo. Por ejemplo,
     orbitaDePrimo 5                  == [0,-4,5,9]
     orbitaDePrimo (primes !! (10^6)) == [0,15485867,-59953011442489,59953026928356]

Soluciones

import Data.Numbers.Primes (primes)
 
orbita :: Integer -> [Integer]
orbita n =
  [k | k <- enteros,
       k^2 - k*n >= 0,
       esCuadrado (k^2 - k*n)]
 
-- entero es la lista de los números enteros. Por ejemplo,
--    λ> take 20 enteros
--    [0,-1,1,-2,2,-3,3,-4,4,-5,5,-6,6,-7,7,-8,8,-9,9,-10]
enteros :: [Integer]
enteros = 0 : concat [[-n,n] | n <- [1..]]
 
-- (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
 
-- 1ª definición de orbitaDePrimo
-- ==============================
 
orbitaDePrimo1 :: Integer -> [Integer]
orbitaDePrimo1 2 = take 2 (orbita 2)
orbitaDePrimo1 p = take 4 (orbita p)
 
-- 2ª definición de orbitaDePrimo
-- ==============================
 
-- Basada en los siguientes cálculos
--    orbitaDePrimo1 2  == [0,2]
--    orbitaDePrimo1 3  == [0,-1,3,4]
--    orbitaDePrimo1 5  == [0,-4,5,9]
--    orbitaDePrimo1 7  == [0, 7,  -9, 16]
--    orbitaDePrimo1 11 == [0,11, -25, 36]
--    orbitaDePrimo1 13 == [0,13, -36, 49]
--    orbitaDePrimo1 17 == [0,17, -64, 81]
--    orbitaDePrimo1 19 == [0,19, -81,100]
--    orbitaDePrimo1 23 == [0,23,-121,144]
 
orbitaDePrimo2 :: Integer -> [Integer]
orbitaDePrimo2 p
  | p == 2    = [0,2]
  | p <= 5    = [0, -((p-1) `div` 2)^2, p, ((p+1) `div` 2)^2]
  | otherwise = [0, p, -((p-1) `div` 2)^2, ((p+1) `div` 2)^2]
 
-- Comprobación de equivalencia
-- ============================
 
-- La comprobación es
--    λ> and [orbitaDePrimo1 n == orbitaDePrimo2 n | n <- take 30 primes]
--    True
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> orbitaDePrimo1 (primes !! 100)
--    [0,547,-74529,75076]
--    (4.94 secs, 4,471,368,256 bytes)
--    λ> orbitaDePrimo2 (primes !! 100)
--    [0,547,-74529,75076]
--    (0.01 secs, 302,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>

Números iguales a potencias de las sumas de sus cifras (OME1999 P2)

El enunciado del problema 2 de la OME (Olimpiada Matemática Española) del 1998 es

Hallar todos los números naturales de 4 cifras, escritos en base 10, que sean iguales al cubo de la suma de sus cifras.

Definir la función

   especiales :: Integer -> Integer -> [Integer]

tal que (especiales a b) es la lista de los números de a cifras que son iguales la suma de sus cifras elevada a b. Por ejemplo,

   especiales 5 3  ==  [17576,19683]
   especiales 6 4  ==  [234256,390625,614656]

Usando la función anterior, calcular las soluciones del problema de la Olimpiada.

Soluciones

import Data.Char (digitToInt)
 
-- 1ª solución
-- ===========
 
especiales :: Integer -> Integer -> [Integer]
especiales a b =
  [n | n <- [10^(a-1)..10^a-1],
       n == (sumaDigitos n)^b]
 
-- (sumaDigitos n) es la suma de los dígitos de n. Por ejemplo,
--    sumaDigitos 2021  ==  5
sumaDigitos :: Integer -> Integer
sumaDigitos = sum . digitos
 
-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 2021  ==  [2,0,2,1]
digitos :: Integer -> [Integer]
digitos x = [read [c] | c <- show x]
 
-- Cálculo de la solución del problema de la Olimpiada:
--    λ> especiales 4 3
--    [4913,5832]
 
-- 2ª solución
-- ===========
 
especiales2 :: Integer -> Integer -> [Integer]
especiales2 c e = [z | z <- map (^e) [a..min (9*c) b], z == (f z)^e]
  where [c', e'] = map fromIntegral [c,e]
        [a , b ] = [ceiling (10**((c'+p)/e')) | p <- [-1,0]]
        f = sum . map (toInteger . digitToInt) . show
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> especiales 6 4
--    [234256,390625,614656]
--    (7.41 secs, 21,808,919,208 bytes)
--    λ> especiales2 6 4
--    [234256,390625,614656]
--    (0.01 secs, 168,072 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áximos de una función recursiva (OME2002 P3)

El enunciado del problema 5 de la OME (Olimpiada Matemática Española) del 2002 es

La función g se define sobre los números naturales y satisface las condiciones:

  • g(1) = 1
  • g(2n) = g(n)
  • g(2n + 1) = g(2n) + 1

Sea n un número natural tal que 1 ≤ n ≤ 2002. Calcula el valor máximo M de g(n). Calcula también cuántos valores de n satisfacen g(n) = M.

Los valores de la función g para n de 1 a 30 son

   1,1,2,1,2,2,3,1,2,2,3,2,3,3,4,1,2,2,3,2,3,3,4,2,3,3,4,3,4,4

Definir la función

   maximoG :: Integer -> Integer

tal que (maximoG m) es el máximo de los valores de g(n) para n en {1, 2,…, m}. Por ejemplo,

   maximoG 30           ==  4
   maximoG (10^(10^5))  ==  332192

Usando la función maximoG, calcular los valores pedidos en el problema.

Soluciones

import Data.List (genericLength, genericTake, group)
import Test.QuickCheck (Property, (==>), quickCheck)
 
-- 1ª solución
-- ===========
 
maximoG :: Integer -> Integer
maximoG m = maximum (genericTake m sucesionG)
 
-- sucesionG es la lista de los valores de g. Por ejemplo,
--    λ> take 30 sucesionG
--    [1,1,2,1,2,2,3,1,2,2,3,2,3,3,4,1,2,2,3,2,3,3,4,2,3,3,4,3,4,4]
sucesionG :: [Integer]
sucesionG = map g [1..]
 
-- (g n) es el valor de g(n).
g :: Integer -> Integer
g 1 = 1
g n | even n    = g (n `div` 2)
    | otherwise = g (n `div` 2) + 1
 
-- 2ª solución
-- ===========
 
-- Observando los siguientes cálculos
--   λ> map maximoG [1..40]
--   [1,1,2,2,2,2,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5]
--   λ> take 10 (map length (group (map maximoG [1..])))
--   [2,4,8,16,32,64,128,256,512,1024]
 
maximoG2 :: Integer -> Integer
maximoG2 m = head [x | x <- [1..], m + 1 < 2^x] - 1
 
-- 3ª solución
-- ===========
 
maximoG3 :: Integer -> Integer
maximoG3 m = genericLength (takeWhile (<m+2) potenciasDeDos) - 1
 
-- potenciasDeDos es la lista de las potencias de dos. Por ejemplo,
--    take 10 potenciasDeDos  ==  [1,2,4,8,16,32,64,128,256,512]
potenciasDeDos :: [Integer]
potenciasDeDos = iterate (*2) 1
 
-- 4ª solución
-- ===========
 
maximoG4 :: Integer -> Integer
maximoG4 m = floor (logBase 2 (fromIntegral (m+1)))
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_maximoG :: Integer -> Property
prop_maximoG m =
  m > 0 ==>
  all (== (maximoG m))
      [ maximoG2 m,
        maximoG3 m,
        maximoG4 m]
 
-- La comprobación es
--    λ> quickCheck prop_maximoG
--    +++ OK, passed 100 tests.
 
-- Nota: Aunque QuickCheck no ha encontrado ningún contraejemplo, la
-- definición maximoG4 que usa números decimales falla para números muy
-- grandes. Por ejemplo,
--    λ> maximoG4 (10^308)
--    1023
--    λ> maximoG4 (10^309)
--    1797693134862315907729305190789024733617976978942306572734300...
--    λ> maximoG3 (10^308)
--    1023
--    λ> maximoG3 (10^309)
--    1026
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> maximoG (10^6)
--    19
--    (8.80 secs, 6,015,772,760 bytes)
--    λ> maximoG2 (10^6)
--    19
--    (0.02 secs, 106,752 bytes)
--    λ> maximoG3 (10^6)
--    19
--    (0.02 secs, 102,592 bytes)
--    λ> maximoG4 (10^6)
--    19
--    (0.01 secs, 98,464 bytes)
--
--    λ> maximoG2 (10^308)
--    1023
--    (0.03 secs, 3,266,096 bytes)
--    λ> maximoG3 (10^308)
--    1023
--    (0.02 secs, 266,856 bytes)
--    λ> maximoG4 (10^308)
--    1023
--    (0.02 secs, 103,176 bytes)
--
--    λ> maximoG2 (10^16789)
--    55771
--    (1.70 secs, 1,201,022,600 bytes)
--    λ> maximoG3 (10^16789)
--    55771
--    (0.24 secs, 214,872,864 bytes)
 
-- Cálculos del problema
-- =====================
 
-- El máximo se calcula como sigue:
--    λ> maximum (take 2002 sucesionG)
--    10
-- Por tanto, el máximo es 10.
 
-- Los valores de n tales que g(n) es el máximo se calcula como sigue:
--    λ> [n | n <- [1..2002], g n == 10]
--    [1023,1535,1791,1919,1983]

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 cuatro consecutivos (OME2006 P5)

El enunciado del problema 5 de la OME (Olimpiada Matemática Española) del 2006 es

Probar que el producto de cuatro naturales consecutivos no puede ser ni cuadrado ni cubo perfecto.

Definir la lista

   productos :: [Integer]

cuyos elementos son los productos de cuatro enteros positivos consecutivos. Por ejemplo,

   λ> take 12 productos
   [24,120,360,840,1680,3024,5040,7920,11880,17160,24024,32760]

Comprobar con QuickCheck que los elementos de la lista productos no son ni cuadrados ni cubos perfectos.

Soluciones

import Test.QuickCheck
 
productos :: [Integer]
productos =
  [product [n..n+3] | n <- [1..]]
 
-- La propiedad es
prop_productos :: Int -> Property
prop_productos n =
  n >= 0 ==>
  not (esCuadrado x) && not (esCubo x)
  where x = productos !! n
 
-- (esCuadrado x) se verifica si x es un cuadrado perfecto. Por
-- ejemplo,
--    esCuadrado 16  ==  True
--    esCuadrado 27  ==  False
esCuadrado :: Integer -> Bool
esCuadrado x = (raizEntera 2 x)^2 == x
 
-- (esCubo x) se verifica si x es un cubo perfecto. Por ejemplo,
--    esCubo 8  ==  True
--    esCubo 9  ==  False
esCubo :: Integer -> Bool
esCubo x = (raizEntera 3 x)^3 == x
 
-- (raizEntera n x) es el mayor entero cuya potencia n-ésima es menor o
-- igual que x. Por ejemplo,
--    raizEntera 2 15  ==  3
--    raizEntera 2 16  ==  4
--    raizEntera 2 17  ==  4
raizEntera :: Int -> Integer -> Integer
raizEntera n 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^n
 
-- La comprobación es
--    λ> quickCheck prop_productos
--    +++ 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>