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

PorJosé A. Alonso 30-abril-20217-mayo-2021

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]

1	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]

1 2	λ> 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))

-- 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 Comentarios

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)

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)

Responder

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

-}

{-# 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

Responder

-- 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)

-- 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)

Responder

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

Soluciones

Nuevas soluciones

3 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico

Soluciones

Nuevas soluciones

Se puede imprimir o compartir con

3 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico