Números cubifinitos

PorJosé A. Alonso 15-marzo-201721-enero-2020

El enunciado del problema Números cubifinitos de ¡Acepta el reto! es el siguiente

Se dice que un número es cubifinito cuando al elevar todos sus dígitos al cubo y sumarlos el resultado o bien es 1 o bien es un número cubifinito.

Por ejemplo, el número 1243 es cubifinito, pues al elevar todos sus dígitos al cubo obtenemos 100 que es cubifinito.

Por su parte, el 513 no es cubifinito, pues al elevar al cubo sus dígitos conseguimos el 153 que nunca podrá ser cubifinito, pues la suma de los cubos de sus dígitos vuelve a dar 153.

Definir las funciones

   esCubifinito :: Int -> Bool
   grafica :: Int -> IO ()

1 2	esCubifinito :: Int -> Bool grafica :: Int -> IO ()

tales que

(esCubifinito n) se verifica si n es un número cubifinito. Por ejemplo,

     esCubifinito 1      ==  True
     esCubifinito 10     ==  True
     esCubifinito 1243   ==  True
     esCubifinito 87418  ==  True
     esCubifinito 513    ==  False

esCubifinito 1 == True

esCubifinito 10 == True

esCubifinito 1243 == True

esCubifinito 87418 == True

esCubifinito 513 == False

(grafica n) dibuja la gráfica de la sucesión de los primeros n números cubifinitos. Por ejemplo, al evaluar (grafica 50) se dibuja

Soluciones

import Graphics.Gnuplot.Simple

-- 1ª solución
-- ===========

esCubifinito :: Int -> Bool
esCubifinito n = aux [n]
  where aux (n:ns) | n == 1      = True
                   | n `elem` ns = False
                   | otherwise   = aux (sumaCubosDigitos n : n : ns)

-- (sumaCubosDigitos b) es la suma de los cubos de los dígitos de n. Por
-- ejemplo, 
--    sumaCubosDigitos 513  ==  153
sumaCubosDigitos :: Int -> Int
sumaCubosDigitos = sum . map (^3) . digitos

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 513  ==  [5,1,3]
digitos :: Int -> [Int]
digitos n = [read [c] | c <- show n]

-- 2ª solución
-- ===========

esCubifinito2 :: Int -> Bool
esCubifinito2 n = primerRepetido (orbita n) == 1

-- (orbita n) es la lista cuyo primer elemento es n y los siguientes se
-- obtienen sumando los cubos de los digitos del elemento anterior. Por
-- ejemplo,  
--    take 9 (orbita 2)  ==  [2,8,512,134,92,737,713,371,371]
orbita :: Int -> [Int]
orbita n = iterate sumaCubosDigitos n

-- (primerRepetido xs) es el primer elemento repetido de la lista
--  xs. Por ejemplo, 
--    primerRepetido [3,7,5,7,2]  ==  7
primerRepetido :: Eq a => [a] -> a
primerRepetido xs = aux xs []
  where
    aux (x:xs') ys | x `elem` ys = x
                   | otherwise   = aux xs' (x:ys) 

grafica :: Int -> IO ()
grafica n = 
    plotList [Key Nothing, PNG "Numeros_cubifinitos.png"]
             (zip [1..n] [x | x <- [1..], esCubifinito x])

import Graphics.Gnuplot.Simple

-- 1ª solución

-- ===========

esCubifinito :: Int -> Bool

esCubifinito n = aux [n]

where aux (n:ns) | n == 1 = True

| n `elem` ns = False

| otherwise = aux (sumaCubosDigitos n : n : ns)

-- (sumaCubosDigitos b) es la suma de los cubos de los dígitos de n. Por

-- ejemplo,

-- sumaCubosDigitos 513 == 153

sumaCubosDigitos :: Int -> Int

sumaCubosDigitos = sum . map (^3) . digitos

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,

-- digitos 513 == [5,1,3]

digitos :: Int -> [Int]

digitos n = [read [c] | c <- show n]

-- 2ª solución

-- ===========

esCubifinito2 :: Int -> Bool

esCubifinito2 n = primerRepetido (orbita n) == 1

-- (orbita n) es la lista cuyo primer elemento es n y los siguientes se

-- obtienen sumando los cubos de los digitos del elemento anterior. Por

-- ejemplo,

-- take 9 (orbita 2) == [2,8,512,134,92,737,713,371,371]

orbita :: Int -> [Int]

orbita n = iterate sumaCubosDigitos n

-- (primerRepetido xs) es el primer elemento repetido de la lista

-- xs. Por ejemplo,

-- primerRepetido [3,7,5,7,2] == 7

primerRepetido :: Eq a => [a] -> a

primerRepetido xs = aux xs []

where

aux (x:xs') ys | x `elem` ys = x

| otherwise = aux xs' (x:ys)

grafica :: Int -> IO ()

grafica n =

plotList [Key Nothing, PNG "Numeros_cubifinitos.png"]

(zip [1..n] [x | x <- [1..], esCubifinito x])

14 Comentarios

esCubifinito :: Int -> Bool
esCubifinito x = aux x []
  where aux n xs | n == 1 = True
                 | elem n xs = False
                 | otherwise = aux t (n:xs)
                   where t = sum (map ((^3).read.(:"")) (show n))

grafica2 :: Int -> IO ()
grafica2 n = plotList [Key Nothing] (take 50 [ x | x <- [1..], esCubifinito x])

esCubifinito :: Int -> Bool

esCubifinito x = aux x []

where aux n xs | n == 1 = True

| elem n xs = False

| otherwise = aux t (n:xs)

where t = sum (map ((^3).read.(:"")) (show n))

grafica2 :: Int -> IO ()

grafica2 n = plotList [Key Nothing] (take 50 [ x | x <- [1..], esCubifinito x])

Responder

esCubifinito :: Int -> Bool
esCubifinito n | k == n = False
               | otherwise = k == 1 || esCubifinito k
 where k = sum [x^3 | x <- diguitos n]
       diguitos l = [read [x] | x <- show l]

esCubifinito :: Int -> Bool

esCubifinito n | k == n = False

| otherwise = k == 1 || esCubifinito k

where k = sum [x^3 | x <- diguitos n]

diguitos l = [read [x] | x <- show l]

Responder

migibagar dice:

15-marzo-2017 a las 19:47

La definición es incorrecta. Para n = 4, no llega a ninguna solución.

Responder

esCubifinito :: Int -> Bool
esCubifinito 1 = True
esCubifinito n | (show k) `mismoConjunto` (show n) = False
               | otherwise = esCubifinito k
  where
    k :: Int
    k = sum $ map ((^3) . read . (:"")) $ show n
    mismoConjunto a b = a `subconjunto` b &&
                        b `subconjunto` a
    subconjunto a b = and $ elem <$> a <*> [b]

esCubifinito :: Int -> Bool

esCubifinito 1 = True

esCubifinito n | (show k) `mismoConjunto` (show n) = False

| otherwise = esCubifinito k

where

k :: Int

k = sum $ map ((^3) . read . (:"")) $ show n

mismoConjunto a b = a `subconjunto` b &&

b `subconjunto` a

subconjunto a b = and $ elem <$> a <*> [b]

Responder

eliguivil dice:

15-marzo-2017 a las 10:12

la definición anterior es incorrecta. No contempla la posibilidad de que se generen bucles de más de un número de longitud

Responder

esCubifinito :: Int -> Bool
esCubifinito x | n == 1 || esCubifinito n = True
               | otherwise = False
          where xs = map (^3) (digitos x)
                n = sum xs
                digitos n = [read [d] | d <- show n]

grafica20 :: Int -> IO ()
grafica20 x = plotList [Key Nothing] (take 50 [n | n <- [1..] , esCubifinito n])

esCubifinito :: Int -> Bool

esCubifinito x | n == 1 || esCubifinito n = True

| otherwise = False

where xs = map (^3) (digitos x)

n = sum xs

digitos n = [read [d] | d <- show n]

grafica20 :: Int -> IO ()

grafica20 x = plotList [Key Nothing] (take 50 [n | n <- [1..] , esCubifinito n])

Responder

esCubifinito :: Int -> Bool
esCubifinito n | (sC n) == 1 || esCubifinito (sC n ) = True
               | otherwise = False
  where sC n = sum (map (^3) (d n))
        d n = [read [x] | x <- show n]

grafica :: Int -> IO ()
grafica n = plotList [Key Nothing] (take n [x | x <- [1..], esCubifinito x])

esCubifinito :: Int -> Bool

esCubifinito n | (sC n) == 1 || esCubifinito (sC n ) = True

| otherwise = False

where sC n = sum (map (^3) (d n))

d n = [read [x] | x <- show n]

grafica :: Int -> IO ()

grafica n = plotList [Key Nothing] (take n [x | x <- [1..], esCubifinito x])

Responder

esCubifinito :: Int -> Bool
esCubifinito n | k == n = False
               | otherwise = k == 1 || esCubifinito k
  where k = sum (map (^3) (digitos n))
        digitos h = [read [x] | x <- show h]

esCubifinito :: Int -> Bool

esCubifinito n | k == n = False

| otherwise = k == 1 || esCubifinito k

where k = sum (map (^3) (digitos n))

digitos h = [read [x] | x <- show h]

Responder

esCubifinito :: Int -> Bool
esCubifinito 1 = True
esCubifinito n | n `mod`  3 == 0 = False
               | n `mod`  3 == 2 = False
               | otherwise       = aux [n] (sum [(read [x])^3 | x <- show n])
               where
                aux _ 1 = True
                aux xs n | n `elem` xs = False
                         | otherwise   = aux (n:xs) (sum [(read [x])^3 | x <- show n])

graficaC :: Int -> IO ()
graficaC n = plotList [Key Nothing] ((take n. filter esCubifinito) [1..])

esCubifinito :: Int -> Bool

esCubifinito 1 = True

esCubifinito n | n `mod` 3 == 0 = False

| n `mod` 3 == 2 = False

| otherwise = aux [n] (sum [(read [x])^3 | x <- show n])

where

aux _ 1 = True

aux xs n | n `elem` xs = False

| otherwise = aux (n:xs) (sum [(read [x])^3 | x <- show n])

graficaC :: Int -> IO ()

graficaC n = plotList [Key Nothing] ((take n. filter esCubifinito) [1..])

Responder

Podemos generar en unos pocos segundos una gráfica con el primer millón de cubifinitos.

{-# LANGUAGE TupleSections, LambdaCase, FlexibleContexts #-}
import System.Environment
import Data.Array
import Data.Char
import Data.BitArray
import Data.Array.ST
import Control.Monad.ST
import Data.Maybe
import Graphics.Gnuplot.Simple (plotList, Attribute(PNG, Key))

-- precalculamos las potencias
p3 :: Integral a =>[a]
p3 = (^3) <$> [0..9]

-- reduce un número de acuerdo al procedimiento indicado
reduce :: (Show a, Integral a) =>a ->a
reduce = sum . zipWith (*) p3 . elems . accumArray (+) 0 (0,9) . map ((,1) . digitToInt) . show

-- cálculo directo de cubifinitismo
cubidirecto :: (Show a, Integral a) => a ->Bool
cubidirecto = f [] where f v n = n == 1 || if n `elem` v then False else f (n:v) (reduce n)

-- podríamos ahora calcular los 50 que nos piden, pero si queremos calcular
-- miles de ellos, podemos reducir el coste a O(1) o, si consideramos el
-- coste de `reduce` a O(log10 n), ya que:
--
--    reduce n <= |_ log10 n _| * 729
--
--    => si precalculamos hasta el cubifinito Q, podemos
--       revisar con coste O(log10 n) el cubifinitismo de
--       números menores que 10^(Q/729), por ejemplo,
--       calculando los cubifinitos hasta el 10^6, podemos
--       calcular directamente el cubifinitismo de números
--       hasta el 10^(10^6/729) es decir, números de hasta
--       1371 dígitos.
--

-- precalcula los cubifinitos (mediante criba) hasta cierto número
-- (debe ser sz >= 2188 pues no es `reduce n <= n` hasta n=2000)
precalcula :: Int ->BitArray
precalcula sz = listBitArray (0, sz) $ map fromJust v
  where v = runST $ do
              a <-newArray (0, sz) Nothing :: ST s (STArray s Int (Maybe Bool))
              let set v = mapM_ (\i ->writeArray a i (Just v))
                  q xs n = readArray a n >>= \case
                             Just r ->set r xs >> return r
                             Nothing ->case (n == 1, n `elem` xs) of
                                   (False, False) ->q (n:xs) (reduce n)
                                   (v, _) ->set v (n:xs) >> return v
              mapM_ (q []) [0..sz]
              getElems a

-- si calculamos hasta Q=5000 tendremos coste O(1) hasta 8e10
c5k :: BitArray
c5k = precalcula 5000

-- una consulta mucho más rápida
esCubifinito :: Int ->Bool
esCubifinito n = if n <= (snd . bitArrayBounds) c5k then lookupBit c5k n else esCubifinito (reduce n)


-- el gráfico
grafica :: Int ->FilePath ->IO ()
grafica s file = plotList [PNG file, Key Nothing] $ take s $ filter esCubifinito [0..]

main = getArgs >>= (\[f, x] ->grafica (read x) f)

{-

Ahora podemos generar una gráfica con el primer millón de cubifinitos en pocos segundos:

[josejuan@centella centella]$ stack exec -- ghc -O2 -threaded -rtsopts ../cubifinitos.hs
[1 of 1] Compiling Main             ( ../cubifinitos.hs, ../cubifinitos.o )
Linking ../cubifinitos ...

[josejuan@centella centella]$ time -f "%E, %M" ../cubifinitos ~/tmp/test.png 1000000
0:38.23, 92744


-}

{-# LANGUAGE TupleSections, LambdaCase, FlexibleContexts #-}

import System.Environment

import Data.Array

import Data.Char

import Data.BitArray

import Data.Array.ST

import Control.Monad.ST

import Data.Maybe

import Graphics.Gnuplot.Simple (plotList, Attribute(PNG, Key))

-- precalculamos las potencias

p3 :: Integral a =>[a]

p3 = (^3) <$> [0..9]

-- reduce un número de acuerdo al procedimiento indicado

reduce :: (Show a, Integral a) =>a ->a

reduce = sum . zipWith (*) p3 . elems . accumArray (+) 0 (0,9) . map ((,1) . digitToInt) . show

-- cálculo directo de cubifinitismo

cubidirecto :: (Show a, Integral a) => a ->Bool

cubidirecto = f [] where f v n = n == 1 || if n `elem` v then False else f (n:v) (reduce n)

-- podríamos ahora calcular los 50 que nos piden, pero si queremos calcular

-- miles de ellos, podemos reducir el coste a O(1) o, si consideramos el

-- coste de `reduce` a O(log10 n), ya que:

-- reduce n <= |_ log10 n _| * 729

-- => si precalculamos hasta el cubifinito Q, podemos

-- revisar con coste O(log10 n) el cubifinitismo de

-- números menores que 10^(Q/729), por ejemplo,

-- calculando los cubifinitos hasta el 10^6, podemos

-- calcular directamente el cubifinitismo de números

-- hasta el 10^(10^6/729) es decir, números de hasta

-- 1371 dígitos.

-- precalcula los cubifinitos (mediante criba) hasta cierto número

-- (debe ser sz >= 2188 pues no es `reduce n <= n` hasta n=2000)

precalcula :: Int ->BitArray

precalcula sz = listBitArray (0, sz) $ map fromJust v

where v = runST $ do

a <-newArray (0, sz) Nothing :: ST s (STArray s Int (Maybe Bool))

let set v = mapM_ (\i ->writeArray a i (Just v))

q xs n = readArray a n >>= \case

Just r ->set r xs >> return r

Nothing ->case (n == 1, n `elem` xs) of

(False, False) ->q (n:xs) (reduce n)

(v, _) ->set v (n:xs) >> return v

mapM_ (q []) [0..sz]

getElems a

-- si calculamos hasta Q=5000 tendremos coste O(1) hasta 8e10

c5k :: BitArray

c5k = precalcula 5000

-- una consulta mucho más rápida

esCubifinito :: Int ->Bool

esCubifinito n = if n <= (snd . bitArrayBounds) c5k then lookupBit c5k n else esCubifinito (reduce n)

-- el gráfico

grafica :: Int ->FilePath ->IO ()

grafica s file = plotList [PNG file, Key Nothing] $ take s $ filter esCubifinito [0..]

main = getArgs >>= (\[f, x] ->grafica (read x) f)

Ahora podemos generar una gráfica con el primer millón de cubifinitos en pocos segundos:

[josejuan@centella centella]$ stack exec -- ghc -O2 -threaded -rtsopts ../cubifinitos.hs

[1 of 1] Compiling Main ( ../cubifinitos.hs, ../cubifinitos.o )

Linking ../cubifinitos ...

[josejuan@centella centella]$ time -f "%E, %M" ../cubifinitos ~/tmp/test.png 1000000

0:38.23, 92744

Responder

Si no nos parece suficiente 1 millón, podemos reducir de O(log10 n) a O(1) sin importar ya el número de dígitos; pudiendo calcular (por ejemplo) casi 2 millones en unos 15 segundos (y graficarlos).

{-

podemos enumerar fácilmente la primera reducción de todos los naturales
sólo con ver cómo contamos en base 10 y cómo van "entrando y saliendo" los
dígitos de dicha representación (decimal)

-}

-- equivalente a `map reduce [0..10^n]`
reducciones :: Int ->[Int]
reducciones = e 0
  where e !a  0 = [a]
        e !a !z = let z' = z - 1
                  in  p3 >>= \d ->e (a + d) z'

-- filtra los cubifinitos
cubifinitos :: Int ->[Int]
cubifinitos = map fst . filter (esCubifinito . snd) . zip [0..] . reducciones

{-

[josejuan@centella centella]$ time -f "%E, %M" ../cubifinitos ~/tmp/test2.png 8
0:15.22, 139312

-}

podemos enumerar fácilmente la primera reducción de todos los naturales

sólo con ver cómo contamos en base 10 y cómo van "entrando y saliendo" los

dígitos de dicha representación (decimal)

-- equivalente a `map reduce [0..10^n]`

reducciones :: Int ->[Int]

reducciones = e 0

where e !a 0 = [a]

e !a !z = let z' = z - 1

in p3 >>= \d ->e (a + d) z'

-- filtra los cubifinitos

cubifinitos :: Int ->[Int]

cubifinitos = map fst . filter (esCubifinito . snd) . zip [0..] . reducciones

[josejuan@centella centella]$ time -f "%E, %M" ../cubifinitos ~/tmp/test2.png 8

0:15.22, 139312

Responder

esCubifinito :: Int -> Bool
esCubifinito x | elem 1 xs = True
               | otherwise =  False
               where xs = sR $ iterate (\y -> funxion y) x

grafica :: Int -> IO ()
grafica n = plotList [Key Nothing] (take n [x | x <- [1..], esCubifinito x])

funxion :: Int -> Int
funxion x = sum $ map (^3) (map (digitToInt) (show x))

--Para saber si hay bucle
sR :: [Int] -> [Int]
sR xs | null $ intersect (y xs) (y (drop 20 xs)) = xs
      | otherwise = y xs
        where y = take 20

--Lista de un Cubifinito
cubiList :: Int -> [Int]
cubiList x = x : f x : (tail (cubiList (f x)))
         where f = funxion

esCubifinito :: Int -> Bool

esCubifinito x | elem 1 xs = True

| otherwise = False

where xs = sR $ iterate (\y -> funxion y) x

grafica :: Int -> IO ()

grafica n = plotList [Key Nothing] (take n [x | x <- [1..], esCubifinito x])

funxion :: Int -> Int

funxion x = sum $ map (^3) (map (digitToInt) (show x))

--Para saber si hay bucle

sR :: [Int] -> [Int]

sR xs | null $ intersect (y xs) (y (drop 20 xs)) = xs

| otherwise = y xs

where y = take 20

--Lista de un Cubifinito

cubiList :: Int -> [Int]

cubiList x = x : f x : (tail (cubiList (f x)))

where f = funxion

Responder

g :: [Int]-> [Int]
g xs = [  x*x*x | x<-xs ]
digit n= [read (x:""):: Int | x<-show n]

f n = (sum.g.digit)n

norep  [] _ = True
norep (y:ys)x | x/=y = norep (ys) x
              | otherwise = False

            
esCubifinito x | norep  (take 100( iterate f x)) 1 == False = True
              | otherwise = False

g :: [Int]-> [Int]

g xs = [ x*x*x | x<-xs ]

digit n= [read (x:""):: Int | x<-show n]

f n = (sum.g.digit)n

norep [] _ = True

norep (y:ys)x | x/=y = norep (ys) x

| otherwise = False

esCubifinito x | norep (take 100( iterate f x)) 1 == False = True

| otherwise = False

Responder

g :: [Int]-> [Int]
g xs = [  x*x*x | x<-xs ]

digit n= [read (x:""):: Int | x<-show n]

f n = (sum.g.digit)n

norep  [] _ = True
norep (y:ys)x | x/=y = norep (ys) x
              | otherwise = False

esCubifinito x | norep  (take 100( iterate f x)) 1 == False = True
               | otherwise = False

suc = [x | x <- [1..], esCubifinito x]

grafica :: Int -> IO ()
grafica n = plotList [] (take n suc)

g :: [Int]-> [Int]

g xs = [ x*x*x | x<-xs ]

digit n= [read (x:""):: Int | x<-show n]

f n = (sum.g.digit)n

norep [] _ = True

norep (y:ys)x | x/=y = norep (ys) x

| otherwise = False

esCubifinito x | norep (take 100( iterate f x)) 1 == False = True

| otherwise = False

suc = [x | x <- [1..], esCubifinito x]

grafica :: Int -> IO ()

grafica n = plotList [] (take n suc)

Responder

Números cubifinitos

Soluciones

14 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico

Soluciones

Se puede imprimir o compartir con

14 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico