Menu Close

Etiqueta: read

Número como suma de sus dígitos

El número 23 se puede escribir de 4 formas como suma de sus dígitos

   2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 3
   2 + 2 + 2 + 2 + 2 + 2 + 2 + 3 + 3 + 3
   2 + 2 + 2 + 2 + 3 + 3 + 3 + 3 + 3
   2 + 3 + 3 + 3 + 3 + 3 + 3 + 3

La de menor número de sumando es la última, que tiene 8 sumandos.

Definir las funciones

   minimoSumandosDigitos        :: Integer -> Integer
   graficaMinimoSumandosDigitos :: Integer -> IO ()

tales que

  • (minimoSumandosDigitos n) es el menor número de dígitos de n cuya suma es n. Por ejemplo,
     minimoSumandosDigitos 23    ==  8
     minimoSumandosDigitos 232   ==  78
     minimoSumandosDigitos 2323  ==  775
     map minimoSumandosDigitos [10..20] == [10,11,6,5,5,3,6,5,4,3,10]
  • (graficaMinimoSumandosDigitos n) dibuja la gráfica de (minimoSumandosDigitos k) par los k primeros números naturales. Por ejemplo, (graficaMinimoSumandosDigitos 300) dibuja

Soluciones

import Test.QuickCheck
import Graphics.Gnuplot.Simple
import Data.List (nub, genericLength, sort)
import Data.Array (array, (!))
 
minimoSumandosDigitos :: Integer -> Integer
minimoSumandosDigitos n =
  minimoSumandos (digitos n) n
 
-- (digitos n) es el conjunto de los dígitos no nulos de n. Por ejemplo,
--    digitos 2032  ==  [2,3]
digitos :: Integer -> [Integer]
digitos n =
  nub [read [c] | c <- show n, c /= '0']
 
-- (minimoSumandos xs n) es el menor número de elementos de la lista de
-- enteros positivos xs (con posibles repeticiones) cuya suma es n. Por
-- ejemplo, 
--    minimoSumandos [7,2,4] 11  ==  2
minimoSumandos :: [Integer] -> Integer -> Integer
minimoSumandos xs n =
  minimum (map genericLength (sumas xs n))
 
-- (sumas xs n) es la lista de elementos de la lista de enteros
-- positivos xs (con posibles repeticiones) cuya suma es n. Por ejemplo,  
--    sumas [7,2,4] 11  ==  [[7,2,2],[7,4]]
sumas :: [Integer] -> Integer -> [[Integer]]
sumas [] 0 = [[]]
sumas [] _ = []
sumas (x:xs) n
  | x <= n    = map (x:) (sumas (x:xs) (n-x)) ++ sumas xs n
  | otherwise = sumas xs n
 
-- 2ª solución
-- ===========
 
minimoSumandosDigitos2 :: Integer -> Integer
minimoSumandosDigitos2 n = aux n 
  where
    aux 0 = 0
    aux k = 1 + minimo [aux (k - x) | x <- ds,  k >= x]
    ds    = digitos n
    infinito = 10^100
    minimo xs | null xs   = infinito
              | otherwise = minimum xs
 
-- 3ª solución
-- ===========
 
minimoSumandosDigitos3 :: Integer -> Integer
minimoSumandosDigitos3 n = v ! n
  where
    v   = array (0,n) [(i,f i) | i <- [0..n]]
    f 0 = 0
    f k = 1 + minimo [v ! (k - x) | x <- ds, k >= x]
    ds       = digitos n
    infinito = 10^100
    minimo xs | null xs   = infinito
              | otherwise = minimum xs
 
-- Equivalencia de las definiciones
-- ================================
 
-- La propiedad es
prop_minimoSumandosDigitos :: Positive Integer -> Bool
prop_minimoSumandosDigitos (Positive n) =
  r1 == r2 && r2 == r3
  where
    r1 = minimoSumandosDigitos n
    r2 = minimoSumandosDigitos n
    r3 = minimoSumandosDigitos n
 
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=9}) prop_minimoSumandosDigitos
--    +++ OK, passed 100 tests.
 
-- Definición de graficaMinimoSumandosDigitos
-- ==========================================
 
graficaMinimoSumandosDigitos :: Integer -> IO ()
graficaMinimoSumandosDigitos n =
  plotList [ Key Nothing
           -- , PNG "Numero_como_suma_de_sus_digitos.png"
           ]
           [minimoSumandosDigitos k | k <- [0..n-1]]

Las sucesiones de Loomis

La sucesión de Loomis generada por un número entero positivo x es la sucesión cuyos términos se definen por

  • f(0) es x
  • f(n) es la suma de f(n-1) y el producto de los dígitos no nulos de f(n-1)

Los primeros términos de las primeras sucesiones de Loomis son

  • Generada por 1: 1, 2, 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, …
  • Generada por 2: 2, 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, …
  • Generada por 3: 3, 6, 12, 14, 18, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, …
  • Generada por 4: 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, 138, …
  • Generada por 5: 5, 10, 11, 12, 14, 18, 26, 38, 62, 74, 102, 104, 108, 116, 122, …

Se observa que a partir de un término todas coinciden con la generada por 1. Dicho término se llama el punto de convergencia. Por ejemplo,

  • la generada por 2 converge a 2
  • la generada por 3 converge a 26
  • la generada por 4 converge a 4
  • la generada por 5 converge a 26

Definir las siguientes funciones

   sucLoomis           :: Integer -> [Integer]
   convergencia        :: Integer -> Integer
   graficaConvergencia :: [Integer] -> IO ()

tales que

  • (sucLoomis x) es la sucesión de Loomis generada por x. Por ejemplo,
     λ> take 15 (sucLoomis 1)
     [1,2,4,8,16,22,26,38,62,74,102,104,108,116,122]
     λ> take 15 (sucLoomis 2)
     [2,4,8,16,22,26,38,62,74,102,104,108,116,122,126]
     λ> take 15 (sucLoomis 3)
     [3,6,12,14,18,26,38,62,74,102,104,108,116,122,126]
     λ> take 15 (sucLoomis 4)
     [4,8,16,22,26,38,62,74,102,104,108,116,122,126,138]
     λ> take 15 (sucLoomis 5)
     [5,10,11,12,14,18,26,38,62,74,102,104,108,116,122]
     λ> take 15 (sucLoomis 20)
     [20,22,26,38,62,74,102,104,108,116,122,126,138,162,174]
     λ> take 15 (sucLoomis 100)
     [100,101,102,104,108,116,122,126,138,162,174,202,206,218,234]
     λ> sucLoomis 1 !! (2*10^5)
     235180736652
  • (convergencia x) es el término de convergencia de la sucesioń de Loomis generada por x xon la geerada por 1. Por ejemplo,
     convergencia  2      ==  2
     convergencia  3      ==  26
     convergencia  4      ==  4
     convergencia 17      ==  38
     convergencia 19      ==  102
     convergencia 43      ==  162
     convergencia 27      ==  202
     convergencia 58      ==  474
     convergencia 63      ==  150056
     convergencia 81      ==  150056
     convergencia 89      ==  150056
     convergencia (10^12) ==  1000101125092
  • (graficaConvergencia xs) dibuja la gráfica de los términos de convergencia de las sucesiones de Loomis generadas por los elementos de xs. Por ejemplo, (graficaConvergencia ([1..50]) dibuja
    Las_sucesiones_de_Loomis_1
    y graficaConvergencia ([1..148] \ [63,81,89,137]) dibuja
    Las_sucesiones_de_Loomis_2

Soluciones

import Data.List               ((\\))
import Data.Char               (digitToInt)
import Graphics.Gnuplot.Simple (plotList, Attribute (Key, Title, XRange, PNG))
 
-- 1ª definición de sucLoomis
-- ==========================
 
sucLoomis :: Integer -> [Integer]
sucLoomis x = map (loomis x) [0..]
 
loomis :: Integer -> Integer -> Integer
loomis x 0 = x
loomis x n = y + productoDigitosNoNulos y
  where y = loomis x (n-1)
 
productoDigitosNoNulos :: Integer -> Integer
productoDigitosNoNulos = product . digitosNoNulos
 
digitosNoNulos :: Integer -> [Integer]
digitosNoNulos x =
  [read [c] | c <- show x, c /= '0']
 
-- 2ª definición de sucLoomis
-- ==========================
 
sucLoomis2 :: Integer -> [Integer]
sucLoomis2 = iterate siguienteLoomis 
 
siguienteLoomis :: Integer -> Integer
siguienteLoomis y = y + productoDigitosNoNulos y
 
-- 3ª definición de sucLoomis
-- ==========================
 
sucLoomis3 :: Integer -> [Integer]
sucLoomis3 =
  iterate ((+) <*> product .
           map (toInteger . digitToInt) .
           filter (/= '0') . show)
 
-- Comparación de eficiencia
-- =========================
 
--    λ> sucLoomis 1 !! 30000
--    6571272766
--    (2.45 secs, 987,955,944 bytes)
--    λ> sucLoomis2 1 !! 30000
--    6571272766
--    (2.26 secs, 979,543,328 bytes)
--    λ> sucLoomis3 1 !! 30000
--    6571272766
--    (0.31 secs, 88,323,832 bytes)
 
-- 1ª definición de convergencia
-- =============================
 
convergencia1 :: Integer -> Integer
convergencia1 x =
  head (dropWhile noEnSucLoomisDe1 (sucLoomis x))
 
noEnSucLoomisDe1 :: Integer -> Bool
noEnSucLoomisDe1 x = not (pertenece x sucLoomisDe1)
 
sucLoomisDe1 :: [Integer]
sucLoomisDe1 = sucLoomis 1
 
pertenece :: Integer -> [Integer] -> Bool
pertenece x ys =
  x == head (dropWhile (<x) ys)
 
-- 2ª definición de convergencia
-- =============================
 
convergencia2 :: Integer -> Integer
convergencia2 = aux (sucLoomis3 1) . sucLoomis3
 where aux as@(x:xs) bs@(y:ys) | x == y    = x
                               | x < y     = aux xs bs
                               | otherwise = aux as ys
 
-- 3ª definición de convergencia
-- =============================
 
convergencia3 :: Integer -> Integer
convergencia3 = head . interseccion (sucLoomis3 1) . sucLoomis3
 
-- (interseccion xs ys) es la intersección entre las listas ordenadas xs
-- e ys. Por ejemplo,
--    λ> take 10 (interseccion (sucLoomis3 1) (sucLoomis3 2))
--    [2,4,8,16,22,26,38,62,74,102]
interseccion :: Ord a => [a] -> [a] -> [a]
interseccion = aux
  where aux as@(x:xs) bs@(y:ys) = case compare x y of
                                    LT ->     aux xs bs
                                    EQ -> x : aux xs ys
                                    GT ->     aux as ys
        aux _         _         = []                           
 
-- 4ª definición de convergencia
-- =============================
 
convergencia4 :: Integer -> Integer
convergencia4 x = perteneceA (sucLoomis3 x) 1
  where perteneceA (y:ys) n | y == c    = y
                            | otherwise = perteneceA ys c
          where c = head $ dropWhile (< y) $ sucLoomis3 n
 
-- Comparación de eficiencia
-- =========================
 
--    λ> convergencia1 (10^4)
--    150056
--    (2.94 secs, 1,260,809,808 bytes)
--    λ> convergencia2 (10^4)
--    150056
--    (0.03 secs, 700,240 bytes)
--    λ> convergencia3 (10^4)
--    150056
--    (0.03 secs, 1,165,496 bytes)
--    λ> convergencia4 (10^4)
--    150056
--    (0.02 secs, 1,119,648 bytes)
--    
--    λ> convergencia2 (10^12)
--    1000101125092
--    (1.81 secs, 714,901,080 bytes)
--    λ> convergencia3 (10^12)
--    1000101125092
--    (1.92 secs, 744,932,184 bytes)
--    λ> convergencia4 (10^12)
--    1000101125092
--    (1.82 secs, 941,053,328 bytes)
 
-- Definición de graficaConvergencia
-- ==================================
 
graficaConvergencia :: [Integer] -> IO ()
graficaConvergencia xs =
  plotList [ Key Nothing
           , Title "Convergencia de sucesiones de Loomis"
           , XRange (fromIntegral (minimum xs),fromIntegral (maximum xs))
           , PNG "Las_sucesiones_de_Loomis_2.png"
           ]
           [(x,convergencia2 x) | x <- xs]

Conjuntos de primos emparejables

Un conjunto de primos emparejables es un conjunto S de números primos tales que al concatenar cualquier par de elementos de S se obtiene un número primo. Por ejemplo, {3, 7, 109, 673} es un conjunto de primos emparejables ya que sus elementos son primos y las concatenaciones de sus parejas son 37, 3109, 3673, 73, 7109, 7673, 1093, 1097, 109673, 6733, 6737 y 673109 son primos.

Definir la función

   emparejables :: Integer -> Integer -> [[Integer]]

tal que (emparejables n m) es el conjunto de los conjuntos emparejables de n elementos menores que n. Por ejemplo,

   take 5 (emparejables 2   10)  ==  [[3,7]]
   take 5 (emparejables 3   10)  ==  []
   take 5 (emparejables 2  100)  ==  [[3,7],[3,11],[3,17],[3,31],[3,37]]
   take 5 (emparejables 3  100)  ==  [[3,37,67],[7,19,97]]
   take 5 (emparejables 4  100)  ==  []
   take 5 (emparejables 4 1000)  ==  [[3,7,109,673],[23,311,677,827]]

Pandigitales primos

Un número con n dígitos es pandigital si contiene todos los dígitos del 1 a n exactamente una vez. Por ejemplo, 2143 es un pandigital con 4 dígitos y, además, es primo.

Definir la constante

   pandigitalesPrimos :: [Int]

tal que sus elementos son los números pandigitales, ordenados de mayor a menor. Por ejemplo,

   take 3 pandigitalesPrimos       ==  [7652413,7642513,7641253]
   2143 `elem` pandigitalesPrimos  ==  True
   length pandigitalesPrimos       ==  538

Soluciones

import Data.List (permutations, sort)
import Data.Char (intToDigit)
import Data.Numbers.Primes (isPrime, primes)
 
-- 1ª solución
-- ===========
 
pandigitalesPrimos :: [Int]
pandigitalesPrimos =
  concatMap nPandigitalesPrimos [9,8..1]
 
-- (nPandigitalesPrimos n) es la lista de los números pandigitales con n
-- dígitos, ordenada de mayor a menor. Por ejemplo,
--    nPandigitalesPrimos 4  ==  [4231,2341,2143,1423]
--    nPandigitalesPrimos 5  ==  []
nPandigitalesPrimos1 :: Int -> [Int]
nPandigitalesPrimos1 n = filter isPrime (pandigitales n)
 
-- Nota. La definición anterior se puede simplificar, ya que la suma de
-- los números de 1 a n es divisible por 3, entonces los números
-- pandigitales con n dígitos también lo son y, por tanto, no son primos.
nPandigitalesPrimos2 :: Int -> [Int]
nPandigitalesPrimos2 n 
  | sum [1..n] `mod` 3 == 0 = []
  | otherwise               = filter isPrime (pandigitales n)
 
-- Nota. La definición anterior se puede simplificar, ya que
--    ghci> [n | n <- [1..9], sum [1..n] `mod` 3 /= 0]
--    [1,4,7]
nPandigitalesPrimos :: Int -> [Int]
nPandigitalesPrimos n 
  | n `elem` [4,7] = filter isPrime (pandigitales n)
  | otherwise      = []
 
-- (pandigitales n) es la lista de los números pandigitales de n dígitos
-- ordenada de mayor a menor. Por ejemplo,
--    pandigitales 3  ==  [321,312,231,213,132,123]
pandigitales :: Int -> [Int]
pandigitales n = 
  reverse $ sort $ map digitosAentero (permutations [1..n])
 
-- (digitosAentero ns) es el número cuyos dígitos son ns. Por ejemplo,
--    digitosAentero [3,2,5]  ==  325
digitosAentero :: [Int] -> Int
digitosAentero = read . map intToDigit

Mayor capicúa producto de dos números de n cifras

Un capicúa es un número que es igual leído de izquierda a derecha que de derecha a izquierda.

Definir la función

   mayorCapicuaP :: Integer -> Integer

tal que (mayorCapicuaP n) es el mayor capicúa que es el producto de dos números de n cifras. Por ejemplo,

   mayorCapicuaP 2  ==  9009
   mayorCapicuaP 3  ==  906609
   mayorCapicuaP 4  ==  99000099
   mayorCapicuaP 5  ==  9966006699
   mayorCapicuaP 6  ==  999000000999
   mayorCapicuaP 7  ==  99956644665999

Soluciones

-- 1ª solución
-- ===========
 
mayorCapicuaP1 :: Integer -> Integer
mayorCapicuaP1 n = head (capicuasP n)
 
-- (capicuasP n) es la lista de las capicúas de 2*n cifras que
-- pueden escribirse como productos de dos números de n cifras. Por
-- ejemplo, Por ejemplo,
--    ghci> capicuasP 2
--    [9009,8448,8118,8008,7227,7007,6776,6336,6006,5775,5445,5335,
--     5225,5115,5005,4884,4774,4664,4554,4224,4004,3773,3663,3003,
--     2992,2772,2552,2442,2332,2112,2002,1881,1771,1551,1221,1001]
capicuasP n = [x | x <- capicuas n,
                        not (null (productosDosNumerosCifras n x))]
 
-- (capicuas n) es la lista de las capicúas de 2*n cifras de mayor a
-- menor. Por ejemplo, 
--    capicuas 1           ==  [99,88,77,66,55,44,33,22,11]
--    take 7 (capicuas 2)  ==  [9999,9889,9779,9669,9559,9449,9339]
capicuas :: Integer -> [Integer]
capicuas n = [capicua x | x <- numerosCifras n]
 
-- (numerosCifras n) es la lista de los números de n cifras de mayor a
-- menor. Por ejemplo,
--    numerosCifras 1           ==  [9,8,7,6,5,4,3,2,1]
--    take 7 (numerosCifras 2)  ==  [99,98,97,96,95,94,93]
--    take 7 (numerosCifras 3)  ==  [999,998,997,996,995,994,993]
numerosCifras :: Integer -> [Integer]
numerosCifras n = [a,a-1..b]
  where a = 10^n-1
        b = 10^(n-1) 
 
-- (capicua n) es la capicúa formada añadiendo el inverso de n a
--  continuación de n. Por ejemplo,
--    capicua 93  ==  9339
capicua :: Integer -> Integer
capicua n = read (xs ++ (reverse xs))
  where xs = show n
 
-- (productosDosNumerosCifras n x) es la lista de los números y de n
-- cifras tales que existe un z de n cifras y x es el producto de y por
-- z. Por ejemplo, 
--    productosDosNumerosCifras 2 9009  ==  [99,91]
productosDosNumerosCifras n x = [y | y <- numeros,
                                     mod x y == 0,
                                     div x y `elem` numeros]
  where numeros = numerosCifras n
 
-- 2ª solución
-- ===========
 
mayorCapicuaP2 :: Integer -> Integer
mayorCapicuaP2 n = maximum [x*y | x <- [a,a-1..b],
                                  y <- [a,a-1..b],
                                  esCapicua (x*y)] 
  where a = 10^n-1
        b = 10^(n-1)
 
-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,
--    esCapicua 353  ==  True
--    esCapicua 357  ==  False
esCapicua :: Integer -> Bool
esCapicua n = xs == reverse xs
  where xs = show n
 
-- 3ª solución
-- ===========
 
mayorCapicuaP3 :: Integer -> Integer
mayorCapicuaP3 n = maximum [x*y | (x,y) <- pares a b, 
                                  esCapicua (x*y)] 
  where a = 10^n-1
        b = 10^(n-1)
 
-- (pares a b) es la lista de los pares de números entre a y b de forma
-- que su suma es decreciente. Por ejemplo,
--    pares 9 7  ==  [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]
pares a b = [(x,z-x) | z <- [a1,a1-1..b1],
                       x <- [a,a-1..b],
                       x <= z-x, z-x <= a]
  where a1 = 2*a
        b1 = 2*b
 
-- 4ª solución
-- ===========
 
mayorCapicuaP4 :: Integer -> Integer
mayorCapicuaP4 n = maximum [x | y <- [a..b],
                                z <- [y..b],
                                let x = y * z,
                                let s = show x,
                                s == reverse s]
  where a = 10^(n-1)
        b = 10^n-1
 
-- 5ª solución
-- ===========
 
mayorCapicuaP5 :: Integer -> Integer
mayorCapicuaP5 n = maximum [x*y | (x,y) <- pares2 b a, esCapicua (x*y)]
  where a = 10^(n-1)
        b = 10^n-1
 
-- (pares2 a b) es la lista de los pares de números entre a y b de forma
-- que su suma es decreciente. Por ejemplo,
--    pares2 9 7  ==  [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]
pares2 a b = [(x,y) | x <- [a,a-1..b], y <- [a,a-1..x]]
 
-- 6ª solución
-- ===========
 
mayorCapicuaP6 :: Integer -> Integer
mayorCapicuaP6 n = maximum [x*y | x <- [a..b], 
                                  y <- [x..b] , 
                                  esCapicua (x*y)]
  where a = 10^(n-1)
        b = 10^n-1
 
-- (cifras n) es la lista de las cifras de n en orden inverso. Por
-- ejemplo,  
--    cifras 325  == [5,2,3]
cifras :: Integer -> [Integer]
cifras n 
    | n < 10    = [n]
    | otherwise = (ultima n) : (cifras (quitarUltima n))
 
-- (ultima n) es la última cifra de n. Por ejemplo,
--    ultima 325  ==  5
ultima  :: Integer -> Integer
ultima n =  n - (n `div` 10)*10
 
-- (quitarUltima n) es el número obtenido al quitarle a n su última
-- cifra. Por ejemplo,
--    quitarUltima 325  =>  32 
quitarUltima :: Integer -> Integer
quitarUltima n = (n - (ultima n)) `div` 10
 
-- 7ª solución
-- ===========
 
mayorCapicuaP7 :: Integer -> Integer
mayorCapicuaP7 n = head [x | x <- capicuas n, esFactorizable x n]
 
-- (esFactorizable x n) se verifica si x se puede escribir como producto
-- de dos números de n dígitos. Por ejemplo,
--    esFactorizable 1219 2  ==  True
--    esFactorizable 1217 2  ==  False
esFactorizable x n = aux i x
  where b = 10^n-1
        i = floor (sqrt (fromIntegral x))
        aux i x | i > b          = False
                | x `mod` i == 0 = x `div` i < b 
                | otherwise      = aux (i+1) x
 
-- Comparación de eficiencia
-- =========================
 
--    λ> mayorCapicuaP1 3
--    906609
--    (0.07 secs, 18,248,224 bytes)
--    λ> mayorCapicuaP2 3
--    906609
--    (0.51 secs, 555,695,720 bytes)
--    λ> mayorCapicuaP3 3
--    906609
--    (0.96 secs, 780,794,768 bytes)
--    λ> mayorCapicuaP4 3
--    906609
--    (0.24 secs, 255,445,448 bytes)
--    λ> mayorCapicuaP5 3
--    906609
--    (0.33 secs, 317,304,080 bytes)
--    λ> mayorCapicuaP6 3
--    906609
--    (0.26 secs, 274,987,472 bytes)
--    λ> mayorCapicuaP7 3
--    906609
--    (0.02 secs, 1,807,720 bytes)
--    
--    λ> mayorCapicuaP1 5
--    9966006699
--    (9.90 secs, 6,349,454,544 bytes)
--    λ> mayorCapicuaP7 5
--    9966006699
--    (0.06 secs, 15,958,616 bytes)