José A. Alonso

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

Raíz digital

PorJosé A. Alonso 6-abril-202113-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 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

   raizDigital :: Integer -> Integer

1	raizDigital :: Integer -> Integer

tal que (raizDigital n) es la raíz digital del entero positivo n. Por ejemplo,

   raizDigital 23451  ==  6

1	raizDigital 23451 == 6

Comprobar con QuickCheck las siguientes propiedades de la raíz digital:

D(m + n) = D(D(m) + D(n)).
D(mn) = D(D(m)D(n)).
D(m^n) = D(D(m)^n).
D(D(n)) = D(n).
D(n + 9) = D(n).
D(9n) = 9.

Soluciones

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

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

raizDigital :: Integer -> Integer
raizDigital n
  | n < 10    = n
  | otherwise = raizDigital (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
-- ===========

raizDigital2 :: Integer -> Integer
raizDigital2 n =
  head (dropWhile (>9) (iterate sumaDigitos n))

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

raizDigital3 :: Integer -> Integer
raizDigital3 n
  | m == 0    = 9
  | otherwise = m
  where m = n `mod` 9

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

raizDigital4 :: Integer -> Integer
raizDigital4 n = 1 + (n-1) `mod` 9

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

-- La propiedad es
prop_raizDigital_equiv :: Integer -> Property
prop_raizDigital_equiv n =
  n > 0 ==>
  all (== (raizDigital n))
      [raizDigital2 n,
       raizDigital3 n,
       raizDigital4 n]

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

-- Propiedades
-- ===========

-- Las propiedades son
prop_raizDigital :: Integer -> Integer -> Property
prop_raizDigital m n =
  m > 0 && n > 0 ==>
  d(m + n) == d(d(m) + d(n)) &&
  d(m*n) == d(d(m)*d(n)) &&
  d(m^n) == d(d(m)^n) &&
  d(d(n)) == d(n) &&
  d(n + 9) == d(n) &&
  d(9*n) == 9
  where d = raizDigital

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

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

-- 1ª solución

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

raizDigital :: Integer -> Integer

raizDigital n

| n < 10 = n

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

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

raizDigital2 :: Integer -> Integer

raizDigital2 n =

head (dropWhile (>9) (iterate sumaDigitos n))

-- 3ª solución

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

raizDigital3 :: Integer -> Integer

raizDigital3 n

| m == 0 = 9

| otherwise = m

where m = n `mod` 9

-- 4ª solución

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

raizDigital4 :: Integer -> Integer

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

-- Comprobación de equivalencia

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

-- La propiedad es

prop_raizDigital_equiv :: Integer -> Property

prop_raizDigital_equiv n =

n > 0 ==>

all (== (raizDigital n))

[raizDigital2 n,

raizDigital3 n,

raizDigital4 n]

-- La comprobación es

-- λ> quickCheck prop_raizDigital_equiv

-- +++ OK, passed 100 tests.

-- Propiedades

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

-- Las propiedades son

prop_raizDigital :: Integer -> Integer -> Property

prop_raizDigital m n =

m > 0 && n > 0 ==>

d(m + n) == d(d(m) + d(n)) &&

d(m*n) == d(d(m)*d(n)) &&

d(m^n) == d(d(m)^n) &&

d(d(n)) == d(n) &&

d(n + 9) == d(n) &&

d(9*n) == 9

where d = raizDigital

-- La comprobación es

-- λ> quickCheck prop_raizDigital

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

Antiimágenes de funciones crecientes bidimensionales

PorJosé A. Alonso 5-abril-202129-marzo-2021

Una función f de pares de números naturales en números naturales es estrictamente creciente en ambos argumentos si

para x1 < x2, se tiene f(x1,y) < f(x1,y), para todo y y
para y1 < y2, se tiene f(x,y1) < f(x,y2), para todo x.

Por ejemplo, la función f definida por f(x,y) = x^2+3^y es creciente en ambos argumentos.

Las antiimágenes por f de t son los pares (x,y) tales que f(x,y) = t. Por ejemplo, las antimágenes por f(x,y) = x^2+3^y de 82 son los pares (1,4) y (9,0).

Definir la función

   antiimagenes :: Integral a => ((a,a) -> a) -> a -> [(a,a)]

1	antiimagenes :: Integral a => ((a,a) -> a) -> a -> [(a,a)]

tal que (antiimagenes f t) es la lista de las antiimágenes por f de t, donde se supone que f es una función de pares de números naturales en números naturales que es estrictamente creciente en ambos argumentos. Por ejemplo,

   antiimagenes (\(x,y) -> x^2+3^y) 82        ==  [(1,4),(9,0)]
   antiimagenes (\(x,y) -> x^2+3^y) 387421785 ==  [(36,18)]

1 2	antiimagenes (\(x,y) -> x^2+3^y) 82 == [(1,4),(9,0)] antiimagenes (\(x,y) -> x^2+3^y) 387421785 == [(36,18)]

Soluciones

[schedule expon=’2021-04-12′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 12 de abril.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

[/schedule]

[schedule on=’2021-04-12′ at=»06:00″]

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

antiimagenes :: Integral a => ((a,a) -> a) -> a -> [(a,a)]
antiimagenes f t =
  [(x,y) | x <- [0..t], y <- [0..t ], f (x,y) == t]

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

antiimagenes2 :: Integral a => ((a,a) -> a) -> a -> [(a,a)]
antiimagenes2 f t = antiimagenesEn (0,t)
  where antiimagenesEn (a,b) = [(x,y) | x <- [a..t], y <- [b,b-1..0], f (x,y) == t]

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

antiimagenes3 :: Integral a => ((a,a) -> a) -> a -> [(a,a)]
antiimagenes3 f t = antiimagenesEn (0,t)
  where antiimagenesEn (a,b)
          | a > t || b < 0 = []
          | c < t          = antiimagenesEn (a+1,b)
          | c == t         = (a,b) : antiimagenesEn (a+1,b-1)
          | c > t          = antiimagenesEn (a,b-1)
          where c = f (a,b)

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

antiimagenes4 :: Integral a => ((a,a) -> a) -> a -> [(a,a)]
antiimagenes4 f t = desde (0,p) (q,0) where
  p = menor (-1,t) (\ y -> f (0,y)) t
  q = menor (-1,t) (\ x -> f (x,0)) t
  desde (x1,y1) (x2,y2)
    | x2 < x1 || y1 < y2 = []
    | y1 - y <= x2 - x1  = fila x
    | otherwise          = columna y
    where
      x = menor (x1-1,x2) (\ x -> f (x,r)) t
      y = menor (y2-1,y1) (\ y -> f (c,y)) t
      c = (x1 + x2) `div` 2
      r = (y1 + y2) `div` 2
      fila x
        | z < t  = desde (x1,y1) (x2,r+1)
        | z == t = (x,r) : desde (x1,y1) (x-1,r+1) ++ desde (x+1,r-1) (x2,y2)
        | z > t  = desde (x1,y1) (x-1,r+1) ++ desde (x,r-1) (x2,y2)
        where z = f (x,r)
      columna y
        | z < t  = desde (c+1,y1) (x2,y2)
        | z == t = (c,y) : desde (x1,y1) (c-1,y+1) ++ desde (c+1,y-1) (x2,y2)
        | z > t  = desde (x1,y1) (c-1,y) ++ desde (c+1,y-1) (x2,y2)
        where z = f (c, y)


-- (menor (a,b) f t), suponiendo que t <= f b, es el menor x enel
-- intervalo (a,b] tal que t <= f x.
menor :: Integral a => (a,a) -> (a -> a) -> a -> a
menor (a,b) f t
  | a + 1 == b = b
  | t <= f m   = menor (a, m) f t
  | otherwise  = menor (m, b) f t
  where m = (a + b) `div` 2

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

-- La comparación es
--    λ> antiimagenes (\(x,y) -> x^2+3^y) 2383
--    [(14,7)]
--    (15.63 secs, 26,904,500,208 bytes)
--    λ> antiimagenes2 (\(x,y) -> x^2+3^y) 2383
--    [(14,7)]
--    (16.37 secs, 26,950,312,440 bytes)
--    λ> antiimagenes3 (\(x,y) -> x^2+3^y) 2383
--    [(14,7)]
--    (0.03 secs, 11,892,160 bytes)
--    λ> antiimagenes4 (\(x,y) -> x^2+3^y) 2383
--    [(14,7)]
--    (0.01 secs, 277,696 bytes)
--
--    λ> antiimagenes3 (\(x,y) -> x^2+3^y) 59449
--    [(20,10)]
--    (3.77 secs, 1,329,803,208 bytes)
--    λ> antiimagenes4 (\(x,y) -> x^2+3^y) 59449
--    [(20,10)]
--    (0.03 secs, 400,400 bytes)

-- 1ª solución

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

antiimagenes :: Integral a => ((a,a) -> a) -> a -> [(a,a)]

antiimagenes f t =

[(x,y) | x <- [0..t], y <- [0..t ], f (x,y) == t]

-- 2ª solución

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

antiimagenes2 :: Integral a => ((a,a) -> a) -> a -> [(a,a)]

antiimagenes2 f t = antiimagenesEn (0,t)

where antiimagenesEn (a,b) = [(x,y) | x <- [a..t], y <- [b,b-1..0], f (x,y) == t]

-- 3ª solución

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

antiimagenes3 :: Integral a => ((a,a) -> a) -> a -> [(a,a)]

antiimagenes3 f t = antiimagenesEn (0,t)

where antiimagenesEn (a,b)

| a > t || b < 0 = []

| c < t = antiimagenesEn (a+1,b)

| c == t = (a,b) : antiimagenesEn (a+1,b-1)

| c > t = antiimagenesEn (a,b-1)

where c = f (a,b)

-- 3ª solución

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

antiimagenes4 :: Integral a => ((a,a) -> a) -> a -> [(a,a)]

antiimagenes4 f t = desde (0,p) (q,0) where

p = menor (-1,t) (\ y -> f (0,y)) t

q = menor (-1,t) (\ x -> f (x,0)) t

desde (x1,y1) (x2,y2)

| x2 < x1 || y1 < y2 = []

| y1 - y <= x2 - x1 = fila x

| otherwise = columna y

where

x = menor (x1-1,x2) (\ x -> f (x,r)) t

y = menor (y2-1,y1) (\ y -> f (c,y)) t

c = (x1 + x2) `div` 2

r = (y1 + y2) `div` 2

fila x

| z < t = desde (x1,y1) (x2,r+1)

| z == t = (x,r) : desde (x1,y1) (x-1,r+1) ++ desde (x+1,r-1) (x2,y2)

| z > t = desde (x1,y1) (x-1,r+1) ++ desde (x,r-1) (x2,y2)

where z = f (x,r)

columna y

| z < t = desde (c+1,y1) (x2,y2)

| z == t = (c,y) : desde (x1,y1) (c-1,y+1) ++ desde (c+1,y-1) (x2,y2)

| z > t = desde (x1,y1) (c-1,y) ++ desde (c+1,y-1) (x2,y2)

where z = f (c, y)

-- (menor (a,b) f t), suponiendo que t <= f b, es el menor x enel

-- intervalo (a,b] tal que t <= f x.

menor :: Integral a => (a,a) -> (a -> a) -> a -> a

menor (a,b) f t

| a + 1 == b = b

| t <= f m = menor (a, m) f t

| otherwise = menor (m, b) f t

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

-- Comparación de eficiencia

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

-- La comparación es

-- λ> antiimagenes (\(x,y) -> x^2+3^y) 2383

-- [(14,7)]

-- (15.63 secs, 26,904,500,208 bytes)

-- λ> antiimagenes2 (\(x,y) -> x^2+3^y) 2383

-- [(14,7)]

-- (16.37 secs, 26,950,312,440 bytes)

-- λ> antiimagenes3 (\(x,y) -> x^2+3^y) 2383

-- [(14,7)]

-- (0.03 secs, 11,892,160 bytes)

-- λ> antiimagenes4 (\(x,y) -> x^2+3^y) 2383

-- [(14,7)]

-- (0.01 secs, 277,696 bytes)

-- λ> antiimagenes3 (\(x,y) -> x^2+3^y) 59449

-- [(20,10)]

-- (3.77 secs, 1,329,803,208 bytes)

-- λ> antiimagenes4 (\(x,y) -> x^2+3^y) 59449

-- [(20,10)]

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

[/schedule]

Antiimagen de función creciente

PorJosé A. Alonso 2-abril-20219-abril-2021

Una función f de los números naturales en los números naturales es estrictamente creciente si para cualquier par de números x, y tales que x < y se verifica que f(x) < f(y). La antiimagen por f de un número natural t es el número natural x tal que f(x) = t. No todos los números tienen antiimiagen por f, pero en caso de tenerla es única.

Definir la función

   antiimagen :: (Integer -> Integer) -> Integer -> Maybe Integer

1	antiimagen :: (Integer -> Integer) -> Integer -> Maybe Integer

tal que, suponiendo que f es una función creciente de los números naturales en los números naturales, (antiimagen f t) es justamente la antiimagen por f de t, si existe y es Nothing, en caso contrario. Por ejemplo,

   antiimagen (\x -> 2*x^2-3) 47  ==  Just 5
   antiimagen (\x -> 2*x^2-3) 48  ==  Nothing
   antiimagen (\x -> 2^x) 1024    ==  Just 10
   antiimagen (2^) 1024           ==  Just 10
   antiimagen (2^) (2^(10^7))     ==  Just 10000000
   antiimagen (2^) (1+2^(10^7))   ==  Nothing

antiimagen (\x -> 2*x^2-3) 47 == Just 5

antiimagen (\x -> 2*x^2-3) 48 == Nothing

antiimagen (\x -> 2^x) 1024 == Just 10

antiimagen (2^) 1024 == Just 10

antiimagen (2^) (2^(10^7)) == Just 10000000

antiimagen (2^) (1+2^(10^7)) == Nothing

Soluciones

import Data.Maybe (listToMaybe)

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

antiimagen :: (Integer -> Integer) -> Integer -> Maybe Integer
antiimagen f t =
  listToMaybe [x | x <- [0..t], f x == t]

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

antiimagen2 :: (Integer -> Integer) -> Integer -> Maybe Integer
antiimagen2 f t = busqueda (0,t)
  where busqueda (a,b) = listToMaybe [x | x <- [a..b], f x == t]

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

antiimagen3 :: (Integer -> Integer) -> Integer -> Maybe Integer
antiimagen3 f t = busqueda (0,t)
  where busqueda (a,b)
          | a > b     = Nothing
          | t < f m   = busqueda (a,m-1)
          | t == f m  = Just m
          | otherwise = busqueda (m+1,b)
          where m = (a+b) `div` 2

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

antiimagen4 :: (Integer -> Integer) -> Integer -> Maybe Integer
antiimagen4 f t | f x == t  = Just x
                | otherwise = Nothing
  where x = busqueda (cotas f t)
        busqueda (a,b) = head [x | x <- [a+1..b], t <= f x]

-- (cotas f t) es un par (a,b) de potencias consecutivas de 2 tal que la
-- antiimagen de t por f está en el intevalo [a+1,b]. Por ejemplo,
--    cotas (\x -> 2*x^2-3) 47  ==  (4,8)
--    cotas (\x -> 2^x) 1024    ==  (8,16)
cotas :: (Integer -> Integer) -> Integer -> (Integer, Integer)
cotas f t | t <= f 0  = (-1,0)
          | otherwise = (b `div` 2, b)
  where b = until done (*2) 1
        done b = t <= f b

-- 5ª solución
-- ===========

antiimagen5 :: (Integer -> Integer) -> Integer -> Maybe Integer
antiimagen5 f t | f x == t  = Just x
                | otherwise = Nothing
  where x = busqueda (cotas f t)
        busqueda (a,b) | a+1 == b  = b
                       | t <= f m  = busqueda (a,m)
                       | otherwise = busqueda (m,b)
          where m = (a+b) `div`  2

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

-- La comparación es
--    λ> antiimagen (2^) (2^30)
--    Just 30
--    (0.01 secs, 142,728 bytes)
--    λ> antiimagen2 (2^) (2^30)
--    Just 30
--    (0.01 secs, 142,784 bytes)
--    λ> antiimagen3 (2^) (2^30)
--    Just 30
--    (8.05 secs, 335,820,048 bytes)
--    λ> antiimagen4 (2^) (2^30)
--    Just 30
--    (0.01 secs, 133,984 bytes)
--    λ> antiimagen5 (2^) (2^30)
--    Just 30
--    (0.02 secs, 121,816 bytes)
--
--    λ> antiimagen (2^) (2^50000)
--    Just 50000
--    (1.29 secs, 673,789,160 bytes)
--    λ> antiimagen2 (2^) (2^50000)
--    Just 50000
--    (1.28 secs, 673,791,368 bytes)
--    λ> antiimagen4 (2^) (2^50000)
--    Just 50000
--    (0.84 secs, 342,311,360 bytes)
--    λ> antiimagen5 (2^) (2^50000)
--    Just 50000
--    (0.01 secs, 549,688 bytes)
--
--    λ> antiimagen4 (2^) (2^100000)
--    Just 100000
--    (4.37 secs, 1,210,476,848 bytes)
--    λ> antiimagen5 (2^) (2^100000)
--    Just 100000
--    (0.01 secs, 918,096 bytes)

import Data.Maybe (listToMaybe)

-- 1ª solución

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

antiimagen :: (Integer -> Integer) -> Integer -> Maybe Integer

antiimagen f t =

listToMaybe [x | x <- [0..t], f x == t]

-- 2ª solución

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

antiimagen2 :: (Integer -> Integer) -> Integer -> Maybe Integer

antiimagen2 f t = busqueda (0,t)

where busqueda (a,b) = listToMaybe [x | x <- [a..b], f x == t]

-- 3ª solución

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

antiimagen3 :: (Integer -> Integer) -> Integer -> Maybe Integer

antiimagen3 f t = busqueda (0,t)

where busqueda (a,b)

| a > b = Nothing

| t < f m = busqueda (a,m-1)

| t == f m = Just m

| otherwise = busqueda (m+1,b)

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

-- 4ª solución

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

antiimagen4 :: (Integer -> Integer) -> Integer -> Maybe Integer

antiimagen4 f t | f x == t = Just x

| otherwise = Nothing

where x = busqueda (cotas f t)

busqueda (a,b) = head [x | x <- [a+1..b], t <= f x]

-- (cotas f t) es un par (a,b) de potencias consecutivas de 2 tal que la

-- antiimagen de t por f está en el intevalo [a+1,b]. Por ejemplo,

-- cotas (\x -> 2*x^2-3) 47 == (4,8)

-- cotas (\x -> 2^x) 1024 == (8,16)

cotas :: (Integer -> Integer) -> Integer -> (Integer, Integer)

cotas f t | t <= f 0 = (-1,0)

| otherwise = (b `div` 2, b)

where b = until done (*2) 1

done b = t <= f b

-- 5ª solución

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

antiimagen5 :: (Integer -> Integer) -> Integer -> Maybe Integer

antiimagen5 f t | f x == t = Just x

| otherwise = Nothing

where x = busqueda (cotas f t)

busqueda (a,b) | a+1 == b = b

| t <= f m = busqueda (a,m)

| otherwise = busqueda (m,b)

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

-- Comparación de eficiencia

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

-- La comparación es

-- λ> antiimagen (2^) (2^30)

-- Just 30

-- (0.01 secs, 142,728 bytes)

-- λ> antiimagen2 (2^) (2^30)

-- Just 30

-- (0.01 secs, 142,784 bytes)

-- λ> antiimagen3 (2^) (2^30)

-- Just 30

-- (8.05 secs, 335,820,048 bytes)

-- λ> antiimagen4 (2^) (2^30)

-- Just 30

-- (0.01 secs, 133,984 bytes)

-- λ> antiimagen5 (2^) (2^30)

-- Just 30

-- (0.02 secs, 121,816 bytes)

-- λ> antiimagen (2^) (2^50000)

-- Just 50000

-- (1.29 secs, 673,789,160 bytes)

-- λ> antiimagen2 (2^) (2^50000)

-- Just 50000

-- (1.28 secs, 673,791,368 bytes)

-- λ> antiimagen4 (2^) (2^50000)

-- Just 50000

-- (0.84 secs, 342,311,360 bytes)

-- λ> antiimagen5 (2^) (2^50000)

-- Just 50000

-- (0.01 secs, 549,688 bytes)

-- λ> antiimagen4 (2^) (2^100000)

-- Just 100000

-- (4.37 secs, 1,210,476,848 bytes)

-- λ> antiimagen5 (2^) (2^100000)

-- Just 100000

-- (0.01 secs, 918,096 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>

Reducción de consecutivos relacionados

PorJosé A. Alonso 1-abril-20218-abril-2021

Definir la función

   reducida :: (a -> a -> Bool) -> [a] -> [a]

1	reducida :: (a -> a -> Bool) -> [a] -> [a]

tal que (reducida r xs) obtenida elimando en xs las repeticiones de elementos consecutivos queverifican la relación r. Por ejemplo,

   reducida (==) [4,4,2,1,1,1,2,5]  ==  [4,2,1,2,5]
   reducida (<)  [4,4,2,1,1,1,2,5]  ==  [4,4,2,1,1,1]
   reducida (>=) [4,4,2,1,1,1,2,5]  ==  [4,5]
   reducida (>)  [4,4,2,1,1,1,2,5]  ==  [4,4,5]
   reducida (/=) [4,4,2,1,1,1,2,5]  ==  [4,4]

reducida (==) [4,4,2,1,1,1,2,5] == [4,2,1,2,5]

reducida (<) [4,4,2,1,1,1,2,5] == [4,4,2,1,1,1]

reducida (>=) [4,4,2,1,1,1,2,5] == [4,5]

reducida (>) [4,4,2,1,1,1,2,5] == [4,4,5]

reducida (/=) [4,4,2,1,1,1,2,5] == [4,4]

Soluciones

import Data.List (groupBy)

-- 1ª solución
reducida :: (a -> a -> Bool) -> [a] -> [a]
reducida _ []     = []
reducida r (x:xs) = x : reducida r (dropWhile (r x) xs)

-- 2ª solución
reducida2 :: (a -> a -> Bool) -> [a] -> [a]
reducida2 r = foldr aux []
  where aux x xs = x : dropWhile (r x) xs

-- 3ª solución
reducida3 :: (a -> a -> Bool) -> [a] -> [a]
reducida3 r xs =
  map head (groupBy r xs)

import Data.List (groupBy)

-- 1ª solución

reducida :: (a -> a -> Bool) -> [a] -> [a]

reducida _ [] = []

reducida r (x:xs) = x : reducida r (dropWhile (r x) xs)

-- 2ª solución

reducida2 :: (a -> a -> Bool) -> [a] -> [a]

reducida2 r = foldr aux []

where aux x xs = x : dropWhile (r x) xs

-- 3ª solución

reducida3 :: (a -> a -> Bool) -> [a] -> [a]

reducida3 r xs =

map head (groupBy r xs)

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>

Lista muy decreciente

PorJosé A. Alonso 31-marzo-20217-abril-2021

Una lista de números es muy decreciente si cada elemento es mayor que la suma de los restantes. Por ejemplo, [19,9,6,2] es muy decreciente ya que

19 > 9 + 6 + 2,
9 > 6 + 2 y
6 > 2

En cambio, [19,8,6,2] no lo es ya que 8 = 6 + 2.

Definir la función

   muyDecreciente :: [Integer] -> Bool

1	muyDecreciente :: [Integer] -> Bool

tal que (muyDecreciente xs) se verifica si xs es muy decreciente. Por ejemplo,

   muyDecreciente [19,9,6,2]  ==  True
   muyDecreciente [19,8,6,2]  ==  False
   muyDecreciente [2^k | k <- [60000,59999..0]]  ==  True

muyDecreciente [19,9,6,2] == True

muyDecreciente [19,8,6,2] == False

muyDecreciente [2^k | k <- [60000,59999..0]] == True

Soluciones

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

muyDecreciente :: [Integer] -> Bool
muyDecreciente []     = True
muyDecreciente (x:xs) = x > sum xs && muyDecreciente xs

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

muyDecreciente2 :: [Integer] -> Bool
muyDecreciente2 = snd . aux
  where aux []     = (0,True)
        aux (x:xs) = (x + s, x > s && b)
          where (s,b) = aux xs

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

muyDecreciente3 :: [Integer] -> Bool
muyDecreciente3 xs =
  and (zipWith (>) xs (tail (scanr1 (+) xs)))

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

-- La comparación es
--    λ> muyDecreciente [2^k | k <- [10000,9999..0]]
--    True
--    (6.72 secs, 48,095,728,720 bytes)
--    λ> muyDecreciente2 [2^k | k <- [10000,9999..0]]
--    True
--    (0.08 secs, 67,222,960 bytes)
--    λ> muyDecreciente3 [2^k | k <- [10000,9999..0]]
--    True
--    (0.10 secs, 66,664,928 bytes)
--
--    λ> muyDecreciente2 [2^k | k <- [50000,49999..0]]
--    True
--    (1.88 secs, 857,128,312 bytes)
--    λ> muyDecreciente3 [2^k | k <- [50000,49999..0]]
--    True
--    (1.67 secs, 854,326,736 bytes)

-- 1ª solución

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

muyDecreciente :: [Integer] -> Bool

muyDecreciente [] = True

muyDecreciente (x:xs) = x > sum xs && muyDecreciente xs

-- 2ª solución

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

muyDecreciente2 :: [Integer] -> Bool

muyDecreciente2 = snd . aux

where aux [] = (0,True)

aux (x:xs) = (x + s, x > s && b)

where (s,b) = aux xs

-- 3ª solución

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

muyDecreciente3 :: [Integer] -> Bool

muyDecreciente3 xs =

and (zipWith (>) xs (tail (scanr1 (+) xs)))

-- Comparación de eficiencia

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

-- La comparación es

-- λ> muyDecreciente [2^k | k <- [10000,9999..0]]

-- True

-- (6.72 secs, 48,095,728,720 bytes)

-- λ> muyDecreciente2 [2^k | k <- [10000,9999..0]]

-- True

-- (0.08 secs, 67,222,960 bytes)

-- λ> muyDecreciente3 [2^k | k <- [10000,9999..0]]

-- True

-- (0.10 secs, 66,664,928 bytes)

-- λ> muyDecreciente2 [2^k | k <- [50000,49999..0]]

-- True

-- (1.88 secs, 857,128,312 bytes)

-- λ> muyDecreciente3 [2^k | k <- [50000,49999..0]]

-- True

-- (1.67 secs, 854,326,736 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>

Menor prefijo con suma positiva

PorJosé A. Alonso 30-marzo-20216-abril-2021

Definir la función

   menorPrefijoSumaPositiva1 :: [[Int]] -> Maybe [[Int]]

1	menorPrefijoSumaPositiva1 :: [[Int]] -> Maybe [[Int]]

tal que (menorPrefijoSumaPositiva1 xss) es justamente el menor prejijo de xss tal que la suma de lsas sumas de sus elementos es positivo y es Nothing si tal prefijo no existe. Por ejemplo,

   menorPrefijoSumaPositiva [[1],[-3],[2,4]]     == Just [[1]]
   menorPrefijoSumaPositiva [[-2,1],[-3],[2,4]]  == Just [[-2,1],[-3],[2,4]]
   menorPrefijoSumaPositiva [[-2,1],[3],[2,4]]   == Just [[-2,1],[3]]
   menorPrefijoSumaPositiva [[-2,1],[-3],[2,-4]] == Nothing
   menorPrefijoSumaPositiva [[-k..k] | k <- [1..5000]]              == Nothing
   fmap length (menorPrefijoSumaPositiva [[-3000..k] | k <- [0..]]) == Just 5198

menorPrefijoSumaPositiva [[1],[-3],[2,4]] == Just [[1]]

menorPrefijoSumaPositiva [[-2,1],[-3],[2,4]] == Just [[-2,1],[-3],[2,4]]

menorPrefijoSumaPositiva [[-2,1],[3],[2,4]] == Just [[-2,1],[3]]

menorPrefijoSumaPositiva [[-2,1],[-3],[2,-4]] == Nothing

menorPrefijoSumaPositiva [[-k..k] | k <- [1..5000]] == Nothing

fmap length (menorPrefijoSumaPositiva [[-3000..k] | k <- [0..]]) == Just 5198

Soluciones

import Data.List (inits)
import Data.Maybe (listToMaybe)
import Test.QuickCheck

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

menorPrefijoSumaPositiva1 :: [[Int]] -> Maybe [[Int]]
menorPrefijoSumaPositiva1 xss =
  listToMaybe [xs | xs <- tail (inits xss),
                    sum (concat xs) > 0]

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

menorPrefijoSumaPositiva2 :: [[Int]] -> Maybe [[Int]]
menorPrefijoSumaPositiva2 xss = aux [] xss
  where aux yss _  | sum (concat yss) > 0 = Just (reverse yss)
        aux _   []                        = Nothing
        aux yss (zs:zss)                  = aux (zs : yss) zss

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

menorPrefijoSumaPositiva3 :: [[Int]] -> Maybe [[Int]]
menorPrefijoSumaPositiva3 xss =
  aux (0,[]) (zip (map sum xss) xss)
  where aux (s,yss) _  | s > 0   = Just (reverse yss)
        aux _ []                 = Nothing
        aux (s,yss) ((t,zs):zss) = aux (s+t,zs:yss) zss

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

-- La propiedad es
prop_equivalencia :: [[Int]] -> Bool
prop_equivalencia xss =
  all (== (menorPrefijoSumaPositiva1 xss))
      [ menorPrefijoSumaPositiva2 xss,
        menorPrefijoSumaPositiva3 xss ]

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

-- Comparación de eficiencia
-- =========================
--
-- La comparación es
--    λ> fmap length (menorPrefijoSumaPositiva1 [[-200..k] | k <- [0..]])
--    Just 348
--    (2.40 secs, 2,801,967,392 bytes)
--    λ> fmap length (menorPrefijoSumaPositiva2 [[-200..k] | k <- [0..]])
--    Just 348
--    (2.46 secs, 2,800,717,720 bytes)
--    λ> fmap length (menorPrefijoSumaPositiva3 [[-200..k] | k <- [0..]])
--    Just 348
--    (0.01 secs, 18,128,464 bytes)

--    λ> menorPrefijoSumaPositiva1 [[-k..k] | k <- [1..500]]
--    Nothing
--    (6.39 secs, 6,127,124,136 bytes)
--    λ> menorPrefijoSumaPositiva2 [[-k..k] | k <- [1..500]]
--    Nothing
--    (6.47 secs, 6,124,201,288 bytes)
--    λ> menorPrefijoSumaPositiva3 [[-k..k] | k <- [1..500]]
--    Nothing
--    (0.03 secs, 37,944,760 bytes)

import Data.List (inits)

import Data.Maybe (listToMaybe)

import Test.QuickCheck

-- 1ª solución

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

menorPrefijoSumaPositiva1 :: [[Int]] -> Maybe [[Int]]

menorPrefijoSumaPositiva1 xss =

listToMaybe [xs | xs <- tail (inits xss),

sum (concat xs) > 0]

-- 2ª solución

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

menorPrefijoSumaPositiva2 :: [[Int]] -> Maybe [[Int]]

menorPrefijoSumaPositiva2 xss = aux [] xss

where aux yss _ | sum (concat yss) > 0 = Just (reverse yss)

aux _ [] = Nothing

aux yss (zs:zss) = aux (zs : yss) zss

-- 3ª solución

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

menorPrefijoSumaPositiva3 :: [[Int]] -> Maybe [[Int]]

menorPrefijoSumaPositiva3 xss =

aux (0,[]) (zip (map sum xss) xss)

where aux (s,yss) _ | s > 0 = Just (reverse yss)

aux _ [] = Nothing

aux (s,yss) ((t,zs):zss) = aux (s+t,zs:yss) zss

-- Comprobación de equivalencia

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

-- La propiedad es

prop_equivalencia :: [[Int]] -> Bool

prop_equivalencia xss =

all (== (menorPrefijoSumaPositiva1 xss))

[ menorPrefijoSumaPositiva2 xss,

menorPrefijoSumaPositiva3 xss ]

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> fmap length (menorPrefijoSumaPositiva1 [[-200..k] | k <- [0..]])

-- Just 348

-- (2.40 secs, 2,801,967,392 bytes)

-- λ> fmap length (menorPrefijoSumaPositiva2 [[-200..k] | k <- [0..]])

-- Just 348

-- (2.46 secs, 2,800,717,720 bytes)

-- λ> fmap length (menorPrefijoSumaPositiva3 [[-200..k] | k <- [0..]])

-- Just 348

-- (0.01 secs, 18,128,464 bytes)

-- λ> menorPrefijoSumaPositiva1 [[-k..k] | k <- [1..500]]

-- Nothing

-- (6.39 secs, 6,127,124,136 bytes)

-- λ> menorPrefijoSumaPositiva2 [[-k..k] | k <- [1..500]]

-- Nothing

-- (6.47 secs, 6,124,201,288 bytes)

-- λ> menorPrefijoSumaPositiva3 [[-k..k] | k <- [1..500]]

-- Nothing

-- (0.03 secs, 37,944,760 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>

Autonúmeros

PorJosé A. Alonso 29-marzo-20215-abril-2021

Un autonúmero es un número entero n tal que no existe ningún número entero positivo k tal que n sea igual a la suma de k y los dígitos de k. Por ejemplo, 5 es un autonúmero pero 21 no lo es ya que 21=15+1+5.

Definir la lista

   autonumeros :: [Integer]

1	autonumeros :: [Integer]

cuyos elementos son los autonúmeros. Por ejemplo,

   λ> take 20 autonumeros
   [1,3,5,7,9,20,31,42,53,64,75,86,97,108,110,121,132,143,154,165]
   λ> autonumeros !! 1200
   12236

λ> take 20 autonumeros

[1,3,5,7,9,20,31,42,53,64,75,86,97,108,110,121,132,143,154,165]

λ> autonumeros !! 1200

12236

Soluciones

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

autonumeros :: [Integer]
autonumeros = filter autonumero [1..]

-- (autonumero n) se verifica si n es un autonúmero. Por ejemplo,
--    autonumero 5  == True
--    autonumero 21 == False
autonumero :: Integer -> Bool
autonumero n =
  all (/=n) [k + sum (digitos k) | k <- [1..n]]

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

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

autonumeros2 :: [Integer]
autonumeros2 = map head sucesionSucesionesSumasDigitales

-- sucesionSucesionesSumasDigitales es la lista de las sucesiones de
-- sumas parciales tal que el primer elemento de cada sucesión es el
-- menor elemento que no pertenece a las sucesiones anteriores. Por
-- ejemplo,
--    λ> map (take 4) (take 8 sucesionSucesionesSumasDigitales)
--    [[1,2,4,8],[3,6,12,15],[5,10,11,13],[7,14,19,29],
--     [9,18,27,36],[20,22,26,34],[31,35,43,50],[42,48,60,66]]
sucesionSucesionesSumasDigitales :: [[Integer]]
sucesionSucesionesSumasDigitales = aux [1..]
  where aux xs = sucesion xs : aux (diferencia xs (sucesion xs))
        sucesion xs = sucesionSumasDigitales (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)

-- (sucesionSumasDigitales a) es la sucesión de las sumas digitales
-- definida por un número a. Por ejemplo,
--    λ> take 16 (sucesionSumasDigitales 1)
--    [1,2,4,8,16,23,28,38,49,62,70,77,91,101,103,107]
--    λ> take 16 (sucesionSumasDigitales 3)
--    [3,6,12,15,21,24,30,33,39,51,57,69,84,96,111,114]
--    λ> take 16 (sucesionSumasDigitales 5)
--    [5,10,11,13,17,25,32,37,47,58,71,79,95,109,119,130]
--    λ> take 16 (sucesionSumasDigitales 7)
--    [7,14,19,29,40,44,52,59,73,83,94,107,115,122,127,137]
--    λ> take 16 (sucesionSumasDigitales 9)
--    [9,18,27,36,45,54,63,72,81,90,99,117,126,135,144,153]
--    λ> take 16 (sucesionSumasDigitales 20)
--    [20,22,26,34,41,46,56,67,80,88,104,109,119,130,134,142]
sucesionSumasDigitales :: Integer -> [Integer]
sucesionSumasDigitales a =
  iterate siguienteSumaDigital a

-- (siguienteSumaDigital a) es el siguiente de a en la sucesión de sumas
-- digitales. Por ejemplo,
--    siguienteSumaDigital 23 == 28
siguienteSumaDigital :: Integer -> Integer
siguienteSumaDigital a =
  a + sum (digitos a)

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

-- La comparación es
--    λ> autonumeros !! 150
--    1502
--    (4.54 secs, 13,302,379,936 bytes)
--    λ> autonumeros2 !! 150
--    1502
--    (0.06 secs, 41,794,872 bytes)

-- 1ª solución

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

autonumeros :: [Integer]

autonumeros = filter autonumero [1..]

-- (autonumero n) se verifica si n es un autonúmero. Por ejemplo,

-- autonumero 5 == True

-- autonumero 21 == False

autonumero :: Integer -> Bool

autonumero n =

all (/=n) [k + sum (digitos k) | k <- [1..n]]

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

-- digitos 325 == [3,2,5]

digitos :: Integer -> [Integer]

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

-- 2ª solución

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

autonumeros2 :: [Integer]

autonumeros2 = map head sucesionSucesionesSumasDigitales

-- sucesionSucesionesSumasDigitales es la lista de las sucesiones de

-- sumas parciales tal que el primer elemento de cada sucesión es el

-- menor elemento que no pertenece a las sucesiones anteriores. Por

-- ejemplo,

-- λ> map (take 4) (take 8 sucesionSucesionesSumasDigitales)

-- [[1,2,4,8],[3,6,12,15],[5,10,11,13],[7,14,19,29],

-- [9,18,27,36],[20,22,26,34],[31,35,43,50],[42,48,60,66]]

sucesionSucesionesSumasDigitales :: [[Integer]]

sucesionSucesionesSumasDigitales = aux [1..]

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

sucesion xs = sucesionSumasDigitales (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)

-- (sucesionSumasDigitales a) es la sucesión de las sumas digitales

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

-- λ> take 16 (sucesionSumasDigitales 1)

-- [1,2,4,8,16,23,28,38,49,62,70,77,91,101,103,107]

-- λ> take 16 (sucesionSumasDigitales 3)

-- [3,6,12,15,21,24,30,33,39,51,57,69,84,96,111,114]

-- λ> take 16 (sucesionSumasDigitales 5)

-- [5,10,11,13,17,25,32,37,47,58,71,79,95,109,119,130]

-- λ> take 16 (sucesionSumasDigitales 7)

-- [7,14,19,29,40,44,52,59,73,83,94,107,115,122,127,137]

-- λ> take 16 (sucesionSumasDigitales 9)

-- [9,18,27,36,45,54,63,72,81,90,99,117,126,135,144,153]

-- λ> take 16 (sucesionSumasDigitales 20)

-- [20,22,26,34,41,46,56,67,80,88,104,109,119,130,134,142]

sucesionSumasDigitales :: Integer -> [Integer]

sucesionSumasDigitales a =

iterate siguienteSumaDigital a

-- (siguienteSumaDigital a) es el siguiente de a en la sucesión de sumas

-- digitales. Por ejemplo,

-- siguienteSumaDigital 23 == 28

siguienteSumaDigital :: Integer -> Integer

siguienteSumaDigital a =

a + sum (digitos a)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> autonumeros !! 150

-- 1502

-- (4.54 secs, 13,302,379,936 bytes)

-- λ> autonumeros2 !! 150

-- 1502

-- (0.06 secs, 41,794,872 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>

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 sumas digitales

PorJosé A. Alonso 26-marzo-20212-abril-2021

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

   1,2,4,8,16,23,28,38,49,62,70,77,91,101,103,107,...

1	1,2,4,8,16,23,28,38,49,62,70,77,91,101,103,107,...

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 sumas digitales definida por 3 son

   3,6,12,15,21,24,30,33,39,51,57,69,84,96,111,114,...

1	3,6,12,15,21,24,30,33,39,51,57,69,84,96,111,114,...

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

   5,10,11,13,17,25,32,37,47,58,71,79,95,109,119,130,...

1	5,10,11,13,17,25,32,37,47,58,71,79,95,109,119,130,...

Se observa que el menor número que no pertenece a las 3 sucesiones anteriores es 7. Los primeros términos de la sucesión de las sumas digitales definida por 7 son

   7,14,19,29,40,44,52,59,73,83,94,107,115,122,127,137,...

1	7,14,19,29,40,44,52,59,73,83,94,107,115,122,127,137,...

Se observa que el menor número que no pertenece a las 4 anteriores es 9. Los primeros términos de la sucesión de las sumas digitales definida por 9 son

   9,18,27,36,45,54,63,72,81,90,99,117,126,135,144,153,...

1	9,18,27,36,45,54,63,72,81,90,99,117,126,135,144,153,...

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

   20,22,26,34,41,46,56,67,80,88,104,109,119,130,134,142,...

1	20,22,26,34,41,46,56,67,80,88,104,109,119,130,134,142,...

Definir la función

   sucesionSucesionesSumasDigitales :: [[Integer]]

1	sucesionSucesionesSumasDigitales :: [[Integer]]

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

   λ> map (take 4) (take 8 sucesionSucesionesSumasDigitales)
   [[1,2,4,8],[3,6,12,15],[5,10,11,13],[7,14,19,29],
    [9,18,27,36],[20,22,26,34],[31,35,43,50],[42,48,60,66]]
   λ> take 10 (sucesionSucesionesSumasDigitales3 !! 1000)
   [10199,10219,10232,10240,10247,10261,10271,10282,10295,10312]

λ> map (take 4) (take 8 sucesionSucesionesSumasDigitales)

[[1,2,4,8],[3,6,12,15],[5,10,11,13],[7,14,19,29],

[9,18,27,36],[20,22,26,34],[31,35,43,50],[42,48,60,66]]

λ> take 10 (sucesionSucesionesSumasDigitales3 !! 1000)

[10199,10219,10232,10240,10247,10261,10271,10282,10295,10312]

Soluciones

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

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

-- (sucesionSumasDigitales a) es la sucesión de las sumas digitales
-- definida por un número a. Por ejemplo,
--    λ> take 16 (sucesionSumasDigitales 1)
--    [1,2,4,8,16,23,28,38,49,62,70,77,91,101,103,107]
--    λ> take 16 (sucesionSumasDigitales 3)
--    [3,6,12,15,21,24,30,33,39,51,57,69,84,96,111,114]
--    λ> take 16 (sucesionSumasDigitales 5)
--    [5,10,11,13,17,25,32,37,47,58,71,79,95,109,119,130]
--    λ> take 16 (sucesionSumasDigitales 7)
--    [7,14,19,29,40,44,52,59,73,83,94,107,115,122,127,137]
--    λ> take 16 (sucesionSumasDigitales 9)
--    [9,18,27,36,45,54,63,72,81,90,99,117,126,135,144,153]
--    λ> take 16 (sucesionSumasDigitales 20)
--    [20,22,26,34,41,46,56,67,80,88,104,109,119,130,134,142]
sucesionSumasDigitales :: Integer -> [Integer]
sucesionSumasDigitales a =
  iterate siguienteSumaDigital a

-- (siguienteSumaDigital a) es el siguiente de a en la sucesión de sumas
-- digitales. Por ejemplo,
--    siguienteSumaDigital 23 == 28
siguienteSumaDigital :: Integer -> Integer
siguienteSumaDigital a =
  a + sum (digitos a)

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

-- (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 =
  x < head (dropWhile (<x) ys)

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

sucesionSucesionesSumasDigitales2 :: [[Integer]]
sucesionSucesionesSumasDigitales2 =
  map sucesionSumasDigitales autonumeros

-- (autonumero n) se verifica si n es un autonúmero; es decir, números
-- que no se pueden escribir como la suma de un número k y los dígitos
-- de k. Por ejemplo,
--    autonumero 5  == True
--    autonumero 21 == False
autonumero :: Integer -> Bool
autonumero n =
  all (/=n) [k + sum (digitos k) | k <- [1..n]]

-- autonumeros es la lista de los autonúmeros. Por ejemplo,
--    λ> take 20 autonumeros
--    [1,3,5,7,9,20,31,42,53,64,75,86,97,108,110,121,132,143,154,165]
autonumeros :: [Integer]
autonumeros = filter autonumero [1..]

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

sucesionSucesionesSumasDigitales3 :: [[Integer]]
sucesionSucesionesSumasDigitales3 = aux [1..]
  where aux xs = sucesion xs : aux (diferencia xs (sucesion xs))
        sucesion xs = sucesionSumasDigitales (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)

-- 1ª solución

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

sucesionSucesionesSumasDigitales :: [[Integer]]

sucesionSucesionesSumasDigitales =

map aux [1..]

where aux 1 = sucesionSumasDigitales 1

aux n = sucesionSumasDigitales m

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

all (a `noPertenece`)

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

-- (sucesionSumasDigitales a) es la sucesión de las sumas digitales

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

-- λ> take 16 (sucesionSumasDigitales 1)

-- [1,2,4,8,16,23,28,38,49,62,70,77,91,101,103,107]

-- λ> take 16 (sucesionSumasDigitales 3)

-- [3,6,12,15,21,24,30,33,39,51,57,69,84,96,111,114]

-- λ> take 16 (sucesionSumasDigitales 5)

-- [5,10,11,13,17,25,32,37,47,58,71,79,95,109,119,130]

-- λ> take 16 (sucesionSumasDigitales 7)

-- [7,14,19,29,40,44,52,59,73,83,94,107,115,122,127,137]

-- λ> take 16 (sucesionSumasDigitales 9)

-- [9,18,27,36,45,54,63,72,81,90,99,117,126,135,144,153]

-- λ> take 16 (sucesionSumasDigitales 20)

-- [20,22,26,34,41,46,56,67,80,88,104,109,119,130,134,142]

sucesionSumasDigitales :: Integer -> [Integer]

sucesionSumasDigitales a =

iterate siguienteSumaDigital a

-- (siguienteSumaDigital a) es el siguiente de a en la sucesión de sumas

-- digitales. Por ejemplo,

-- siguienteSumaDigital 23 == 28

siguienteSumaDigital :: Integer -> Integer

siguienteSumaDigital a =

a + sum (digitos a)

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

-- digitos 325 == [3,2,5]

digitos :: Integer -> [Integer]

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

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

x < head (dropWhile (<x) ys)

-- 2ª solución

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

sucesionSucesionesSumasDigitales2 :: [[Integer]]

sucesionSucesionesSumasDigitales2 =

map sucesionSumasDigitales autonumeros

-- (autonumero n) se verifica si n es un autonúmero; es decir, números

-- que no se pueden escribir como la suma de un número k y los dígitos

-- de k. Por ejemplo,

-- autonumero 5 == True

-- autonumero 21 == False

autonumero :: Integer -> Bool

autonumero n =

all (/=n) [k + sum (digitos k) | k <- [1..n]]

-- autonumeros es la lista de los autonúmeros. Por ejemplo,

-- λ> take 20 autonumeros

-- [1,3,5,7,9,20,31,42,53,64,75,86,97,108,110,121,132,143,154,165]

autonumeros :: [Integer]

autonumeros = filter autonumero [1..]

-- 3ª solución

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

sucesionSucesionesSumasDigitales3 :: [[Integer]]

sucesionSucesionesSumasDigitales3 = aux [1..]

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

sucesion xs = sucesionSumasDigitales (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)

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>

Coste del recorrido ordenado

PorJosé A. Alonso 25-marzo-20211-abril-2021

El coste de visitar los elementos de la lista [4,3,2,5,1] de manera creciente empezando en el primer elemento y siendo el coste de dada paso el valor absoluto de la diferencia de las posiciones se calcula de la siguiente manera

Coste de 4 a 1 = |0-4| = 4
Coste de 1 a 2 = |4-2| = 2
Coste de 2 a 3 = |2-1| = 1
Coste de 3 a 4 = |1-0| = 1
Coste de 4 a 5 = |0-3| = 3

Por tanto, el coste del recorrido es 4+2+1+1+3 = 11.

Definir la función coste :: Ord a => [a] -> Int tal que (coste xs) es el coste de visitar los elementos de xs de manera creciente empezando en el primer elemento y siendo el coste de dada paso el valor absoluto de la diferencia de las posiciones (se supone que los elementos de xs son distintos). Por ejemplo,

   coste [4,3,2,5,1] ==  11
   coste "betis"     ==  6

1 2	coste [4,3,2,5,1] == 11 coste "betis" == 6

Soluciones

import Data.List (sort)

coste :: Ord  a => [a] -> Int
coste xs =
  sum [abs (i-j) | (i,j) <- zip aux (tail aux)]
  where aux = recorrido xs

-- (recorrido xs) esla lista de las posiciones al visitar los elementos
-- de xs de manera creciente empezando en el primer elemento. Por
-- ejemplo,
--    recorrido [4,3,2,5,1] == [0,4,2,1,0,3]
recorrido :: Ord  a => [a] -> [Int]
recorrido xs =
  0 : map snd (sort (zip xs [0..]))

import Data.List (sort)

coste :: Ord a => [a] -> Int

coste xs =

sum [abs (i-j) | (i,j) <- zip aux (tail aux)]

where aux = recorrido xs

-- (recorrido xs) esla lista de las posiciones al visitar los elementos

-- de xs de manera creciente empezando en el primer elemento. Por

-- ejemplo,

-- recorrido [4,3,2,5,1] == [0,4,2,1,0,3]

recorrido :: Ord a => [a] -> [Int]

recorrido xs =

0 : map snd (sort (zip xs [0..]))

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>

Mínimo número de divisiones para igualar

PorJosé A. Alonso 24-marzo-202131-marzo-2021

El mínimo número de divisiones por 2, 3 ó 5 que hay que realizar igualar 15 y 20 es 6. En efecto, 15 se reduce a 5 dividiéndolo por 3 y 20 se reduce a 5 diviéndolo dos veces por 2.

Definir la función

   minimoNumeroDivisiones :: Integer -> Integer -> Maybe Int

1	minimoNumeroDivisiones :: Integer -> Integer -> Maybe Int

tal que (minimoNumeroDivisiones x y) es justamente el mínimo número de divisiones por 2, 3 ó 5 que hay que realizar para igualar x e y, o Nothing si no se pueden igualar. Por ejemplo,

   minimoNumeroDivisiones 15 20       ==  Just 3
   minimoNumeroDivisiones 15 15       ==  Just 0
   minimoNumeroDivisiones 15 16       ==  Just 6
   minimoNumeroDivisiones 15 17       ==  Nothing
   minimoNumeroDivisiones (10^99) 21  ==  Nothing

minimoNumeroDivisiones 15 20 == Just 3

minimoNumeroDivisiones 15 15 == Just 0

minimoNumeroDivisiones 15 16 == Just 6

minimoNumeroDivisiones 15 17 == Nothing

minimoNumeroDivisiones (10^99) 21 == Nothing

Soluciones

import Data.List (group, intersect, nub, sort)
import Data.Maybe (fromJust, isNothing, listToMaybe)
import Data.Numbers.Primes (primeFactors)
import Data.Tree (Tree (Node), flatten, levels)
import Test.QuickCheck (Property, (==>), quickCheck)

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

minimoNumeroDivisiones :: Integer -> Integer -> Maybe Int
minimoNumeroDivisiones x y
  | isNothing a = Nothing
  | otherwise   = Just (fst (fromJust a))
  where a = minimoNumeroDivisionesAux x y

-- La definición anterior se puede simplificar
minimoNumeroDivisiones' :: Integer -> Integer -> Maybe Int
minimoNumeroDivisiones' x y =
  Just fst <*> minimoNumeroDivisionesAux x y

-- (minimoNumeroDivisiones x y) es justamente el par formado por el
-- mínimo número de divisiones por 2, 3 ó 5 que hay que realizar para
-- igualar x e y junto con el número al que se reducen, o Nothing si no
-- se pueden igualar. Por ejemplo,
--    minimoNumeroDivisionesAux 15 20  ==  Just (3,5)
--    minimoNumeroDivisionesAux 15 15  ==  Just (0,15)
--    minimoNumeroDivisionesAux 15 16  ==  Just (6,1)
--    minimoNumeroDivisionesAux 15 17  ==  Nothing
minimoNumeroDivisionesAux :: Integer -> Integer -> Maybe (Int,Integer)
minimoNumeroDivisionesAux x y
  | null as   = Nothing
  | otherwise = Just (head as)
  where as = sort [(m+n,z) | (z,(m,n)) <- minimasProfundidadesComunes x y]

-- La definición anterior se puede simplificar
minimoNumeroDivisionesAux2 :: Integer -> Integer -> Maybe (Int,Integer)
minimoNumeroDivisionesAux2 x y =
  listToMaybe (sort [(m+n,z) | (z,(m,n)) <- minimasProfundidadesComunes x y])

-- (arbolDivisiones x) es el árbol de las divisiones enteras de x entre
-- 2, 3 ó 5. Por ejemplo,
--    λ> putStrLn (drawTree (fmap show (arbolDivisiones 30)))
--    30
--    |
--    +- 15
--    |  |
--    |  +- 5
--    |  |  |
--    |  |  `- 1
--    |  |
--    |  `- 3
--    |     |
--    |     `- 1
--    |
--    +- 10
--    |  |
--    |  +- 5
--    |  |  |
--    |  |  `- 1
--    |  |
--    |  `- 2
--    |     |
--    |     `- 1
--    |
--    `- 6
--       |
--       +- 3
--       |  |
--       |  `- 1
--       |
--       `- 2
--          |
--          `- 1
arbolDivisiones :: Integer -> Tree Integer
arbolDivisiones x =
  Node x (map arbolDivisiones (divisiones x))

-- (divisiones x) es la lista de las divisiones enteras de x entre 2, 3
-- y 5. Por ejemplo,
--    divisiones 30  ==  [15,10,6]
--    divisiones 15  ==  [5,3]
divisiones :: Integer -> [Integer]
divisiones x =
  [x `div` y | y <- [2,3,5], x `mod` y == 0]

-- (nodos a) es el conjunto de nodos del árbol a. Por ejemplo,
--    nodos (Node 2 [Node 2 [], Node 5 []])  ==  [2,5]
--    nodos (arbolDivisiones 30)  ==  [30,15,5,1,3,10,2,6]
nodos :: Tree Integer -> [Integer]
nodos = nub . flatten

-- (divisionesComunes x y) es la lista de los nodos comunes de los
-- árboles de las divisiones de x e y entre 2, 3 ó 5. Por ejemplo,
--    divisionesComunes 15 20  ==  [5,1]
divisionesComunes :: Integer -> Integer -> [Integer]
divisionesComunes x y =
  nodos (arbolDivisiones x) `intersect` nodos (arbolDivisiones y)

-- (minimaProfundidad x ns) es justamente la mínima produndidad
-- donde aparece x en el árbol ns, si aparece y Nothing, en caso
-- contrario. Por ejemplo,minimaProfundidad :: Ord a => a -> Tree a -> Maybe Int
--    λ> minimaProfundidad 3 (Node 1 [Node 6 [],Node 3 [Node 1 []]])
--    Just 1
--    λ> minimaProfundidad 4 (Node 1 [Node 6 [],Node 3 [Node 1 []]])
--    Nothing
minimaProfundidad :: Ord a => a -> Tree a -> Maybe Int
minimaProfundidad x ns =
  listToMaybe [z | (z,ys) <- zip [0..] (levels ns), x `elem` ys]

-- (minimasProfundidadesComunes x e y) es la lista de pares formadas por
-- los nodos comunes de los árboles de las divisiones de x e y entre 2,
-- 3 ó 5 junto con las mínimas profundidades en cada uno de los
-- árboles. Por ejemplo,
--    minimasProfundidadesComunes 15 20  ==  [(5,(1,2)),(1,(2,3))]
--    minimasProfundidadesComunes 15 22  ==  []
minimasProfundidadesComunes :: Integer -> Integer -> [(Integer,(Int,Int))]
minimasProfundidadesComunes x1 x2 =
  [(c,(fromJust (minimaProfundidad c a1), fromJust (minimaProfundidad c a2)))
  | c <- cs]
  where a1 = arbolDivisiones x1
        a2 = arbolDivisiones x2
        cs = divisionesComunes x1 x2

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

-- El mínimo número de divisiones se alcanza en el máximo común divisor.
prop_minimoNumeroDivisiones :: Integer -> Integer -> Property
prop_minimoNumeroDivisiones x y =
  x > 0 && y > 0 ==>
  isNothing a || snd (fromJust a) == gcd x y
  where a = minimoNumeroDivisionesAux x y

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

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

minimoNumeroDivisiones2 :: Integer -> Integer -> Maybe Int
minimoNumeroDivisiones2 x y
  | as' == bs' = Just (sum [abs (a - b) | (a,b) <- zip as bs])
  | otherwise  = Nothing
  where (as,as') = factorizacion x
        (bs,bs') = factorizacion y

-- (factorización n) es la lista de pares cuya primera componente es la
-- lista de los exponentes de 2, 3 y 5 en la factorización de n y la
-- segunda esla lista delos restantes divisores primos. Por ejemplo,
--    factorizacion 15   ==  ([0,1,1],[])
--    factorizacion 20   ==  ([2,0,1],[])
--    factorizacion 17   ==  ([0,0,0],[17])
--    factorizacion 147  ==  ([0,1,0],[7,7])
factorizacion :: Integer -> ([Int],[Integer])
factorizacion n =
  (map length [bs,cs,ds], es)
  where as = primeFactors n
        (bs,bs') = span (==2) as
        (cs,cs') = span (==3) bs'
        (ds,es)  = span (==5) cs'

-- Equivalencia
-- ============

-- La propies de la equivalencia de las dos definiciones es
prop_equivalencia :: Integer -> Integer -> Property
prop_equivalencia x y =
  x > 0 && y > 0 ==>
  minimoNumeroDivisiones x y == minimoNumeroDivisiones2 x y

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

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

--    λ> minimoNumeroDivisiones (10^11) (3^10*7)
--    Nothing
--    (6.08 secs, 2,725,931,872 bytes)
--    λ> minimoNumeroDivisiones2(10^11) (3^10*7)
--    Nothing
--    (0.01 secs, 128,944 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

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

import Data.List (group, intersect, nub, sort)

import Data.Maybe (fromJust, isNothing, listToMaybe)

import Data.Numbers.Primes (primeFactors)

import Data.Tree (Tree (Node), flatten, levels)

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

-- 1ª solución

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

minimoNumeroDivisiones :: Integer -> Integer -> Maybe Int

minimoNumeroDivisiones x y

| isNothing a = Nothing

| otherwise = Just (fst (fromJust a))

where a = minimoNumeroDivisionesAux x y

-- La definición anterior se puede simplificar

minimoNumeroDivisiones' :: Integer -> Integer -> Maybe Int

minimoNumeroDivisiones' x y =

Just fst <*> minimoNumeroDivisionesAux x y

-- (minimoNumeroDivisiones x y) es justamente el par formado por el

-- mínimo número de divisiones por 2, 3 ó 5 que hay que realizar para

-- igualar x e y junto con el número al que se reducen, o Nothing si no

-- se pueden igualar. Por ejemplo,

-- minimoNumeroDivisionesAux 15 20 == Just (3,5)

-- minimoNumeroDivisionesAux 15 15 == Just (0,15)

-- minimoNumeroDivisionesAux 15 16 == Just (6,1)

-- minimoNumeroDivisionesAux 15 17 == Nothing

minimoNumeroDivisionesAux :: Integer -> Integer -> Maybe (Int,Integer)

minimoNumeroDivisionesAux x y

| null as = Nothing

| otherwise = Just (head as)

where as = sort [(m+n,z) | (z,(m,n)) <- minimasProfundidadesComunes x y]

-- La definición anterior se puede simplificar

minimoNumeroDivisionesAux2 :: Integer -> Integer -> Maybe (Int,Integer)

minimoNumeroDivisionesAux2 x y =

listToMaybe (sort [(m+n,z) | (z,(m,n)) <- minimasProfundidadesComunes x y])

-- (arbolDivisiones x) es el árbol de las divisiones enteras de x entre

-- 2, 3 ó 5. Por ejemplo,

-- λ> putStrLn (drawTree (fmap show (arbolDivisiones 30)))

-- 30

-- |

-- +- 15

-- | |

-- | +- 5

-- | | |

-- | | `- 1

-- | |

-- | `- 3

-- | |

-- | `- 1

-- |

-- +- 10

-- | |

-- | +- 5

-- | | |

-- | | `- 1

-- | |

-- | `- 2

-- | |

-- | `- 1

-- |

-- `- 6

-- |

-- +- 3

-- | |

-- | `- 1

-- |

-- `- 2

-- |

-- `- 1

arbolDivisiones :: Integer -> Tree Integer

arbolDivisiones x =

Node x (map arbolDivisiones (divisiones x))

-- (divisiones x) es la lista de las divisiones enteras de x entre 2, 3

-- y 5. Por ejemplo,

-- divisiones 30 == [15,10,6]

-- divisiones 15 == [5,3]

divisiones :: Integer -> [Integer]

divisiones x =

[x `div` y | y <- [2,3,5], x `mod` y == 0]

-- (nodos a) es el conjunto de nodos del árbol a. Por ejemplo,

-- nodos (Node 2 [Node 2 [], Node 5 []]) == [2,5]

-- nodos (arbolDivisiones 30) == [30,15,5,1,3,10,2,6]

nodos :: Tree Integer -> [Integer]

nodos = nub . flatten

-- (divisionesComunes x y) es la lista de los nodos comunes de los

-- árboles de las divisiones de x e y entre 2, 3 ó 5. Por ejemplo,

-- divisionesComunes 15 20 == [5,1]

divisionesComunes :: Integer -> Integer -> [Integer]

divisionesComunes x y =

nodos (arbolDivisiones x) `intersect` nodos (arbolDivisiones y)

-- (minimaProfundidad x ns) es justamente la mínima produndidad

-- donde aparece x en el árbol ns, si aparece y Nothing, en caso

-- contrario. Por ejemplo,minimaProfundidad :: Ord a => a -> Tree a -> Maybe Int

-- λ> minimaProfundidad 3 (Node 1 [Node 6 [],Node 3 [Node 1 []]])

-- Just 1

-- λ> minimaProfundidad 4 (Node 1 [Node 6 [],Node 3 [Node 1 []]])

-- Nothing

minimaProfundidad :: Ord a => a -> Tree a -> Maybe Int

minimaProfundidad x ns =

listToMaybe [z | (z,ys) <- zip [0..] (levels ns), x `elem` ys]

-- (minimasProfundidadesComunes x e y) es la lista de pares formadas por

-- los nodos comunes de los árboles de las divisiones de x e y entre 2,

-- 3 ó 5 junto con las mínimas profundidades en cada uno de los

-- árboles. Por ejemplo,

-- minimasProfundidadesComunes 15 20 == [(5,(1,2)),(1,(2,3))]

-- minimasProfundidadesComunes 15 22 == []

minimasProfundidadesComunes :: Integer -> Integer -> [(Integer,(Int,Int))]

minimasProfundidadesComunes x1 x2 =

[(c,(fromJust (minimaProfundidad c a1), fromJust (minimaProfundidad c a2)))

| c <- cs]

where a1 = arbolDivisiones x1

a2 = arbolDivisiones x2

cs = divisionesComunes x1 x2

-- Propiedad

-- =========

-- El mínimo número de divisiones se alcanza en el máximo común divisor.

prop_minimoNumeroDivisiones :: Integer -> Integer -> Property

prop_minimoNumeroDivisiones x y =

x > 0 && y > 0 ==>

isNothing a || snd (fromJust a) == gcd x y

where a = minimoNumeroDivisionesAux x y

-- La comprobación es

-- λ> quickCheck prop_minimoNumeroDivisiones

-- +++ OK, passed 100 tests.

-- 2ª solución

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

minimoNumeroDivisiones2 :: Integer -> Integer -> Maybe Int

minimoNumeroDivisiones2 x y

| as' == bs' = Just (sum [abs (a - b) | (a,b) <- zip as bs])

| otherwise = Nothing

where (as,as') = factorizacion x

(bs,bs') = factorizacion y

-- (factorización n) es la lista de pares cuya primera componente es la

-- lista de los exponentes de 2, 3 y 5 en la factorización de n y la

-- segunda esla lista delos restantes divisores primos. Por ejemplo,

-- factorizacion 15 == ([0,1,1],[])

-- factorizacion 20 == ([2,0,1],[])

-- factorizacion 17 == ([0,0,0],[17])

-- factorizacion 147 == ([0,1,0],[7,7])

factorizacion :: Integer -> ([Int],[Integer])

factorizacion n =

(map length [bs,cs,ds], es)

where as = primeFactors n

(bs,bs') = span (==2) as

(cs,cs') = span (==3) bs'

(ds,es) = span (==5) cs'

-- Equivalencia

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

-- La propies de la equivalencia de las dos definiciones es

prop_equivalencia :: Integer -> Integer -> Property

prop_equivalencia x y =

x > 0 && y > 0 ==>

minimoNumeroDivisiones x y == minimoNumeroDivisiones2 x y

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> minimoNumeroDivisiones (10^11) (3^10*7)

-- Nothing

-- (6.08 secs, 2,725,931,872 bytes)

-- λ> minimoNumeroDivisiones2(10^11) (3^10*7)

-- Nothing

-- (0.01 secs, 128,944 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>

Mínima profundidad

PorJosé A. Alonso 23-marzo-202130-marzo-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]

Por ejemplo, los árboles

     1               3
    / \             /|\
   6   3           / | \
       |          5  4  7
       1          |     /\
                  3    6  5

1 3

/ \ /|\

6 3 / | \

| 5 4 7

1 | /\

3 6 5

se representan por

   ej1, ej2 :: Tree Int
   ej1 = Node 1 [Node 6 [],Node 3 [Node 1 []]]
   ej2 = Node 3 [Node 5 [Node 3 []], Node 4 [], Node 7 [Node 6 [], Node 5 []]]

ej1, ej2 :: Tree Int

ej1 = Node 1 [Node 6 [],Node 3 [Node 1 []]]

ej2 = Node 3 [Node 5 [Node 3 []], Node 4 [], Node 7 [Node 6 [], Node 5 []]]

Definir la función

    minimaProfundidad :: Ord a => a -> Tree a -> Maybe Int

1	minimaProfundidad :: Ord a => a -> Tree a -> Maybe Int

tal que (minimaProfundidad x ns) es justamente la mínima donde aparece x en el árbol ns, si aparece y Nothing, en caso contrario. Por ejemplo,

    minimaProfundidad 1 ej1  ==  Just 0
    minimaProfundidad 3 ej1  ==  Just 1
    minimaProfundidad 2 ej1  ==  Nothing
    minimaProfundidad 3 ej2  ==  Just 0
    minimaProfundidad 4 ej2  ==  Just 1
    minimaProfundidad 6 ej2  ==  Just 2
    minimaProfundidad 9 ej2  ==  Nothing

minimaProfundidad 1 ej1 == Just 0

minimaProfundidad 3 ej1 == Just 1

minimaProfundidad 2 ej1 == Nothing

minimaProfundidad 3 ej2 == Just 0

minimaProfundidad 4 ej2 == Just 1

minimaProfundidad 6 ej2 == Just 2

minimaProfundidad 9 ej2 == Nothing

Soluciones

import Data.Tree (Tree (Node), levels)
import Data.Maybe (isNothing, fromJust, listToMaybe)

ej1, ej2 :: Tree Int
ej1 = Node 1 [Node 6 [],Node 3 [Node 1 []]]
ej2 = Node 3 [Node 5 [Node 3 []], Node 4 [], Node 7 [Node 6 [], Node 5 []]]

-- 1ª definición
minimaProfundidad1 :: Ord a => a -> Tree a -> Maybe Int
minimaProfundidad1 x (Node y ns)
  | x == y    = Just 0
  | null zs   = Nothing
  | otherwise = Just (1 + minimum zs)
  where zs = [z | Just z <- filter (/=Nothing) (map (minimaProfundidad1 x) ns)]

-- 2ª definición
minimaProfundidad2 :: Ord a => a -> Tree a -> Maybe Int
minimaProfundidad2 x (Node y ns)
  | x == y       = Just 0
  | z == Nothing = Nothing
  | otherwise    = Just (1 + fromJust z)
  where z = minimum (map (minimaProfundidad2 x) ns)

-- 3ª definición
minimaProfundidad3 :: Ord a => a -> Tree a -> Maybe Int
minimaProfundidad3 x (Node y ns)
  | x == y       = Just 0
  | otherwise    = Just (+1) <*> minimum (map (minimaProfundidad3 x) ns)

-- 4ª definición
minimaProfundidad4 :: Ord a => a -> Tree a -> Maybe Int
minimaProfundidad4 x ns
  | null zs   = Nothing
  | otherwise = Just (head zs)
  where zs = [z | (z,ys) <- zip [0..] (levels ns), x `elem` ys]

-- 5ª definición
minimaProfundidad5 :: Ord a => a -> Tree a -> Maybe Int
minimaProfundidad5 x ns =
  listToMaybe [z | (z,ys) <- zip [0..] (levels ns), x `elem` ys]

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

import Data.Maybe (isNothing, fromJust, listToMaybe)

ej1, ej2 :: Tree Int

ej1 = Node 1 [Node 6 [],Node 3 [Node 1 []]]

ej2 = Node 3 [Node 5 [Node 3 []], Node 4 [], Node 7 [Node 6 [], Node 5 []]]

-- 1ª definición

minimaProfundidad1 :: Ord a => a -> Tree a -> Maybe Int

minimaProfundidad1 x (Node y ns)

| x == y = Just 0

| null zs = Nothing

| otherwise = Just (1 + minimum zs)

where zs = [z | Just z <- filter (/=Nothing) (map (minimaProfundidad1 x) ns)]

-- 2ª definición

minimaProfundidad2 :: Ord a => a -> Tree a -> Maybe Int

minimaProfundidad2 x (Node y ns)

| x == y = Just 0

| z == Nothing = Nothing

| otherwise = Just (1 + fromJust z)

where z = minimum (map (minimaProfundidad2 x) ns)

-- 3ª definición

minimaProfundidad3 :: Ord a => a -> Tree a -> Maybe Int

minimaProfundidad3 x (Node y ns)

| x == y = Just 0

| otherwise = Just (+1) <*> minimum (map (minimaProfundidad3 x) ns)

-- 4ª definición

minimaProfundidad4 :: Ord a => a -> Tree a -> Maybe Int

minimaProfundidad4 x ns

| null zs = Nothing

| otherwise = Just (head zs)

where zs = [z | (z,ys) <- zip [0..] (levels ns), x `elem` ys]

-- 5ª definición

minimaProfundidad5 :: Ord a => a -> Tree a -> Maybe Int

minimaProfundidad5 x ns =

listToMaybe [z | (z,ys) <- zip [0..] (levels ns), x `elem` ys]

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 las divisiones por 2, 3 ó 5

PorJosé A. Alonso 22-marzo-202129-marzo-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

Definir la función

   arbolDivisiones :: Int -> Tree Int

1	arbolDivisiones :: Int -> Tree Int

tal que (arbolDivisiones x) es el árbol de las divisiones enteras de x entre 2, 3 ó 5. Por ejemplo,

   λ> putStrLn (drawTree (fmap show (arbolDivisiones 20)))
   20
   |
   +- 10
   |  |
   |  +- 5
   |  |  |
   |  |  `- 1
   |  |
   |  `- 2
   |     |
   |     `- 1
   |
   `- 4
      |
      `- 2
         |
         `- 1

   λ> putStrLn (drawTree (fmap show (arbolDivisiones 30)))
   30
   |
   +- 15
   |  |
   |  +- 5
   |  |  |
   |  |  `- 1
   |  |
   |  `- 3
   |     |
   |     `- 1
   |
   +- 10
   |  |
   |  +- 5
   |  |  |
   |  |  `- 1
   |  |
   |  `- 2
   |     |
   |     `- 1
   |
   `- 6
      |
      +- 3
      |  |
      |  `- 1
      |
      `- 2
         |
         `- 1

λ> putStrLn (drawTree (fmap show (arbolDivisiones 20)))

+- 10

| |

| +- 5

| | |

| | `- 1

| |

| `- 2

| |

| `- 1

`- 4

`- 2

`- 1

λ> putStrLn (drawTree (fmap show (arbolDivisiones 30)))

+- 15

| |

| +- 5

| | |

| | `- 1

| |

| `- 3

| |

| `- 1

+- 10

| |

| +- 5

| | |

| | `- 1

| |

| `- 2

| |

| `- 1

`- 6

+- 3

| |

| `- 1

`- 2

`- 1

Soluciones

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

arbolDivisiones :: Int -> Tree Int
arbolDivisiones x =
  Node x (map arbolDivisiones (divisiones x))

-- (divisiones x) es la lista de las divisiones enteras de x entre 2, 3
-- y 5. Por ejemplo,
--    divisiones 30  ==  [15,10,6]
--    divisiones 15  ==  [5,3]
divisiones :: Int -> [Int]
divisiones x =
  [x `div` y | y <- [2,3,5], x `mod` y == 0]

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

arbolDivisiones :: Int -> Tree Int

arbolDivisiones x =

Node x (map arbolDivisiones (divisiones x))

-- (divisiones x) es la lista de las divisiones enteras de x entre 2, 3

-- y 5. Por ejemplo,

-- divisiones 30 == [15,10,6]

-- divisiones 15 == [5,3]

divisiones :: Int -> [Int]

divisiones x =

[x `div` y | y <- [2,3,5], x `mod` y == 0]

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>

Cálculo de pi mediante la fórmula de Beeler

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

El pasado 12 de marzo se publicó en Twitter un mensaje con una fórmula de Beeler para el cálculo de pi

Los primeros valores son

   λ> 2*1
   2
   λ> 2*(1+1/3)
   2.6666666666666665
   λ> 2*(1+1/3+(1*2)/(3*5))
   2.933333333333333
   λ> 2*(1+1/3+(1*2)/(3*5)+(1*2*3)/(3*5*7))
   3.0476190476190474
   λ> 2*(1+1/3+(1*2)/(3*5)+(1*2*3)/(3*5*7)+(1*2*3*4)/(3*5*7*9))
   3.098412698412698

λ> 2*1

λ> 2*(1+1/3)

2.6666666666666665

λ> 2*(1+1/3+(1*2)/(3*5))

2.933333333333333

λ> 2*(1+1/3+(1*2)/(3*5)+(1*2*3)/(3*5*7))

3.0476190476190474

λ> 2*(1+1/3+(1*2)/(3*5)+(1*2*3)/(3*5*7)+(1*2*3*4)/(3*5*7*9))

3.098412698412698

Definir las funciones

   aproximacionPi :: Int -> Double
   grafica        :: [Int] -> IO ()

1 2	aproximacionPi :: Int -> Double grafica :: [Int] -> IO ()

tales que

(aproximacionPi n) es la n-ésima aproximación de pi con la fórmula de Beeler. Por ejemplo,

     aproximacionPi 0    ==  2.0
     aproximacionPi 1    ==  2.6666666666666665
     aproximacionPi 2    ==  2.933333333333333
     aproximacionPi 3    ==  3.0476190476190474
     aproximacionPi 4    ==  3.098412698412698
     aproximacionPi 10   ==  3.141106021601377
     aproximacionPi 100  ==  3.1415926535897922
     pi                  ==  3.141592653589793

aproximacionPi 0 == 2.0

aproximacionPi 1 == 2.6666666666666665

aproximacionPi 2 == 2.933333333333333

aproximacionPi 3 == 3.0476190476190474

aproximacionPi 4 == 3.098412698412698

aproximacionPi 10 == 3.141106021601377

aproximacionPi 100 == 3.1415926535897922

pi == 3.141592653589793

(grafica xs) dibuja la gráfica de las k-ésimas aproximaciones de pi para k en xs. Por ejemplo, (grafica [0..99]) dibuja

Soluciones

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

aproximacionPi :: Int -> Double
aproximacionPi n =
  aproximacionesPi !! n

aproximacionesPi :: [Double]
aproximacionesPi =
  map (*2) (scanl1 (+) (1 : scanl1 (*) [(x/y) | (x,y) <- zip [1..] [3,5..]]))


-- Gráfica
-- =======

grafica :: [Int] -> IO ()
grafica xs =
  plotList [ Key Nothing
           -- , PNG "Calculo_de_pi_mediante_la_formula_de_Beeler_1.png"
           ]
           [(k,aproximacionPi k) | k <- xs]

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

aproximacionPi :: Int -> Double

aproximacionPi n =

aproximacionesPi !! n

aproximacionesPi :: [Double]

aproximacionesPi =

map (*2) (scanl1 (+) (1 : scanl1 (*) [(x/y) | (x,y) <- zip [1..] [3,5..]]))

-- Gráfica

-- =======

grafica :: [Int] -> IO ()

grafica xs =

plotList [ Key Nothing

-- , PNG "Calculo_de_pi_mediante_la_formula_de_Beeler_1.png"

]

[(k,aproximacionPi k) | k <- xs]

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>

Números ordenados con cuadrados ordenados

PorJosé A. Alonso 18-marzo-202125-marzo-2021

Un número es ordenado si cada uno de sus dígitos es menor o igual el siguiente dígito. Por ejemplo, 116 es un número creciente y su cuadrado es 13456, que también es ordenado. En cambio, 115 es ordenado pero su cuadrado es 13225 que no es ordenado.

Definir la lista

   numerosOrdenadosConCuadradosOrdenados :: [Integer]

1	numerosOrdenadosConCuadradosOrdenados :: [Integer]

cuyos elementos son los números ordenados cuyos cuadrados también lo son. Por ejemplo,

   λ> take 20 numerosOrdenadosConCuadradosOrdenados
   [0,1,2,3,4,5,6,7,12,13,15,16,17,34,35,37,38,67,116,117]
   λ> length (show (numerosOrdenadosConCuadradosOrdenados !! (10^6)))
   1411
   λ> length (show (numerosOrdenadosConCuadradosOrdenados !! (5*10^6)))
   3159

λ> take 20 numerosOrdenadosConCuadradosOrdenados

[0,1,2,3,4,5,6,7,12,13,15,16,17,34,35,37,38,67,116,117]

λ> length (show (numerosOrdenadosConCuadradosOrdenados !! (10^6)))

1411

λ> length (show (numerosOrdenadosConCuadradosOrdenados !! (5*10^6)))

3159

Soluciones

import Data.List

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

numerosOrdenadosConCuadradosOrdenados :: [Integer]
numerosOrdenadosConCuadradosOrdenados =
  filter numeroOrdenadoConCuadradoOrdenado [0..]

-- (numeroOrdenadoConCuadradoOrdenado n) se verifica si n es un número
-- ordenado cuyo cuadrado también lo es. Por ejemplo,
--    numeroOrdenadoConCuadradoOrdenado 116  ==  True
--    numeroOrdenadoConCuadradoOrdenado 115  ==  False
numeroOrdenadoConCuadradoOrdenado :: Integer -> Bool
numeroOrdenadoConCuadradoOrdenado n =
  ordenado n && ordenado (n^2)

-- (ordenado n) se verifica si n es un número ordenado. Por ejemplo,
--    ordenado 115  ==  True
--    ordenado 151  ==  False
ordenado :: Integer -> Bool
ordenado n =
  and [x <= y | (x,y) <- zip xs (tail xs)]
  where xs = show n

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

-- Se basa en la observación de los sisuientes cálculos con la primera
-- solución
--    λ> take 30 numerosOrdenadosConCuadradosOrdenados
--    [0,1,2,3,4,5,6,7,12,13,15,16,17,34,35,37,38,67,116,117,
--     167,334,335,337,367,667,1667,3334,3335,3337]
--    λ> take 21 (dropWhile (<= 117) numerosOrdenadosConCuadradosOrdenados)
--    [167,334,335,337,367,667,
--     1667,3334,3335,3337,3367,3667,6667,
--     16667,33334,33335,33337,33367,33667,36667,66667]
--
-- Se observa que a partir del 167 todos los elementos son de 4 tipos
-- como se ve en la siguente tabla
--    |-------+--------+--------+--------+--------|
--    |       | Tipo A | Tipo B | Tipo C | Tipo D |
--    |-------+--------+--------+--------+--------|
--    |   167 | 16¹7   |        |        |        |
--    |   334 |        | 3²4    |        |        |
--    |   335 |        |        | 3²5    |        |
--    |   337 |        |        |        | 3²6⁰7  |
--    |   367 |        |        |        | 3¹6¹7  |
--    |   667 |        |        |        | 3⁰6²7  |
--    |  1667 | 16²7   |        |        |        |
--    |  3334 |        | 3³4    |        |        |
--    |  3335 |        |        | 3³5    |        |
--    |  3337 |        |        |        | 3³6⁰7  |
--    |  3367 |        |        |        | 3²6¹7  |
--    |  3667 |        |        |        | 3¹6²7  |
--    |  6667 |        |        |        | 3⁰6³7  |
--    | 16667 | 16³7   |        |        |        |
--    | 33334 |        | 3⁴4    |        |        |
--    | 33335 |        |        | 3⁴5    |        |
--    | 33337 |        |        |        | 3⁴6⁰7  |
--    | 33367 |        |        |        | 3³6¹7  |
--    | 33667 |        |        |        | 3²6²7  |
--    | 36667 |        |        |        | 3¹6³7  |
--    | 66667 |        |        |        | 3⁰6⁴7  |
--    |-------+--------+--------+--------+--------|
-- donde el exponente en cad dígito indica el número de repeticiones de
-- dicho dígito.

numerosOrdenadosConCuadradosOrdenados2 :: [Integer]
numerosOrdenadosConCuadradosOrdenados2 =
  [0,1,2,3,4,5,6,7,12,13,15,16,17,34,35,37,38,67,116,117] ++
  map read (concat [['1' : replicate n '6' ++ "7",
                     replicate (n+1) '3' ++ "4",
                     replicate (n+1) '3' ++ "5"] ++
                    [replicate a '3' ++ replicate b '6' ++ "7"
                    | b <- [0..n+1], let a = (n+1) - b]
                   | n <- [1..]])

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

-- La comparación es
--    λ> numerosOrdenadosConCuadradosOrdenados !! 50
--    1666667
--    (2.35 secs, 2,173,983,096 bytes)
--    λ> numerosOrdenadosConCuadradosOrdenados2 !! 50
--    1666667
--    (0.01 secs, 125,296 bytes)

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

-- La comprobación es
--    λ> take 50 numerosOrdenadosConCuadradosOrdenados == take 50 numerosOrdenadosConCuadradosOrdenados2
--    True

import Data.List

-- 1ª solución

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

numerosOrdenadosConCuadradosOrdenados :: [Integer]

numerosOrdenadosConCuadradosOrdenados =

filter numeroOrdenadoConCuadradoOrdenado [0..]

-- (numeroOrdenadoConCuadradoOrdenado n) se verifica si n es un número

-- ordenado cuyo cuadrado también lo es. Por ejemplo,

-- numeroOrdenadoConCuadradoOrdenado 116 == True

-- numeroOrdenadoConCuadradoOrdenado 115 == False

numeroOrdenadoConCuadradoOrdenado :: Integer -> Bool

numeroOrdenadoConCuadradoOrdenado n =

ordenado n && ordenado (n^2)

-- (ordenado n) se verifica si n es un número ordenado. Por ejemplo,

-- ordenado 115 == True

-- ordenado 151 == False

ordenado :: Integer -> Bool

ordenado n =

and [x <= y | (x,y) <- zip xs (tail xs)]

where xs = show n

-- 2ª solución

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

-- Se basa en la observación de los sisuientes cálculos con la primera

-- solución

-- λ> take 30 numerosOrdenadosConCuadradosOrdenados

-- [0,1,2,3,4,5,6,7,12,13,15,16,17,34,35,37,38,67,116,117,

-- 167,334,335,337,367,667,1667,3334,3335,3337]

-- λ> take 21 (dropWhile (<= 117) numerosOrdenadosConCuadradosOrdenados)

-- [167,334,335,337,367,667,

-- 1667,3334,3335,3337,3367,3667,6667,

-- 16667,33334,33335,33337,33367,33667,36667,66667]

-- Se observa que a partir del 167 todos los elementos son de 4 tipos

-- como se ve en la siguente tabla

-- |-------+--------+--------+--------+--------|

-- |-------+--------+--------+--------+--------|

-- | 167 | 16¹7 | | | |

-- | 334 | | 3²4 | | |

-- | 335 | | | 3²5 | |

-- | 337 | | | | 3²6⁰7 |

-- | 367 | | | | 3¹6¹7 |

-- | 667 | | | | 3⁰6²7 |

-- | 1667 | 16²7 | | | |

-- | 3334 | | 3³4 | | |

-- | 3335 | | | 3³5 | |

-- | 3337 | | | | 3³6⁰7 |

-- | 3367 | | | | 3²6¹7 |

-- | 3667 | | | | 3¹6²7 |

-- | 6667 | | | | 3⁰6³7 |

-- | 16667 | 16³7 | | | |

-- | 33334 | | 3⁴4 | | |

-- | 33335 | | | 3⁴5 | |

-- | 33337 | | | | 3⁴6⁰7 |

-- | 33367 | | | | 3³6¹7 |

-- | 33667 | | | | 3²6²7 |

-- | 36667 | | | | 3¹6³7 |

-- | 66667 | | | | 3⁰6⁴7 |

-- |-------+--------+--------+--------+--------|

-- donde el exponente en cad dígito indica el número de repeticiones de

-- dicho dígito.

numerosOrdenadosConCuadradosOrdenados2 :: [Integer]

numerosOrdenadosConCuadradosOrdenados2 =

[0,1,2,3,4,5,6,7,12,13,15,16,17,34,35,37,38,67,116,117] ++

map read (concat [['1' : replicate n '6' ++ "7",

replicate (n+1) '3' ++ "4",

replicate (n+1) '3' ++ "5"] ++

[replicate a '3' ++ replicate b '6' ++ "7"

| b <- [0..n+1], let a = (n+1) - b]

| n <- [1..]])

-- Comparación de eficiencia

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

-- La comparación es

-- λ> numerosOrdenadosConCuadradosOrdenados !! 50

-- 1666667

-- (2.35 secs, 2,173,983,096 bytes)

-- λ> numerosOrdenadosConCuadradosOrdenados2 !! 50

-- 1666667

-- (0.01 secs, 125,296 bytes)

-- Comprobación de equivalencia

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

-- La comprobación es

-- λ> take 50 numerosOrdenadosConCuadradosOrdenados == take 50 numerosOrdenadosConCuadradosOrdenados2

-- True

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>

Números con cuadrados con dígitos pares

PorJosé A. Alonso 17-marzo-202124-marzo-2021

Definir la lista

   numerosConCuadradosConDigitosPares :: [Integer]

1	numerosConCuadradosConDigitosPares :: [Integer]

cuyos elementos son los números cuyos cuadrados tienen todos sus dígitos pares. Por ejemplo,

   λ> take 20 numerosConCuadradosConDigitosPares
   [0,2,8,20,22,68,78,80,92,162,168,200,202,220,262,298,478,492,498,668]

1 2	λ> take 20 numerosConCuadradosConDigitosPares [0,2,8,20,22,68,78,80,92,162,168,200,202,220,262,298,478,492,498,668]

Comprobar con QuickCheck que numerosConCuadradosConDigitosPares es infinita; es decir, para cualquier n posee algún elemento mayor que n.

Soluciones

import Test.QuickCheck

numerosConCuadradosConDigitosPares :: [Integer]
numerosConCuadradosConDigitosPares =
  filter tieneCuadradoConDigitosPares [0..]

-- (tieneCuadradoConDigitosPares n) se verifica si todos los dígitos de
-- n^2 son pares. Por ejemplo,
--    tieneCuadradoConDigitosPares 78  ==  True
--    tieneCuadradoConDigitosPares 76  ==  False
tieneCuadradoConDigitosPares :: Integer -> Bool
tieneCuadradoConDigitosPares n =
  tieneDigitosPares (n^2)

-- (tieneDigitosPares n) se verifica si todos los dígitos de n son
-- pares. Por ejemplo,
--    tieneDigitosPares 426  ==  True
--    tieneDigitosPares 436  ==  False
tieneDigitosPares :: Integer -> Bool
tieneDigitosPares n =
  all even (digitos n)

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

-- La propiedad es
prop_infinito :: Integer -> Bool
prop_infinito n =
  not (null (dropWhile (<= n) numerosConCuadradosConDigitosPares))

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

import Test.QuickCheck

numerosConCuadradosConDigitosPares :: [Integer]

numerosConCuadradosConDigitosPares =

filter tieneCuadradoConDigitosPares [0..]

-- (tieneCuadradoConDigitosPares n) se verifica si todos los dígitos de

-- n^2 son pares. Por ejemplo,

-- tieneCuadradoConDigitosPares 78 == True

-- tieneCuadradoConDigitosPares 76 == False

tieneCuadradoConDigitosPares :: Integer -> Bool

tieneCuadradoConDigitosPares n =

tieneDigitosPares (n^2)

-- (tieneDigitosPares n) se verifica si todos los dígitos de n son

-- pares. Por ejemplo,

-- tieneDigitosPares 426 == True

-- tieneDigitosPares 436 == False

tieneDigitosPares :: Integer -> Bool

tieneDigitosPares n =

all even (digitos n)

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

-- digitos 325 == [3,2,5]

digitos :: Integer -> [Int]

digitos n =

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

-- La propiedad es

prop_infinito :: Integer -> Bool

prop_infinito n =

not (null (dropWhile (<= n) numerosConCuadradosConDigitosPares))

-- La comprobación es

-- λ> quickCheck prop_infinito

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

Cálculo de pi mediante la fórmula de Bauer

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

El pasado 10 de marzo se publicó en Twitter un mensaje con una fórmula de Bauer para el cálculo de pi

Los primeros valores son

   λ> 2/1
   2.0
   λ> 2/(1 - 5*(1/2)^3)
   5.333333333333333
   λ> 2/(1 - 5*(1/2)^3 + 9*((1*3)/(2*4))^3)
   2.354022988505747
   λ> 2/(1 - 5*(1/2)^3 + 9*((1*3)/(2*4))^3 - 13*((1*3*5)/(2*4*6))^3)
   4.416172506738545

λ> 2/1

2.0

λ> 2/(1 - 5*(1/2)^3)

5.333333333333333

λ> 2/(1 - 5*(1/2)^3 + 9*((1*3)/(2*4))^3)

2.354022988505747

λ> 2/(1 - 5*(1/2)^3 + 9*((1*3)/(2*4))^3 - 13*((1*3*5)/(2*4*6))^3)

4.416172506738545

Definir las funciones

   aproximacionPi :: Int -> Double
   grafica        :: [Int] -> IO ()

1 2	aproximacionPi :: Int -> Double grafica :: [Int] -> IO ()

tales que

(aproximacionPi n) es la n-ésima aproximación de pi con la fórmula de Bauer. Por ejemplo,

     aproximacionPi 0         ==  2.0
     aproximacionPi 1         ==  5.333333333333333
     aproximacionPi 2         ==  2.354022988505747
     aproximacionPi 3         ==  4.416172506738545
     aproximacionPi (10^2)    ==  2.974407762733626
     aproximacionPi (10^2+1)  ==  3.3277148010019233
     aproximacionPi (10^3)    ==  3.0865454975585744
     aproximacionPi (10^3+1)  ==  3.1986099487445463
     aproximacionPi (10^4)    ==  3.1239682112773868
     aproximacionPi (10^4+1)  ==  3.1594161911246594
     aproximacionPi (10^5)    ==  3.135997665507836
     aproximacionPi (10^5+1)  ==  3.147207613460776
     pi                       ==  3.141592653589793

aproximacionPi 0 == 2.0

aproximacionPi 1 == 5.333333333333333

aproximacionPi 2 == 2.354022988505747

aproximacionPi 3 == 4.416172506738545

aproximacionPi (10^2) == 2.974407762733626

aproximacionPi (10^2+1) == 3.3277148010019233

aproximacionPi (10^3) == 3.0865454975585744

aproximacionPi (10^3+1) == 3.1986099487445463

aproximacionPi (10^4) == 3.1239682112773868

aproximacionPi (10^4+1) == 3.1594161911246594

aproximacionPi (10^5) == 3.135997665507836

aproximacionPi (10^5+1) == 3.147207613460776

pi == 3.141592653589793

(grafica xs) dibuja la gráfica de las k-ésimas aproximaciones de pi para k en xs. Por ejemplo, (grafica [0..99]) dibuja

Soluciones

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

aproximacionPi :: Int -> Double
aproximacionPi n =
  aproximacionesPi !! n

aproximacionesPi :: [Double]
aproximacionesPi =
  map (2/)
      (scanl1 (+)
              (zipWith (*)
                       [fromIntegral ((-1)^n*(4*n+1))| n <- [0..]]
                       (1 : scanl1 (*) [(x/y)^3 | (x,y) <- zip [1,3..] [2,4..]])))

-- Gráfica
-- =======

grafica :: [Int] -> IO ()
grafica xs =
  plotList [ Key Nothing
           -- , PNG "Calculo_de_pi_mediante_la_formula_de_Bauer_1.png"
           ]
           [(k,aproximacionPi k) | k <- xs]

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

aproximacionPi :: Int -> Double

aproximacionPi n =

aproximacionesPi !! n

aproximacionesPi :: [Double]

aproximacionesPi =

map (2/)

(scanl1 (+)

(zipWith (*)

[fromIntegral ((-1)^n*(4*n+1))| n <- [0..]]

(1 : scanl1 (*) [(x/y)^3 | (x,y) <- zip [1,3..] [2,4..]])))

-- Gráfica

-- =======

grafica :: [Int] -> IO ()

grafica xs =

plotList [ Key Nothing

-- , PNG "Calculo_de_pi_mediante_la_formula_de_Bauer_1.png"

]

[(k,aproximacionPi k) | k <- xs]

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>

Cálculo de pi mediante la fórmula de Euler

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

El pasado 6 de marzo se publicó en Twitter un mensaje con una fórmula de Euler para el cálculo de pi

Definir las funciones

   aproximacionPi :: Int -> Double
   grafica        :: [Int] -> IO ()

1 2	aproximacionPi :: Int -> Double grafica :: [Int] -> IO ()

tales que

(aproximacionPi n) es la n-ésima aproximación de pi con la fórmula de Euler. Por ejemplo,

     aproximacionPi 1        ==  2.449489742783178
     aproximacionPi 10       ==  3.04936163598207
     aproximacionPi 100      ==  3.1320765318091053
     aproximacionPi 1000     ==  3.1406380562059946
     aproximacionPi 10000    ==  3.1414971639472147
     aproximacionPi 100000   ==  3.141583104326456
     aproximacionPi 1000000  ==  3.1415916986605086
     pi                      ==  3.141592653589793

aproximacionPi 1 == 2.449489742783178

aproximacionPi 10 == 3.04936163598207

aproximacionPi 100 == 3.1320765318091053

aproximacionPi 1000 == 3.1406380562059946

aproximacionPi 10000 == 3.1414971639472147

aproximacionPi 100000 == 3.141583104326456

aproximacionPi 1000000 == 3.1415916986605086

pi == 3.141592653589793

(grafica xs) dibuja la gráfica de las k-ésimas aproximaciones de pi para k en xs. Por ejemplo, (grafica [1..100]) dibuja

Soluciones

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

aproximacionPi :: Int -> Double
aproximacionPi n =
  sqrt (6 * sum [1/k^2 | k <- [1.0..fromIntegral n]])

grafica :: [Int] -> IO ()
grafica xs =
  plotList [ Key Nothing
           -- , PNG "Calculo_de_pi_mediante_la_formula_de_Euler_1.png"
           ]
           [(k,aproximacionPi k) | k <- xs]

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

aproximacionPi :: Int -> Double

aproximacionPi n =

sqrt (6 * sum [1/k^2 | k <- [1.0..fromIntegral n]])

grafica :: [Int] -> IO ()

grafica xs =

plotList [ Key Nothing

-- , PNG "Calculo_de_pi_mediante_la_formula_de_Euler_1.png"

]

[(k,aproximacionPi k) | k <- xs]

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>

Representaciones de un número como potencia

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

El número 512 se puede escribir de tres maneras como potencias:

   512 = 2⁹ = 8³ = 512¹

1	512 = 2⁹ = 8³ = 512¹

Definir las funciones

   potencias       :: Integer -> [(Integer,Integer)]
   numeroPotencias :: Integer -> Int

1 2	potencias :: Integer -> [(Integer,Integer)] numeroPotencias :: Integer -> Int

tales que

(potencias x) es la lista de las representaciones de x como potencias de números enteros positivos. Por ejemplo,

     potencias 7      ==  [(7,1)]
     potencias 8      ==  [(2,3),(8,1)]
     potencias 512    ==  [(2,9),(8,3),(512,1)]
     potencias 16384  ==  [(2,14),(4,7),(128,2),(16384,1)]
     potencias 65536  ==  [(2,16),(4,8),(16,4),(256,2),(65536,1)]

potencias 7 == [(7,1)]

potencias 8 == [(2,3),(8,1)]

potencias 512 == [(2,9),(8,3),(512,1)]

potencias 16384 == [(2,14),(4,7),(128,2),(16384,1)]

potencias 65536 == [(2,16),(4,8),(16,4),(256,2),(65536,1)]

(numeroPotencias x) de las representaciones de x como potencias de números enteros positivos. Por ejemplo,

     numeroPotencias 7          ==  1
     numeroPotencias 8          ==  2
     numeroPotencias 512        ==  3
     numeroPotencias 16384      ==  4
     numeroPotencias 65536      ==  5
     numeroPotencias (2^(10^5)) ==  36

numeroPotencias 7 == 1

numeroPotencias 8 == 2

numeroPotencias 512 == 3

numeroPotencias 16384 == 4

numeroPotencias 65536 == 5

numeroPotencias (2^(10^5)) == 36

Soluciones

import Data.List (group,genericLength)
import Data.Numbers.Primes (primeFactors)

potencias :: Integer -> [(Integer,Integer)]
potencias x = [(a^d,b `div` d) | d <- divisores b]
  where ps = factorizacionPrima x
        b   = mcd (map snd ps)
        a   = product [c^(e `div` b) | (c,e) <- ps]

-- (divisores x) es la lista de los divisores de x. Por ejemplo,
--    divisores 120  ==  [1,2,3,4,5,6,8,10,12,15,20,24,30,40,60,120]
divisores :: Integer -> [Integer]
divisores x =
  [y | y <- [1..x], x `mod` y == 0]

-- (factorizacionPrima x) es la factorización prima de x. Por ejemplo,
--    factorizacionPrima 1200  ==  [(2,4),(3,1),(5,2)]
factorizacionPrima :: Integer -> [(Integer,Integer)]
factorizacionPrima x =
  [(head xs, genericLength xs) | xs <- group (primeFactors x)]

-- (mcd xs) es el máximo común divisor de xs. Por ejemplo,
--    mcd [12,30,42]  ==  6
mcd :: Integral a => [a] -> a
mcd xs = foldr1 gcd xs

-- 1ª definición de numeroPotencias
-- ================================

--    numeroPotencias 7          ==  1
--    numeroPotencias 8          ==  2
--    numeroPotencias 512        ==  3
--    numeroPotencias 16384      ==  4
--    numeroPotencias 65536      ==  5
--    numeroPotencias (2^(10^5)) ==  36
numeroPotencias :: Integer -> Int
numeroPotencias = length . potencias

-- 2ª definición de numeroPotencias
-- ================================

numeroPotencias2 :: Integer -> Int
numeroPotencias2 n =
  numeroDivisores (mcd (map length (group (primeFactors n))))

-- (numeroDivisores n) es el número de divisores de n. Por ejemplo,
--    numeroDivisores 12  ==  6
--    numeroDivisores 14  ==  4
numeroDivisores :: Int -> Int
numeroDivisores =
  product . map ((+1) . length) . group . primeFactors

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

-- La comparación es
--    λ> numeroPotencias (2^(10^5))
--    36
--    (0.40 secs, 707,287,312 bytes)
--    λ> numeroPotencias2 (2^(10^5))
--    36
--    (0.35 secs, 675,954,872 bytes)

import Data.List (group,genericLength)

import Data.Numbers.Primes (primeFactors)

potencias :: Integer -> [(Integer,Integer)]

potencias x = [(a^d,b `div` d) | d <- divisores b]

where ps = factorizacionPrima x

b = mcd (map snd ps)

a = product [c^(e `div` b) | (c,e) <- ps]

-- (divisores x) es la lista de los divisores de x. Por ejemplo,

-- divisores 120 == [1,2,3,4,5,6,8,10,12,15,20,24,30,40,60,120]

divisores :: Integer -> [Integer]

divisores x =

[y | y <- [1..x], x `mod` y == 0]

-- (factorizacionPrima x) es la factorización prima de x. Por ejemplo,

-- factorizacionPrima 1200 == [(2,4),(3,1),(5,2)]

factorizacionPrima :: Integer -> [(Integer,Integer)]

factorizacionPrima x =

[(head xs, genericLength xs) | xs <- group (primeFactors x)]

-- (mcd xs) es el máximo común divisor de xs. Por ejemplo,

-- mcd [12,30,42] == 6

mcd :: Integral a => [a] -> a

mcd xs = foldr1 gcd xs

-- 1ª definición de numeroPotencias

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

-- numeroPotencias 7 == 1

-- numeroPotencias 8 == 2

-- numeroPotencias 512 == 3

-- numeroPotencias 16384 == 4

-- numeroPotencias 65536 == 5

-- numeroPotencias (2^(10^5)) == 36

numeroPotencias :: Integer -> Int

numeroPotencias = length . potencias

-- 2ª definición de numeroPotencias

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

numeroPotencias2 :: Integer -> Int

numeroPotencias2 n =

numeroDivisores (mcd (map length (group (primeFactors n))))

-- (numeroDivisores n) es el número de divisores de n. Por ejemplo,

-- numeroDivisores 12 == 6

-- numeroDivisores 14 == 4

numeroDivisores :: Int -> Int

numeroDivisores =

product . map ((+1) . length) . group . primeFactors

-- Comparación de eficiencia de numeroPotencias

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

-- La comparación es

-- λ> numeroPotencias (2^(10^5))

-- 36

-- (0.40 secs, 707,287,312 bytes)

-- λ> numeroPotencias2 (2^(10^5))

-- 36

-- (0.35 secs, 675,954,872 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>

Cálculo de pi mediante la fórmula de Brouncker

PorJosé A. Alonso 11-marzo-202118-marzo-2021

El mes de marzo es el mes de pi, ya que el 14 de marzo (3/14) es el día de pi. Con ese motivo, el pasado 3 de marzo se publicó en Twitter un mensaje con la fórmula de Brouncker para el cálculo de pi

La primeras aproximaciones son

     a(1) = 4                                  =  4
     a(2) = 4/(1+1^2)                          =  2.0
     a(3) = 4/(1+1^2/(2+3^2))                  =  3.666666666666667
     a(4) = 4/(1+1^2/(2+3^2/(2+5^2)))          =  2.8
     a(5) = 4/(1+1^2/(2+3^2/(2+5^2/(2+7^2))))  =  3.395238095238095

a(1) = 4 = 4

a(2) = 4/(1+1^2) = 2.0

a(3) = 4/(1+1^2/(2+3^2)) = 3.666666666666667

a(4) = 4/(1+1^2/(2+3^2/(2+5^2))) = 2.8

a(5) = 4/(1+1^2/(2+3^2/(2+5^2/(2+7^2)))) = 3.395238095238095

Definir las funciones

   aproximacionPi :: Int -> Double
   grafica        :: [Int] -> IO ()

1 2	aproximacionPi :: Int -> Double grafica :: [Int] -> IO ()

tales que

(aproximacionPi n) es la n-ésima aproximación de pi con la fórmula de Brouncker. Por ejemplo,

     aproximacionPi 1      ==  4.0
     aproximacionPi 2      ==  2.0
     aproximacionPi 3      ==  3.666666666666667
     aproximacionPi 4      ==  2.8
     aproximacionPi 5      ==  3.395238095238095
     aproximacionPi 10     ==  3.0301437124966535
     aproximacionPi 1000   ==  3.1405916523380406
     aproximacionPi 1001   ==  3.142592653839793
     aproximacionPi 10000  ==  3.141492643588543
     aproximacionPi 10001  ==  3.1416926535900433
     pi                    ==  3.141592653589793

aproximacionPi 1 == 4.0

aproximacionPi 2 == 2.0

aproximacionPi 3 == 3.666666666666667

aproximacionPi 4 == 2.8

aproximacionPi 5 == 3.395238095238095

aproximacionPi 10 == 3.0301437124966535

aproximacionPi 1000 == 3.1405916523380406

aproximacionPi 1001 == 3.142592653839793

aproximacionPi 10000 == 3.141492643588543

aproximacionPi 10001 == 3.1416926535900433

pi == 3.141592653589793

(grafica xs) dibuja la gráfica de las k-ésimas aproximaciones de pi para k en xs. Por ejemplo, (grafica [10..100]) dibuja

Soluciones

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

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

aproximacionPi :: Int -> Double
aproximacionPi 1 = 4
aproximacionPi n = 4/(1 + 1/(aux 1 3))
  where aux a b | a == n-1  = 1
                | otherwise = 2 + (b^2)/(aux (a+1) (b+2))

-- El cálculo es
--    aproximacionPi 2
--      = 4/(1 + 1/(aux 1 3))
--      = 4/(1 + 1/1)
--      = 2.0
--
--    aproximacionPi 3
--      = 4/(1 + 1/(aux 1 3))
--      = 4/(1 + 1/(2 + 3^2/(aux 2 5))
--      = 4/(1 + 1/(2 + 3^2/1))
--      = 3.666666666666667
--
--    aproximacionPi 4
--      = 4/(1 + 1/(aux 1 3))
--      = 4/(1 + 1/(2 + 3^2/(aux 2 5))
--      = 4/(1 + 1/(2 + 3^2/(2 + 5^2/(aux 3 7))))
--      = 4/(1 + 1/(2 + 3^2/(2 + 5^2/1)))
--      = 2.8

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

aproximacionPi2 :: Int -> Double
aproximacionPi2 n =
  aproximacionFC n fraccionPi

-- fraccionPi es la representación de la fracción continua de pi como un
-- par de listas infinitas.
fraccionPi :: [(Integer, Integer)]
fraccionPi = zip (0 : 1 : [2,2..]) (4 : map (^2) [1,3..])

-- (aproximacionFC n fc) es la n-ésima aproximación de la fracción
-- continua fc (como un par de listas).
aproximacionFC :: Int -> [(Integer, Integer)] -> Double
aproximacionFC n =
  foldr (\(a,b) z -> fromIntegral a + fromIntegral b / z) 1 . take n

-- Gráfica
-- =======

grafica :: [Int] -> IO ()
grafica xs =
  plotList [ Key Nothing
           -- , PNG "Calculo_de_pi_mediante_la_formula_de_Brouncker_1.png"
           ]
           [(k,aproximacionPi k) | k <- xs]

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

-- 1ª solución

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

aproximacionPi :: Int -> Double

aproximacionPi 1 = 4

aproximacionPi n = 4/(1 + 1/(aux 1 3))

where aux a b | a == n-1 = 1

| otherwise = 2 + (b^2)/(aux (a+1) (b+2))

-- El cálculo es

-- aproximacionPi 2

-- = 4/(1 + 1/(aux 1 3))

-- = 4/(1 + 1/1)

-- = 2.0

-- aproximacionPi 3

-- = 4/(1 + 1/(aux 1 3))

-- = 4/(1 + 1/(2 + 3^2/(aux 2 5))

-- = 4/(1 + 1/(2 + 3^2/1))

-- = 3.666666666666667

-- aproximacionPi 4

-- = 4/(1 + 1/(aux 1 3))

-- = 4/(1 + 1/(2 + 3^2/(aux 2 5))

-- = 4/(1 + 1/(2 + 3^2/(2 + 5^2/(aux 3 7))))

-- = 4/(1 + 1/(2 + 3^2/(2 + 5^2/1)))

-- = 2.8

-- 2ª solución

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

aproximacionPi2 :: Int -> Double

aproximacionPi2 n =

aproximacionFC n fraccionPi

-- fraccionPi es la representación de la fracción continua de pi como un

-- par de listas infinitas.

fraccionPi :: [(Integer, Integer)]

fraccionPi = zip (0 : 1 : [2,2..]) (4 : map (^2) [1,3..])

-- (aproximacionFC n fc) es la n-ésima aproximación de la fracción

-- continua fc (como un par de listas).

aproximacionFC :: Int -> [(Integer, Integer)] -> Double

aproximacionFC n =

foldr (\(a,b) z -> fromIntegral a + fromIntegral b / z) 1 . take n

-- Gráfica

-- =======

grafica :: [Int] -> IO ()

grafica xs =

plotList [ Key Nothing

-- , PNG "Calculo_de_pi_mediante_la_formula_de_Brouncker_1.png"

]

[(k,aproximacionPi k) | k <- xs]

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>

Cálculo de pi mediante la serie de Madhava

PorJosé A. Alonso 10-marzo-202117-marzo-2021

El mes de marzo es el mes de pi, ya que el 14 de marzo (3/14) es el día de pi. Con ese motivo, el pasado 1 de marzo se publicó en Twitter un mensaje con la fórmula de Madhava para el cálculo de pi

Definir las funciones

   aproximacionPi :: Int -> Double
   grafica        :: Int -> IO ()

1 2	aproximacionPi :: Int -> Double grafica :: Int -> IO ()

tales que

(aproximacionPi n) es la n-ésima aproximación de pi con la fórmula de Madhava. Por ejemplo,

     aproximacionPi 0   ==  3.4641016151377544
     aproximacionPi 1   ==  3.0792014356780038
     aproximacionPi 2   ==  3.156181471569954
     aproximacionPi 10  ==  3.1415933045030813
     aproximacionPi 21  ==  3.1415926535879337
     pi                 ==  3.141592653589793

aproximacionPi 0 == 3.4641016151377544

aproximacionPi 1 == 3.0792014356780038

aproximacionPi 2 == 3.156181471569954

aproximacionPi 10 == 3.1415933045030813

aproximacionPi 21 == 3.1415926535879337

pi == 3.141592653589793

(grafica n) dibuja la gráfica de las k-ésimas aproximaciones de pi para k desde 0 a n. Por ejemplo, (grafica 30) dibuja

Soluciones

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

aproximacionPi :: Int -> Double
aproximacionPi n =
  sqrt 12 * aux (fromIntegral n)
  where
    aux 0 = 1
    aux n = aux (n-1) + (-1)**n/(3**n*(2*n+1))

grafica :: Int -> IO ()
grafica n =
    plotList [ Key Nothing
             -- , PNG "Calculo_de_pi_mediante_la_serie_de_Madhava_1.png"
             ]
             [aproximacionPi n | n <- [0..n]]

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

aproximacionPi :: Int -> Double

aproximacionPi n =

sqrt 12 * aux (fromIntegral n)

where

aux 0 = 1

aux n = aux (n-1) + (-1)**n/(3**n*(2*n+1))

grafica :: Int -> IO ()

grafica n =

plotList [ Key Nothing

-- , PNG "Calculo_de_pi_mediante_la_serie_de_Madhava_1.png"

]

[aproximacionPi n | n <- [0..n]]

Nuevas soluciones

En los comentarios se pueden escribir nuevas soluciones.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Sucesión de Rowland

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

Definir las siguientes sucesiones

   sucesionA       :: [Integer]
   sucesionB       :: [Integer]
   sucesionRowland :: [Integer]

sucesionA :: [Integer]

sucesionB :: [Integer]

sucesionRowland :: [Integer]

tales que

el término n-ésimo de la sucesionA es a(n) definido por a(1) = 7 y a(n) = a(n-1) + mcd(n, a(n-1)), para n > 1. Por ejemplo,

     λ> take 20 sucesionA
     [7,8,9,10,15,18,19,20,21,22,33,36,37,38,39,40,41,42,43,44]

1 2	λ> take 20 sucesionA [7,8,9,10,15,18,19,20,21,22,33,36,37,38,39,40,41,42,43,44]

los términos de la sucesionB son las diferencias de los términos consecutivos de la sucesionA. Por ejemplo,

     λ> take 30 sucesionB
     [1,1,1,5,3,1,1,1,1,11,3,1,1,1,1,1,1,1,1,1,1,23,3,1,1,1,1,1,1,1]

1 2	λ> take 30 sucesionB [1,1,1,5,3,1,1,1,1,11,3,1,1,1,1,1,1,1,1,1,1,23,3,1,1,1,1,1,1,1]

los términos de la sucesionRowland son los términos de la sucesionB distintos de 1. Por ejemplo,\0

      λ> take 20 sucesionRowland
      [5,3,11,3,23,3,47,3,5,3,101,3,7,11,3,13,233,3,467,3]
      λ> sucesionRowland !! 92
      15567089

λ> take 20 sucesionRowland

[5,3,11,3,23,3,47,3,5,3,101,3,7,11,3,13,233,3,467,3]

λ> sucesionRowland !! 92

15567089

Comprobar con QuickCheck que los elementos de la sucesionRowland son números primos.

Nota: Eric S. Rowland demostró en A natural prime-generating recurrence que los elementos de la sucesionRowland son números primos.

Soluciones

import Data.Numbers.Primes (isPrime)
import Test.QuickCheck (Property, (==>), quickCheck)

sucesionA :: [Integer]
sucesionA =
   7 : zipWith (+) sucesionA (zipWith gcd sucesionA [2..])

sucesionB :: [Integer]
sucesionB = zipWith (-) (tail sucesionA) sucesionA

sucesionRowland :: [Integer]
sucesionRowland =  filter (> 1) sucesionB

-- La propiedad es
prop_sucesionRowland :: Int -> Property
prop_sucesionRowland n =
  n >= 0 ==> isPrime (sucesionRowland !! n)

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

import Data.Numbers.Primes (isPrime)

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

sucesionA :: [Integer]

sucesionA =

7 : zipWith (+) sucesionA (zipWith gcd sucesionA [2..])

sucesionB :: [Integer]

sucesionB = zipWith (-) (tail sucesionA) sucesionA

sucesionRowland :: [Integer]

sucesionRowland = filter (> 1) sucesionB

-- La propiedad es

prop_sucesionRowland :: Int -> Property

prop_sucesionRowland n =

n >= 0 ==> isPrime (sucesionRowland !! n)

-- La comprobación es

-- λ> quickCheck prop_sucesionRowland

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

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Entradas recientes

Buscar

Correo electrónico