Menu Close

Categoría: Ejercicio

Números automórficos

Un número n es automórfico si los últimos dígitos de su cuadrado son los dígitos de n. Por ejemplo, 5, 6, 76 y 890625 son números automórficos ya que 5² = 25, 6² = 36, 76² = 5776 y 890625² = 793212890625.

Definir la sucesión

   automorficos :: [Integer]

tal que sus elementos son los números automórficos. Por ejemplo,

   λ> take 11 automorficos
   [1,5,6,25,76,376,625,9376,90625,109376,890625]
   λ> automorficos !! 30
   56259918212890625

Soluciones

import Data.List (isSuffixOf, nub, sort)
 
automorficos :: [Integer] 
automorficos = filter esAutomorfico [1..]
 
esAutomorfico :: Integer -> Bool 
esAutomorfico n = show n `isSuffixOf` show (n*n)
 
-- 2ª definición 
-- =============
 
automorficos2 :: [Integer] 
automorficos2 = nub (1 : concat [sort [a,b] |
                                 k <- [1..], 
                                 let a = 5^(2^k) `mod` 10^k, 
                                 let b = 10^k - a + 1])
 
-- Comparación de eficiencia 
-- =========================
 
-- λ> automorficos !! 12 
-- 7109376 
-- (16.64 secs, 6,759,638,824 bytes)
-- λ> automorficos2 !! 12 
-- 7109376 
-- (0.00 secs, 0 bytes)

Referencias

Dígitos en la factorización

El enunciado del problema 652 de Números y algo más es el siguiente

Si factorizamos los factoriales de un número en función de sus divisores primos y sus potencias, ¿Cuál es el menor número n tal que entre los factores primos y los exponentes de estos, n! contiene los dígitos del cero al nueve? Por ejemplo

  • 6! = 2⁴x3²x5¹, le faltan los dígitos 0,6,7,8 y 9
  • 12! = 2¹⁰x3⁵x5²x7¹x11¹, le faltan los dígitos 4,6,8 y 9

Definir la función

   digitosDeFactorizacion :: Integer -> [Integer]

tal que (digitosDeFactorizacion n) es el conjunto de los dígitos que aparecen en la factorización de n. Por ejemplo,

   digitosDeFactorizacion (factorial 6)   ==  [1,2,3,4,5]
   digitosDeFactorizacion (factorial 12)  ==  [0,1,2,3,5,7]

Usando la función anterior, calcular la solución del problema.

Comprobar con QuickCheck que si n es mayor que 100, entonces

   digitosDeFactorizacion (factorial n) == [0..9]

Soluciones

import Data.List (genericLength, group, nub, sort)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck
 
-- 1ª definición
-- =============
 
digitosDeFactorizacion1 :: Integer -> [Integer]
digitosDeFactorizacion1 n =
   sort (nub (concat [digitos x | x <- numerosDeFactorizacion n]))
 
-- (digitos n) es la lista de los digitos del número n. Por ejemplo, 
--    digitos 320274  ==  [3,2,0,2,7,4]
digitos :: Integer -> [Integer]
digitos n = [read [x] | x <- show n]
 
-- (numerosDeFactorizacion n) es el conjunto de los números en la
-- factorización de n. Por ejemplo,
--    numerosDeFactorizacion 60  ==  [1,2,3,5]
numerosDeFactorizacion :: Integer -> [Integer]
numerosDeFactorizacion n = 
   sort (nub (aux (factorizacion n)))
   where aux [] = []
         aux ((x,y):zs) = x : y : aux zs
 
-- (factorización n) es la factorización de n. Por ejemplo,
--    factorizacion 300  ==  [(2,2),(3,1),(5,2)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion n = 
    [(head xs, genericLength xs) | xs <- group (factorizacion' n)]
 
-- (factorizacion' n) es la lista de todos los factores primos de n; es
-- decir, es una lista de números primos cuyo producto es n. Por ejemplo,
--    factorizacion 300  ==  [2,2,3,5,5]
factorizacion' :: Integer -> [Integer]
factorizacion' n | n == 1    = []
                 | otherwise = x : factorizacion' (div n x)
                 where x = menorFactor n
 
-- (menorFactor n) es el menor factor primo de n. Por ejemplo,
--    menorFactor 15  ==  3
menorFactor :: Integer -> Integer
menorFactor n = head [x | x <- [2..], rem n x == 0]
 
-- (factorial n) es el factorial de n. Por ejemplo,
--    factorial 5  ==  120
factorial :: Integer -> Integer
factorial n = product [1..n]
 
-- 2ª definición
-- =============
 
digitosDeFactorizacion2 :: Integer -> [Integer]
digitosDeFactorizacion2 n =
   sort (nub (concat [digitos x | x <- numerosDeFactorizacion2 n]))
 
-- (numerosDeFactorizacion2 n) es el conjunto de los números en la
-- factorización de n. Por ejemplo,
--    numerosDeFactorizacion2 60  ==  [1,2,3,5]
numerosDeFactorizacion2 :: Integer -> [Integer]
numerosDeFactorizacion2 n = 
    sort (nub (aux (factorizacion2 n)))
    where aux xs = concat [[a,b] | (a,b) <- xs]
 
-- (factorización2 n) es la factorización de n. Por ejemplo,
--    factorizacion2 300  ==  [(2,2),(3,1),(5,2)]
factorizacion2 :: Integer -> [(Integer,Integer)]
factorizacion2 n =
    [(head xs, genericLength xs) | xs <- group (primeFactors n)]
 
-- 3ª definición
-- =============
 
digitosDeFactorizacion3 :: Integer -> [Integer]
digitosDeFactorizacion3 n =
    sort (nub (concat [digitos x | x <- aux (group (primeFactors n))]))
    where aux  []            = []
          aux (ys@(y:_):xss) = y : genericLength ys : aux xss
 
-- Definición
-- ==========
 
digitosDeFactorizacion :: Integer -> [Integer]
digitosDeFactorizacion = digitosDeFactorizacion3
 
-- Solución
-- ========
 
-- Para calcular la solución, se define la constante
solucion :: Integer
solucion = 
    head [n | n <- [1..], digitosDeFactorizacion (factorial n) == [0..9]]
 
-- El cálculo de la solución es
--    ghci> solucion2
--    49
 
-- Propiedad
-- =========
 
-- La propiedad es
prop_completa :: Integer -> Bool
prop_completa n =
    digitosDeFactorizacion (factorial n1) == [0..9]
    where n1 = 101 + abs n
 
-- La comprobación es
--    λ> quickCheck prop_completa
--    +++ OK, passed 100 tests.

La solución en Maxima

/* digitos(n) es la lista de los digitos del número n. Por ejemplo, 
      digitos (320274) == [3,2,0,2,7,4]
*/      
digitos (n) := charlist (string (n))$
 
digitosDeFactorizacion (n) :=
   unique (apply (append, map (digitos, apply (append, ifactors (n))))) $
 
solucion () := block ([n:1],
  while length (digitosDeFactorizacion (n!)) < 10 do
     n : n+1,
  n)$   
 
/*
   (%i5) digitosDeFactorizacion (6!);
   (%o5) [1, 2, 3, 4, 5]
 
   (%i6) solucion ();
   (%o6) 49
*/

Diagonales de matrices como listas

Las matrices se pueden representar como listas de listas de la misma longitud, donde cada uno de sus elementos representa una fila de la matriz.

Definir la función

   diagonal :: [[a]] -> [a]

tal que (diagonal xss) es la diagonal de la matriz xss. Por ejemplo,

   diagonal [[3,5,2],[4,7,1],[6,9,0]]           ==  [3,7,0]
   diagonal [[3,5],[4,7],[6,9]]                 ==  [3,7]
   diagonal [[3,5,2],[4,7,1]]                   ==  [3,7]
   sum (diagonal (replicate 20000 [1..20000]))  ==  200010000

Soluciones

import Data.Array  ((!), listArray)
import Data.Matrix (fromLists, getDiag)
import Data.Vector (toList)
 
-- 1ª definición (por recursión):
diagonal1 :: [[a]] -> [a]
diagonal1 ((x:_):xss) = x : diagonal1 [tail xs | xs <- xss]
diagonal1 _           = []
 
-- 2ª definición (por comprensión):
diagonal2 :: [[a]] -> [a]
diagonal2 xss = [xs!!k | (xs,k) <- zip xss [0..n]]
    where n = length (head xss) - 1
 
-- 3ª definición (con Data.Matrix)
diagonal3 :: [[a]] -> [a]
diagonal3 = toList . getDiag . fromLists
 
-- 4ª definición (con Data.Array)
diagonal4 :: [[a]] -> [a]
diagonal4 xss = [p!(i,i) | i <- [1..k]] 
    where m = length xss
          n = length (head xss)
          k = min m n
          p = listArray ((1,1),(m,n)) (concat xss)
 
-- Comparación de eficiencia
--    λ> let n = 3000 in sum (diagonal1 (replicate n [1..n]))
--    4501500
--    (2.08 secs, 754,089,992 bytes)
--    λ> let n = 3000 in sum (diagonal2 (replicate n [1..n]))
--    4501500
--    (0.06 secs, 0 bytes)
--    λ> let n = 3000 in sum (diagonal3 (replicate n [1..n]))
--    4501500
--    (1.22 secs, 1,040,787,360 bytes)
--    λ> let n = 3000 in sum (diagonal4 (replicate n [1..n]))
--    4501500
--    (0.96 secs, 624,463,632 bytes)

Solución con Maxima

diagonal (xss) := block ([A],
  A : apply (matrix, xss),
  [m,n] : matrix_size (A),
  k : min (m,n),
  makelist (A[i,i],i,k))$

La sucesión de Thue-Morse

La serie de Thue-Morse comienza con el término [0] y sus siguientes términos se construyen añadiéndole al anterior su complementario. Los primeros términos de la serie son

   [0]
   [0,1]
   [0,1,1,0]
   [0,1,1,0,1,0,0,1]
   [0,1,1,0,1,0,0,1,1,0,0,1,0,1,1,0]

De esta forma se va formando una sucesión

   0,1,1,0,1,0,0,1,1,0,0,1,0,1,1,0,...

que se conoce como la sucesión de Thue-Morse.

Definir la sucesión

   sucThueMorse :: [Int]

cuyos elementos son los de la sucesión de Thue-Morse. Por ejemplo,

   λ> take 30 sucThueMorse
   [0,1,1,0,1,0,0,1,1,0,0,1,0,1,1,0,1,0,0,1,0,1,1,0,0,1,1,0,1,0]
   λ> map (sucThueMorse4 !!) [1234567..1234596] 
   [1,1,0,0,1,0,1,1,0,1,0,0,1,0,1,1,0,0,1,1,0,1,0,0,1,1,0,0,1,0]
   λ> map (sucThueMorse4 !!) [4000000..4000030] 
   [1,0,0,1,0,1,1,0,0,1,1,0,1,0,0,1,0,1,1,0,1,0,0,1,1,0,0,1,0,1,1]

Comprobar con QuickCheck que si s(n) representa el término n-ésimo de la sucesión de Thue-Morse, entonces

   s(2n)   = s(n)
   s(2n+1) = 1 - s(n)

Soluciones

import Test.QuickCheck
 
-- 1ª definición (basada en la serie de Thue-Morse)
-- ================================================
 
sucThueMorse1 :: [Int]
sucThueMorse1 = map termSucThueMorse1 [0..]
 
-- (termSucThueMorse1 n) es el n-ésimo término de la sucesión de
-- Thue-Morse. Por ejemplo, 
--    termSucThueMorse1 0  ==  0
--    termSucThueMorse1 1  ==  1
--    termSucThueMorse1 2  ==  1
--    termSucThueMorse1 3  ==  0
--    termSucThueMorse1 4  ==  1
termSucThueMorse1 :: Int -> Int
termSucThueMorse1 0 = 0
termSucThueMorse1 n = 
    (serieThueMorse !! k) !! n
    where k = 1 + floor (logBase 2 (fromIntegral n))
 
-- serieThueMorse es la lista cuyos elementos son los términos de la
-- serie de Thue-Morse. Por ejemplo, 
--    λ> take 4 serieThueMorse3
--    [[0],[0,1],[0,1,1,0],[0,1,1,0,1,0,0,1]]
serieThueMorse :: [[Int]]
serieThueMorse = iterate paso [0]
    where paso xs = xs ++ map (1-) xs
 
-- Comprobación de la propiedad
-- ============================
 
-- La propiedad es
prop_termSucThueMorse :: Int -> Property
prop_termSucThueMorse n =
    n > 0 ==>
      sucThueMorse1 !! (2*n)   == sn &&
      sucThueMorse1 !! (2*n+1) == 1 - sn 
    where sn = sucThueMorse1 !! n
 
-- La comprobación es
--    λ> quickCheck prop_termSucThueMorse
--    +++ OK, passed 100 tests.
 
-- 2ª definición (basada en la propiedad anterior)
-- ===============================================
 
sucThueMorse2 :: [Int]
sucThueMorse2 = map termSucThueMorse2 [0..]
 
-- (termSucThueMorse2 n) es el n-ésimo término de la sucesión de
-- Thue-Morse. Por ejemplo, 
--    termSucThueMorse2 0  ==  0
--    termSucThueMorse2 1  ==  1
--    termSucThueMorse2 2  ==  1
--    termSucThueMorse2 3  ==  0
--    termSucThueMorse2 4  ==  1
termSucThueMorse2 :: Int -> Int
termSucThueMorse2 0 = 0
termSucThueMorse2 n 
    | even n    = termSucThueMorse2 (n `div` 2)
    | otherwise = 1 - termSucThueMorse2 (n `div` 2)
 
-- 3ª definición
-- =============
 
sucThueMorse3 :: [Int]
sucThueMorse3 = 
   0 : intercala (map (1-) sucThueMorse3) (tail sucThueMorse3)
 
-- (intercala xs ys) es la lista obtenida intercalando los elementos de
-- las listas infinitas xs e ys. Por ejemplo, 
--    take 10 (intercala [1,5..] [2,4..])  ==  [1,2,5,4,9,6,13,8,17,10]
intercala :: [a] -> [a] -> [a]
intercala (x:xs) ys = x : intercala ys xs 
 
-- 4ª definición
-- =============
 
sucThueMorse4 :: [Int]
sucThueMorse4 = 0 : aux [1]
    where aux xs = xs ++ aux (xs ++ map (1-) xs) 
 
-- 5ª definición
-- =============
 
sucThueMorse5 :: [Int]
sucThueMorse5 = 0 : 1 : aux (tail sucThueMorse5) 
    where aux = (\(x:xs) -> x : (1 - x) : aux xs)
 
-- Comparación de eficiencia
-- =========================
 
--    λ> sucThueMorse1 !! 2000000
--    1
--    (1.78 secs, 620,335,144 bytes)
--    λ> sucThueMorse2 !! 2000000
--    1
--    (0.34 secs, 197,790,760 bytes)
--    λ> sucThueMorse3 !! 2000000
--    1
--    (1.70 secs, 332,015,856 bytes)
--    λ> sucThueMorse4 !! 2000000
--    1
--    (0.17 secs, 0 bytes)
--    λ> sucThueMorse5 !! 2000000
--    1
--    (1.74 secs, 319,026,688 bytes)

Referencias

Potencias perfectas

Un número natural n es una potencia perfecta si existen dos números naturales m > 1 y k > 1 tales que n = m^k. Las primeras potencias perfectas son

   4 = 2², 8 = 2³, 9 = 3², 16 = 2⁴, 25 = 5², 27 = 3³, 32 = 2⁵, 
   36 = 6², 49 = 7², 64 = 2⁶, ...

Definir la sucesión

   potenciasPerfectas :: [Integer]

cuyos términos son las potencias perfectas. Por ejemplo,

   take 10 potenciasPerfectas  ==  [4,8,9,16,25,27,32,36,49,64]
   potenciasPerfectas !! 100   ==  6724

Definir el procedimiento

   grafica :: Int -> IO ()

tal que (grafica n) es la representación gráfica de las n primeras potencias perfectas. Por ejemplo, para (grafica 30) dibuja

Soluciones

import Data.List (group)
import Data.Numbers.Primes (primeFactors)
import Graphics.Gnuplot.Simple
 
-- 1ª definición
-- =============
 
potenciasPerfectas1 :: [Integer]
potenciasPerfectas1 = filter esPotenciaPerfecta [4..]
 
-- (esPotenciaPerfecta x) se verifica si x es una potencia perfecta. Por
-- ejemplo, 
--    esPotenciaPerfecta 36  ==  True
--    esPotenciaPerfecta 72  ==  False
esPotenciaPerfecta :: Integer -> Bool
esPotenciaPerfecta = not . null. potenciasPerfectasDe 
 
-- (potenciasPerfectasDe x) es la lista de pares (a,b) tales que 
-- x = a^b. Por ejemplo,
--    potenciasPerfectasDe 64  ==  [(2,6),(4,3),(8,2)]
--    potenciasPerfectasDe 72  ==  []
potenciasPerfectasDe :: Integer -> [(Integer,Integer)]
potenciasPerfectasDe n = 
    [(m,k) | m <- takeWhile (\x -> x*x <= n) [2..]
           , k <- takeWhile (\x -> m^x <= n) [2..]
           , m^k == n]
 
-- 2ª solución
-- ===========
 
potenciasPerfectas2 :: [Integer]
potenciasPerfectas2 = [x | x <- [4..], esPotenciaPerfecta2 x]
 
-- (esPotenciaPerfecta2 x) se verifica si x es una potencia perfecta. Por
-- ejemplo, 
--    esPotenciaPerfecta2 36  ==  True
--    esPotenciaPerfecta2 72  ==  False
esPotenciaPerfecta2 :: Integer -> Bool
esPotenciaPerfecta2 x = mcd (exponentes x) > 1
 
-- (exponentes x) es la lista de los exponentes de l factorización prima
-- de x. Por ejemplos,
--    exponentes 36  ==  [2,2]
--    exponentes 72  ==  [3,2]
exponentes :: Integer -> [Int]
exponentes x = [length ys | ys <- group (primeFactors x)] 
 
-- (mcd xs) es el máximo común divisor de la lista xs. Por ejemplo,
--    mcd [4,6,10]  ==  2
--    mcd [4,5,10]  ==  1
mcd :: [Int] -> Int
mcd = foldl1 gcd
 
-- 3ª definición
-- =============
 
potenciasPerfectas3 :: [Integer]
potenciasPerfectas3 = mezclaTodas potencias
 
-- potencias es la lista las listas de potencias de todos los números
-- mayores que 1 con exponentes mayores que 1. Por ejemplo,
--    λ> map (take 3) (take 4 potencias)
--    [[4,8,16],[9,27,81],[16,64,256],[25,125,625]]
potencias:: [[Integer]]
potencias = [[n^k | k <- [2..]] | n <- [2..]]
 
-- (mezclaTodas xss) es la mezcla ordenada sin repeticiones de las
-- listas ordenadas xss. Por ejemplo,
--    take 7 (mezclaTodas potencias)  ==  [4,8,9,16,25,27,32]
mezclaTodas :: Ord a => [[a]] -> [a]
mezclaTodas = foldr1 xmezcla
    where xmezcla (x:xs) ys = x : mezcla xs ys
 
-- (mezcla xs ys) es la mezcla ordenada sin repeticiones de las
-- listas ordenadas xs e ys. Por ejemplo,
--    take 7 (mezcla [2,5..] [4,6..])  ==  [2,4,5,6,8,10,11]
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
 
-- Comparación de eficiencia
-- =========================
 
--    ghci> potenciasPerfectas1 !! 100
--    6724
--    (3.39 secs, 692758212 bytes)
--    ghci> potenciasPerfectas2 !! 100
--    6724
--    (0.29 secs, 105,459,200 bytes)
--    ghci> potenciasPerfectas3 !! 100
--    6724
--    (0.01 secs, 1582436 bytes)
 
-- En lo que sigue se usa la 3ª definición
potenciasPerfectas :: [Integer]
potenciasPerfectas = potenciasPerfectas3
 
-- Representación gráfica
-- ======================
 
grafica :: Int -> IO ()
grafica n = 
    plotList [Key Nothing] (take n potenciasPerfectas)