abril 2021 – Página 3

Sucesión de cubos perfectos

PorJosé A. Alonso 16-abril-202123-abril-2021

Definir la lista

   sucesion :: [Integer]

1	sucesion :: [Integer]

cuyos elementos son los términos de la sucesión

   107811/3, 110778111/3, 111077781111/3, 111107777811111/3, ...

1	107811/3, 110778111/3, 111077781111/3, 111107777811111/3, ...

Por ejemplo,

   λ> take 5 sucesion
   [35937,36926037,37025927037,37035925937037,37036925926037037]
   λ> length (show (sucesion2 !! (3*10^6)))
   9000005

λ> take 5 sucesion

[35937,36926037,37025927037,37035925937037,37036925926037037]

λ> length (show (sucesion2 !! (3*10^6)))

9000005

Comprobar con QuickCheck que todos los términos de la sucesión son cubos perfectos.

Soluciones

import Test.QuickCheck

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

sucesion :: [Integer]
sucesion = map termino [1..]

-- (termino n) es el término n-ésimo de la sucesión por ejemplo,
--    termino 1  ==  35937
--    termino 2  ==  36926037
--    termino 3  ==  37025927037
termino :: Int -> Integer
termino n = numerador n `div` 3


-- (numerador n) es el numerador del término n-ésimo de la sucesión por
-- ejemplo,
--    λ> mapM_ print (map numerador [1..5])
--    107811
--    110778111
--    111077781111
--    111107777811111
--    111110777778111111
numerador :: Int -> Integer
numerador n =
  read (replicate n '1' ++ "0" ++ replicate n '7' ++ "81" ++ replicate n '1')

-- Propiedad
-- =========

-- La propiedad es
prop_sucesion :: Int -> Property
prop_sucesion n =
  n >= 0 ==>
  esCubo (sucesion !! n)

-- La comprobación es
--    λ> quickCheck prop_sucesion
--    +++ OK, passed 100 tests.

-- (esCubo x) se verifica si x es un cubo perfecto. Por ejemplo,
--    esCubo 27  ==  True
--    esCubo 28  ==  False
esCubo :: Integer -> Bool
esCubo x =
  (raizCubicaEntera x)^3 == x

-- (raizCubicaEntera x) es el mayor entero cuyo cubo es menor o igual
-- que x. Por ejemplo,
--    raizCubicaEntera 26  ==  2
--    raizCubicaEntera 27  ==  3
--    raizCubicaEntera 28  ==  3
raizCubicaEntera :: Integer -> Integer
raizCubicaEntera x = aux (1,x)
    where aux (a,b) | d == x    = c
                    | c == a    = c
                    | d < x     = aux (c,b)
                    | otherwise = aux (a,c)
              where c = (a+b) `div` 2
                    d = c^3

-- Otra forma es observando los cubos de los términos de la sucesión
--    λ> map raizCubicaEntera (take 7 sucesion)
--    [33,333,3333,33333,333333,3333333,33333333]

-- La propiedad es
prop_sucesion2 :: Int -> Property
prop_sucesion2 n =
  n >= 0 ==>
  sucesion !! n == ((10^(n+2)-1) `div` 3)^3

-- La comprobación es
--    λ> quickCheck prop_sucesion2
--    +++ OK, passed 100 tests.

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

-- Basada en la propiedad anterior.

sucesion2 :: [Integer]
sucesion2 =
  [((10^n-1) `div` 3)^3 | n <- [2..]]

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_equiv :: Int -> Property
prop_equiv n =
  n >= 0 ==>
  sucesion !! n == sucesion2 !! n

-- La comprobación es
--    λ> quickCheck prop_equiv
--    +++ OK, passed 100 tests.

-- Comparación de eficiencia
-- =========================

-- La comparación es
--    λ> length (show (sucesion !! (3*10^6)))
--    9000005
--    (6.34 secs, 5,161,177,808 bytes)
--    λ> length (show (sucesion2 !! (3*10^6)))
--    9000005
--    (2.72 secs, 1,124,065,328 bytes)

100

101

102

103

104

105

106

107

108

import Test.QuickCheck

-- 1ª solución

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

sucesion :: [Integer]

sucesion = map termino [1..]

-- (termino n) es el término n-ésimo de la sucesión por ejemplo,

-- termino 1 == 35937

-- termino 2 == 36926037

-- termino 3 == 37025927037

termino :: Int -> Integer

termino n = numerador n `div` 3

-- (numerador n) es el numerador del término n-ésimo de la sucesión por

-- ejemplo,

-- λ> mapM_ print (map numerador [1..5])

-- 107811

-- 110778111

-- 111077781111

-- 111107777811111

-- 111110777778111111

numerador :: Int -> Integer

numerador n =

read (replicate n '1' ++ "0" ++ replicate n '7' ++ "81" ++ replicate n '1')

-- Propiedad

-- =========

-- La propiedad es

prop_sucesion :: Int -> Property

prop_sucesion n =

n >= 0 ==>

esCubo (sucesion !! n)

-- La comprobación es

-- λ> quickCheck prop_sucesion

-- +++ OK, passed 100 tests.

-- (esCubo x) se verifica si x es un cubo perfecto. Por ejemplo,

-- esCubo 27 == True

-- esCubo 28 == False

esCubo :: Integer -> Bool

esCubo x =

(raizCubicaEntera x)^3 == x

-- (raizCubicaEntera x) es el mayor entero cuyo cubo es menor o igual

-- que x. Por ejemplo,

-- raizCubicaEntera 26 == 2

-- raizCubicaEntera 27 == 3

-- raizCubicaEntera 28 == 3

raizCubicaEntera :: Integer -> Integer

raizCubicaEntera x = aux (1,x)

where aux (a,b) | d == x = c

| c == a = c

| d < x = aux (c,b)

| otherwise = aux (a,c)

where c = (a+b) `div` 2

d = c^3

-- Otra forma es observando los cubos de los términos de la sucesión

-- λ> map raizCubicaEntera (take 7 sucesion)

-- [33,333,3333,33333,333333,3333333,33333333]

-- La propiedad es

prop_sucesion2 :: Int -> Property

prop_sucesion2 n =

n >= 0 ==>

sucesion !! n == ((10^(n+2)-1) `div` 3)^3

-- La comprobación es

-- λ> quickCheck prop_sucesion2

-- +++ OK, passed 100 tests.

-- 2ª solución

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

-- Basada en la propiedad anterior.

sucesion2 :: [Integer]

sucesion2 =

[((10^n-1) `div` 3)^3 | n <- [2..]]

-- Comprobación de equivalencia

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

-- La propiedad es

prop_equiv :: Int -> Property

prop_equiv n =

n >= 0 ==>

sucesion !! n == sucesion2 !! n

-- La comprobación es

-- λ> quickCheck prop_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (show (sucesion !! (3*10^6)))

-- 9000005

-- (6.34 secs, 5,161,177,808 bytes)

-- λ> length (show (sucesion2 !! (3*10^6)))

-- 9000005

-- (2.72 secs, 1,124,065,328 bytes)

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>

Enlaces primos

PorJosé A. Alonso 15-abril-202122-abril-2021

Un enlace primo de longitud n es una permutación de 1, 2, …, n comienza con 1 y termina con n, tal que la suma de cada par de términos adyacentes es primo. Por ejemplo, para n = 6 la lista [1,4,3,2,5,6] es un enlace primo ua que las sumas de los pares de términos adyacentes son los números primos 5, 7, 5, 7, 11.

Definir la función

   enlacesPrimos :: Int -> [[Int]]

1	enlacesPrimos :: Int -> [[Int]]

tal que (enlacesPrimos n) es la lista de los enlaces primos de longitud n. Por ejemplo,

   λ> enlacesPrimos 6
   [[1,4,3,2,5,6]]
   λ> enlacesPrimos 7
   [[1,4,3,2,5,6,7],[1,6,5,2,3,4,7]]
   λ> enlacesPrimos 8
   [[1,2,5,6,7,4,3,8],[1,4,7,6,5,2,3,8],[1,2,3,4,7,6,5,8],[1,6,7,4,3,2,5,8]]
   λ> length (enlacesPrimos 10)
   24
   λ> length (head (enlacesPrimos (5*10^4)))
   50000

λ> enlacesPrimos 6

[[1,4,3,2,5,6]]

λ> enlacesPrimos 7

[[1,4,3,2,5,6,7],[1,6,5,2,3,4,7]]

λ> enlacesPrimos 8

[[1,2,5,6,7,4,3,8],[1,4,7,6,5,2,3,8],[1,2,3,4,7,6,5,8],[1,6,7,4,3,2,5,8]]

λ> length (enlacesPrimos 10)

λ> length (head (enlacesPrimos (5*10^4)))

50000

Soluciones

import Data.List (permutations, delete)
import Data.Numbers.Primes (isPrime)

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

enlacesPrimos :: Int -> [[Int]]
enlacesPrimos 1 = [[1]]
enlacesPrimos n =
  [ys | xs <- permutations [2..n-1],
       let ys = (1:xs)++[n],
       conEnlacesPrimos ys]

-- (conEnlacesPrimos xs) se verifica si las sumas de los elementos
-- adyacentes de xs son primos. Por ejemplo,
--    conEnlacesPrimos [1,4,3,2,5,6]  ==  True
--    conEnlacesPrimos [1,3,4,2,5,6]  ==  False
conEnlacesPrimos :: [Int] -> Bool
conEnlacesPrimos xs =
  all isPrime (enlaces xs)

-- (enlaces xs) es la lista de las sumas de los elementos adyacentes de
-- xs. Por ejemplo,
--    enlaces [1,4,3,2,5,6]  ==  [5,7,5,7,11]
--    enlaces [1,3,4,2,5,6]  ==  [4,7,6,7,11]
enlaces :: [Int] -> [Int]
enlaces xs =
  zipWith (+) xs (tail xs)

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

enlacesPrimos2 :: Int -> [[Int]]
enlacesPrimos2 1 = [[1]]
enlacesPrimos2 n = aux [(n-1,[n],[n-1,n-2..2])]
  where
    aux [] = []
    aux ((1,x:xs,_):ts) =
      [1:x:xs | isPrime (1+x)] ++ aux ts
    aux ((k,x:xs,ys):ts) =
      aux ([(k-1,y:x:xs,delete y ys) | y <-ys, isPrime (y+x)] ++ ts)

-- Comparación de eficiencia
-- =========================

-- La comparación es
--    λ> length (enlacesPrimos 12)
--    216
--    (6.04 secs, 22,266,444,408 bytes)
--    λ> length (enlacesPrimos2 12)
--    216
--    (0.03 secs, 18,102,192 bytes)
--
--    λ> length (enlacesPrimos2 17)
--    59448
--    (2.69 secs, 8,514,104,800 bytes)

import Data.List (permutations, delete)

import Data.Numbers.Primes (isPrime)

-- 1ª solución

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

enlacesPrimos :: Int -> [[Int]]

enlacesPrimos 1 = [[1]]

enlacesPrimos n =

[ys | xs <- permutations [2..n-1],

let ys = (1:xs)++[n],

conEnlacesPrimos ys]

-- (conEnlacesPrimos xs) se verifica si las sumas de los elementos

-- adyacentes de xs son primos. Por ejemplo,

-- conEnlacesPrimos [1,4,3,2,5,6] == True

-- conEnlacesPrimos [1,3,4,2,5,6] == False

conEnlacesPrimos :: [Int] -> Bool

conEnlacesPrimos xs =

all isPrime (enlaces xs)

-- (enlaces xs) es la lista de las sumas de los elementos adyacentes de

-- xs. Por ejemplo,

-- enlaces [1,4,3,2,5,6] == [5,7,5,7,11]

-- enlaces [1,3,4,2,5,6] == [4,7,6,7,11]

enlaces :: [Int] -> [Int]

enlaces xs =

zipWith (+) xs (tail xs)

-- 2ª solución

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

enlacesPrimos2 :: Int -> [[Int]]

enlacesPrimos2 1 = [[1]]

enlacesPrimos2 n = aux [(n-1,[n],[n-1,n-2..2])]

where

aux [] = []

aux ((1,x:xs,_):ts) =

[1:x:xs | isPrime (1+x)] ++ aux ts

aux ((k,x:xs,ys):ts) =

aux ([(k-1,y:x:xs,delete y ys) | y <-ys, isPrime (y+x)] ++ ts)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (enlacesPrimos 12)

-- 216

-- (6.04 secs, 22,266,444,408 bytes)

-- λ> length (enlacesPrimos2 12)

-- 216

-- (0.03 secs, 18,102,192 bytes)

-- λ> length (enlacesPrimos2 17)

-- 59448

-- (2.69 secs, 8,514,104,800 bytes)

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>

Raíces digitales de sucesiones de raíces digitales

PorJosé A. Alonso 14-abril-202121-abril-2021

La raíz digital de un número entero positivo n es el dígito que resulta al sumar sus dígitos, volviendo a sumar reiteradamente los resultados de esa suma y de las siguientes hasta que la suma sea un número de un dígito, al que se llama la raíz digital del número n y se representa pod D(n). Por ejemplo, la raíz digital del número 2345 es 6, porque 2+3+4+5+1 = 15 y sumando los dígitos del 15 resulta 6.

La sucesión de las raices digitales definida por un número a es la sucesión a(n) tal que a(0) = a y a(n+1) es la suma de a(n) y la raíz dígital de a(n). Por ejemplo, los primeros términos de la sucesión de las raíces digitales definida por 1 son

   1,2,4,8,16,23,28,29,31,35,43,50,55,56,58,62,70,77,82,83,85,89,...

1	1,2,4,8,16,23,28,29,31,35,43,50,55,56,58,62,70,77,82,83,85,89,...

Definir la función

   raicesDigitalesSucesionRaicesDigitales :: Integer -> [Integer]

1	raicesDigitalesSucesionRaicesDigitales :: Integer -> [Integer]

tal que (raicesDigitalesSucesionRaicesDigitales a) es la lista de las raíces digitales de los elementos de la sucesión de raíces digitales definidas por a. Por ejemplo,

   λ> take 20 (raicesDigitalesSucesionRaicesDigitales 1)
   [1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5,1,2]
   λ> take 20 (raicesDigitalesSucesionRaicesDigitales 2021)
   [5,1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5,1]
   λ> raicesDigitalesSucesionRaicesDigitales (9^100) !! (10^9)
   9

λ> take 20 (raicesDigitalesSucesionRaicesDigitales 1)

[1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5,1,2]

λ> take 20 (raicesDigitalesSucesionRaicesDigitales 2021)

[5,1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5,1]

λ> raicesDigitalesSucesionRaicesDigitales (9^100) !! (10^9)

Soluciones

import Data.List (cycle)

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

raicesDigitalesSucesionRaicesDigitales :: Integer -> [Integer]
raicesDigitalesSucesionRaicesDigitales a =
  map raizDigital (sucesionRaicesDigitales a)

-- (sucesionRaicesDigitales a) es la sucesión de las raíces digitales
-- definida por un número a. Por ejemplo,
--    λ> take 22 (sucesionRaicesDigitales 1)
--    [1,2,4,8,16,23,28,29,31,35,43,50,55,56,58,62,70,77,82,83,85,89]
--    λ> take 22 (sucesionRaicesDigitales 3)
--    [3,6,12,15,21,24,30,33,39,42,48,51,57,60,66,69,75,78,84,87,93,96]
--    λ> take 22 (sucesionRaicesDigitales 5)
--    [5,10,11,13,17,25,32,37,38,40,44,52,59,64,65,67,71,79,86,91,92,94]
--    λ> take 22 (sucesionRaicesDigitales 7)
--    [7,14,19,20,22,26,34,41,46,47,49,53,61,68,73,74,76,80,88,95,100,101]
--    λ> take 22 (sucesionRaicesDigitales 9)
--    [9,18,27,36,45,54,63,72,81,90,99,108,117,126,135,144,153,162,171,180,189,198]
sucesionRaicesDigitales :: Integer -> [Integer]
sucesionRaicesDigitales a =
  iterate siguienteRaizDigital a

-- (siguienteRaizDigital a) es el siguiente de a en la sucesión de raices
-- digitales. Por ejemplo,
--    siguienteRaizDigital 23 == 28
siguienteRaizDigital :: Integer -> Integer
siguienteRaizDigital a =
  a + raizDigital a

-- (raizDigital n) es la raíz digital de n. Por ejemplo,
--    raizDigital 23451  ==  6
raizDigital :: Integer -> Integer
raizDigital n = 1 + (n-1) `mod` 9

-- (noPertenece x ys) se verifica si x no pertenece a la lista infinita
-- ordenada creciente ys. Por ejemplo,
--    noPertenece 2 [1,3..] == True
--    noPertenece 5 [1,3..] == False
noPertenece :: Integer -> [Integer] -> Bool
noPertenece x ys =
  not (x `pertenece` ys)

-- (Pertenece x ys) se verifica si x pertenece a la lista infinita
-- ordenada creciente ys. Por ejemplo,
--    pertenece 5 [1,3..] == True
--    pertenece 2 [1,3..] == False
pertenece :: Integer -> [Integer] -> Bool
pertenece x ys =
  x == head (dropWhile (<x) ys)

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

-- En el ejercicio aterior vimos que sólo hay 5 sucesiones de ríace
-- digitales: las generadas por 1, 3, 5, 7 y 9. Las raíces digitales de
-- dichas sucesiones son
--    λ> take 20 (raicesDigitalesSucesionRaicesDigitales 1)
--    [1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5,1,2]
--    λ> take 20 (raicesDigitalesSucesionRaicesDigitales 3)
--    [3,6,3,6,3,6,3,6,3,6,3,6,3,6,3,6,3,6,3,6]
--    λ> take 20 (raicesDigitalesSucesionRaicesDigitales 5)
--    [5,1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5,1]
--    λ> take 20 (raicesDigitalesSucesionRaicesDigitales 7)
--    [7,5,1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5]
--    λ> take 20 (raicesDigitalesSucesionRaicesDigitales 9)
--    [9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9]
-- Se observa que todas son periódicas.

raicesDigitalesSucesionRaicesDigitales2 :: Integer -> [Integer]
raicesDigitalesSucesionRaicesDigitales2 a =
  cycle (d : takeWhile (/= d) (tail (raicesDigitalesSucesionRaicesDigitales a)))
  where d = raizDigital a

-- 3ª solución
-- ===========

raicesDigitalesSucesionRaicesDigitales3 :: Integer -> [Integer]
raicesDigitalesSucesionRaicesDigitales3 a =
  case (raizDigital a) of
    1 -> cycle [1,2,4,8,7,5]
    2 -> cycle [2,4,8,7,5,1]
    3 -> cycle [3,6]
    4 -> cycle [4,8,7,5,1,2]
    5 -> cycle [5,1,2,4,8,7]
    6 -> cycle [6,3]
    7 -> cycle [7,5,1,2,4,8]
    8 -> cycle [8,7,5,1,2,4]
    9 -> cycle [9]

-- Comparación de eficiencia
-- =========================

-- La comparación es
--    λ> raicesDigitalesSucesionRaicesDigitales (9^100) !! (3*10^6)
--    9
--    (4.23 secs, 2,160,860,128 bytes)
--    λ> raicesDigitalesSucesionRaicesDigitales2 (9^100) !! (3*10^6)
--    9
--    (0.02 secs, 103,768 bytes)
--    λ> raicesDigitalesSucesionRaicesDigitales3 (9^100) !! (3*10^6)
--    9
--    (0.02 secs, 103,056 bytes)
--
--    λ> raicesDigitalesSucesionRaicesDigitales2 (9^100) !! (10^9)
--    9
--    (2.09 secs, 103,608 bytes)
--    λ> raicesDigitalesSucesionRaicesDigitales3 (9^100) !! (10^9)
--    9
--    (2.25 secs, 102,952 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

import Data.List (cycle)

-- 1ª solución

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

raicesDigitalesSucesionRaicesDigitales :: Integer -> [Integer]

raicesDigitalesSucesionRaicesDigitales a =

map raizDigital (sucesionRaicesDigitales a)

-- (sucesionRaicesDigitales a) es la sucesión de las raíces digitales

-- definida por un número a. Por ejemplo,

-- λ> take 22 (sucesionRaicesDigitales 1)

-- [1,2,4,8,16,23,28,29,31,35,43,50,55,56,58,62,70,77,82,83,85,89]

-- λ> take 22 (sucesionRaicesDigitales 3)

-- [3,6,12,15,21,24,30,33,39,42,48,51,57,60,66,69,75,78,84,87,93,96]

-- λ> take 22 (sucesionRaicesDigitales 5)

-- [5,10,11,13,17,25,32,37,38,40,44,52,59,64,65,67,71,79,86,91,92,94]

-- λ> take 22 (sucesionRaicesDigitales 7)

-- [7,14,19,20,22,26,34,41,46,47,49,53,61,68,73,74,76,80,88,95,100,101]

-- λ> take 22 (sucesionRaicesDigitales 9)

-- [9,18,27,36,45,54,63,72,81,90,99,108,117,126,135,144,153,162,171,180,189,198]

sucesionRaicesDigitales :: Integer -> [Integer]

sucesionRaicesDigitales a =

iterate siguienteRaizDigital a

-- (siguienteRaizDigital a) es el siguiente de a en la sucesión de raices

-- digitales. Por ejemplo,

-- siguienteRaizDigital 23 == 28

siguienteRaizDigital :: Integer -> Integer

siguienteRaizDigital a =

a + raizDigital a

-- (raizDigital n) es la raíz digital de n. Por ejemplo,

-- raizDigital 23451 == 6

raizDigital :: Integer -> Integer

raizDigital n = 1 + (n-1) `mod` 9

-- (noPertenece x ys) se verifica si x no pertenece a la lista infinita

-- ordenada creciente ys. Por ejemplo,

-- noPertenece 2 [1,3..] == True

-- noPertenece 5 [1,3..] == False

noPertenece :: Integer -> [Integer] -> Bool

noPertenece x ys =

not (x `pertenece` ys)

-- (Pertenece x ys) se verifica si x pertenece a la lista infinita

-- ordenada creciente ys. Por ejemplo,

-- pertenece 5 [1,3..] == True

-- pertenece 2 [1,3..] == False

pertenece :: Integer -> [Integer] -> Bool

pertenece x ys =

x == head (dropWhile (<x) ys)

-- 2ª solución

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

-- En el ejercicio aterior vimos que sólo hay 5 sucesiones de ríace

-- digitales: las generadas por 1, 3, 5, 7 y 9. Las raíces digitales de

-- dichas sucesiones son

-- λ> take 20 (raicesDigitalesSucesionRaicesDigitales 1)

-- [1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5,1,2]

-- λ> take 20 (raicesDigitalesSucesionRaicesDigitales 3)

-- [3,6,3,6,3,6,3,6,3,6,3,6,3,6,3,6,3,6,3,6]

-- λ> take 20 (raicesDigitalesSucesionRaicesDigitales 5)

-- [5,1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5,1]

-- λ> take 20 (raicesDigitalesSucesionRaicesDigitales 7)

-- [7,5,1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5]

-- λ> take 20 (raicesDigitalesSucesionRaicesDigitales 9)

-- [9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9]

-- Se observa que todas son periódicas.

raicesDigitalesSucesionRaicesDigitales2 :: Integer -> [Integer]

raicesDigitalesSucesionRaicesDigitales2 a =

cycle (d : takeWhile (/= d) (tail (raicesDigitalesSucesionRaicesDigitales a)))

where d = raizDigital a

-- 3ª solución

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

raicesDigitalesSucesionRaicesDigitales3 :: Integer -> [Integer]

raicesDigitalesSucesionRaicesDigitales3 a =

case (raizDigital a) of

1 -> cycle [1,2,4,8,7,5]

2 -> cycle [2,4,8,7,5,1]

3 -> cycle [3,6]

4 -> cycle [4,8,7,5,1,2]

5 -> cycle [5,1,2,4,8,7]

6 -> cycle [6,3]

7 -> cycle [7,5,1,2,4,8]

8 -> cycle [8,7,5,1,2,4]

9 -> cycle [9]

-- Comparación de eficiencia

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

-- La comparación es

-- λ> raicesDigitalesSucesionRaicesDigitales (9^100) !! (3*10^6)

-- 9

-- (4.23 secs, 2,160,860,128 bytes)

-- λ> raicesDigitalesSucesionRaicesDigitales2 (9^100) !! (3*10^6)

-- 9

-- (0.02 secs, 103,768 bytes)

-- λ> raicesDigitalesSucesionRaicesDigitales3 (9^100) !! (3*10^6)

-- 9

-- (0.02 secs, 103,056 bytes)

-- λ> raicesDigitalesSucesionRaicesDigitales2 (9^100) !! (10^9)

-- 9

-- (2.09 secs, 103,608 bytes)

-- λ> raicesDigitalesSucesionRaicesDigitales3 (9^100) !! (10^9)

-- 9

-- (2.25 secs, 102,952 bytes)

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>

Sucesiones de raíces digitales

PorJosé A. Alonso 13-abril-202120-abril-2021

La raíz digital de un número entero positivo n es el dígito resulta al sumar sus dígitos, volviendo a sumar reiteradamente resultados de esa suma y de las siguientes hasta que la suma sea un número de un dígito, al que se llama la raíz digital del número n y se representa pod D(n). Por ejemplo, la raíz digital del número 23451 es 6, porque 2+3+4+5+1 = 15 y sumando los dígitos del 15 resulta 6.

   1,2,4,8,16,23,28,29,31,35,43,50,55,56,58,62,70,77,82,83,85,89,...

1	1,2,4,8,16,23,28,29,31,35,43,50,55,56,58,62,70,77,82,83,85,89,...

Se observa que el menor número que no pertenece a la sucesión anterior es 3. Los primeros términos de la sucesión de las raíces digitales definida por 3 son

   3,6,12,15,21,24,30,33,39,42,48,51,57,60,66,69,75,78,84,87,93,96,...

1	3,6,12,15,21,24,30,33,39,42,48,51,57,60,66,69,75,78,84,87,93,96,...

Se observa que el menor número que no pertenece a las 2 sucesiones anteriores es 5. Los primeros términos de la sucesión de las raíces digitales definida por 5 son

   5,10,11,13,17,25,32,37,38,40,44,52,59,64,65,67,71,79,86,91,92,94,...

1	5,10,11,13,17,25,32,37,38,40,44,52,59,64,65,67,71,79,86,91,92,94,...

Definir la función

   sucesionSucesionesRaicesDigitales :: [[Integer]]

1	sucesionSucesionesRaicesDigitales :: [[Integer]]

tal que sus elementos son las sucesiones de raíces digitales tal el primer elemento de cada sucesión es el menor elemento que no pertenece a las sucesiones anteriores. Por ejemplo,

   λ> map (take 5) (take 4 sucesionSucesionesRaicesDigitales)
   [[1,2,4,8,16],[3,6,12,15,21],[5,10,11,13,17],[7,14,19,20,22]]

1 2	λ> map (take 5) (take 4 sucesionSucesionesRaicesDigitales) [[1,2,4,8,16],[3,6,12,15,21],[5,10,11,13,17],[7,14,19,20,22]]

Comprobar con QuickCheck que sucesionSucesionesRaicesDigitales tiene exactamente 5 elementos.

Soluciones

import Test.QuickCheck

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

sucesionSucesionesRaicesDigitales :: [[Integer]]
sucesionSucesionesRaicesDigitales =
  map aux [1..]
  where aux 1 = sucesionRaicesDigitales 1
        aux n = sucesionRaicesDigitales m
          where m = head [a | a <- [1..],
                              all (a `noPertenece`)
                                  [aux k | k <- [1..n-1]]]

-- (sucesionRaicesDigitales a) es la sucesión de las raíces digitales
-- definida por un número a. Por ejemplo,
--    λ> take 22 (sucesionRaicesDigitales 1)
--    [1,2,4,8,16,23,28,29,31,35,43,50,55,56,58,62,70,77,82,83,85,89]
--    λ> take 22 (sucesionRaicesDigitales 3)
--    [3,6,12,15,21,24,30,33,39,42,48,51,57,60,66,69,75,78,84,87,93,96]
--    λ> take 22 (sucesionRaicesDigitales 5)
--    [5,10,11,13,17,25,32,37,38,40,44,52,59,64,65,67,71,79,86,91,92,94]
--    λ> take 22 (sucesionRaicesDigitales 7)
--    [7,14,19,20,22,26,34,41,46,47,49,53,61,68,73,74,76,80,88,95,100,101]
--    λ> take 22 (sucesionRaicesDigitales 9)
--    [9,18,27,36,45,54,63,72,81,90,99,108,117,126,135,144,153,162,171,180,189,198]
sucesionRaicesDigitales :: Integer -> [Integer]
sucesionRaicesDigitales a =
  iterate siguienteRaizDigital a

-- (siguienteRaizDigital a) es el siguiente de a en la sucesión de raices
-- digitales. Por ejemplo,
--    siguienteRaizDigital 23 == 28
siguienteRaizDigital :: Integer -> Integer
siguienteRaizDigital a =
  a + raizDigital a

-- (raizDigital n) es la raíz digital de n. Por ejemplo,
--    raizDigital 23451  ==  6
raizDigital :: Integer -> Integer
raizDigital n = 1 + (n-1) `mod` 9

-- (noPertenece x ys) se verifica si x no pertenece a la lista infinita
-- ordenada creciente ys. Por ejemplo,
--    noPertenece 2 [1,3..] == True
--    noPertenece 5 [1,3..] == False
noPertenece :: Integer -> [Integer] -> Bool
noPertenece x ys =
  not (x `pertenece` ys)

-- (Pertenece x ys) se verifica si x pertenece a la lista infinita
-- ordenada creciente ys. Por ejemplo,
--    pertenece 5 [1,3..] == True
--    pertenece 2 [1,3..] == False
pertenece :: Integer -> [Integer] -> Bool
pertenece x ys =
  x == head (dropWhile (<x) ys)

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

sucesionSucesionesRaicesDigitales2 :: [[Integer]]
sucesionSucesionesRaicesDigitales2 = aux [1..]
  where aux xs = sucesion xs : aux (diferencia xs (sucesion xs))
        sucesion xs = sucesionRaicesDigitales (head xs)

-- (diferencia xs ys) es la diferencia las listas infinitas ordenadas
-- crecientes xs e ys. Por ejemplo,
--    λ> take 8 (diferencia [1..] [2,4..])
--    [1,3,5,7,9,11,13,15]
diferencia :: [Integer] -> [Integer] -> [Integer]
diferencia (x:xs) (y:ys)
  | x == y    = diferencia xs ys
  | otherwise = x : diferencia xs (y:ys)

-- Propiedad
-- =========

-- Del cálculo 
--    λ> map (take 4) (take 5 sucesionSucesionesRaicesDigitales)
--    [[1,2,4,8],[3,6,12,15],[5,10,11,13],[7,14,19,20],[9,18,27,36]]
-- se deduce que tiene al menos 5. Sólo queda por comprobar que no tiene más; es decir
prop_sucesionSucesionesRaicesDigitales :: Integer -> Property
prop_sucesionSucesionesRaicesDigitales n =
  n > 0 ==>
  any (n `pertenece`) xss
  where xss = take 5 (sucesionSucesionesRaicesDigitales2)

-- La comprobación es
--    λ> quickCheck prop_sucesionSucesionesRaicesDigitales
--    +++ OK, passed 100 tests.

import Test.QuickCheck

-- 1ª solución

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

sucesionSucesionesRaicesDigitales :: [[Integer]]

sucesionSucesionesRaicesDigitales =

map aux [1..]

where aux 1 = sucesionRaicesDigitales 1

aux n = sucesionRaicesDigitales m

where m = head [a | a <- [1..],

all (a `noPertenece`)

[aux k | k <- [1..n-1]]]

-- (sucesionRaicesDigitales a) es la sucesión de las raíces digitales

-- definida por un número a. Por ejemplo,

-- λ> take 22 (sucesionRaicesDigitales 1)

-- [1,2,4,8,16,23,28,29,31,35,43,50,55,56,58,62,70,77,82,83,85,89]

-- λ> take 22 (sucesionRaicesDigitales 3)

-- [3,6,12,15,21,24,30,33,39,42,48,51,57,60,66,69,75,78,84,87,93,96]

-- λ> take 22 (sucesionRaicesDigitales 5)

-- [5,10,11,13,17,25,32,37,38,40,44,52,59,64,65,67,71,79,86,91,92,94]

-- λ> take 22 (sucesionRaicesDigitales 7)

-- [7,14,19,20,22,26,34,41,46,47,49,53,61,68,73,74,76,80,88,95,100,101]

-- λ> take 22 (sucesionRaicesDigitales 9)

-- [9,18,27,36,45,54,63,72,81,90,99,108,117,126,135,144,153,162,171,180,189,198]

sucesionRaicesDigitales :: Integer -> [Integer]

sucesionRaicesDigitales a =

iterate siguienteRaizDigital a

-- (siguienteRaizDigital a) es el siguiente de a en la sucesión de raices

-- digitales. Por ejemplo,

-- siguienteRaizDigital 23 == 28

siguienteRaizDigital :: Integer -> Integer

siguienteRaizDigital a =

a + raizDigital a

-- (raizDigital n) es la raíz digital de n. Por ejemplo,

-- raizDigital 23451 == 6

raizDigital :: Integer -> Integer

raizDigital n = 1 + (n-1) `mod` 9

-- (noPertenece x ys) se verifica si x no pertenece a la lista infinita

-- ordenada creciente ys. Por ejemplo,

-- noPertenece 2 [1,3..] == True

-- noPertenece 5 [1,3..] == False

noPertenece :: Integer -> [Integer] -> Bool

noPertenece x ys =

not (x `pertenece` ys)

-- (Pertenece x ys) se verifica si x pertenece a la lista infinita

-- ordenada creciente ys. Por ejemplo,

-- pertenece 5 [1,3..] == True

-- pertenece 2 [1,3..] == False

pertenece :: Integer -> [Integer] -> Bool

pertenece x ys =

x == head (dropWhile (<x) ys)

-- 2ª solución

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

sucesionSucesionesRaicesDigitales2 :: [[Integer]]

sucesionSucesionesRaicesDigitales2 = aux [1..]

where aux xs = sucesion xs : aux (diferencia xs (sucesion xs))

sucesion xs = sucesionRaicesDigitales (head xs)

-- (diferencia xs ys) es la diferencia las listas infinitas ordenadas

-- crecientes xs e ys. Por ejemplo,

-- λ> take 8 (diferencia [1..] [2,4..])

-- [1,3,5,7,9,11,13,15]

diferencia :: [Integer] -> [Integer] -> [Integer]

diferencia (x:xs) (y:ys)

| x == y = diferencia xs ys

| otherwise = x : diferencia xs (y:ys)

-- Propiedad

-- =========

-- Del cálculo

-- λ> map (take 4) (take 5 sucesionSucesionesRaicesDigitales)

-- [[1,2,4,8],[3,6,12,15],[5,10,11,13],[7,14,19,20],[9,18,27,36]]

-- se deduce que tiene al menos 5. Sólo queda por comprobar que no tiene más; es decir

prop_sucesionSucesionesRaicesDigitales :: Integer -> Property

prop_sucesionSucesionesRaicesDigitales n =

n > 0 ==>

any (n `pertenece`) xss

where xss = take 5 (sucesionSucesionesRaicesDigitales2)

-- La comprobación es

-- λ> quickCheck prop_sucesionSucesionesRaicesDigitales

-- +++ OK, passed 100 tests.

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>

Raíces digitales de los números de Fibonacci

PorJosé A. Alonso 12-abril-202119-abril-2021

La sucesión Fibonacci es la siguiente sucesión infinita de números naturales:

   1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, ...

1	1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, ...

La sucesión comienza con los números 1 y 1 y, a partir de estos, cada término es la suma de los dos anteriores.

Definir la función

   raizDigitalFibonacci :: Integer -> Integer

1	raizDigitalFibonacci :: Integer -> Integer

tal que (raizDigitalFibonacci n) es la raíz digital del n-ésimo número de Fibonacci. Por ejemplo,

   raizDigitalFibonacci 6         ==  4
   raizDigitalFibonacci 7         ==  3
   raizDigitalFibonacci (3*10^7)  ==  1

raizDigitalFibonacci 6 == 4

raizDigitalFibonacci 7 == 3

raizDigitalFibonacci (3*10^7) == 1

Soluciones

import Data.List (genericIndex, cycle)

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

raizDigitalFibonacci :: Integer -> Integer
raizDigitalFibonacci =
  raizDigital . fibonacci

-- (fibonacci k) es el k-ésimo número de Fibonacci. Por ejemplo,
fibonacci :: Integer -> Integer
fibonacci 0 = 1
fibonacci 1 = 1
fibonacci n = fibonacci (n-1) + fibonacci (n-2)

-- (raizDigital n) es la raíz digital de n. Por ejemplo,
--    raizDigital 23451  ==  6
raizDigital :: Integer -> Integer
raizDigital n = 1 + (n-1) `mod` 9

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

raizDigitalFibonacci2 :: Integer -> Integer
raizDigitalFibonacci2 n =
  raizDigital (fibs `genericIndex` n)

-- fibs es la la sucesión de los números de Fibonacci. Por ejemplo,
--    take 14 fibs  == [1,1,2,3,5,8,13,21,34,55,89,144,233,377]
fibs :: [Integer]
fibs = 1 : scanl (+) 1 fibs

-- 3ª solución
-- ===========

-- En el cálculo
---   λ> map raizDigitalFibonacci2 [0..47]
---   [1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9,
--     1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9]
-- se observa que la lista es periódica con período
--    1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9,

raizDigitalFibonacci3 :: Integer -> Integer
raizDigitalFibonacci3 n =
  raicesDigitalesFibonacci `genericIndex` n

-- raicesDigitalesFibonacci es la suceción de las raíces digitales de
-- los números de Fibonacci. Por ejemplo,
---   λ> take 24 raicesDigitalesFibonacci
---   [1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9]
raicesDigitalesFibonacci :: [Integer]
raicesDigitalesFibonacci =
  concat (repeat [1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9])

-- 4ª solución
-- ===========

raizDigitalFibonacci4 :: Integer -> Integer
raizDigitalFibonacci4 n =
  raicesDigitalesFibonacci2 `genericIndex` n

-- raicesDigitalesFibonacci2 es la suceción de las raíces digitales de
-- los números de Fibonacci. Por ejemplo,
---   λ> take 24 raicesDigitalesFibonacci2
---   [1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9]
raicesDigitalesFibonacci2 :: [Integer]
raicesDigitalesFibonacci2 =
  cycle [1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9]

-- Comparación de eficiencia
-- =========================

-- La comparación es
--    λ> raizDigitalFibonacci 34
--    8
--    (7.88 secs, 3,560,871,624 bytes)
--    λ> raizDigitalFibonacci2 34
--    8
--    (0.01 secs, 106,896 bytes)
--    λ> raizDigitalFibonacci3 34
--    8
--    (0.01 secs, 106,568 bytes)
--    λ> raizDigitalFibonacci4 34
--    8
--    (0.01 secs, 107,512 bytes)
--
--    λ> raizDigitalFibonacci2 (4*10^5)
--    4
--    (3.19 secs, 7,146,227,192 bytes)
--    λ> raizDigitalFibonacci3 (4*10^5)
--    4
--    (0.05 secs, 80,635,064 bytes)
--    λ> raizDigitalFibonacci4 (4*10^5)
--    4
--    (0.05 secs, 57,701,392 bytes)
--
--    λ> raizDigitalFibonacci3 (10^7)
--    4
--    (1.34 secs, 2,013,435,912 bytes)
--    λ> raizDigitalFibonacci4 (10^7)
--    4
--    (0.66 secs, 1,440,100,712 bytes)
--
--    λ> raizDigitalFibonacci4 (3*10^7)
--    1
--    (1.92 secs, 4,320,102,368 bytes)

100

101

102

103

104

105

106

import Data.List (genericIndex, cycle)

-- 1ª solución

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

raizDigitalFibonacci :: Integer -> Integer

raizDigitalFibonacci =

raizDigital . fibonacci

-- (fibonacci k) es el k-ésimo número de Fibonacci. Por ejemplo,

fibonacci :: Integer -> Integer

fibonacci 0 = 1

fibonacci 1 = 1

fibonacci n = fibonacci (n-1) + fibonacci (n-2)

-- (raizDigital n) es la raíz digital de n. Por ejemplo,

-- raizDigital 23451 == 6

raizDigital :: Integer -> Integer

raizDigital n = 1 + (n-1) `mod` 9

-- 2ª solución

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

raizDigitalFibonacci2 :: Integer -> Integer

raizDigitalFibonacci2 n =

raizDigital (fibs `genericIndex` n)

-- fibs es la la sucesión de los números de Fibonacci. Por ejemplo,

-- take 14 fibs == [1,1,2,3,5,8,13,21,34,55,89,144,233,377]

fibs :: [Integer]

fibs = 1 : scanl (+) 1 fibs

-- 3ª solución

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

-- En el cálculo

--- λ> map raizDigitalFibonacci2 [0..47]

--- [1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9,

-- 1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9]

-- se observa que la lista es periódica con período

-- 1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9,

raizDigitalFibonacci3 :: Integer -> Integer

raizDigitalFibonacci3 n =

raicesDigitalesFibonacci `genericIndex` n

-- raicesDigitalesFibonacci es la suceción de las raíces digitales de

-- los números de Fibonacci. Por ejemplo,

--- λ> take 24 raicesDigitalesFibonacci

--- [1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9]

raicesDigitalesFibonacci :: [Integer]

raicesDigitalesFibonacci =

concat (repeat [1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9])

-- 4ª solución

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

raizDigitalFibonacci4 :: Integer -> Integer

raizDigitalFibonacci4 n =

raicesDigitalesFibonacci2 `genericIndex` n

-- raicesDigitalesFibonacci2 es la suceción de las raíces digitales de

-- los números de Fibonacci. Por ejemplo,

--- λ> take 24 raicesDigitalesFibonacci2

--- [1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9]

raicesDigitalesFibonacci2 :: [Integer]

raicesDigitalesFibonacci2 =

cycle [1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9]

-- Comparación de eficiencia

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

-- La comparación es

-- λ> raizDigitalFibonacci 34

-- 8

-- (7.88 secs, 3,560,871,624 bytes)

-- λ> raizDigitalFibonacci2 34

-- 8

-- (0.01 secs, 106,896 bytes)

-- λ> raizDigitalFibonacci3 34

-- 8

-- (0.01 secs, 106,568 bytes)

-- λ> raizDigitalFibonacci4 34

-- 8

-- (0.01 secs, 107,512 bytes)

-- λ> raizDigitalFibonacci2 (4*10^5)

-- 4

-- (3.19 secs, 7,146,227,192 bytes)

-- λ> raizDigitalFibonacci3 (4*10^5)

-- 4

-- (0.05 secs, 80,635,064 bytes)

-- λ> raizDigitalFibonacci4 (4*10^5)

-- 4

-- (0.05 secs, 57,701,392 bytes)

-- λ> raizDigitalFibonacci3 (10^7)

-- 4

-- (1.34 secs, 2,013,435,912 bytes)

-- λ> raizDigitalFibonacci4 (10^7)

-- 4

-- (0.66 secs, 1,440,100,712 bytes)

-- λ> raizDigitalFibonacci4 (3*10^7)

-- 1

-- (1.92 secs, 4,320,102,368 bytes)

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>

Meses: abril 2021

Sucesión de cubos perfectos

Soluciones

Nuevas soluciones

Enlaces primos

Soluciones

Nuevas soluciones

Raíces digitales de sucesiones de raíces digitales

Soluciones

Nuevas soluciones

Sucesiones de raíces digitales

Soluciones

Nuevas soluciones

Raíces digitales de los números de Fibonacci

Soluciones

Nuevas soluciones

Entradas recientes

Buscar

Correo electrónico