Menu Close

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>

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

  1. Joaquín Infante Rodríguez
    import Data.List
    import Data.Numbers.Primes
     
    potenciaSumaDigitos :: [Integer]
    potenciaSumaDigitos = [0..9]++[x | x<-[10..], esPotenciaSumaDigitos x]
     
    esPotenciaSumaDigitos :: Integer -> Bool
    esPotenciaSumaDigitos n | s==1            = False
                            | isPrime n       = False
                            | esPotencia s n  = True
                            | otherwise       = False
                      where s  = sum [read [x] | x<-show n]
     
     
    esPotencia :: Integer -> Integer -> Bool
    esPotencia x y = aux (primeFactors x) (primeFactors y)
              where aux xs ys | lxs == lys && xs == ys = True
                              | lxs <  lys             = (ampliacion xs ys == ys)
                              | otherwise              = False
                     where lxs = genericLength xs
                           lys = genericLength ys
                           ampliacion xs ys  = sort $concat (replicate d xs)
                             where   d = div (genericLength ys) (genericLength xs)
  2. j0sejuan

    Más o menos como en el anterior pero ahora usando aritmética real para no perder precisión con números grandes.

    {-# LANGUAGE DataKinds #-}
    import System.Environment
    import Data.List
    import Data.Char
    import Data.CReal
     
    -- Operación con reales, la precisión de salida no importa (Integer)
    type Re = CReal 1
     
    -- Tenemos la relación:
    --
    --      u             u
    -- n =  ∑ 10^k Dk = ( ∑ Dk )^p
    --     k=1           k=1
    --
    -- con m la suma de los dígitos.
    --
     
    -- Dados u y p las cotas a <= m <= b
    u2m :: Integer -> Integer -> (Integer, Integer)
    u2m u p = let u'   = fromInteger u :: Re
                  p'   = fromInteger p :: Re
                  minM = ceiling $ 10**((u' - 1) / p')
                  maxM = min (9 * u) (floor $ (10**u' - 1)**(1 / p'))
              in  (minM, maxM)
     
    -- Dado u la cota p <= z
    maxPfromU u = floor $ (fromInteger u :: Re) / logBase 10 2
     
    -- Dado u, todos los (p,(a,b)) candidatos
    u2mp :: Integer -> [(Integer,(Integer, Integer))]
    u2mp u = [(p, (a, b)) | p <- [2 .. maxPfromU u], let (a, b) = u2m u p, a <= b]
     
    -- Dado n la suma m
    n2m = toInteger . sum . map digitToInt . show
     
    -- Dado u, sus potencias perfectas de la suma de sus dígitos
    potenciasU :: Integer -> [Integer]
    potenciasU u = sort [mp | (p, (a, b)) <- u2mp u, m <- [a .. b], let mp = m^p, n2m mp == m]
     
    -- La lista solicitada
    potenciaSumaDigitos :: [Integer]
    potenciaSumaDigitos = [0..9] ++ concatMap potenciasU [2..]
     
    -- Dado n calcula m y p
    extract :: Integer -> (Integer, Integer)
    extract n = let m = n2m n
                    u = (fromIntegral . length . show) n :: Re
                    p = round $ u / logBase 10 (fromInteger m)
                in  (m, p)
     
    -- Dado n verifica que cumple
    verify :: Integer -> Bool
    verify n = let (m, p) = extract n
               in  n == m^p
     
    -- Por compilar
    main = do
      n <- ((potenciaSumaDigitos!!) . read . head) <$> getArgs
      if not (verify n)
        then putStrLn "Bad value!"
        else print n
     
    {-
     
    -- las primeras 201 potencias
    *Main> potenciaSumaDigitos!!200
    608426270054842929256063688447931973737861223448671189171192111878636288818561306470655836164951324462890625
    (17.40 secs, 17,262,703,432 bytes)
     
    -- las primeras 401 potencias
    $ time -f '%E %Mk' ./copotencias 400
    3307140413845674549131850189060014741742227359634494352028344087896163443904746478719663165229614144976046487140048841884493464568106050489935547124915203216132444373570261670834299897901622403099143264704564368081191734754515179952144763379164399930972004351937353875456
    0:19.03 7292k
     
    -}
  3. Rubén Muñoz Mkrtchian
    -- Vamos a definir la función potenciaSumaDigitos empleando la función
    -- especiales de otro ejercicio anterior. Para facilitar el cálculo, veamos
    -- que si b > a > 1, entonces especiales a b es la lista vacía.
     
    especiales :: Integer -> Integer -> [Integer]
    especiales a b = map fst (filter p lista)
      where p (a,b) = sum [read [x] | x <- show a] == b
            lista = takeWhile f [(n,x) | x <- [1..], let n = x^b, n >= 10^(a-1)]
            f (n,_) = n < 10^a
     
    prop :: Integer -> Integer -> Property
    prop a b = m > n ==> null (especiales n m)
      where n = abs a + 2
            m = abs b + 2
     
    -- La comprobación es:
    -- λ> quickCheck prop
    -- +++ OK, passed 100 tests.
     
    potenciaSumaDigitos :: [Integer]
    potenciaSumaDigitos = [0..9] ++
      concat [especiales a b | a <- [2..], b <- [a,a-1..2]]
     
    -- Nota:
    -- ====
     
    -- La función no es muy eficiente. Calcula los 17 primeros términos sin
    -- problemas pero necesita bastante tiempo y espacio si calculamos los 30
    -- primeros términos. Mejorando la eficiencia de la función especiales
    -- mejoraríamos significativamente la de la función potenciaSumaDigitos.
     
    -- λ> take 30 potenciaSumaDigitos
    -- [0,1,2,3,4,5,6,7,8,9,81,512,2401,4913,5832,17576,19683,234256,390625,614656,
    -- 1679616,34012224,17210368,52521875,60466176,612220032,205962976,8303765625,
    -- 10460353203,27512614111]
    -- (1.79 secs, 4,220,157,792 bytes)

Leave a Reply

Este sitio usa Akismet para reducir el spam. Aprende cómo se procesan los datos de tus comentarios.