Ejercicio

Cuadriseguidos y números encadenados

PorJosé A. Alonso 20-abril-202127-abril-2021

El enunciado del primer problema de este mes de la RSME es el siguiente:

Un entero positivo de dos o más cifras se denomina cuadriseguido si cada par de dígitos consecutivos que tenga es un cuadrado perfecto. Por ejemplo,

364 es cuadriseguido, pues 36 = 6^2 y 64 = 8^2

3642 no lo es porque 42 no es un cuadrado perfecto.

Obtén todos los números cuadriseguidos posibles.

El concepto de cuadriseguido se puede generalizar como sigue: Un entero positivo n de dos o más cifras se denomina encadenado respecto de una lista de números de dos dígitos xs si cada par de dígitos consecutivos que tenga es un elemento distinto de xs. Por ejemplo,

364 es encadenado respecto de xs = [36,64,15], porque 36 y 64 pertenecen a xs
3642 no es encadenado respecto de xs = [36,64,15], porque 42 no pertenece a xs

Definir la función

   encadenados :: [Integer] -> [Integer]

1	encadenados :: [Integer] -> [Integer]

tal que (encadenados xs) es la lista de los números encadenados respecto de xs. Por ejemplo,

   λ> encadenados [12,23,31]
   [12,23,31,123,231,312,1231,2312,3123]
   λ> encadenados [12,22,31]
   [12,22,31,122,312,3122]
   λ> take 14 (encadenados [n^2 | n <- [4..9]])
   [16,25,36,49,64,81,164,364,649,816,1649,3649,8164,81649]
   λ> length (encadenados [10..42])
   911208

λ> encadenados [12,23,31]

[12,23,31,123,231,312,1231,2312,3123]

λ> encadenados [12,22,31]

[12,22,31,122,312,3122]

λ> take 14 (encadenados [n^2 | n <- [4..9]])

[16,25,36,49,64,81,164,364,649,816,1649,3649,8164,81649]

λ> length (encadenados [10..42])

911208

Calcular todos los números cuadriseguidos posibles usando la función encadenados.

Soluciones

import Data.List (delete, sort)
import Data.Tree (Tree (Node), drawTree)
import Test.QuickCheck (Gen, choose, sublistOf, quickCheck)

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

encadenados :: [Integer] -> [Integer]
encadenados xs =
  filter (esEncadenado xs) [10..10^(2 * length xs) - 1]

-- (esEncadenado xs n) se verifica si n es un número encadenado respecto
-- de xs. Por ejemplo,
--    esEncadenado [36,64,15] 364   ==  True
--    esEncadenado [36,64,15] 3642  ==  False
--    esEncadenado [36,63] 3636     ==  False
esEncadenado :: [Integer] -> Integer -> Bool
esEncadenado xs n =
  dosConsecutivos n `contenido` xs

-- (dosConsecutivos n) es la lista de los números formados por dos
-- dígitos consecutivos de xs. Por ejemplo,
--    dosConsecutivos 81649  ==  [81,16,64,49]
dosConsecutivos :: Integer -> [Integer]
dosConsecutivos n =
  map read [[x,y] | (x,y) <- zip xs (tail xs)]
  where xs = show n

-- Otra definición alternativa
dosConsecutivos2 :: Integer -> [Integer]
dosConsecutivos2 = reverse . aux
  where aux n
          | n < 10    = []
          | otherwise = n `mod` 100 : aux (n `div` 10)

-- (contenido xs ys) se verifica si xs está contenido en ys. Por
-- ejemplo,
--    contenido [2,5] [3,5,2]  ==  True
--    contenido [2,5,5] [3,5,2]  ==  False
contenido :: [Integer] -> [Integer] -> Bool
contenido [] _      = True
contenido (x:xs) ys = x `elem` ys && xs `contenido` (delete x ys)

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

encadenados2 :: [Integer] -> [Integer]
encadenados2 xs =
  sort (map (digitosAnumero . cadenaReducida) (tail (nodos (arbolCadenas ps))))
  where ps = map (`divMod` 10) xs

-- (arbolCadenas ps) es el árbol de las cadenas formadas con los
-- elementos de ps. Por ejemplo,
--    λ> putStrLn (drawTree (fmap show (arbolCadenas [(1,2),(2,3),(3,1)])))
--    []
--    |
--    +- [(1,2)]
--    |  |
--    |  `- [(3,1),(1,2)]
--    |     |
--    |     `- [(2,3),(3,1),(1,2)]
--    |
--    +- [(2,3)]
--    |  |
--    |  `- [(1,2),(2,3)]
--    |     |
--    |     `- [(3,1),(1,2),(2,3)]
--    |
--    `- [(3,1)]
--       |
--       `- [(2,3),(3,1)]
--          |
--          `- [(1,2),(2,3),(3,1)]
arbolCadenas :: Eq a => [(a,a)] -> Tree [(a,a)]
arbolCadenas ps = aux []
  where
    aux xs = Node xs (map aux (extensiones xs))
    extensiones [] =
      [[p] | p <- ps]
    extensiones ((x,y):rs) =
      [(a,b):(x,y):rs | (a,b) <- ps,
                        b == x,
                        (a,b) `notElem` ((x,y):rs)]

-- (nodos a) es la lista de los nodos del árbol a. Por ejemplo,
--    λ> nodos (arbolCadenas [(1,6),(6,4),(8,1)])
--    [[],[(1,6)],[(8,1),(1,6)],[(6,4)],[(1,6),(6,4)],[(8,1),(1,6),(6,4)],[(8,1)]]
nodos :: Tree [(a,a)] -> [[(a,a)]]
nodos (Node x ys) =
  x : concatMap nodos ys

-- (cadenaReducida ps) es la lista de los elementos la cadena ps donde
-- los enlaces solo se escriben una vez. Por ejemplo,
--    cadenaReducida [(8,1),(1,6),(6,4),(4,9)]  ==  [8,1,6,4,9]
cadenaReducida :: [(a,a)] -> [a]
cadenaReducida [] = []
cadenaReducida ((x,y):ps) = x : y : map snd ps

-- (digitosAnumero xs) es el número cuya lista de dígitos es xs. Por
-- ejemplo,
--    digitosAnumero [8,1,6,4,9]  ==  81649
digitosAnumero :: [Integer] -> Integer
digitosAnumero xs =
  read (concatMap show xs)

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

encadenados3 :: [Integer] -> [Integer]
encadenados3 xs =
  sort (map read (aux [(p,delete p ps) | p <- ps]))
  where
    ps = map show xs
    aux [] = []
    aux ((as,qs):yss)
      | null zss  = as : aux yss
      | otherwise = as : aux (zss ++ yss)
      where zss = extensiones (as,qs)
    extensiones (x:xs,cs) =
      [(a:x:xs,delete [a,b] cs) | [a,b] <- cs, b == x]

-- Cálculo de cuadriseguidos
-- =========================

-- El cálculo es
--    λ> encadenados2 [n^2 | n <- [4..9]]
--    [16,25,36,49,64,81,164,364,649,816,1649,3649,8164,81649]

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

-- La propiedad es
prop_encadenados :: Gen Bool
prop_encadenados = do
  n <- choose (2,9)
  xs <- sublistOf [10..99]
  let ys = take n xs
      as = encadenados3 ys
      m  = length as
  return (take m (encadenados ys) == as &&
          encadenados2 ys == as)

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

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

-- La comparación es
--    λ> encadenados [12,24,41]
--    [12,24,41,124,241,412,1241,2412,4124]
--    (2.23 secs, 5,189,736,248 bytes)
--    λ> encadenados2 [12,24,41]
--    [12,24,41,124,241,412,1241,2412,4124]
--    (0.00 secs, 188,496 bytes)
--    λ> encadenados3 [12,24,41]
--    [12,24,41,124,241,412,1241,2412,4124]
--    (0.01 secs, 176,376 bytes)
--
--    λ> length (encadenados2 [10..42])
--    911208
--    (13.59 secs, 14,104,867,760 bytes)
--    λ> length (encadenados3 [10..42])
--    911208
--    (10.62 secs, 10,164,004,808 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

import Data.List (delete, sort)

import Data.Tree (Tree (Node), drawTree)

import Test.QuickCheck (Gen, choose, sublistOf, quickCheck)

-- 1ª solución

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

encadenados :: [Integer] -> [Integer]

encadenados xs =

filter (esEncadenado xs) [10..10^(2 * length xs) - 1]

-- (esEncadenado xs n) se verifica si n es un número encadenado respecto

-- de xs. Por ejemplo,

-- esEncadenado [36,64,15] 364 == True

-- esEncadenado [36,64,15] 3642 == False

-- esEncadenado [36,63] 3636 == False

esEncadenado :: [Integer] -> Integer -> Bool

esEncadenado xs n =

dosConsecutivos n `contenido` xs

-- (dosConsecutivos n) es la lista de los números formados por dos

-- dígitos consecutivos de xs. Por ejemplo,

-- dosConsecutivos 81649 == [81,16,64,49]

dosConsecutivos :: Integer -> [Integer]

dosConsecutivos n =

map read [[x,y] | (x,y) <- zip xs (tail xs)]

where xs = show n

-- Otra definición alternativa

dosConsecutivos2 :: Integer -> [Integer]

dosConsecutivos2 = reverse . aux

where aux n

| n < 10 = []

| otherwise = n `mod` 100 : aux (n `div` 10)

-- (contenido xs ys) se verifica si xs está contenido en ys. Por

-- ejemplo,

-- contenido [2,5] [3,5,2] == True

-- contenido [2,5,5] [3,5,2] == False

contenido :: [Integer] -> [Integer] -> Bool

contenido [] _ = True

contenido (x:xs) ys = x `elem` ys && xs `contenido` (delete x ys)

-- 2ª solución

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

encadenados2 :: [Integer] -> [Integer]

encadenados2 xs =

sort (map (digitosAnumero . cadenaReducida) (tail (nodos (arbolCadenas ps))))

where ps = map (`divMod` 10) xs

-- (arbolCadenas ps) es el árbol de las cadenas formadas con los

-- elementos de ps. Por ejemplo,

-- λ> putStrLn (drawTree (fmap show (arbolCadenas [(1,2),(2,3),(3,1)])))

-- []

-- |

-- +- [(1,2)]

-- | |

-- | `- [(3,1),(1,2)]

-- | |

-- | `- [(2,3),(3,1),(1,2)]

-- |

-- +- [(2,3)]

-- | |

-- | `- [(1,2),(2,3)]

-- | |

-- | `- [(3,1),(1,2),(2,3)]

-- |

-- `- [(3,1)]

-- |

-- `- [(2,3),(3,1)]

-- |

-- `- [(1,2),(2,3),(3,1)]

arbolCadenas :: Eq a => [(a,a)] -> Tree [(a,a)]

arbolCadenas ps = aux []

where

aux xs = Node xs (map aux (extensiones xs))

extensiones [] =

[[p] | p <- ps]

extensiones ((x,y):rs) =

[(a,b):(x,y):rs | (a,b) <- ps,

b == x,

(a,b) `notElem` ((x,y):rs)]

-- (nodos a) es la lista de los nodos del árbol a. Por ejemplo,

-- λ> nodos (arbolCadenas [(1,6),(6,4),(8,1)])

-- [[],[(1,6)],[(8,1),(1,6)],[(6,4)],[(1,6),(6,4)],[(8,1),(1,6),(6,4)],[(8,1)]]

nodos :: Tree [(a,a)] -> [[(a,a)]]

nodos (Node x ys) =

x : concatMap nodos ys

-- (cadenaReducida ps) es la lista de los elementos la cadena ps donde

-- los enlaces solo se escriben una vez. Por ejemplo,

-- cadenaReducida [(8,1),(1,6),(6,4),(4,9)] == [8,1,6,4,9]

cadenaReducida :: [(a,a)] -> [a]

cadenaReducida [] = []

cadenaReducida ((x,y):ps) = x : y : map snd ps

-- (digitosAnumero xs) es el número cuya lista de dígitos es xs. Por

-- ejemplo,

-- digitosAnumero [8,1,6,4,9] == 81649

digitosAnumero :: [Integer] -> Integer

digitosAnumero xs =

read (concatMap show xs)

-- 3ª solución

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

encadenados3 :: [Integer] -> [Integer]

encadenados3 xs =

sort (map read (aux [(p,delete p ps) | p <- ps]))

where

ps = map show xs

aux [] = []

aux ((as,qs):yss)

| null zss = as : aux yss

| otherwise = as : aux (zss ++ yss)

where zss = extensiones (as,qs)

extensiones (x:xs,cs) =

[(a:x:xs,delete [a,b] cs) | [a,b] <- cs, b == x]

-- Cálculo de cuadriseguidos

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

-- El cálculo es

-- λ> encadenados2 [n^2 | n <- [4..9]]

-- [16,25,36,49,64,81,164,364,649,816,1649,3649,8164,81649]

-- Comprobación de equivalencia

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

-- La propiedad es

prop_encadenados :: Gen Bool

prop_encadenados = do

n <- choose (2,9)

xs <- sublistOf [10..99]

let ys = take n xs

as = encadenados3 ys

m = length as

return (take m (encadenados ys) == as &&

encadenados2 ys == as)

-- La comprobación es

-- λ> quickCheck prop_encadenados

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> encadenados [12,24,41]

-- [12,24,41,124,241,412,1241,2412,4124]

-- (2.23 secs, 5,189,736,248 bytes)

-- λ> encadenados2 [12,24,41]

-- [12,24,41,124,241,412,1241,2412,4124]

-- (0.00 secs, 188,496 bytes)

-- λ> encadenados3 [12,24,41]

-- [12,24,41,124,241,412,1241,2412,4124]

-- (0.01 secs, 176,376 bytes)

-- λ> length (encadenados2 [10..42])

-- 911208

-- (13.59 secs, 14,104,867,760 bytes)

-- λ> length (encadenados3 [10..42])

-- 911208

-- (10.62 secs, 10,164,004,808 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>

Árbol de cadenas

PorJosé A. Alonso 19-abril-202126-abril-2021

En la librería Data.Tree se definen los árboles y los bosques como sigue

   data Tree a   = Node a (Forest a)
   type Forest a = [Tree a]

1 2	data Tree a = Node a (Forest a) type Forest a = [Tree a]

Se pueden definir árboles. Por ejemplo,

   ej = Node 3 [Node 5 [Node 9 []], Node 7 []]

1	ej = Node 3 [Node 5 [Node 9 []], Node 7 []]

Y se pueden dibujar con la función drawTree. Por ejemplo,

   λ> putStrLn (drawTree (fmap show ej))
   3
   |
   +- 5
   |  |
   |  `- 9
   |
   `- 7

λ> putStrLn (drawTree (fmap show ej))

+- 5

| |

| `- 9

`- 7

Una cadena con un conjunto de pares ps es una lista xs de elementos distintos de ps tales que la segunda componente de cada elemento de xs es igual a la primera componente de su siguiente elemento. Por ejemplo, si ps = [(1,6),(2,5),(3,6),(4,9),(6,4),(8,1)] entonces [(6,4)], [(8,1),(1,6)] y [(8,1),(1,6),(6,4),(4,9)] son cadenas con ps.

Definir la función

   arbolCadenas :: Eq a => [(a,a)] -> Tree [(a,a)]

1	arbolCadenas :: Eq a => [(a,a)] -> Tree [(a,a)]

tal que (arbolCadenas ps) es el árbol de las cadenas formadas con los elementos de ps. Por ejemplo,

   λ> putStrLn (drawTree (fmap show (arbolCadenas [(1,2),(2,3),(3,1)])))
   []
   |
   +- [(1,2)]
   |  |
   |  `- [(3,1),(1,2)]
   |     |
   |     `- [(2,3),(3,1),(1,2)]
   |
   +- [(2,3)]
   |  |
   |  `- [(1,2),(2,3)]
   |     |
   |     `- [(3,1),(1,2),(2,3)]
   |
   `- [(3,1)]
      |
      `- [(2,3),(3,1)]
         |
         `- [(1,2),(2,3),(3,1)]

   λ> putStrLn (drawTree (fmap show (arbolCadenas [(1,6),(2,5),(3,6),(4,9),(6,4),(8,1)])))
   []
   |
   +- [(1,6)]
   |  |
   |  `- [(8,1),(1,6)]
   |
   +- [(2,5)]
   |
   +- [(3,6)]
   |
   +- [(4,9)]
   |  |
   |  `- [(6,4),(4,9)]
   |     |
   |     +- [(1,6),(6,4),(4,9)]
   |     |  |
   |     |  `- [(8,1),(1,6),(6,4),(4,9)]
   |     |
   |     `- [(3,6),(6,4),(4,9)]
   |
   +- [(6,4)]
   |  |
   |  +- [(1,6),(6,4)]
   |  |  |
   |  |  `- [(8,1),(1,6),(6,4)]
   |  |
   |  `- [(3,6),(6,4)]
   |
   `- [(8,1)]

λ> putStrLn (drawTree (fmap show (arbolCadenas [(1,2),(2,3),(3,1)])))

[]

+- [(1,2)]

| |

| `- [(3,1),(1,2)]

| |

| `- [(2,3),(3,1),(1,2)]

+- [(2,3)]

| |

| `- [(1,2),(2,3)]

| |

| `- [(3,1),(1,2),(2,3)]

`- [(3,1)]

`- [(2,3),(3,1)]

`- [(1,2),(2,3),(3,1)]

λ> putStrLn (drawTree (fmap show (arbolCadenas [(1,6),(2,5),(3,6),(4,9),(6,4),(8,1)])))

[]

+- [(1,6)]

| |

| `- [(8,1),(1,6)]

+- [(2,5)]

+- [(3,6)]

+- [(4,9)]

| |

| `- [(6,4),(4,9)]

| |

| +- [(1,6),(6,4),(4,9)]

| | |

| | `- [(8,1),(1,6),(6,4),(4,9)]

| |

| `- [(3,6),(6,4),(4,9)]

+- [(6,4)]

| |

| +- [(1,6),(6,4)]

| | |

| | `- [(8,1),(1,6),(6,4)]

| |

| `- [(3,6),(6,4)]

`- [(8,1)]

Soluciones

import Data.Tree (Tree (Node), drawTree)

arbolCadenas :: Eq a => [(a,a)] -> Tree [(a,a)]
arbolCadenas ps = aux []
  where
    aux xs = Node xs (map aux (extensiones xs))
    extensiones [] =
      [[p] | p <- ps]
    extensiones ((x,y):rs) =
      [(a,b):(x,y):rs | (a,b) <- ps,
                        b == x,
                        (a,b) `notElem` ((x,y):rs)]

import Data.Tree (Tree (Node), drawTree)

arbolCadenas :: Eq a => [(a,a)] -> Tree [(a,a)]

arbolCadenas ps = aux []

where

aux xs = Node xs (map aux (extensiones xs))

extensiones [] =

[[p] | p <- ps]

extensiones ((x,y):rs) =

[(a,b):(x,y):rs | (a,b) <- ps,

b == x,

(a,b) `notElem` ((x,y):rs)]

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>

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>

Raíces digitales de los números de Fermat.

PorJosé A. Alonso 9-abril-202116-abril-2021

Los números de Fermat son los número de la forma F(n) = 2^(2^n) + 1, donde n es un número natural.

Definir la función

   raizDigitalFermat :: Integer -> Integer

1	raizDigitalFermat :: Integer -> Integer

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

   raizDigitalFermat 3          ==  5
   raizDigitalFermat (10^2021)  ==  8

1 2	raizDigitalFermat 3 == 5 raizDigitalFermat (10^2021) == 8

Soluciones

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

raizDigitalFermat :: Integer -> Integer
raizDigitalFermat =
  raizDigital . fermat

-- (fermat k) es el k-ésimo número de Fermat. Por ejemplo,
--    fermat 0  ==  3
--    fermat 1  ==  5
--    fermat 2  ==  17
--    fermat 3  ==  257
--    fermat 4  ==  65537
--    fermat 5  ==  4294967297
fermat :: Integer -> Integer
fermat k = 1 + 2^(2^k)

-- (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
-- ===========

-- En el cálculo
--    λ> map raizDigitalFermat [0..20]
--    [3,5,8,5,8,5,8,5,8,5,8,5,8,5,8,5,8,5,8,5,8]
-- se observa que se compone del 3 seguido por la repetición periódica
-- de 5 y 8.

raizDigitalFermat2 :: Integer -> Integer
raizDigitalFermat2 0 = 3
raizDigitalFermat2 n
  | odd n     = 5
  | otherwise = 8

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

-- La comparación es
--    λ> raizDigitalFermat 30
--    8
--    (6.76 secs, 536,981,128 bytes)
--    λ> raizDigitalFermat2 30
--    8
--    (0.01 secs, 98,400 bytes)

-- 1ª solución

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

raizDigitalFermat :: Integer -> Integer

raizDigitalFermat =

raizDigital . fermat

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

-- fermat 0 == 3

-- fermat 1 == 5

-- fermat 2 == 17

-- fermat 3 == 257

-- fermat 4 == 65537

-- fermat 5 == 4294967297

fermat :: Integer -> Integer

fermat k = 1 + 2^(2^k)

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

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

-- En el cálculo

-- λ> map raizDigitalFermat [0..20]

-- [3,5,8,5,8,5,8,5,8,5,8,5,8,5,8,5,8,5,8,5,8]

-- se observa que se compone del 3 seguido por la repetición periódica

-- de 5 y 8.

raizDigitalFermat2 :: Integer -> Integer

raizDigitalFermat2 0 = 3

raizDigitalFermat2 n

| odd n = 5

| otherwise = 8

-- Comparación de eficiencia

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

-- La comparación es

-- λ> raizDigitalFermat 30

-- 8

-- (6.76 secs, 536,981,128 bytes)

-- λ> raizDigitalFermat2 30

-- 8

-- (0.01 secs, 98,400 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>

Persistencia aditiva

PorJosé A. Alonso 8-abril-202115-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 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 23451 es 6, porque 2+3+4+5+1 = 15 y sumando los dígitos del 15 resulta 6.

La persistencia aditiva de un número entero positivo es el número de veces que hay sumar sus dígitos para llegar a su raíz digital. Por ejemplo, la persistencia aditiva de 2718 es 2: primero encontramos que 2+7+1+8 = 18, luego que 1+8 = 9.

Definir la función

   persistencia :: Integer -> Integer

1	persistencia :: Integer -> Integer

tal que (persistencia n) es la persistencia del número entero positivo n. Por ejemplo,

   persistencia 2718                     ==  2
   persistencia 199                      ==  3
   persistencia 19999999999999999999999  ==  4

persistencia 2718 == 2

persistencia 199 == 3

persistencia 19999999999999999999999 == 4

Soluciones

import Data.List (genericLength)
import Test.QuickCheck (Property, (==>), quickCheck)

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

persistencia :: Integer -> Integer
persistencia n
  | n < 10    = 0
  | otherwise = 1 + persistencia (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
-- ===========

persistencia2 :: Integer -> Integer
persistencia2 = aux 0
  where aux m n
          | n < 10    = m
          | otherwise = aux (m+1) (sumaDigitos n)

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

persistencia3 :: Integer -> Integer
persistencia3 n =
  genericLength (takeWhile (>9) (iterate sumaDigitos n))

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

-- La propiedad es
prop_equiv :: Integer -> Property
prop_equiv n =
  n > 0 ==>
  all (== (persistencia n))
      [persistencia2 n,
       persistencia3 n]

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

import Data.List (genericLength)

import Test.QuickCheck (Property, (==>), quickCheck)

-- 1ª solución

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

persistencia :: Integer -> Integer

persistencia n

| n < 10 = 0

| otherwise = 1 + persistencia (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

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

persistencia2 :: Integer -> Integer

persistencia2 = aux 0

where aux m n

| n < 10 = m

| otherwise = aux (m+1) (sumaDigitos n)

-- 3ª solución

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

persistencia3 :: Integer -> Integer

persistencia3 n =

genericLength (takeWhile (>9) (iterate sumaDigitos n))

-- Comprobación de equivalencia

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

-- La propiedad es

prop_equiv :: Integer -> Property

prop_equiv n =

n > 0 ==>

all (== (persistencia n))

[persistencia2 n,

persistencia3 n]

-- La comprobación es

-- λ> quickCheck prop_equiv

-- +++ 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 potencias de dos

PorJosé A. Alonso 7-abril-202114-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 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 por 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.

Definir la función

   raizDigitalPotencia :: Integer -> Integer

1	raizDigitalPotencia :: Integer -> Integer

tal que (raizDigitalPotencia n) es la raíz digital de 2^n. Por ejemplo,

   raizDigitalPotencia 6            ==  1
   raizDigitalPotencia (10^(10^8))  ==  7

1 2	raizDigitalPotencia 6 == 1 raizDigitalPotencia (10^(10^8)) == 7

Soluciones

import Test.QuickCheck (Property, (==>), quickCheck)

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

raizDigitalPotencia :: Integer -> Integer
raizDigitalPotencia n =
  raizDigital (2^n)

-- (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
-- ===========

-- Calculando las raíces digitales de los primeros números se obtiene
--    λ> map raizDigitalPotencia [0..29]
--    [1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5]
-- Se observa se repite el período 1,2,4,8,7,5.

raizDigitalPotencia2 :: Integer -> Integer
raizDigitalPotencia2 n
    | m == 0 = 1
    | m == 1 = 2
    | m == 2 = 4
    | m == 3 = 8
    | m == 4 = 7
    | m == 5 = 5
  where m = n `mod` 6

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

raizDigitalPotencia3 :: Integer -> Integer
raizDigitalPotencia3 n =
  case (n `mod` 6) of
    0 -> 1
    1 -> 2
    2 -> 4
    3 -> 8
    4 -> 7
    5 -> 5

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

raizDigitalPotencia4 :: Integer -> Integer
raizDigitalPotencia4 n =
  raizDigital (2^(mod n 6))

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

-- La propiedad es
prop_raizDigitalPotencia :: Integer -> Property
prop_raizDigitalPotencia n =
  n >= 0 ==>
  all (== (raizDigitalPotencia n))
      [raizDigitalPotencia2 n,
       raizDigitalPotencia3 n,
       raizDigitalPotencia4 n]

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

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

-- La comparación es
--    λ> raizDigitalPotencia 300000000
--    1
--    (2.82 secs, 149,107,152 bytes)
--    λ> raizDigitalPotencia2 300000000
--    1
--    (0.01 secs, 98,480 bytes)
--    λ> raizDigitalPotencia3 300000000
--    1
--    (0.01 secs, 98,440 bytes)
--    λ> raizDigitalPotencia4 300000000
--    1
--    (0.01 secs, 98,568 bytes)
--
--    λ> raizDigitalPotencia2 (10^(10^8))
--    7
--    (3.09 secs, 123,233,992 bytes)
--    λ> raizDigitalPotencia3 (10^(10^8))
--    7
--    (3.07 secs, 123,232,728 bytes)
--    λ> raizDigitalPotencia4 (10^(10^8))
--    7
--    (3.18 secs, 123,234,344 bytes)

import Test.QuickCheck (Property, (==>), quickCheck)

-- 1ª solución

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

raizDigitalPotencia :: Integer -> Integer

raizDigitalPotencia n =

raizDigital (2^n)

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

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

-- Calculando las raíces digitales de los primeros números se obtiene

-- λ> map raizDigitalPotencia [0..29]

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

-- Se observa se repite el período 1,2,4,8,7,5.

raizDigitalPotencia2 :: Integer -> Integer

raizDigitalPotencia2 n

| m == 0 = 1

| m == 1 = 2

| m == 2 = 4

| m == 3 = 8

| m == 4 = 7

| m == 5 = 5

where m = n `mod` 6

-- 3ª solución

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

raizDigitalPotencia3 :: Integer -> Integer

raizDigitalPotencia3 n =

case (n `mod` 6) of

0 -> 1

1 -> 2

2 -> 4

3 -> 8

4 -> 7

5 -> 5

-- 4ª solución

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

raizDigitalPotencia4 :: Integer -> Integer

raizDigitalPotencia4 n =

raizDigital (2^(mod n 6))

-- Comprobación de equivalencia

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

-- La propiedad es

prop_raizDigitalPotencia :: Integer -> Property

prop_raizDigitalPotencia n =

n >= 0 ==>

all (== (raizDigitalPotencia n))

[raizDigitalPotencia2 n,

raizDigitalPotencia3 n,

raizDigitalPotencia4 n]

-- La comprobación es

-- λ> quickCheck prop_raizDigitalPotencia

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> raizDigitalPotencia 300000000

-- 1

-- (2.82 secs, 149,107,152 bytes)

-- λ> raizDigitalPotencia2 300000000

-- 1

-- (0.01 secs, 98,480 bytes)

-- λ> raizDigitalPotencia3 300000000

-- 1

-- (0.01 secs, 98,440 bytes)

-- λ> raizDigitalPotencia4 300000000

-- 1

-- (0.01 secs, 98,568 bytes)

-- λ> raizDigitalPotencia2 (10^(10^8))

-- 7

-- (3.09 secs, 123,233,992 bytes)

-- λ> raizDigitalPotencia3 (10^(10^8))

-- 7

-- (3.07 secs, 123,232,728 bytes)

-- λ> raizDigitalPotencia4 (10^(10^8))

-- 7

-- (3.18 secs, 123,234,344 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>

Cuadriseguidos y números encadenados

Soluciones

Nuevas soluciones

Árbol de cadenas

Soluciones

Nuevas soluciones

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

Raíces digitales de los números de Fermat.

Soluciones

Nuevas soluciones

Persistencia aditiva

Soluciones

Nuevas soluciones

Raíces digitales de potencias de dos

Soluciones

Nuevas soluciones

Entradas recientes

Buscar

Correo electrónico