show

Número de dígitos del factorial

PorJosé A. Alonso 23-marzo-201731-marzo-2017

Definir las funciones

   nDigitosFact :: Integer -> Integer
   graficas     :: [Integer] -> IO ()

1 2	nDigitosFact :: Integer -> Integer graficas :: [Integer] -> IO ()

tales que

(nDigitosFact n) es el número de dígitos de n!. Por ejemplo,

     nDigitosFact 0        ==  1
     nDigitosFact 4        ==  2
     nDigitosFact 5        ==  3
     nDigitosFact 10       ==  7
     nDigitosFact 100      ==  158
     nDigitosFact 1000     ==  2568
     nDigitosFact 10000    ==  35660
     nDigitosFact 100000   ==  456574
     nDigitosFact 1000000  ==  5565709

nDigitosFact 0 == 1

nDigitosFact 4 == 2

nDigitosFact 5 == 3

nDigitosFact 10 == 7

nDigitosFact 100 == 158

nDigitosFact 1000 == 2568

nDigitosFact 10000 == 35660

nDigitosFact 100000 == 456574

nDigitosFact 1000000 == 5565709

(graficas xs) dibuja las gráficas de los números de dígitos del factorial de k (para k en xs) y de la recta y = 5.5 x. Por ejemplo, (graficas [0,500..10^6]) dibuja

Nota: Este ejercicio está basado en el problema How many digits? de Kattis en donde se impone la restricción de calcular, en menos de 1 segundo, el número de dígitos de los factoriales de 10.000 números del rango [0,1.000.000].

Se puede simular como sigue

   λ> import System.Random 
   λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]
   λ> maximum (map nDigitosFact xs)
   5561492
   λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]
   λ> maximum (map nDigitosFact xs)
   5563303

λ> import System.Random

λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]

λ> maximum (map nDigitosFact xs)

5561492

λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]

λ> maximum (map nDigitosFact xs)

5563303

Soluciones

import Data.List (genericLength, genericIndex)
import Graphics.Gnuplot.Simple

-- 1ª definición
nDigitosFact1 :: Integer -> Integer
nDigitosFact1 n =
  genericLength (show (product [1..n]))

-- 2ª definición (usando logaritmos)
-- =================================

-- Basado en
--    nDigitos (n!) = 1 + floor (log (n!))
--                  = 1 + floor (log (1*2*3*...*n))
--                  = 1 + floor (log(1) + log(2) + log(3) +...+ log(n))

nDigitosFact2 :: Integer -> Integer
nDigitosFact2 n =
  1 + floor (sum [logBase 10 (fromIntegral k) | k <- [1..n]])

-- 3ª definición (usando logaritmos y programación dinámica)
-- =========================================================

nDigitosFact3 :: Integer -> Integer
nDigitosFact3 0 = 1
nDigitosFact3 n = 1 + floor ((sumLogs `genericIndex` (n-1)) / log 10)

logs :: [Double]
logs = map log [1..]

sumLogs :: [Double]
sumLogs = scanl1 (+) logs

-- 4ª definición (Usando la fórmula de Kamenetsky)
-- ===============================================

-- La fórmula se encuentra en https://oeis.org/A034886

nDigitosFact4 :: Integer -> Integer
nDigitosFact4 0 = 1
nDigitosFact4 1 = 1
nDigitosFact4 n =
  1 + floor (m * logBase 10 (m/e) + logBase 10 (2*pi*m)/2)
  where m = fromIntegral n
        e = exp 1

--    λ> nDigitosFact1 (4*10^4)
--    166714
--    (5.61 secs, 1,649,912,864 bytes)
--    λ> nDigitosFact2 (4*10^4)
--    166714
--    (0.10 secs, 13,741,360 bytes)
--
--    λ> nDigitosFact2 (7*10^5)
--    3787566
--    (1.86 secs, 187,666,328 bytes)
--    λ> nDigitosFact3 (7*10^5)
--    3787566
--    (0.02 secs, 0 bytes)
--    λ> nDigitosFact3 (7*10^5)
--    3787566
--    (1.01 secs, 238,682,064 bytes)
--    λ> nDigitosFact4 (7*10^5)
--    3787566
--    (0.01 secs, 0 bytes)
-- 
--    λ> import System.Random 
--    λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^2]]
--    λ> maximum (map nDigitosFact3 xs)
--    5565097
--    (11.19 secs, 7,336,595,440 bytes)
--    λ> maximum (map nDigitosFact4 xs)
--    5565097
--    (0.01 secs, 0 bytes)

graficas :: [Integer] -> IO ()
graficas xs = 
    plotLists [Key Nothing]
              [p1, p2]
    where p1, p2 :: [(Float, Float)]
          p1 = [(fi k, fi (nDigitosFact4 k)) | k <- xs]
          p2 = [(k',5.5*k') | k <- xs, let k' = fi k]
          fi = fromIntegral

import Data.List (genericLength, genericIndex)

import Graphics.Gnuplot.Simple

-- 1ª definición

nDigitosFact1 :: Integer -> Integer

nDigitosFact1 n =

genericLength (show (product [1..n]))

-- 2ª definición (usando logaritmos)

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

-- Basado en

-- nDigitos (n!) = 1 + floor (log (n!))

-- = 1 + floor (log (1*2*3*...*n))

-- = 1 + floor (log(1) + log(2) + log(3) +...+ log(n))

nDigitosFact2 :: Integer -> Integer

nDigitosFact2 n =

1 + floor (sum [logBase 10 (fromIntegral k) | k <- [1..n]])

-- 3ª definición (usando logaritmos y programación dinámica)

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

nDigitosFact3 :: Integer -> Integer

nDigitosFact3 0 = 1

nDigitosFact3 n = 1 + floor ((sumLogs `genericIndex` (n-1)) / log 10)

logs :: [Double]

logs = map log [1..]

sumLogs :: [Double]

sumLogs = scanl1 (+) logs

-- 4ª definición (Usando la fórmula de Kamenetsky)

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

-- La fórmula se encuentra en https://oeis.org/A034886

nDigitosFact4 :: Integer -> Integer

nDigitosFact4 0 = 1

nDigitosFact4 1 = 1

nDigitosFact4 n =

1 + floor (m * logBase 10 (m/e) + logBase 10 (2*pi*m)/2)

where m = fromIntegral n

e = exp 1

-- λ> nDigitosFact1 (4*10^4)

-- 166714

-- (5.61 secs, 1,649,912,864 bytes)

-- λ> nDigitosFact2 (4*10^4)

-- 166714

-- (0.10 secs, 13,741,360 bytes)

-- λ> nDigitosFact2 (7*10^5)

-- 3787566

-- (1.86 secs, 187,666,328 bytes)

-- λ> nDigitosFact3 (7*10^5)

-- 3787566

-- (0.02 secs, 0 bytes)

-- λ> nDigitosFact3 (7*10^5)

-- 3787566

-- (1.01 secs, 238,682,064 bytes)

-- λ> nDigitosFact4 (7*10^5)

-- 3787566

-- (0.01 secs, 0 bytes)

-- λ> import System.Random

-- λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^2]]

-- λ> maximum (map nDigitosFact3 xs)

-- 5565097

-- (11.19 secs, 7,336,595,440 bytes)

-- λ> maximum (map nDigitosFact4 xs)

-- 5565097

-- (0.01 secs, 0 bytes)

graficas :: [Integer] -> IO ()

graficas xs =

plotLists [Key Nothing]

[p1, p2]

where p1, p2 :: [(Float, Float)]

p1 = [(fi k, fi (nDigitosFact4 k)) | k <- xs]

p2 = [(k',5.5*k') | k <- xs, let k' = fi k]

fi = fromIntegral

Contando en la arena

PorJosé A. Alonso 2-marzo-20179-marzo-2017

El problema de ayer de ¡Acepta el reto! fue Contando en la arena cuyo enunciado es el siguiente:

Es ampliamente conocido que escribimos los números utilizando base 10, en la que expresamos las cantidades utilizando 10 dígitos distintos (0…9). El valor de cada uno de ellos depende de la posición que ocupe dentro del número, pues cada dígito se multiplica por una potencia de 10 distinta según cuál sea esa posición.

La descomposición, por ejemplo, del número 1.234 es: 1.234 = 1×10^3 + 2×10^2 + 3×10^1 + 4×10^0

Otra base muy conocida es la base 2 al ser la utilizada por los dispositivos electrónicos. En ella sólo hay dos dígitos distintos (0 y 1), que se ven multiplicados por potencias de 2.

Mucho antes de que llegaran la base 2, la base 10 e incluso los números romanos, los primeros seres humanos contaban haciendo surcos en la arena, muescas en un trozo de madera o colocando palos en línea. Estaban, sin saberlo, usando base 1. En ella sólo hay un símbolo y cada dígito es multiplicado por una potencia de 1. Dado que 1^n = 1 el resultado es que todos los dígitos tienen el mismo peso.

Definir la función

   transformaAbase1 :: FilePath -> FilePath -> IO ()

1	transformaAbase1 :: FilePath -> FilePath -> IO ()

tal que al evaluar (transformaAbase1 f1 f2) lee el contenido del fichero f1 (que estará compuesto por distintos números mayores que 0, cada uno en una línea) y escribe en el fichero f2 una línea con la representación en base 1 de cada uno de los números de f1 excepto el 0 final. Por ejemplo, si el contenido de «Entrada.txt» es

al evaluar (transformaAbase1 «Entrada.txt» «Salida.txt») el contenido de «Salida.txt» debe de ser

1
1111
111111

1111

111111

Soluciones

transformaAbase1 :: FilePath -> FilePath -> IO ()
transformaAbase1 f1 f2 = do
  cs <- readFile f1
  writeFile f2 (transformaAbase1Aux cs)

-- (transformaAbase1Aux cs) es la cadena obtenida transformando a base 1
-- cada uno de los números de cs. Por ejemplo,
--    λ> transformaAbase1Aux "1\n4\n6\n0\n" 
--    "1\n1111\n111111\n"
transformaAbase1Aux :: String -> String
transformaAbase1Aux cs =
  unlines (map (show . enBase1) (numeros cs))

-- (numeros cs) es la lista de los números de cs, excepto el último. Por
-- ejemplo, 
--    numeros "1\n4\n6\n0\n"  ==  [1,4,6]
numeros :: String -> [Integer]
numeros cs  =
  init (map read (lines cs))

-- (enBsase1 x) es la representación de x en base 1. Por ejemplo,
--    enBase1 4  ==  1111
enBase1 :: Integer -> Integer
enBase1 x = (10^x - 1) `div` 9

transformaAbase1 :: FilePath -> FilePath -> IO ()

transformaAbase1 f1 f2 = do

cs <- readFile f1

writeFile f2 (transformaAbase1Aux cs)

-- (transformaAbase1Aux cs) es la cadena obtenida transformando a base 1

-- cada uno de los números de cs. Por ejemplo,

-- λ> transformaAbase1Aux "1\n4\n6\n0\n"

-- "1\n1111\n111111\n"

transformaAbase1Aux :: String -> String

transformaAbase1Aux cs =

unlines (map (show . enBase1) (numeros cs))

-- (numeros cs) es la lista de los números de cs, excepto el último. Por

-- ejemplo,

-- numeros "1\n4\n6\n0\n" == [1,4,6]

numeros :: String -> [Integer]

numeros cs =

init (map read (lines cs))

-- (enBsase1 x) es la representación de x en base 1. Por ejemplo,

-- enBase1 4 == 1111

enBase1 :: Integer -> Integer

enBase1 x = (10^x - 1) `div` 9

Precisión de aproximaciones de pi

PorJosé A. Alonso 27-febrero-20176-marzo-2017

La precisión de una aproximación x de pi es el número de dígitos comunes entre el inicio de x y de pi. Por ejemplo, puesto que 355/113 es 3.1415929203539825 y pi es 3.141592653589793, la precisión de 355/113 es 7.

Definir las siguientes funciones

   mayorPrefijoComun :: Eq a => [a] -> [a] -> [a]
   precisionPi       :: Double -> Int
   precisionPiCR     :: CReal -> Int

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

precisionPi :: Double -> Int

precisionPiCR :: CReal -> Int

tales que

(mayorPrefijoComun xs ys) es el mayor prefijo común de xs e ys. Por ejemplo,

     mayorPrefijoComun []      [2,3,4,5]  ==  []
     mayorPrefijoComun [2,3,5] []         ==  []
     mayorPrefijoComun [2,3,5] [2,3,4,5]  ==  [2,3]
     mayorPrefijoComun [2,3,5] [2,5,3,4]  ==  [2]
     mayorPrefijoComun [2,3,5] [5,2,3,4]  ==  []

mayorPrefijoComun [] [2,3,4,5] == []

mayorPrefijoComun [2,3,5] [] == []

mayorPrefijoComun [2,3,5] [2,3,4,5] == [2,3]

mayorPrefijoComun [2,3,5] [2,5,3,4] == [2]

mayorPrefijoComun [2,3,5] [5,2,3,4] == []

(precisionPi x) es la precisión de la aproximación de pi x. Por ejemplo,

     precisionPi (25/8)              ==  2
     precisionPi (22/7)              ==  3
     precisionPi (sqrt 2 + sqrt 3)   ==  3
     precisionPi (377/120)           ==  4
     precisionPi (31**(1/3))         ==  4
     precisionPi (7^7/4^9)           ==  5
     precisionPi (355/113)           ==  7
     precisionPi ((2143/22)**(1/4))  ==  9

precisionPi (25/8) == 2

precisionPi (22/7) == 3

precisionPi (sqrt 2 + sqrt 3) == 3

precisionPi (377/120) == 4

precisionPi (31**(1/3)) == 4

precisionPi (7^7/4^9) == 5

precisionPi (355/113) == 7

precisionPi ((2143/22)**(1/4)) == 9

(precisionPiCR x) es la precisión de la aproximación de pi x, como números reales. Por ejemplo,

     precisionPiCR (log (640320^3+744)/(sqrt 163))                        == 31
     precisionPiCR (log (5280^3*(236674+30303*sqrt 61)^3+744)/(sqrt 427)) == 53

1 2	precisionPiCR (log (640320^3+744)/(sqrt 163)) == 31 precisionPiCR (log (5280^3(236674+30303sqrt 61)^3+744)/(sqrt 427)) == 53

Nota: Para la definición precisionPiCR se usa la librería Data.Number.CReal que se instala con

   cabal install numbers

1	cabal install numbers

Soluciones

import Data.Number.CReal

-- mayorPrefijoComún
-- =================

-- 1ª definición
mayorPrefijoComun :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun [] _ = []
mayorPrefijoComun _ [] = []
mayorPrefijoComun (x:xs) (y:ys)
  | x == y    = x : mayorPrefijoComun xs ys
  | otherwise = []

-- 2ª definición
mayorPrefijoComun2 :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun2 xs ys =
  [x | (x,y) <- takeWhile (\(x,y) -> x == y) (zip xs ys)] 

-- 3ª definición
mayorPrefijoComun3 :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun3 xs ys =
  [x | (x,y) <- takeWhile (uncurry (==)) (zip xs ys)] 

-- 4ª definición
mayorPrefijoComun4 :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun4 xs =
  map fst . takeWhile (uncurry (==)) . zip xs

-- 5ª definición
mayorPrefijoComun5 :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun5 =
  ((map fst . takeWhile (uncurry (==))) .) . zip

-- precisionPi
-- ===========

-- 1ª definición
precisionPi :: Double -> Int
precisionPi x =
  length (mayorPrefijoComun xs ys) - 1
  where xs = show x
        ys = show pi

-- 2ª definición
precisionPi2 :: Double -> Int
precisionPi2 =
  pred . length . mayorPrefijoComun (show pi) . show

-- precisionPiCR
-- =============

precisionPiCR :: CReal -> Int
precisionPiCR = aux 50
  where aux n x | p < n-1   = p
                | otherwise = aux (n+50) x
          where p = precisionPiCRHasta n x

-- (precisionPiCRHasta n x) es la precisión de pi acotada por n. Por
-- ejemplo,
--    precisionPiCRHasta 1 3.14   ==  2
--    precisionPiCRHasta 5 3.14   ==  3
--    precisionPiCRHasta 5 3.142  ==  3
--    precisionPiCRHasta 5 3.141  ==  4
precisionPiCRHasta :: Int -> CReal -> Int
precisionPiCRHasta n x =
  length (mayorPrefijoComun xs ys) - 1
  where xs = showCReal n x
        ys = showCReal n pi

import Data.Number.CReal

-- mayorPrefijoComún

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

-- 1ª definición

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

mayorPrefijoComun [] _ = []

mayorPrefijoComun _ [] = []

mayorPrefijoComun (x:xs) (y:ys)

| x == y = x : mayorPrefijoComun xs ys

| otherwise = []

-- 2ª definición

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

mayorPrefijoComun2 xs ys =

[x | (x,y) <- takeWhile (\(x,y) -> x == y) (zip xs ys)]

-- 3ª definición

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

mayorPrefijoComun3 xs ys =

[x | (x,y) <- takeWhile (uncurry (==)) (zip xs ys)]

-- 4ª definición

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

mayorPrefijoComun4 xs =

map fst . takeWhile (uncurry (==)) . zip xs

-- 5ª definición

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

mayorPrefijoComun5 =

((map fst . takeWhile (uncurry (==))) .) . zip

-- precisionPi

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

-- 1ª definición

precisionPi :: Double -> Int

precisionPi x =

length (mayorPrefijoComun xs ys) - 1

where xs = show x

ys = show pi

-- 2ª definición

precisionPi2 :: Double -> Int

precisionPi2 =

pred . length . mayorPrefijoComun (show pi) . show

-- precisionPiCR

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

precisionPiCR :: CReal -> Int

precisionPiCR = aux 50

where aux n x | p < n-1 = p

| otherwise = aux (n+50) x

where p = precisionPiCRHasta n x

-- (precisionPiCRHasta n x) es la precisión de pi acotada por n. Por

-- ejemplo,

-- precisionPiCRHasta 1 3.14 == 2

-- precisionPiCRHasta 5 3.14 == 3

-- precisionPiCRHasta 5 3.142 == 3

-- precisionPiCRHasta 5 3.141 == 4

precisionPiCRHasta :: Int -> CReal -> Int

precisionPiCRHasta n x =

length (mayorPrefijoComun xs ys) - 1

where xs = showCReal n x

ys = showCReal n pi

Sucesión de Cantor de números innombrables

PorJosé A. Alonso 3-febrero-201725-abril-2021

Un número es innombrable si es divisible por 7 o alguno de sus dígitos es un 7. Un juego infantil consiste en contar saltándose los números innombrables:

   1 2 3 4 5 6 ( ) 8 9 10 11 12 13 ( ) 15 16 ( ) 18 ...

1	1 2 3 4 5 6 ( ) 8 9 10 11 12 13 ( ) 15 16 ( ) 18 ...

La sucesión de Cantor se obtiene llenando los huecos de la sucesión anterior
como se indica a continuación:

  1 2 3 4 5 6 (1) 8 9 10 11 12 13 (2) 15 16 (3) 18 19 20 (4) 22 23
  24 25 26 (5) (6) 29 30 31 32 33 34 (1) 36 (8) 38 39 40 41  (9) 43
  44 45 46 (10) 48 (11) 50 51 52 53 54 55 (12) (13) 58 59 60 61 62
  (2) 64 65 66 (15) 68 69 (16) (3) (18) (19) (20) (4) (22) (23) (24)
  (25) 80 81 82 83 (26) 85 86 (5) 88 89 90 (6) 92 93 94 95 96 (29)
  (30) 99 100

1 2 3 4 5 6 (1) 8 9 10 11 12 13 (2) 15 16 (3) 18 19 20 (4) 22 23

24 25 26 (5) (6) 29 30 31 32 33 34 (1) 36 (8) 38 39 40 41 (9) 43

44 45 46 (10) 48 (11) 50 51 52 53 54 55 (12) (13) 58 59 60 61 62

(2) 64 65 66 (15) 68 69 (16) (3) (18) (19) (20) (4) (22) (23) (24)

(25) 80 81 82 83 (26) 85 86 (5) 88 89 90 (6) 92 93 94 95 96 (29)

(30) 99 100

Definir la sucesión

   sucCantor :: [Integer]

1	sucCantor :: [Integer]

cuyos elementos son los términos de la sucesión de Cantor. Por ejemplo,

   λ> take 100 sucCantor
   [1,2,3,4,5,6, 1 ,8,9,10,11,12,13, 2, 15,16, 3, 18,19,20, 4,
    22,23,24,25,26, 5 , 6 ,29,30,31,32,33,34, 1 ,36 , 8 ,38,39,
    40,41, 9 ,43,44,45,46, 10 ,48, 11 ,50,51,52,53,54,55 , 12 ,
    13, 58,59,60,61,62, 2 ,64,65,66, 15 ,68,69, 16 , 3 , 18, 19,
    20, 4, 22, 23, 24 ,25 ,80,81,82,83, 26 ,85,86, 5 ,88,89,90,
    6, 92,93,94,95,96, 29, 30 ,99,100]

   λ> sucCantor2 !! (5+10^6)
   544480

   λ> sucCantor2 !! (6+10^6)
   266086

λ> take 100 sucCantor

[1,2,3,4,5,6, 1 ,8,9,10,11,12,13, 2, 15,16, 3, 18,19,20, 4,

22,23,24,25,26, 5 , 6 ,29,30,31,32,33,34, 1 ,36 , 8 ,38,39,

40,41, 9 ,43,44,45,46, 10 ,48, 11 ,50,51,52,53,54,55 , 12 ,

13, 58,59,60,61,62, 2 ,64,65,66, 15 ,68,69, 16 , 3 , 18, 19,

20, 4, 22, 23, 24 ,25 ,80,81,82,83, 26 ,85,86, 5 ,88,89,90,

6, 92,93,94,95,96, 29, 30 ,99,100]

λ> sucCantor2 !! (5+10^6)

544480

λ> sucCantor2 !! (6+10^6)

266086

Soluciones

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

sucCantor1 :: [Integer]
sucCantor1 = map fst $ scanl f (1,0) [2..]
  where f (a,i) x
          | esInnombrable x = (sucCantor1 !! i, i+1)
          | otherwise       = (x,i)


esInnombrable :: Integer -> Bool
esInnombrable x =
  rem x 7 == 0 || '7' `elem` show x

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

sucCantor2 :: [Integer]
sucCantor2 = aux 0 1
  where aux i x
          | esInnombrable x = sucCantor2 !! i : aux (i+1) (x+1)
          | otherwise       = x : aux i (x+1)

-- 1ª solución

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

sucCantor1 :: [Integer]

sucCantor1 = map fst $ scanl f (1,0) [2..]

where f (a,i) x

| esInnombrable x = (sucCantor1 !! i, i+1)

| otherwise = (x,i)

esInnombrable :: Integer -> Bool

esInnombrable x =

rem x 7 == 0 || '7' `elem` show x

-- 2ª solución

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

sucCantor2 :: [Integer]

sucCantor2 = aux 0 1

where aux i x

| esInnombrable x = sucCantor2 !! i : aux (i+1) (x+1)

| otherwise = x : aux i (x+1)

Referencia

Basado en Cantor’s unspeakable numbers de
CodeGolf.

La sucesión «Mira y di»

PorJosé A. Alonso 24-enero-201731-enero-2017

La sucesión «Mira y di» (en inglés, Look-and-Say) es una sucesión de números naturales en donde cada término se obtiene agrupando las cifras iguales del anterior y recitándolas. Por ejemplo, si x(0) = 1 se lee como «un uno» y por tanto x(1) = 11. Análogamente,

   x(1) = 11     ("dos unos                          --> "21")
   x(2) = 21     ("un dos un uno                     --> "1211")
   x(3) = 1211   ("un uno un dos dos unos            --> "111221")
   x(4) = 111221 ("tres unos dos doses un uno        --> "312211")
   x(5) = 312211 ("un tres un uno dos doses dos unos --> "13112221")

x(1) = 11 ("dos unos --> "21")

x(2) = 21 ("un dos un uno --> "1211")

x(3) = 1211 ("un uno un dos dos unos --> "111221")

x(4) = 111221 ("tres unos dos doses un uno --> "312211")

x(5) = 312211 ("un tres un uno dos doses dos unos --> "13112221")

Definir la función

  sucMiraYDi :: Integer -> [Integer]

1	sucMiraYDi :: Integer -> [Integer]

tal que (sucMiraYDi n) es la sucesión «Mira y di» cuyo primer término es n. Por ejemplo,

   λ> take 9 (sucMiraYdi 1)
   [1,11,21,1211,111221,312211,13112221,1113213211,31131211131221]
   λ> take 5 (sucMiraYdi 2017)
   [2017,12101117,111211103117,31123110132117,1321121321101113122117]
   λ> take 7 (sucMiraYDi 22)
   [22,22,22,22,22,22,22]
   λ> (sucMiraYDi 1) !! 11
   3113112221232112111312211312113211
   λ> (sucMiraYDi 1) !! 12
   1321132132111213122112311311222113111221131221

λ> take 9 (sucMiraYdi 1)

[1,11,21,1211,111221,312211,13112221,1113213211,31131211131221]

λ> take 5 (sucMiraYdi 2017)

[2017,12101117,111211103117,31123110132117,1321121321101113122117]

λ> take 7 (sucMiraYDi 22)

[22,22,22,22,22,22,22]

λ> (sucMiraYDi 1) !! 11

3113112221232112111312211312113211

λ> (sucMiraYDi 1) !! 12

1321132132111213122112311311222113111221131221

Independientemente del término inicial x(0) elegido (con la única salvedad del 22), la sucesión diverge y la razón entre el número de cifras de x(n) y el de x(n-1) tiende a un valor fijo que es la constante de Conway λ ≈ 1.303577269. Por ejemplo, para x(0) = 1, las razones son

   2, 1, 2, 1.5, 1, 1.3333333333333333, 1.25, 1.4, 1.4285714285714286, 1.3

1	2, 1, 2, 1.5, 1, 1.3333333333333333, 1.25, 1.4, 1.4285714285714286, 1.3

Definir la función

   aproximacionConway :: Integer -> Double -> Int

1	aproximacionConway :: Integer -> Double -> Int

tal que (aproximacionConway n e) es el menor k tal que la diferencia entre la constante de Conway y la razón entre el número de cifras de x(k) x(k-1) es, en valor absoluto, menor que e. Por ejemplo,

   aproximacionConway 1 0.3     ==  3
   aproximacionConway 1 0.1     ==  5
   aproximacionConway 1 0.01    ==  9
   aproximacionConway 1 0.001   ==  24
   aproximacionConway 1 0.0001  ==  43
   aproximacionConway 2 0.0001  ==  47

aproximacionConway 1 0.3 == 3

aproximacionConway 1 0.1 == 5

aproximacionConway 1 0.01 == 9

aproximacionConway 1 0.001 == 24

aproximacionConway 1 0.0001 == 43

aproximacionConway 2 0.0001 == 47

Nota: Este ejercicio ha sido propuesto por Elías Guisado.

Soluciones

import Data.List (genericLength, group)

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

sucMiraYdi :: Integer -> [Integer]
sucMiraYdi = iterate di

-- (di x) es el número correspondiente a la lectura de x. Por ejemplo.
--    di 1       ==  11
--    di 11      ==  21
--    di 21      ==  1211
--    di 1211    ==  111221
--    di 111221  ==  312211
--    di 312211  ==  13112221
di :: Integer -> Integer
di = read . concatMap aux . group . show
  where aux s = show (length s) ++ [head s]

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

sucMiraYdi2 :: Integer -> [Integer]
sucMiraYdi2 = iterate (read . concatMap aux . group . show)
  where aux s = show (length s) ++ [head s]

-- Constante de Conway
-- ===================

aproximacionConway :: Integer -> Double -> Int
aproximacionConway n e =
  length (takeWhile aux (razonesMiraYdi n))
  where aux x = abs (x - constanteConway) > e 

constanteConway :: Double
constanteConway = 1.303577269

-- (razonesMiraYdi n) es la sucesión de las razones entre de cada
-- elemento de la sucesión "Mira y di" con elemento inicial n y su
-- anterior. Por ejemplo,
--    λ> take 10 (razonesMiraYdi 1)
--    [2.0,1.0,2.0,1.5,1.0,1.3333333333333333,1.25,1.4,1.4285714285714286,1.3]
--    λ> take 7 (razonesMiraYdi 10)
--    [2.0,1.0,1.5,1.6666666666666667,1.2,1.1666666666666667,1.5714285714285714]
razonesMiraYdi :: Integer -> [Double]
razonesMiraYdi n =
  zipWith (/) (tail xs) xs
  where xs = map (genericLength . show) (sucMiraYdi n)

import Data.List (genericLength, group)

-- 1ª solución

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

sucMiraYdi :: Integer -> [Integer]

sucMiraYdi = iterate di

-- (di x) es el número correspondiente a la lectura de x. Por ejemplo.

-- di 1 == 11

-- di 11 == 21

-- di 21 == 1211

-- di 1211 == 111221

-- di 111221 == 312211

-- di 312211 == 13112221

di :: Integer -> Integer

di = read . concatMap aux . group . show

where aux s = show (length s) ++ [head s]

-- 2ª solución

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

sucMiraYdi2 :: Integer -> [Integer]

sucMiraYdi2 = iterate (read . concatMap aux . group . show)

where aux s = show (length s) ++ [head s]

-- Constante de Conway

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

aproximacionConway :: Integer -> Double -> Int

aproximacionConway n e =

length (takeWhile aux (razonesMiraYdi n))

where aux x = abs (x - constanteConway) > e

constanteConway :: Double

constanteConway = 1.303577269

-- (razonesMiraYdi n) es la sucesión de las razones entre de cada

-- elemento de la sucesión "Mira y di" con elemento inicial n y su

-- anterior. Por ejemplo,

-- λ> take 10 (razonesMiraYdi 1)

-- [2.0,1.0,2.0,1.5,1.0,1.3333333333333333,1.25,1.4,1.4285714285714286,1.3]

-- λ> take 7 (razonesMiraYdi 10)

-- [2.0,1.0,1.5,1.6666666666666667,1.2,1.1666666666666667,1.5714285714285714]

razonesMiraYdi :: Integer -> [Double]

razonesMiraYdi n =

zipWith (/) (tail xs) xs

where xs = map (genericLength . show) (sucMiraYdi n)

Número de dígitos del factorial

Soluciones

Contando en la arena

Soluciones

Precisión de aproximaciones de pi

Soluciones

Sucesión de Cantor de números innombrables

Soluciones

Referencia

Entradas recientes

Buscar

Correo electrónico