Inicial – Exercitium

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

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>

Sumas parciales

PorJosé A. Alonso 8-marzo-202115-marzo-2021

Los sufijos de la lista [3,7,2,5,4,6] son

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

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

[7,2,5,4,6]

[2,5,4,6]

[5,4,6]

[4,6]

[6]

[]

y la lista de sus sumas es [27,24,17,15,10,6,0].

Definir la función

   sumasParciales :: [Integer] -> [Integer]

1	sumasParciales :: [Integer] -> [Integer]

tal que (sumasParciales xs) es la lista de las sumas de los sufijos de xs. Por ejemplo,

   sumasParciales [3,7,2,5,4,6]  ==  [27,24,17,15,10,6,0]
   sumasParciales [1..10]        ==  [55,54,52,49,45,40,34,27,19,10,0]
   sum (sumasParciales [1..5*10^6])  ==  41666679166667500000

sumasParciales [3,7,2,5,4,6] == [27,24,17,15,10,6,0]

sumasParciales [1..10] == [55,54,52,49,45,40,34,27,19,10,0]

sum (sumasParciales [1..5*10^6]) == 41666679166667500000

Soluciones

import Data.List (tails)

-- 1ª solución
sumasParciales1 :: [Integer] -> [Integer]
sumasParciales1 xs = map sum (tails xs)

-- 2ª solución
sumasParciales2 :: [Integer] -> [Integer]
sumasParciales2 []     = [0]
sumasParciales2 (x:xs) = (x + s):s:ss
  where (s:ss) = sumasParciales2 xs

-- 3ª solución
sumasParciales3 :: [Integer] -> [Integer]
sumasParciales3 = foldr (\x (s:ss) -> (x + s) : (s:ss)) [0]

-- 4ª solución
sumasParciales4 :: [Integer] -> [Integer]
sumasParciales4 xs = scanl (-) (sum xs) xs

-- 5ª solución
sumasParciales5 :: [Integer] -> [Integer]
sumasParciales5 xs = reverse (0 : scanl1 (+) (reverse xs))

-- 6ª solución
sumasParciales6 :: [Integer] -> [Integer]
sumasParciales6 = scanr (+) 0

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

-- La comparación es
--    λ> sum (sumasParciales1 [1..3*10^4])
--    9000450005000
--    (19.70 secs, 40,132,872,616 bytes)
--    λ> sum (sumasParciales2 [1..3*10^4])
--    9000450005000
--    (0.04 secs, 16,932,840 bytes)
--    λ> sum (sumasParciales3 [1..3*10^4])
--    9000450005000
--    (0.02 secs, 13,880,608 bytes)
--    λ> sum (sumasParciales4 [1..3*10^4])
--    9000450005000
--    (0.03 secs, 12,178,080 bytes)
--    λ> sum (sumasParciales5 [1..3*10^4])
--    9000450005000
--    (0.02 secs, 9,974,600 bytes)
--    λ> sum (sumasParciales6 [1..3*10^4])
--    9000450005000
--    (0.02 secs, 10,694,368 bytes)
--
--    λ> sum (sumasParciales2 [1..3*10^6])
--    9000004500000500000
--    (3.13 secs, 1,685,139,696 bytes)
--    λ> sum (sumasParciales3 [1..3*10^6])
--    9000004500000500000
--    (2.37 secs, 1,380,492,448 bytes)
--    λ> sum (sumasParciales4 [1..3*10^6])
--    9000004500000500000
--    (1.84 secs, 1,211,188,264 bytes)
--    λ> sum (sumasParciales5 [1..3*10^6])
--    9000004500000500000
--    (1.22 secs, 987,790,392 bytes)
--    λ> sum (sumasParciales6 [1..3*10^6])
--    9000004500000500000
--    (1.34 secs, 1,059,792,344 bytes)
--
--    λ> sum (sumasParciales5 [1..5*10^6])
--    41666679166667500000
--    (2.36 secs, 1,844,332,576 bytes)
--    λ> sum (sumasParciales6 [1..5*10^6])
--    41666679166667500000
--    (2.03 secs, 1,964,365,912 bytes)

import Data.List (tails)

-- 1ª solución

sumasParciales1 :: [Integer] -> [Integer]

sumasParciales1 xs = map sum (tails xs)

-- 2ª solución

sumasParciales2 :: [Integer] -> [Integer]

sumasParciales2 [] = [0]

sumasParciales2 (x:xs) = (x + s):s:ss

where (s:ss) = sumasParciales2 xs

-- 3ª solución

sumasParciales3 :: [Integer] -> [Integer]

sumasParciales3 = foldr (\x (s:ss) -> (x + s) : (s:ss)) [0]

-- 4ª solución

sumasParciales4 :: [Integer] -> [Integer]

sumasParciales4 xs = scanl (-) (sum xs) xs

-- 5ª solución

sumasParciales5 :: [Integer] -> [Integer]

sumasParciales5 xs = reverse (0 : scanl1 (+) (reverse xs))

-- 6ª solución

sumasParciales6 :: [Integer] -> [Integer]

sumasParciales6 = scanr (+) 0

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sum (sumasParciales1 [1..3*10^4])

-- 9000450005000

-- (19.70 secs, 40,132,872,616 bytes)

-- λ> sum (sumasParciales2 [1..3*10^4])

-- 9000450005000

-- (0.04 secs, 16,932,840 bytes)

-- λ> sum (sumasParciales3 [1..3*10^4])

-- 9000450005000

-- (0.02 secs, 13,880,608 bytes)

-- λ> sum (sumasParciales4 [1..3*10^4])

-- 9000450005000

-- (0.03 secs, 12,178,080 bytes)

-- λ> sum (sumasParciales5 [1..3*10^4])

-- 9000450005000

-- (0.02 secs, 9,974,600 bytes)

-- λ> sum (sumasParciales6 [1..3*10^4])

-- 9000450005000

-- (0.02 secs, 10,694,368 bytes)

-- λ> sum (sumasParciales2 [1..3*10^6])

-- 9000004500000500000

-- (3.13 secs, 1,685,139,696 bytes)

-- λ> sum (sumasParciales3 [1..3*10^6])

-- 9000004500000500000

-- (2.37 secs, 1,380,492,448 bytes)

-- λ> sum (sumasParciales4 [1..3*10^6])

-- 9000004500000500000

-- (1.84 secs, 1,211,188,264 bytes)

-- λ> sum (sumasParciales5 [1..3*10^6])

-- 9000004500000500000

-- (1.22 secs, 987,790,392 bytes)

-- λ> sum (sumasParciales6 [1..3*10^6])

-- 9000004500000500000

-- (1.34 secs, 1,059,792,344 bytes)

-- λ> sum (sumasParciales5 [1..5*10^6])

-- 41666679166667500000

-- (2.36 secs, 1,844,332,576 bytes)

-- λ> sum (sumasParciales6 [1..5*10^6])

-- 41666679166667500000

-- (2.03 secs, 1,964,365,912 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>

Suma de la lista reducida

PorJosé A. Alonso 4-marzo-202111-marzo-2021

Definir las siguientes funciones

   transformada :: Integral a => [a] -> [a]
   reducida     :: Integral a => [a] -> [a]
   sumaReducida :: Integral a => [a] -> a

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

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

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

tales que

(transformada xs) es la lista obtenida sustituyendo en el primer de elementos consecutivos de xs el mayor por su diferencia, donde se supone que xs es una lista de enteros positivos. Por ejemplo,

     transformada [7,2,6]  ==  [5,2,6]
     transformada [2,7,6]  ==  [2,5,6]
     transformada [2,2,6]  ==  [2,2,4]
     transformada [2,2,2]  ==  [2,2,2]

transformada [7,2,6] == [5,2,6]

transformada [2,7,6] == [2,5,6]

transformada [2,2,6] == [2,2,4]

transformada [2,2,2] == [2,2,2]

(reducida xs) es la lista obtenida aplicando la transformación anterior mientras sea posible (es decir, mientras tenga elementos distintos), donde se supone que xs es una lista de enteros positivos. Por ejemplo,

     reducida [7,2,6]   ==  [1,1,1]
     reducida [6,9,21]  ==  [3,3,3]

1 2	reducida [7,2,6] == [1,1,1] reducida [6,9,21] == [3,3,3]

(sumaReducida xs) es la suma de la reducida de la lista xs. Por ejemplo,

     sumaReducida1 [7,2,6]   ==  3
     sumaReducida1 [6,9,21]  ==  9

1 2	sumaReducida1 [7,2,6] == 3 sumaReducida1 [6,9,21] == 9

Soluciones

import Data.List (genericLength)

-- Definición de transformada
-- ==========================

transformada :: Integral a => [a] -> [a]
transformada []  = []
transformada [x] = [x]
transformada (x:y:zs)
  | x > y = x-y : y : zs
  | x < y = x : y-x : zs
  | otherwise = x : transformada (y:zs)

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

reducida1 :: Integral a => [a] -> [a]
reducida1 xs
  | xs == ys  = xs
  | otherwise = reducida ys
  where ys = transformada xs

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

reducida2 :: Integral a => [a] -> [a]
reducida2 xs =
  replicate (length xs) (foldl1 gcd xs)

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

-- La comparación es
--    λ> sum (reducida1 [2,4..4*10^6])
--    4000000
--    (1.97 secs, 1,277,797,888 bytes)
--    λ> sum (reducida2 [2,4..4*10^6])
--    4000000
--    (1.92 secs, 1,277,798,344 bytes)

-- Definición de reducida
-- =======================

reducida :: Integral a => [a] -> [a]
reducida = reducida2

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

sumaReducida1 :: Integral a => [a] -> a
sumaReducida1 = sum . reducida

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

sumaReducida2 :: Integral a => [a] -> a
sumaReducida2 xs = genericLength xs * foldl1 gcd xs

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

-- La comparación es
--    λ> sumaReducida1 [2,4..4*10^6]
--    4000000
--    (2.53 secs, 1,277,796,760 bytes)
--    λ> sumaReducida2 [2,4..4*10^6]
--    4000000
--    (1.89 secs, 1,214,376,960 bytes)

import Data.List (genericLength)

-- Definición de transformada

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

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

transformada [] = []

transformada [x] = [x]

transformada (x:y:zs)

| x > y = x-y : y : zs

| x < y = x : y-x : zs

| otherwise = x : transformada (y:zs)

-- 1ª definición de reducida

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

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

reducida1 xs

| xs == ys = xs

| otherwise = reducida ys

where ys = transformada xs

-- 2ª definición de reducida

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

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

reducida2 xs =

replicate (length xs) (foldl1 gcd xs)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sum (reducida1 [2,4..4*10^6])

-- 4000000

-- (1.97 secs, 1,277,797,888 bytes)

-- λ> sum (reducida2 [2,4..4*10^6])

-- 4000000

-- (1.92 secs, 1,277,798,344 bytes)

-- Definición de reducida

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

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

reducida = reducida2

-- 1ª definición de sumaReducida

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

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

sumaReducida1 = sum . reducida

-- 2ª solución

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

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

sumaReducida2 xs = genericLength xs * foldl1 gcd xs

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sumaReducida1 [2,4..4*10^6]

-- 4000000

-- (2.53 secs, 1,277,796,760 bytes)

-- λ> sumaReducida2 [2,4..4*10^6]

-- 4000000

-- (1.89 secs, 1,214,376,960 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>

Eliminaciones anotadas

PorJosé A. Alonso 26-febrero-20215-marzo-2021

Definir la función

   eliminaciones :: [a] -> [(a,Int,[a])]

1	eliminaciones :: [a] -> [(a,Int,[a])]

tal que (eliminaciones xs) es la lista de ternas (x,i,zs) tales que x es un elemento de xs, i es la posición de x en xs y zs es la lista de los restantes elementos de xs. Por ejemplo,

   λ> eliminaciones [5,7,6,5]
   [(5,0,[7,6,5]),(7,1,[5,6,5]),(6,2,[5,7,5]),(5,3,[5,7,6])]

1 2	λ> eliminaciones [5,7,6,5] [(5,0,[7,6,5]),(7,1,[5,6,5]),(6,2,[5,7,5]),(5,3,[5,7,6])]

Soluciones

import Test.QuickCheck (quickCheck)

-- 1ª solución
eliminaciones :: [a] -> [(a,Int,[a])]
eliminaciones xs = [(z,i,zs) | ((z,zs),i) <- zip (aux xs) [0..]]
  where aux []       = []
        aux [x]      = [(x,[])]
        aux (x:y:zs) = (x,y:zs) : [(v,x:vs) | (v,vs) <- aux (y:zs)]

-- 2ª solución
eliminaciones2 :: [a] -> [(a,Int,[a])]
eliminaciones2 xs =
  [(v,i,us++vs) | i <- [0..length xs - 1],
                  let (us,v:vs) = splitAt i xs]

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

-- La propiedad es
prop_equivalencia :: [Int] -> Bool
prop_equivalencia xs =
  eliminaciones xs == eliminaciones2 xs

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

import Test.QuickCheck (quickCheck)

-- 1ª solución

eliminaciones :: [a] -> [(a,Int,[a])]

eliminaciones xs = [(z,i,zs) | ((z,zs),i) <- zip (aux xs) [0..]]

where aux [] = []

aux [x] = [(x,[])]

aux (x:y:zs) = (x,y:zs) : [(v,x:vs) | (v,vs) <- aux (y:zs)]

-- 2ª solución

eliminaciones2 :: [a] -> [(a,Int,[a])]

eliminaciones2 xs =

[(v,i,us++vs) | i <- [0..length xs - 1],

let (us,v:vs) = splitAt i xs]

-- Comprobación de equivalencia

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

-- La propiedad es

prop_equivalencia :: [Int] -> Bool

prop_equivalencia xs =

eliminaciones xs == eliminaciones2 xs

-- La comprobación es

-- λ> quickCheck prop_equivalencia

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

Ternas crecientes de primos con el mayor igual a la suma de los menores

PorJosé A. Alonso 25-febrero-20214-marzo-2021

Definir la función

   ternasPrimas :: [(Integer,Integer,Integer)]

1	ternasPrimas :: [(Integer,Integer,Integer)]

tal que sus elementos son las ternas crecientes de primos con el mayor igual a la suma de los menores. Por ejemplo,

   ternasPrimas  ==  (2,3,5)
   ternasPrimas !! 34567  ==  (2,5393909,5393911)

1 2	ternasPrimas == (2,3,5) ternasPrimas !! 34567 == (2,5393909,5393911)

Soluciones

import Data.Numbers.Primes (primes)

ternasPrimas :: [(Integer,Integer,Integer)]
ternasPrimas = [(2,a,b) | (a,b) <- zip (primes) (tail (primes)),
                          a + 2 == b]

import Data.Numbers.Primes (primes)

ternasPrimas :: [(Integer,Integer,Integer)]

ternasPrimas = [(2,a,b) | (a,b) <- zip (primes) (tail (primes)),

a + 2 == b]

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 balanceados

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

Un número está balanceado si tiene un número par de divisores primos (contados con su multiplicidad). Por ejemplo, 60 es balanceado porque tiene 4 divisores primos (2, 2, 3 y 5).

Un balanceador del entero positivo k es par de enteros positivos (a,b) tales que a es menor que b y, para todo x entre 1 y k, el valor del polinomio P(x) = (x+a)*(x+b) es un número balanceado. Por ejemplo, (2,4) es un balanceador de 3 ya que

P(1) = (1+2)*(1+4) = 15 = 3*5     es balanceado
P(2) = (2+2)*(2+4) = 24 = 2*2*2*3 es balanceado
P(3) = (3+2)*(3+4) = 35 = 5*7     es balanceado

P(1) = (1+2)*(1+4) = 15 = 3*5 es balanceado

P(2) = (2+2)*(2+4) = 24 = 2*2*2*3 es balanceado

P(3) = (3+2)*(3+4) = 35 = 5*7 es balanceado

Definir la función

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

1	balanceadores :: Integer -> [(Integer,Integer)]

tal que (balanceadores k) es el conjunto de los balanceadores de k. Por ejemplo,

   λ> take 7 (balanceadores 3)
   [(2,4),(1,6),(5,9),(1,11),(6,11),(7,12),(8,14)]
   λ> take 7 (balanceadores 5)
   [(8,14),(10,17),(6,18),(12,22),(13,23),(8,24),(14,24)]
   λ> take 7 (balanceadores 3)
   [(2,4),(1,6),(5,9),(1,11),(6,11),(7,12),(8,14)]
   λ> take 7 (balanceadores 4)
   [(6,11),(8,14),(9,15),(10,17),(6,18),(11,18),(7,19)]
   λ> take 7 (balanceadores 5)
   [(8,14),(10,17),(6,18),(12,22),(13,23),(8,24),(14,24)]
   λ> head (balanceadores 19)
   (1325,2827)

λ> take 7 (balanceadores 3)

[(2,4),(1,6),(5,9),(1,11),(6,11),(7,12),(8,14)]

λ> take 7 (balanceadores 5)

[(8,14),(10,17),(6,18),(12,22),(13,23),(8,24),(14,24)]

λ> take 7 (balanceadores 3)

[(2,4),(1,6),(5,9),(1,11),(6,11),(7,12),(8,14)]

λ> take 7 (balanceadores 4)

[(6,11),(8,14),(9,15),(10,17),(6,18),(11,18),(7,19)]

λ> take 7 (balanceadores 5)

[(8,14),(10,17),(6,18),(12,22),(13,23),(8,24),(14,24)]

λ> head (balanceadores 19)

(1325,2827)

Nota: Este ejercicio está basado en el problema N2 de la Olimpíada Internacional de Matemáticas (IMO) del 2009.

Soluciones

import Data.Numbers.Primes (primeFactors)

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

balanceadores :: Integer -> [(Integer,Integer)]
balanceadores k =
  [(a,b) | (a,b) <- pares
         , all esBalanceado [(x+a)*(x+b) | x <- [1..k]]]

-- (esBalanceado x) se verifica si x es balanceado. Por ejemplo,
--    esBalanceado 60  ==  True
--    esBalanceado 50  ==  False
esBalanceado :: Integer -> Bool
esBalanceado = even . length . primeFactors

-- pares el lista de pares de enteros positivos con el primero menor que
-- el segundo. Por ejemplo,
--    λ> take 10 pares
--    [(1,2),(1,3),(2,3),(1,4),(2,4),(3,4),(1,5),(2,5),(3,5),(4,5)]
pares :: [(Integer,Integer)]
pares = [(a,b) | b <- [1..]
               , a <- [1..b-1]]

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

balanceadores2 :: Integer -> [(Integer,Integer)]
balanceadores2 1 = balanceadores 1
balanceadores2 k =
  [(a,b) | (a,b) <- balanceadores2 (k-1)
         , all esBalanceado [(x+a)*(x+b) | x <- [1..k]]]

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

balanceadores3 :: Integer -> [(Integer,Integer)]
balanceadores3 k =
  [(a,b) | (a,b) <- pares
         , and [esBalanceado (x+a) == esBalanceado (x+b) | x <- [1..k]]]

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

-- La comparación es
--    λ> head (balanceadores 17)
--    (189,282)
--    (0.53 secs, 1,227,921,384 bytes)
--    λ> head (balanceadores2 17)
--    (189,282)
--    (0.97 secs, 2,483,869,656 bytes)
--    λ> head (balanceadores3 17)
--    (189,282)
--    (0.36 secs, 983,881,264 bytes)

import Data.Numbers.Primes (primeFactors)

-- 1ª solución

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

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

balanceadores k =

[(a,b) | (a,b) <- pares

, all esBalanceado [(x+a)*(x+b) | x <- [1..k]]]

-- (esBalanceado x) se verifica si x es balanceado. Por ejemplo,

-- esBalanceado 60 == True

-- esBalanceado 50 == False

esBalanceado :: Integer -> Bool

esBalanceado = even . length . primeFactors

-- pares el lista de pares de enteros positivos con el primero menor que

-- el segundo. Por ejemplo,

-- λ> take 10 pares

-- [(1,2),(1,3),(2,3),(1,4),(2,4),(3,4),(1,5),(2,5),(3,5),(4,5)]

pares :: [(Integer,Integer)]

pares = [(a,b) | b <- [1..]

, a <- [1..b-1]]

-- 2ª solución

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

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

balanceadores2 1 = balanceadores 1

balanceadores2 k =

[(a,b) | (a,b) <- balanceadores2 (k-1)

, all esBalanceado [(x+a)*(x+b) | x <- [1..k]]]

-- 3ª solución

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

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

balanceadores3 k =

[(a,b) | (a,b) <- pares

, and [esBalanceado (x+a) == esBalanceado (x+b) | x <- [1..k]]]

-- Comparación de eficiencia

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

-- La comparación es

-- λ> head (balanceadores 17)

-- (189,282)

-- (0.53 secs, 1,227,921,384 bytes)

-- λ> head (balanceadores2 17)

-- (189,282)

-- (0.97 secs, 2,483,869,656 bytes)

-- λ> head (balanceadores3 17)

-- (189,282)

-- (0.36 secs, 983,881,264 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>

Cantidad de números oblongos en un intervalo

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

Un número oblongo es un número que es el producto de dos números naturales consecutivos; es decir, n es un número oblongo si existe un número natural x tal que n = x(x+1). Por ejemplo, 42 es un número oblongo porque 42 = 6 x 7.

La sucesión de los números oblongos es

   0, 2, 6, 12, 20, 30, 42, 56, 72, 90, 110, 132, 156, 182, 210, ...

1	0, 2, 6, 12, 20, 30, 42, 56, 72, 90, 110, 132, 156, 182, 210, ...

En el intervalo [10,30] hay 3 números oblongos (el 12, el 20 y el 30).

Definir las funciones

   oblongos            :: [Integer]
   oblongosEnIntervalo :: Integer -> Integer -> Int

1 2	oblongos :: [Integer] oblongosEnIntervalo :: Integer -> Integer -> Int

tales que

oblongos es la sucesión de los números oblongos. Por ejemplo,

     take 15 oblongos   == [0,2,6,12,20,30,42,56,72,90,110,132,156,182,210]
     oblongos !! 50     == 2550
     oblongos !! (10^5) == 10000100000
     oblongos !! (10^6) == 1000001000000
     oblongos !! (10^7) == 100000010000000

take 15 oblongos == [0,2,6,12,20,30,42,56,72,90,110,132,156,182,210]

oblongos !! 50 == 2550

oblongos !! (10^5) == 10000100000

oblongos !! (10^6) == 1000001000000

oblongos !! (10^7) == 100000010000000

(oblongosEnIntervalo a b) es la cantidad de números oblongos en el intervalo [a,b]. Por ejemplo,

     oblongosEnIntervalo 10 30           ==  3
     oblongosEnIntervalo (10^3) (10^10)  ==  99968
     oblongosEnIntervalo (10^3) (10^12)  ==  999968
     oblongosEnIntervalo (10^3) (10^14)  ==  9999968

oblongosEnIntervalo 10 30 == 3

oblongosEnIntervalo (10^3) (10^10) == 99968

oblongosEnIntervalo (10^3) (10^12) == 999968

oblongosEnIntervalo (10^3) (10^14) == 9999968

Soluciones

-- 1ª definición de oblongos
oblongos1 :: [Integer]
oblongos1 = [n*(n+1) | n <- [0..]]

-- 2ª definición de oblongos
oblongos2 :: [Integer]
oblongos2 = zipWith (*) [0..] [1..]

-- 3ª definición de oblongos
oblongos3 :: [Integer]
oblongos3 = scanl1 (+) [0,2..]

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

--    λ> oblongos1 !! (10^7)
--    100000010000000
--    (3.05 secs, 1,840,112,008 bytes)
--    λ> oblongos2 !! (10^7)
--    100000010000000
--    (0.90 secs, 2,480,112,304 bytes)
--    λ> oblongos3 !! (10^7)
--    100000010000000
--    (3.38 secs, 2,252,411,640 bytes)

-- Definición de oblongos
-- ======================

-- En lo que sigue, usaremos la 2ª.
oblongos :: [Integer]
oblongos = oblongos2

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

oblongosEnIntervalo1 :: Integer -> Integer -> Int
oblongosEnIntervalo1 a b =
  length [x | x <- [a..b]
            , x `elem` takeWhile (<=b) oblongos]

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

oblongosEnIntervalo2 :: Integer -> Integer -> Int
oblongosEnIntervalo2 a b =
  length (takeWhile (<=b) (dropWhile (< a) oblongos))

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

-- La comparación es
--    λ> oblongosEnIntervalo1 100 (10^5)
--    306
--    (2.43 secs, 1,784,537,632 bytes)
--    λ> oblongosEnIntervalo2 100 (10^5)
--    306
--    (0.01 secs, 119,112 bytes)

-- 1ª definición de oblongos

oblongos1 :: [Integer]

oblongos1 = [n*(n+1) | n <- [0..]]

-- 2ª definición de oblongos

oblongos2 :: [Integer]

oblongos2 = zipWith (*) [0..] [1..]

-- 3ª definición de oblongos

oblongos3 :: [Integer]

oblongos3 = scanl1 (+) [0,2..]

-- Comparación de eficiencia

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

-- λ> oblongos1 !! (10^7)

-- 100000010000000

-- (3.05 secs, 1,840,112,008 bytes)

-- λ> oblongos2 !! (10^7)

-- 100000010000000

-- (0.90 secs, 2,480,112,304 bytes)

-- λ> oblongos3 !! (10^7)

-- 100000010000000

-- (3.38 secs, 2,252,411,640 bytes)

-- Definición de oblongos

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

-- En lo que sigue, usaremos la 2ª.

oblongos :: [Integer]

oblongos = oblongos2

-- 1ª definición de oblongosEnIntervalo

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

oblongosEnIntervalo1 :: Integer -> Integer -> Int

oblongosEnIntervalo1 a b =

length [x | x <- [a..b]

, x `elem` takeWhile (<=b) oblongos]

-- 2ª definición de oblongosEnIntervalo

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

oblongosEnIntervalo2 :: Integer -> Integer -> Int

oblongosEnIntervalo2 a b =

length (takeWhile (<=b) (dropWhile (< a) oblongos))

-- Comparación de eficiencia

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

-- La comparación es

-- λ> oblongosEnIntervalo1 100 (10^5)

-- 306

-- (2.43 secs, 1,784,537,632 bytes)

-- λ> oblongosEnIntervalo2 100 (10^5)

-- 306

-- (0.01 secs, 119,112 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>

Ternas potencias de dos

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

Una terna (a,b,c) de números enteros positivos es especial si se verifica que ab-c, bc-a y ca-b son potencias de 2. Por ejemplo, (3,5,7) es especial ya que

   3 * 5 - 7 =  8 = 2^3
   5 * 7 - 3 = 32 = 2^5
   7 * 3 - 5 = 16 = 2^4

3 * 5 - 7 = 8 = 2^3

5 * 7 - 3 = 32 = 2^5

7 * 3 - 5 = 16 = 2^4

Definir las funciones

   esEspecial       :: (Integer,Integer,Integer) -> Bool
   ternasEspeciales :: [(Integer,Integer,Integer)]

1 2	esEspecial :: (Integer,Integer,Integer) -> Bool ternasEspeciales :: [(Integer,Integer,Integer)]

tales que

(esEspecial t) se verifica si t es una terna especial. Por ejemplo,

     esEspecial (3,5,7)  ==  True
     esEspecial (5,7,9)  ==  False

1 2	esEspecial (3,5,7) == True esEspecial (5,7,9) == False

ternasEspeciales es la lista de las ternasEspeciales ordenadas según su suma y las de la misma suma por orden lexicográfico. Por ejemplo,

     λ> take 16 ternasEspeciales
     [(2,2,2),
      (2,2,3),(2,3,2),(3,2,2),
      (3,5,7),(3,7,5),(5,3,7),(5,7,3),(7,3,5),(7,5,3),
      (2,6,11),(2,11,6),(6,2,11),(6,11,2),(11,2,6),(11,6,2)]

λ> take 16 ternasEspeciales

[(2,2,2),

(2,2,3),(2,3,2),(3,2,2),

(3,5,7),(3,7,5),(5,3,7),(5,7,3),(7,3,5),(7,5,3),

(2,6,11),(2,11,6),(6,2,11),(6,11,2),(11,2,6),(11,6,2)]

Comprobar con QuickCheck que sólo hay 16 ternas especiales; es decir, para toda terna t de enteros positivos, t pertenece a la lista de los 16 primeros elementos de ternasEspeciales o no es una terna especial.

Nota: Este ejercicio está basado en el problema N5 de la Olimpíada Internacional de Matemáticas (IMO) del 2015.

Soluciones

import Data.List (nub, permutations, sort)
import Data.Numbers.Primes (primeFactors)
import Data.Bits ((.&.))
import Test.QuickCheck (Property, (==>), quickCheck)

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

esEspecial1 :: (Integer,Integer,Integer) -> Bool
esEspecial1 (a,b,c) =
  all esPotenciaDeDos1 [a * b - c, b * c - a, c * a - b]

-- (esPotenciaDeDos n) se verifica si n es una potencia de dos. Por
-- ejemplo.
--    esPotenciaDeDos  8  == True
--    esPotenciaDeDos 32  == True
--    esPotenciaDeDos  0  == False
--    esPotenciaDeDos  1  == True
--    esPotenciaDeDos  2  == True
--    esPotenciaDeDos  6  == False
esPotenciaDeDos1 :: Integer -> Bool
esPotenciaDeDos1 n
    | n <= 0    = False
    | n <= 2    = True
    | even n    = esPotenciaDeDos1 (n `div` 2)
    | otherwise = False

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

esEspecial2 :: (Integer,Integer,Integer) -> Bool
esEspecial2 (a,b,c) =
  all esPotenciaDeDos2 [a * b - c, b * c - a, c * a - b]

esPotenciaDeDos2 :: Integer -> Bool
esPotenciaDeDos2 n = n == head (dropWhile (<n) potenciasDeDos)

-- potenciasDeDos es la lista de las potencias de dos. Por ejemplo,
potenciasDeDos :: [Integer]
potenciasDeDos = iterate (*2) 1

-- 3ª definición de esEspecial
-- ===========================

esEspecial3 :: (Integer,Integer,Integer) -> Bool
esEspecial3 (a,b,c) =
  all esPotenciaDeDos3 [a * b - c, b * c - a, c * a - b]

esPotenciaDeDos3 :: Integer -> Bool
esPotenciaDeDos3 x = all (==2) (primeFactors x)

-- 4ª definición de esEspecial
-- ===========================

esEspecial4 :: (Integer,Integer,Integer) -> Bool
esEspecial4 (a,b,c) =
  all esPotenciaDeDos4 [a * b - c, b * c - a, c * a - b]

-- La siguiente definición de esPotenciaDeDos usa la función (.&.) de la
-- librería Data.Bits. Dicha función calcula el número correspondiente a
-- la conjunción de las representaciones binarias de sus argumentos. Por
-- ejemplo,
--    6 .&. 3 == 2
-- ya que
--    la representación binaria de 6 es     [1,1,0]
--    la representación binaria de 3 es       [1,1]
--    la conjunción es                        [1,0]
--    la representación decimal de [1,0] es   2
--
-- Otros ejemplos:
--    4 .&. 3 ==   [1,0,0] .&.   [1,1] == 0
--    8 .&. 7 == [1,0,0,0] .&. [1,1,1] = 0
esPotenciaDeDos4 :: Integer -> Bool
esPotenciaDeDos4 n = n .&. (n-1) == 0

-- Comparación de eficiencia de las definiciones de esEspecial
-- ===========================================================

-- La comparación es
--    λ> esEspecial1 (2^300000,2,0)
--    False
--    (3.05 secs, 5,765,728,296 bytes)
--    λ> esEspecial2 (2^300000,2,0)
--    False
--    (2.68 secs, 5,755,293,608 bytes)
--    λ> esEspecial3 (2^300000,2,0)
--    False
--    (2.45 secs, 5,758,527,232 bytes)
--    λ> esEspecial4 (2^300000,2,0)
--    False
--    (0.01 secs, 516,512 bytes)

-- Definición de esEspecial
-- ========================

-- En lo sucesivo usaremos la 4ª definición.
esEspecial :: (Integer,Integer,Integer) -> Bool
esEspecial = esEspecial4

-- Definición de ternasEspeciales
-- ==============================

--    λ> take 16 ternasEspeciales
--    [(2,2,2),(2,2,3),(2,3,2),(3,2,2),(3,5,7),(3,7,5),(5,3,7),(5,7,3),
--     (7,3,5),(7,5,3),(2,6,11),(2,11,6),(6,2,11),(6,11,2),(11,2,6),(11,6,2)]
ternasEspeciales :: [(Integer,Integer,Integer)]
ternasEspeciales = filter esEspecial1 ternas

-- ternas es la lista de ternas de enteros positivos con el orden
-- descrito anteriormente. Por ejemplo,
--    λ> take 20 ternas
--    [(1,1,1),
--     (1,1,2),(1,2,1),(2,1,1),
--     (1,1,3),(1,2,2),(1,3,1),(2,1,2),(2,2,1),(3,1,1),
--     (1,1,4),(1,2,3),(1,3,2),(1,4,1),(2,1,3),(2,2,2),(2,3,1),(3,1,2),(3,2,1),(4,1,1)]
ternas :: [(Integer,Integer,Integer)]
ternas = concatMap ternasSuma [3..]

-- (ternasSuma n) es la lista de las ternas de enteros positivos cuya
-- suma es n ordenadas lexicográficamte. Por ejemplo,
--    λ> ternasSuma 3
--    [(1,1,1)]
--    λ> ternasSuma 4
--    [(1,1,2),(1,2,1),(2,1,1)]
--    λ> ternasSuma 5
--    [(1,1,3),(1,2,2),(1,3,1),(2,1,2),(2,2,1),(3,1,1)]
--    λ> ternasSuma 6
--    [(1,1,4),(1,2,3),(1,3,2),(1,4,1),(2,1,3),(2,2,2),(2,3,1),(3,1,2),(3,2,1),(4,1,1)]
ternasSuma :: Integer -> [(Integer,Integer,Integer)]
ternasSuma n =
  sort (concatMap permutaciones [(a,b,c) | a <- [1..n]
                                         , b <- [a..n]
                                         , let c = n-a-b
                                         , b <= c])


-- (permutaciones t) es la lista de las permutaciones de la terna t. Por ejemplo,
--    λ> permutaciones (1,2,3)
--    [(1,2,3),(2,1,3),(3,2,1),(2,3,1),(3,1,2),(1,3,2)]
--    λ> permutaciones (1,1,2)
--    [(1,1,2),(2,1,1),(1,2,1)]
--    λ> permutaciones (1,1,1)
--    [(1,1,1)]
permutaciones :: (Integer,Integer,Integer) -> [(Integer,Integer,Integer)]
permutaciones (a,b,c) =
  nub [(x,y,z) | [x,y,z] <- permutations [a,b,c]]

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

-- La propiedad es
prop_ternasEspeciales :: (Integer,Integer,Integer) -> Property
prop_ternasEspeciales (a,b,c) =
  a > 0 && b > 0 && c > 0 ==>
  (a,b,c) `elem` xs || not (esEspecial (a,b,c))
  where xs = take 16 ternasEspeciales

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

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

import Data.List (nub, permutations, sort)

import Data.Numbers.Primes (primeFactors)

import Data.Bits ((.&.))

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

-- 1ª definición de esEspecial

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

esEspecial1 :: (Integer,Integer,Integer) -> Bool

esEspecial1 (a,b,c) =

all esPotenciaDeDos1 [a * b - c, b * c - a, c * a - b]

-- (esPotenciaDeDos n) se verifica si n es una potencia de dos. Por

-- ejemplo.

-- esPotenciaDeDos 8 == True

-- esPotenciaDeDos 32 == True

-- esPotenciaDeDos 0 == False

-- esPotenciaDeDos 1 == True

-- esPotenciaDeDos 2 == True

-- esPotenciaDeDos 6 == False

esPotenciaDeDos1 :: Integer -> Bool

esPotenciaDeDos1 n

| n <= 0 = False

| n <= 2 = True

| even n = esPotenciaDeDos1 (n `div` 2)

| otherwise = False

-- 2ª definición de esEspecial

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

esEspecial2 :: (Integer,Integer,Integer) -> Bool

esEspecial2 (a,b,c) =

all esPotenciaDeDos2 [a * b - c, b * c - a, c * a - b]

esPotenciaDeDos2 :: Integer -> Bool

esPotenciaDeDos2 n = n == head (dropWhile (<n) potenciasDeDos)

-- potenciasDeDos es la lista de las potencias de dos. Por ejemplo,

potenciasDeDos :: [Integer]

potenciasDeDos = iterate (*2) 1

-- 3ª definición de esEspecial

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

esEspecial3 :: (Integer,Integer,Integer) -> Bool

esEspecial3 (a,b,c) =

all esPotenciaDeDos3 [a * b - c, b * c - a, c * a - b]

esPotenciaDeDos3 :: Integer -> Bool

esPotenciaDeDos3 x = all (==2) (primeFactors x)

-- 4ª definición de esEspecial

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

esEspecial4 :: (Integer,Integer,Integer) -> Bool

esEspecial4 (a,b,c) =

all esPotenciaDeDos4 [a * b - c, b * c - a, c * a - b]

-- La siguiente definición de esPotenciaDeDos usa la función (.&.) de la

-- librería Data.Bits. Dicha función calcula el número correspondiente a

-- la conjunción de las representaciones binarias de sus argumentos. Por

-- ejemplo,

-- 6 .&. 3 == 2

-- ya que

-- la representación binaria de 6 es [1,1,0]

-- la representación binaria de 3 es [1,1]

-- la conjunción es [1,0]

-- la representación decimal de [1,0] es 2

-- Otros ejemplos:

-- 4 .&. 3 == [1,0,0] .&. [1,1] == 0

-- 8 .&. 7 == [1,0,0,0] .&. [1,1,1] = 0

esPotenciaDeDos4 :: Integer -> Bool

esPotenciaDeDos4 n = n .&. (n-1) == 0

-- Comparación de eficiencia de las definiciones de esEspecial

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

-- La comparación es

-- λ> esEspecial1 (2^300000,2,0)

-- False

-- (3.05 secs, 5,765,728,296 bytes)

-- λ> esEspecial2 (2^300000,2,0)

-- False

-- (2.68 secs, 5,755,293,608 bytes)

-- λ> esEspecial3 (2^300000,2,0)

-- False

-- (2.45 secs, 5,758,527,232 bytes)

-- λ> esEspecial4 (2^300000,2,0)

-- False

-- (0.01 secs, 516,512 bytes)

-- Definición de esEspecial

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

-- En lo sucesivo usaremos la 4ª definición.

esEspecial :: (Integer,Integer,Integer) -> Bool

esEspecial = esEspecial4

-- Definición de ternasEspeciales

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

-- λ> take 16 ternasEspeciales

-- [(2,2,2),(2,2,3),(2,3,2),(3,2,2),(3,5,7),(3,7,5),(5,3,7),(5,7,3),

-- (7,3,5),(7,5,3),(2,6,11),(2,11,6),(6,2,11),(6,11,2),(11,2,6),(11,6,2)]

ternasEspeciales :: [(Integer,Integer,Integer)]

ternasEspeciales = filter esEspecial1 ternas

-- ternas es la lista de ternas de enteros positivos con el orden

-- descrito anteriormente. Por ejemplo,

-- λ> take 20 ternas

-- [(1,1,1),

-- (1,1,2),(1,2,1),(2,1,1),

-- (1,1,3),(1,2,2),(1,3,1),(2,1,2),(2,2,1),(3,1,1),

-- (1,1,4),(1,2,3),(1,3,2),(1,4,1),(2,1,3),(2,2,2),(2,3,1),(3,1,2),(3,2,1),(4,1,1)]

ternas :: [(Integer,Integer,Integer)]

ternas = concatMap ternasSuma [3..]

-- (ternasSuma n) es la lista de las ternas de enteros positivos cuya

-- suma es n ordenadas lexicográficamte. Por ejemplo,

-- λ> ternasSuma 3

-- [(1,1,1)]

-- λ> ternasSuma 4

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

-- λ> ternasSuma 5

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

-- λ> ternasSuma 6

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

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

ternasSuma n =

sort (concatMap permutaciones [(a,b,c) | a <- [1..n]

, b <- [a..n]

, let c = n-a-b

, b <= c])

-- (permutaciones t) es la lista de las permutaciones de la terna t. Por ejemplo,

-- λ> permutaciones (1,2,3)

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

-- λ> permutaciones (1,1,2)

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

-- λ> permutaciones (1,1,1)

-- [(1,1,1)]

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

permutaciones (a,b,c) =

nub [(x,y,z) | [x,y,z] <- permutations [a,b,c]]

-- Propiedad

-- =========

-- La propiedad es

prop_ternasEspeciales :: (Integer,Integer,Integer) -> Property

prop_ternasEspeciales (a,b,c) =

a > 0 && b > 0 && c > 0 ==>

(a,b,c) `elem` xs || not (esEspecial (a,b,c))

where xs = take 16 ternasEspeciales

-- La comprobación es

-- λ> quickCheck prop_ternasEspeciales

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

Ordenación de ternas de enteros

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

Las ternas de números enteros positivos se pueden ordenar por su suma y las de la misma suma por orden lexicográfico. Por ejemplo,

ternas de suma 3:

   (1,1,1)

(1,1,1)

ternas de suma 4:

   (1,1,2),(1,2,1),(2,1,1)

1	(1,1,2),(1,2,1),(2,1,1)

ternas de suma 5:

   (1,1,3),(1,2,2),(1,3,1),(2,1,2),(2,2,1),(3,1,1)

1	(1,1,3),(1,2,2),(1,3,1),(2,1,2),(2,2,1),(3,1,1)

ternas de suma 6

   (1,1,4),(1,2,3),(1,3,2),(1,4,1),(2,1,3),(2,2,2),(2,3,1),(3,1,2),(3,2,1),(4,1,1)

1	(1,1,4),(1,2,3),(1,3,2),(1,4,1),(2,1,3),(2,2,2),(2,3,1),(3,1,2),(3,2,1),(4,1,1)

y así sucesivamente.

Definir la función

   ternas :: [(integer,integer,integer)]

1	ternas :: [(integer,integer,integer)]

tal que ternas es la lista de las ternas de enteros positivos con el orden descrito anteriormente. por ejemplo,

   λ> take 20 ternas
   [(1,1,1),
    (1,1,2),(1,2,1),(2,1,1),
    (1,1,3),(1,2,2),(1,3,1),(2,1,2),(2,2,1),(3,1,1),
    (1,1,4),(1,2,3),(1,3,2),(1,4,1),(2,1,3),(2,2,2),(2,3,1),(3,1,2),(3,2,1),(4,1,1)]

λ> take 20 ternas

[(1,1,1),

(1,1,2),(1,2,1),(2,1,1),

(1,1,3),(1,2,2),(1,3,1),(2,1,2),(2,2,1),(3,1,1),

(1,1,4),(1,2,3),(1,3,2),(1,4,1),(2,1,3),(2,2,2),(2,3,1),(3,1,2),(3,2,1),(4,1,1)]

Soluciones

import Data.List (nub, permutations, sort)

ternas :: [(Integer,Integer,Integer)]
ternas = concatMap ternasSuma [3..]

-- (ternasSuma n) es la lista de las ternas de enteros positivos cuya
-- suma es n ordenadas lexicográficamte. Por ejemplo,
--    λ> ternasSuma 3
--    [(1,1,1)]
--    λ> ternasSuma 4
--    [(1,1,2),(1,2,1),(2,1,1)]
--    λ> ternasSuma 5
--    [(1,1,3),(1,2,2),(1,3,1),(2,1,2),(2,2,1),(3,1,1)]
--    λ> ternasSuma 6
--    [(1,1,4),(1,2,3),(1,3,2),(1,4,1),(2,1,3),(2,2,2),(2,3,1),(3,1,2),(3,2,1),(4,1,1)]
ternasSuma :: Integer -> [(Integer,Integer,Integer)]
ternasSuma n =
  sort (concatMap permutaciones [(a,b,c) | a <- [1..n]
                                         , b <- [a..n]
                                         , let c = n-a-b
                                         , b <= c])

-- (permutaciones t) es la lista de las permutaciones de la terna t. Por ejemplo,
--    λ> permutaciones (1,2,3)
--    [(1,2,3),(2,1,3),(3,2,1),(2,3,1),(3,1,2),(1,3,2)]
--    λ> permutaciones (1,1,2)
--    [(1,1,2),(2,1,1),(1,2,1)]
--    λ> permutaciones (1,1,1)
--    [(1,1,1)]
permutaciones :: (Integer,Integer,Integer) -> [(Integer,Integer,Integer)]
permutaciones (a,b,c) =
  nub [(x,y,z) | [x,y,z] <- permutations [a,b,c]]

import Data.List (nub, permutations, sort)

ternas :: [(Integer,Integer,Integer)]

ternas = concatMap ternasSuma [3..]

-- (ternasSuma n) es la lista de las ternas de enteros positivos cuya

-- suma es n ordenadas lexicográficamte. Por ejemplo,

-- λ> ternasSuma 3

-- [(1,1,1)]

-- λ> ternasSuma 4

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

-- λ> ternasSuma 5

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

-- λ> ternasSuma 6

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

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

ternasSuma n =

sort (concatMap permutaciones [(a,b,c) | a <- [1..n]

, b <- [a..n]

, let c = n-a-b

, b <= c])

-- (permutaciones t) es la lista de las permutaciones de la terna t. Por ejemplo,

-- λ> permutaciones (1,2,3)

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

-- λ> permutaciones (1,1,2)

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

-- λ> permutaciones (1,1,1)

-- [(1,1,1)]

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

permutaciones (a,b,c) =

nub [(x,y,z) | [x,y,z] <- permutations [a,b,c]]

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>

Listas obtenidas borrando k elementos

PorJosé A. Alonso 5-febrero-202112-febrero-2021

Definir la función

   borra :: Int -> [a] -> [[a]]

1	borra :: Int -> [a] -> [[a]]

tal que (borra n xs) es la lista de las listas obtenidas borrando n elementos de xs. Por ejemplo,

   borra 0 "abcd"  ==  ["abcd"]
   borra 1 "abcd"  ==  ["abc","abd","acd","bcd"]
   borra 2 "abcd"  ==  ["ab","ac","ad","bc","bd","cd"]
   borra 3 "abcd"  ==  ["a","b","c","d"]
   borra 4 "abcd"  ==  [""]
   borra 5 "abcd"  ==  []
   borra 6 "abcd"  ==  []
   length (borra 2 [1..300])  ==  44850

borra 0 "abcd" == ["abcd"]

borra 1 "abcd" == ["abc","abd","acd","bcd"]

borra 2 "abcd" == ["ab","ac","ad","bc","bd","cd"]

borra 3 "abcd" == ["a","b","c","d"]

borra 4 "abcd" == [""]

borra 5 "abcd" == []

borra 6 "abcd" == []

length (borra 2 [1..300]) == 44850

Soluciones

import Data.List (nub, subsequences)

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

borra1 :: Eq a => Int -> [a] -> [[a]]
borra1 n xs = [ys | ys <- subsequences xs, length ys == k]
  where k = length xs - n

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

borra2 :: Eq a => Int -> [a] -> [[a]]
borra2 0 xs     = [xs]
borra2 n []     = []
borra2 n (x:xs) = [x:ys | ys <- borra2 n xs] ++ borra2 (n-1) xs

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

borra3 :: Eq a => Int -> [a] -> [[a]]
borra3 n xs =
  nub (itera n borraUnoListas [xs])

-- (borraUno xs) es la lista de listas obtenidas borrando un elemento de la
-- lista no vacía xs de todas las formas posibles. Por ejemplo,
--    borraUno "abcde"  ==  ["bcde","acde","abde","abce","abcd"]
borraUno :: [a] -> [[a]]
borraUno [x] = [[]]
borraUno (x:xs) = xs : map (x:) (borraUno xs)

--    borraUnoListas ["abc", "def"]  ==  ["bc","ac","ab","ef","df","de"]
borraUnoListas :: [[a]] -> [[a]]
borraUnoListas = concatMap borraUno

-- (itera k f x) es el resultado de aplicar k veces la función f al
-- elemento x. Por ejmplo,
--    itera 3 (*2) 1   ==  8
--    itera 4 (+2) 10  ==  18
itera :: Eq a => Int -> (a -> a) -> a -> a
itera 0 _ x = x
itera n f x = itera (n-1) f (f x)

-- 2ª definición de itera
itera2 :: Eq a => Int -> (a -> a) -> a -> a
itera2 0 _ = id
itera2 n f = itera2 (n-1) f . f

-- 3ª definición de itera
itera3 :: Eq a => Int -> (a -> a) -> a -> a
itera3 n f x = (iterate f x) !! n

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

-- La comparación es
--    λ> length (borra1 10 [1..11])
--    11
--    (0.03 secs, 527,712 bytes)
--    λ> length (borra2 10 [1..11])
--    11
--    (0.01 secs, 917,720 bytes)
--    λ> length (borra3 10 [1..11])
--    11
--    (22.32 secs, 20,104,455,496 bytes)
--
--    λ> length (borra1 25 [1..26])
--    26
--    (16.30 secs, 13,958,748,280 bytes)
--    λ> length (borra2 25 [1..26])
--    26
--    (36.36 secs, 25,769,904,744 bytes)
--
--    λ> length (borra1 2 [1..26])
--    325
--    (16.51 secs, 13,958,767,696 bytes)
--    λ> length (borra2 2 [1..26])
--    325
--    (0.01 secs, 168,272 bytes)
--    λ> length (borra3 2 [1..26])
--    325
--    (0.03 secs, 1,209,992 bytes)
--
--    λ> length (borra2 2 [1..100])
--    4950
--    (0.06 secs, 59,128,272 bytes)
--    λ> length (borra3 2 [1..100])
--    4950
--    (6.37 secs, 57,943,128 bytes)

import Data.List (nub, subsequences)

-- 1ª solución

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

borra1 :: Eq a => Int -> [a] -> [[a]]

borra1 n xs = [ys | ys <- subsequences xs, length ys == k]

where k = length xs - n

-- 2ª solución

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

borra2 :: Eq a => Int -> [a] -> [[a]]

borra2 0 xs = [xs]

borra2 n [] = []

borra2 n (x:xs) = [x:ys | ys <- borra2 n xs] ++ borra2 (n-1) xs

-- 3ª solución

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

borra3 :: Eq a => Int -> [a] -> [[a]]

borra3 n xs =

nub (itera n borraUnoListas [xs])

-- (borraUno xs) es la lista de listas obtenidas borrando un elemento de la

-- lista no vacía xs de todas las formas posibles. Por ejemplo,

-- borraUno "abcde" == ["bcde","acde","abde","abce","abcd"]

borraUno :: [a] -> [[a]]

borraUno [x] = [[]]

borraUno (x:xs) = xs : map (x:) (borraUno xs)

-- borraUnoListas ["abc", "def"] == ["bc","ac","ab","ef","df","de"]

borraUnoListas :: [[a]] -> [[a]]

borraUnoListas = concatMap borraUno

-- (itera k f x) es el resultado de aplicar k veces la función f al

-- elemento x. Por ejmplo,

-- itera 3 (*2) 1 == 8

-- itera 4 (+2) 10 == 18

itera :: Eq a => Int -> (a -> a) -> a -> a

itera 0 _ x = x

itera n f x = itera (n-1) f (f x)

-- 2ª definición de itera

itera2 :: Eq a => Int -> (a -> a) -> a -> a

itera2 0 _ = id

itera2 n f = itera2 (n-1) f . f

-- 3ª definición de itera

itera3 :: Eq a => Int -> (a -> a) -> a -> a

itera3 n f x = (iterate f x) !! n

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (borra1 10 [1..11])

-- 11

-- (0.03 secs, 527,712 bytes)

-- λ> length (borra2 10 [1..11])

-- 11

-- (0.01 secs, 917,720 bytes)

-- λ> length (borra3 10 [1..11])

-- 11

-- (22.32 secs, 20,104,455,496 bytes)

-- λ> length (borra1 25 [1..26])

-- 26

-- (16.30 secs, 13,958,748,280 bytes)

-- λ> length (borra2 25 [1..26])

-- 26

-- (36.36 secs, 25,769,904,744 bytes)

-- λ> length (borra1 2 [1..26])

-- 325

-- (16.51 secs, 13,958,767,696 bytes)

-- λ> length (borra2 2 [1..26])

-- 325

-- (0.01 secs, 168,272 bytes)

-- λ> length (borra3 2 [1..26])

-- 325

-- (0.03 secs, 1,209,992 bytes)

-- λ> length (borra2 2 [1..100])

-- 4950

-- (0.06 secs, 59,128,272 bytes)

-- λ> length (borra3 2 [1..100])

-- 4950

-- (6.37 secs, 57,943,128 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>

Árboles acotados

PorJosé A. Alonso 27-enero-20213-febrero-2021

Los árboles binarios se pueden representar mediante el tipo Arbol definido por

   data Arbol a = H a
                | N a (Arbol a) (Arbol a)
     deriving Show

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving Show

Por ejemplo, el árbol

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

/ \

4 9

/ \ / \

1 3 5 6

se puede representar por

   N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))

1	N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))

Un árbol está acotado por un conjunto ys si todos los valores de sus hojas y sus nodos pertenecen a ys. Por ejemplo, el árbol anterior está acotado por [1..10] pero no lo está por [1..7].

Un árbol es monovalorado si todos sus elementos son iguales. Por ejemplo, de los siguientes árboles sólo son monovalorados los dos primeros

    5          9           5          9
   / \        / \         / \        / \
  5   5      9   9       5   6      9   7
                / \                    / \
               9   9                  9   9

5 9 5 9

/ \ / \ / \ / \

5 5 9 9 5 6 9 7

/ \ / \

9 9 9 9

Definir las funciones

   acotado :: Eq a => Arbol a -> [a] -> Bool
   monovalorados :: Arbol -> [Arbol]

1 2	acotado :: Eq a => Arbol a -> [a] -> Bool monovalorados :: Arbol -> [Arbol]

tales que

(acotado a ys) se verifica si a está acotado por ys. Por ejemplo,

     acotado (N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))) [1..10] == True
     acotado (N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))) [1..7]  == False

1 2	acotado (N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))) [1..10] == True acotado (N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))) [1..7] == False

(monovalorado a) se verifica si a es monovalorado. Por ejemplo,

     monovalorado (N 5 (H 5) (H 5))              ==  True
     monovalorado (N 5 (H 5) (H 6))              ==  False
     monovalorado (N 9 (H 9) (N 9 (H 9) (H 9)))  ==  True
     monovalorado (N 9 (H 9) (N 7 (H 9) (H 9)))  ==  False
     monovalorado (N 9 (H 9) (N 9 (H 7) (H 9)))  ==  False

monovalorado (N 5 (H 5) (H 5)) == True

monovalorado (N 5 (H 5) (H 6)) == False

monovalorado (N 9 (H 9) (N 9 (H 9) (H 9))) == True

monovalorado (N 9 (H 9) (N 7 (H 9) (H 9))) == False

monovalorado (N 9 (H 9) (N 9 (H 7) (H 9))) == False

Soluciones

data Arbol a = H a
             | N a (Arbol a) (Arbol a)
  deriving Show

acotado :: Eq a => Arbol a -> [a] -> Bool
acotado (H x) ys     = x `elem` ys
acotado (N x i d) ys = x `elem` ys && acotado i ys && acotado d ys

monovalorado :: Eq a => Arbol a -> Bool
monovalorado (H _) = True
monovalorado (N x i d) = acotado i [x] && acotado d [x]

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving Show

acotado :: Eq a => Arbol a -> [a] -> Bool

acotado (H x) ys = x `elem` ys

acotado (N x i d) ys = x `elem` ys && acotado i ys && acotado d ys

monovalorado :: Eq a => Arbol a -> Bool

monovalorado (H _) = True

monovalorado (N x i d) = acotado i [x] && acotado d [x]

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>

Potencias de dos más cercanas

PorJosé A. Alonso 25-enero-20211-febrero-2021

Definir la función

   potenciasDeDosMasCercanas :: [Integer] -> [Integer]

1	potenciasDeDosMasCercanas :: [Integer] -> [Integer]

tal que (potenciasDeDosMasCercanas xs) es la lista sustituyendo cada elemento de xs por su potencia de dos más cercana (en el caso de que haya dos equidistantes se elige la menor). Por ejemplo,

   potenciasDeDosMasCercanas2 [6,7,8,9,2021]  ==  [4,8,8,8,2048]

1	potenciasDeDosMasCercanas2 [6,7,8,9,2021] == [4,8,8,8,2048]

Soluciones

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

potenciasDeDosMasCercanas :: [Integer] -> [Integer]
potenciasDeDosMasCercanas = map potenciaDeDosMasCercana

-- (potenciaDeDosMasCercana n) es la potencia de dos más cercana (en el
-- caso de que haya dos equidistantes se elige la menor). Por ejemplo,
--    potenciaDeDosMasCercana 6  ==  4
--    potenciaDeDosMasCercana 7  ==  8
--    potenciaDeDosMasCercana 8  ==  8
--    potenciaDeDosMasCercana 9  ==  8
potenciaDeDosMasCercana :: Integer -> Integer
potenciaDeDosMasCercana n
  | dx <= dy  = x
  | otherwise = y
  where (x,y) = potenciasDeDosCercanas n
        dx    = n - x
        dy    = y - n

-- (potenciasDeDosMasCercanas n) es par formado por las dos potencias de
-- dos más cercana a n. Por ejemplo,
--    potenciasDeDosCercanas 6  ==  (4,8)
--    potenciasDeDosCercanas 7  ==  (4,8)
--    potenciasDeDosCercanas 8  ==  (4,8)
--    potenciasDeDosCercanas 9  ==  (8,16)
potenciasDeDosCercanas :: Integer -> (Integer, Integer)
potenciasDeDosCercanas n =
  (x `div` 2, x)
  where x = menorPotenciaDeDosMayorOIgual n

-- (menorPotenciaDeDosMayorOIgual n) es la menor potencia de dos mayor o
-- igual que n. Por ejemplo,
--    menorPotenciaDeDosMayorOIgual 6  ==  8
--    menorPotenciaDeDosMayorOIgual 8  ==  8
menorPotenciaDeDosMayorOIgual :: Integer -> Integer
menorPotenciaDeDosMayorOIgual n =
  head [2^x | x <- [0..], 2^x >= n]

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

potenciasDeDosMasCercanas2 :: [Integer] -> [Integer]
potenciasDeDosMasCercanas2 = map potenciaDeDosMasCercana2

potenciaDeDosMasCercana2 :: Integer -> Integer
potenciaDeDosMasCercana2 n =
  snd (min (n-x,x) (y-n,y))
  where (x,y) = potenciasDeDosCercanas2 n

potenciasDeDosCercanas2 :: Integer -> (Integer, Integer)
potenciasDeDosCercanas2 n = (x `div` 2, x)
  where (x:_) = dropWhile (<n) potenciasDeDos

-- potenciasDeDos es la lista de las potencias de dos. Por ejemplo,
--    take 11 potenciasDeDos  ==  [1,2,4,8,16,32,64,128,256,512,1024]
potenciasDeDos :: [Integer]
potenciasDeDos = iterate (*2) 1

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

-- La comparación es
--    λ> maximum (potenciasDeDosMasCercanas [10^5..10^6])
--    1048576
--    (18.28 secs, 20,835,181,624 bytes)
--    λ> maximum (potenciasDeDosMasCercanas2 [10^5..10^6])
--    1048576
--    (2.44 secs, 830,307,736 bytes)

-- 1ª solución

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

potenciasDeDosMasCercanas :: [Integer] -> [Integer]

potenciasDeDosMasCercanas = map potenciaDeDosMasCercana

-- (potenciaDeDosMasCercana n) es la potencia de dos más cercana (en el

-- caso de que haya dos equidistantes se elige la menor). Por ejemplo,

-- potenciaDeDosMasCercana 6 == 4

-- potenciaDeDosMasCercana 7 == 8

-- potenciaDeDosMasCercana 8 == 8

-- potenciaDeDosMasCercana 9 == 8

potenciaDeDosMasCercana :: Integer -> Integer

potenciaDeDosMasCercana n

| dx <= dy = x

| otherwise = y

where (x,y) = potenciasDeDosCercanas n

dx = n - x

dy = y - n

-- (potenciasDeDosMasCercanas n) es par formado por las dos potencias de

-- dos más cercana a n. Por ejemplo,

-- potenciasDeDosCercanas 6 == (4,8)

-- potenciasDeDosCercanas 7 == (4,8)

-- potenciasDeDosCercanas 8 == (4,8)

-- potenciasDeDosCercanas 9 == (8,16)

potenciasDeDosCercanas :: Integer -> (Integer, Integer)

potenciasDeDosCercanas n =

(x `div` 2, x)

where x = menorPotenciaDeDosMayorOIgual n

-- (menorPotenciaDeDosMayorOIgual n) es la menor potencia de dos mayor o

-- igual que n. Por ejemplo,

-- menorPotenciaDeDosMayorOIgual 6 == 8

-- menorPotenciaDeDosMayorOIgual 8 == 8

menorPotenciaDeDosMayorOIgual :: Integer -> Integer

menorPotenciaDeDosMayorOIgual n =

head [2^x | x <- [0..], 2^x >= n]

-- 2ª solución

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

potenciasDeDosMasCercanas2 :: [Integer] -> [Integer]

potenciasDeDosMasCercanas2 = map potenciaDeDosMasCercana2

potenciaDeDosMasCercana2 :: Integer -> Integer

potenciaDeDosMasCercana2 n =

snd (min (n-x,x) (y-n,y))

where (x,y) = potenciasDeDosCercanas2 n

potenciasDeDosCercanas2 :: Integer -> (Integer, Integer)

potenciasDeDosCercanas2 n = (x `div` 2, x)

where (x:_) = dropWhile (<n) potenciasDeDos

-- potenciasDeDos es la lista de las potencias de dos. Por ejemplo,

-- take 11 potenciasDeDos == [1,2,4,8,16,32,64,128,256,512,1024]

potenciasDeDos :: [Integer]

potenciasDeDos = iterate (*2) 1

-- Comparación de eficiencia

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

-- La comparación es

-- λ> maximum (potenciasDeDosMasCercanas [10^5..10^6])

-- 1048576

-- (18.28 secs, 20,835,181,624 bytes)

-- λ> maximum (potenciasDeDosMasCercanas2 [10^5..10^6])

-- 1048576

-- (2.44 secs, 830,307,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>

La serie 1 – 2 + 3 – 4 + ···

PorJosé A. Alonso 22-enero-202129-enero-2021

En este ejercicio se considerará la serie

   1 - 2 + 3 - 4 + 5 - 6 + 7 - 8 + 9 - 10 + ···

1	1 - 2 + 3 - 4 + 5 - 6 + 7 - 8 + 9 - 10 + ···

Definir las funciones

   serie     :: [Integer]
   sumaSerie :: Integer -> Integer

1 2	serie :: [Integer] sumaSerie :: Integer -> Integer

tales que

serie es lalista de los términos de la serie anterior; es decir,

     take 7 serie  ==  [1,-2,3,-4,5,-6,7]

1	take 7 serie == [1,-2,3,-4,5,-6,7]

(sumaSerie n) es la suma de los n primeros términos de la serie. Por ejemplo,

     sumaSerie 5     ==  3
     sumaSerie 6     ==  -3
     sumaSerie 2021  ==  1011
     length (show (sumaSerie (10^1000)))  ==  1001

sumaSerie 5 == 3

sumaSerie 6 == -3

sumaSerie 2021 == 1011

length (show (sumaSerie (10^1000))) == 1001

Comprobar con QuickCheck que

la suma de la serie se puede hacer tan grande como se desee; es decir, que para todo número a existe un n tal que la suma de los n primeros términos de la serie es mayor que a;
la suma de la serie se puede hacer tan pequeña como se desee; es decir, que para todo número a existe un n tal que la suma de los n primeros términos de la serie es menor que a.

Soluciones

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

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

serie :: [Integer]
serie = [(-1)^(n-1) * n | n <- [1..]]

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

serie2 :: [Integer]
serie2 = zipWith (*) (cycle [1,-1]) [1..]

-- 3ª definición de serie
-- ======================

serie3 :: [Integer]
serie3 = zipWith ($) (cycle [id,negate]) [1..]

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

sumaSerie :: Integer -> Integer
sumaSerie n = sum (genericTake n serie)

-- 2ª definición sumaSerie
-- =======================

-- La 2ª definición se basa en la siguiente observación
-- + Si n es par, entonces
--        1 - 2 + 3 - 4 + 5 - 6 + ··· + (n-1) - n
--      = (1 - 2) + (3 - 4) + (5 - 6) + ··· + ((n-1) - n)
--      = -1      - 1       - 1       - ··· - 1
--      = -1 * n/2
-- + Si n es impar, entonces
--        1 - 2 + 3 - 4 + 5 - 6 + ··· + (n-2) - (n-1) + n
--      = (1 - 2) + (3 - 4) + (5 - 6) + ··· + ((n-2) - (n-1)) + n
--      = -1      - 1       - 1       - ··· - 1               + n
--      = -1 * (n-1)/2 + n
--      = n - ((n-1)/2)

sumaSerie2 :: Integer -> Integer
sumaSerie2 n
  | even n    = -(n `div` 2)
  | otherwise = n - ((n - 1) `div` 2)


-- 3ª definición sumaSerie
-- =======================

-- La 3ª definición se basa en la siguiente observación
--    λ> [sumaSerie n | n <- [1..20]]
--    [1,-1,2,-2,3,-3,4,-4,5,-5,6,-6,7,-7,8,-8,9,-9,10,-10]

sumaSerie3 :: Integer -> Integer
sumaSerie3 n = ((-1)^(n-1)*(2*n+1)+1) `div` 4

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

-- La propiedad es
prop_sumaSerie_equiv :: Integer -> Property
prop_sumaSerie_equiv n =
  n > 0 ==>
  sumaSerie  n == sumaSerie2 n &&
  sumaSerie2 n == sumaSerie3 n

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

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

-- La comparación es
--    λ> sumaSerie (10^6)
--    -500000
--    (3.34 secs, 5,106,633,208 bytes)
--    λ> sumaSerie2 (10^6)
--    -500000
--    (0.01 secs, 102,600 bytes)
--    λ> sumaSerie3 (10^6)
--    -500000
--    (0.02 secs, 110,976 bytes)
--    λ> sumaSerie3 (10^6)
--    -500000

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

-- La propiedad es
prop_sumaSerie :: Integer -> Bool
prop_sumaSerie a =
  any (> a) sumas && any (< a) sumas
  where sumas = [sumaSerie2 n | n <- [1..]]

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

100

101

import Data.List (cycle, genericTake)

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

-- 1ª definición de serie

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

serie :: [Integer]

serie = [(-1)^(n-1) * n | n <- [1..]]

-- 2ª definición de serie

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

serie2 :: [Integer]

serie2 = zipWith (*) (cycle [1,-1]) [1..]

-- 3ª definición de serie

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

serie3 :: [Integer]

serie3 = zipWith ($) (cycle [id,negate]) [1..]

-- 1ª definición de sumaSerie

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

sumaSerie :: Integer -> Integer

sumaSerie n = sum (genericTake n serie)

-- 2ª definición sumaSerie

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

-- La 2ª definición se basa en la siguiente observación

-- + Si n es par, entonces

-- 1 - 2 + 3 - 4 + 5 - 6 + ··· + (n-1) - n

-- = (1 - 2) + (3 - 4) + (5 - 6) + ··· + ((n-1) - n)

-- = -1 - 1 - 1 - ··· - 1

-- = -1 * n/2

-- + Si n es impar, entonces

-- 1 - 2 + 3 - 4 + 5 - 6 + ··· + (n-2) - (n-1) + n

-- = (1 - 2) + (3 - 4) + (5 - 6) + ··· + ((n-2) - (n-1)) + n

-- = -1 - 1 - 1 - ··· - 1 + n

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

-- = n - ((n-1)/2)

sumaSerie2 :: Integer -> Integer

sumaSerie2 n

| even n = -(n `div` 2)

| otherwise = n - ((n - 1) `div` 2)

-- 3ª definición sumaSerie

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

-- La 3ª definición se basa en la siguiente observación

-- λ> [sumaSerie n | n <- [1..20]]

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

sumaSerie3 :: Integer -> Integer

sumaSerie3 n = ((-1)^(n-1)*(2*n+1)+1) `div` 4

-- Equivalencia

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

-- La propiedad es

prop_sumaSerie_equiv :: Integer -> Property

prop_sumaSerie_equiv n =

n > 0 ==>

sumaSerie n == sumaSerie2 n &&

sumaSerie2 n == sumaSerie3 n

-- La comprobación es

-- λ> quickCheck prop_sumaSerie_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sumaSerie (10^6)

-- -500000

-- (3.34 secs, 5,106,633,208 bytes)

-- λ> sumaSerie2 (10^6)

-- -500000

-- (0.01 secs, 102,600 bytes)

-- λ> sumaSerie3 (10^6)

-- -500000

-- (0.02 secs, 110,976 bytes)

-- λ> sumaSerie3 (10^6)

-- -500000

-- Propiedad

-- =========

-- La propiedad es

prop_sumaSerie :: Integer -> Bool

prop_sumaSerie a =

any (> a) sumas && any (< a) sumas

where sumas = [sumaSerie2 n | n <- [1..]]

-- La comprobación es

-- λ> quickCheck prop_sumaSerie

-- +++ OK, passed 100 tests.

Números en potencias de dos

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

Las potencias de dos son

   1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,32768,...

1	1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,32768,...

Se observa que la primera potencia de dos que contiene al 638 es la 14 ya que 2^14 = 16384.

Definir la función

   potenciasContenedoras :: Integer -> [Integer]

1	potenciasContenedoras :: Integer -> [Integer]

tal que (potenciasContenedoras x) es la lista de las potencias de 2 que contienen a x. Por ejemplo,

   λ> head (potenciasContenedoras 638)
   14
   λ> head (potenciasContenedoras 2021)
   452
   λ> take 20 (potenciasContenedoras 4)
   [2,6,10,11,12,14,18,19,20,22,25,26,27,28,30,31,32,33,34,35]
   λ> [head (potenciasContenedoras n) | n <- [0..20]]
   [10,4,1,5,2,8,4,15,3,12,10,40,7,17,18,21,4,27,30,13,11]

λ> head (potenciasContenedoras 638)

λ> head (potenciasContenedoras 2021)

452

λ> take 20 (potenciasContenedoras 4)

[2,6,10,11,12,14,18,19,20,22,25,26,27,28,30,31,32,33,34,35]

λ> [head (potenciasContenedoras n) | n <- [0..20]]

[10,4,1,5,2,8,4,15,3,12,10,40,7,17,18,21,4,27,30,13,11]

Comprobar con QuickCheck si todos los números naturales están contenenidos en alguna potencia de 2.

Soluciones

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

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

potenciasContenedoras :: Integer -> [Integer]
potenciasContenedoras x =
  [n | n <- [1..], x `estaContenidoEn` (2^n)]

-- (estaContenidoEn x y) se verifica si el número x está contenido en
-- y. Por ejemplo,
--    estaContenidoEn 23 42357  ==  True
--    estaContenidoEn 23 42537  ==  False
estaContenidoEn :: Integer -> Integer -> Bool
estaContenidoEn x y = show x `isInfixOf` show y

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

potenciasContenedoras2 :: Integer -> [Integer]
potenciasContenedoras2 x =
  [n | (n,y) <- zip [0..] potenciasDeDos, x `estaContenidoEn` y]

-- potenciasDeDos es la lista de las potencias de dos. Por ejemplo,
--    λ> take 12 potenciasDeDos
--    [1,2,4,8,16,32,64,128,256,512,1024,2048]
potenciasDeDos :: [Integer]
potenciasDeDos = iterate (*2) 1

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

-- La propiedad es
prop_potenciasContenedoras :: Integer -> Property
prop_potenciasContenedoras n =
  n > 0 ==> not (null (potenciasContenedoras n))

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

import Data.List (isInfixOf)

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

-- 1ª solución

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

potenciasContenedoras :: Integer -> [Integer]

potenciasContenedoras x =

[n | n <- [1..], x `estaContenidoEn` (2^n)]

-- (estaContenidoEn x y) se verifica si el número x está contenido en

-- y. Por ejemplo,

-- estaContenidoEn 23 42357 == True

-- estaContenidoEn 23 42537 == False

estaContenidoEn :: Integer -> Integer -> Bool

estaContenidoEn x y = show x `isInfixOf` show y

-- 2ª solución

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

potenciasContenedoras2 :: Integer -> [Integer]

potenciasContenedoras2 x =

[n | (n,y) <- zip [0..] potenciasDeDos, x `estaContenidoEn` y]

-- potenciasDeDos es la lista de las potencias de dos. Por ejemplo,

-- λ> take 12 potenciasDeDos

-- [1,2,4,8,16,32,64,128,256,512,1024,2048]

potenciasDeDos :: [Integer]

potenciasDeDos = iterate (*2) 1

-- Propiedad

-- =========

-- La propiedad es

prop_potenciasContenedoras :: Integer -> Property

prop_potenciasContenedoras n =

n > 0 ==> not (null (potenciasContenedoras n))

-- La comprobación es

-- λ> quickCheck prop_potenciasContenedoras

-- +++ OK, passed 100 tests.

Números equidigitales

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

Un número equidigital es un número natural que tiene el mismo número de dígitos que el número de dígitos en su factorización prima, incluidos los exponentes mayores que 1. Por ejemplo,

10 es equidigital ya que tiene 2 dígitos al igual que su factorización prima (2 x 5).
25 es equidigital ya que tiene 2 dígitos al igual que su factorización prima (5^2).
121 es equidigital ya que tiene 3 dígitos al igual que su factorización prima (11^2).
175 es equidigital ya que tiene 3 dígitos al igual que su factorización prima (5^2 x 7).
1125 es equidigital ya que tiene 4 dígitos al igual que su factorización prima (3^2 x 5^3).
2021 es equidigital ya que tiene 4 dígitos al igual que su factorización prima (43 x 47).
3072 es equidigital ya que tiene 4 dígitos al igual que su factorización prima (3 x 2^10).

Definir las funciones

   esEquidigital :: Int -> Bool
   equidigitales :: [Int]

1 2	esEquidigital :: Int -> Bool equidigitales :: [Int]

tal que

(esEquidigital x) se verifica si x es un número equidigital. Por ejemplo.

     esEquidigital 10    ==  True
     esEquidigital 11    ==  True
     esEquidigital 2021  ==  True
     esEquidigital 2022  ==  False

esEquidigital 10 == True

esEquidigital 11 == True

esEquidigital 2021 == True

esEquidigital 2022 == False

equidigitales es la lista de los números equidigitales. Por ejemplo,

     λ> take 20 equidigitales
     [2,3,5,7,10,11,13,14,15,16,17,19,21,23,25,27,29,31,32,35]
     λ> equidigitales !! 755
     2021
     λ> equidigitales !! 100000
     405341

λ> take 20 equidigitales

[2,3,5,7,10,11,13,14,15,16,17,19,21,23,25,27,29,31,32,35]

λ> equidigitales !! 755

2021

λ> equidigitales !! 100000

405341

Comprobar con QuickChek que el conjunto de los números equidigitales es infinito; es decir, para cada entero n existe un equidigital mayor que n.

Soluciones

import Data.Numbers.Primes
import Data.List
import Test.QuickCheck

esEquidigital :: Int -> Bool
esEquidigital x =
  nDigitos x == nDigitosFactorizacion x

-- (nDigitos n) es el número de dígitos de n. Por ejemplo,
--    nDigitos 2021  ==  4
nDigitos :: Int -> Int
nDigitos = length . show

-- (nDigitosFactorizacion x) es el número de dígitos en la factorización
-- prima de x, incluyendo los exponentes mayores que 1. Por ejemplo,
--    nDigitosFactorizacion 3000  ==  5
--    nDigitosFactorizacion 2021  ==  4
--    nDigitosFactorizacion 3072  ==  4
nDigitosFactorizacion :: Int -> Int
nDigitosFactorizacion x =
  sum [nDigitos y + aux n | (y,n) <- factorizacion x]
  where aux 1 = 0
        aux n = nDigitos n

-- (factorizacion x) es la factorización prima de x expresada como una
-- lista de pares que son las bases y los exponentes. Por ejemplo,
--    factorizacion 3000  ==  [(2,3),(3,1),(5,3)]
--    factorizacion 2021  ==  [(43,1),(47,1)]
--    factorizacion 3072  ==  [(2,10),(3,1)]
factorizacion :: Int -> [(Int,Int)]
factorizacion x =
  [(y, 1 + length ys) | (y:ys) <- group (primeFactors x)]

equidigitales :: [Int]
equidigitales = filter esEquidigital [1..]

-- La propiedad es
prop_equidigitales :: Int -> Property
prop_equidigitales n =
  n > 0 ==> any esEquidigital [n+1..]

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

import Data.Numbers.Primes

import Data.List

import Test.QuickCheck

esEquidigital :: Int -> Bool

esEquidigital x =

nDigitos x == nDigitosFactorizacion x

-- (nDigitos n) es el número de dígitos de n. Por ejemplo,

-- nDigitos 2021 == 4

nDigitos :: Int -> Int

nDigitos = length . show

-- (nDigitosFactorizacion x) es el número de dígitos en la factorización

-- prima de x, incluyendo los exponentes mayores que 1. Por ejemplo,

-- nDigitosFactorizacion 3000 == 5

-- nDigitosFactorizacion 2021 == 4

-- nDigitosFactorizacion 3072 == 4

nDigitosFactorizacion :: Int -> Int

nDigitosFactorizacion x =

sum [nDigitos y + aux n | (y,n) <- factorizacion x]

where aux 1 = 0

aux n = nDigitos n

-- (factorizacion x) es la factorización prima de x expresada como una

-- lista de pares que son las bases y los exponentes. Por ejemplo,

-- factorizacion 3000 == [(2,3),(3,1),(5,3)]

-- factorizacion 2021 == [(43,1),(47,1)]

-- factorizacion 3072 == [(2,10),(3,1)]

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

factorizacion x =

[(y, 1 + length ys) | (y:ys) <- group (primeFactors x)]

equidigitales :: [Int]

equidigitales = filter esEquidigital [1..]

-- La propiedad es

prop_equidigitales :: Int -> Property

prop_equidigitales n =

n > 0 ==> any esEquidigital [n+1..]

-- La comprobación es

-- λ> quickCheck prop_equidigitales

-- +++ OK, passed 100 tests.

Números cíclicos

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

La indicatriz de Euler (también llamada función φ de Euler) es una función importante en teoría de números. Si n es un entero positivo, entonces φ(n) se define como el número de enteros positivos menores o iguales a n y coprimos con n. Por ejemplo,

φ(15) = 8 ya que los números menores o iguales a 36 y coprimos con 36 son ocho: 1, 2, 4, 7, 8, 11, 13 y 14.
φ(21) = 12 ya que los números menores o iguales a 36 y coprimos con 36 son doce: 1, 2, 4, 5, 8, 10, 11, 13, 16, 17, 19 y 20.

Un número n es un número cíclico si n y φ(n) no tiene ningún divisor primo común. Por ejemplo, el número 15 es cíclico ya que 15 y 8 (que es φ(15)) no tiene ningún divisor primo común; en cambio, el número 21 no es cíclico ya 21 y 12 (que es φ(21)) son divisibles por 3.

Definir las funciones

   esCiclico :: Integer -> Bool
   ciclicos  :: [Integer]

1 2	esCiclico :: Integer -> Bool ciclicos :: [Integer]

tales que

(esCiclico n) se verifica si n es un número cíclico. Por ejemplo,

     esCiclico 15    ==  True
     esCiclico 16    ==  False
     esCiclico 2021  ==  True
     esCiclico (product [1..10^4])  ==  False

esCiclico 15 == True

esCiclico 16 == False

esCiclico 2021 == True

esCiclico (product [1..10^4]) == False

ciclicos es la lista de los números cíclicos. Por ejemplo,

     λ> take 20 ciclicos
     [2,3,5,7,11,13,15,17,19,23,29,31,33,35,37,41,43,47,51,53]
     λ> ciclicos !! (10^5)
     336059

λ> take 20 ciclicos

[2,3,5,7,11,13,15,17,19,23,29,31,33,35,37,41,43,47,51,53]

λ> ciclicos !! (10^5)

336059

Comprobar con QuickCheck que todos los números primos mayores que 2 son cíclicos.

Soluciones

module Numeros_ciclicos where

import Data.List (genericLength, group)
import Data.Numbers.Primes (primeFactors, primes)
import Test.QuickCheck (Property, (==>), quickCheck)

-- 1ª definición
-- =============

ciclicos1 :: [Integer]
ciclicos1 = filter esCiclico1 [2..]

esCiclico1 :: Integer -> Bool
esCiclico1 n = gcd n (phi1 n) == 1

-- (phi1 n) es igual a φ(n). Por ejemplo,
--    phi1 15    ==  8
--    phi1 21    ==  12
--    phi1 2021  ==  1932
phi1 :: Integer -> Integer
phi1 n = genericLength [x | x <- [1..n], gcd x n == 1]

-- 2ª definición
-- =============

ciclicos2 :: [Integer]
ciclicos2 = filter esCiclico2 [2..]

esCiclico2 :: Integer -> Bool
esCiclico2 n = gcd n (phi2 n) == 1

-- (phi2 n) es igual a φ(n). Por ejemplo,
--    phi2 15    ==  8
--    phi2 21    ==  12
--    phi2 2021  ==  1932
phi2 :: Integer -> Integer
phi2 n = product [(p-1)*p^(e-1) | (p,e) <- factorizacion n]

-- (factorizacion n) es la descomposición de n en factores primos como
-- una lista de pares donde los primeros elementos son la base y los
-- segundo son los exponentes. Por ejemplo,
--    factorizacion 3000  ==  [(2,3),(3,1),(5,3)]
-- ya que 3000 = 2^3*3*5^3
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion n =
  [(head xs,genericLength xs) | xs <- group (primeFactors n)]

-- 3ª definición
-- =============

ciclicos3 :: [Integer]
ciclicos3 = filter esCiclico3 [2..]

esCiclico3 :: Integer -> Bool
esCiclico3 n = gcd n (phi3 n) == 1

-- (phi3 n) es igual a φ(n). Por ejemplo,
--    phi3 15    ==  8
--    phi3 21    ==  12
--    phi3 2021  ==  1932
phi3 :: Integer -> Integer
phi3 n =
  product [(x-1) * product xs | (x:xs) <- group (primeFactors n)]

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

-- La comparación es
--    λ> esCiclico1 (4*10^6)
--    False
--    (3.64 secs, 4,448,223,616 bytes)
--    λ> esCiclico2 (4*10^6)
--    False
--    (0.01 secs, 116,144 bytes)
--    λ> esCiclico3 (4*10^6)
--    False
--    (0.01 secs, 111,336 bytes)
--
--    λ> esCiclico2 (product [1..3*10^4])
--    False
--    (2.49 secs, 5,846,361,904 bytes)
--    λ> esCiclico3 (product [1..3*10^4])
--    False
--    (2.50 secs, 5,947,164,552 bytes)


-- Verificación de la propiedad
-- ============================

-- La propiedad es
prop_ciclicos :: Int -> Property
prop_ciclicos n =
    n > 1 ==> esCiclico3 (primes !! n)

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

verificacion :: IO ()
verificacion = quickCheck prop_ciclicos

100

module Numeros_ciclicos where

import Data.List (genericLength, group)

import Data.Numbers.Primes (primeFactors, primes)

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

-- 1ª definición

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

ciclicos1 :: [Integer]

ciclicos1 = filter esCiclico1 [2..]

esCiclico1 :: Integer -> Bool

esCiclico1 n = gcd n (phi1 n) == 1

-- (phi1 n) es igual a φ(n). Por ejemplo,

-- phi1 15 == 8

-- phi1 21 == 12

-- phi1 2021 == 1932

phi1 :: Integer -> Integer

phi1 n = genericLength [x | x <- [1..n], gcd x n == 1]

-- 2ª definición

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

ciclicos2 :: [Integer]

ciclicos2 = filter esCiclico2 [2..]

esCiclico2 :: Integer -> Bool

esCiclico2 n = gcd n (phi2 n) == 1

-- (phi2 n) es igual a φ(n). Por ejemplo,

-- phi2 15 == 8

-- phi2 21 == 12

-- phi2 2021 == 1932

phi2 :: Integer -> Integer

phi2 n = product [(p-1)*p^(e-1) | (p,e) <- factorizacion n]

-- (factorizacion n) es la descomposición de n en factores primos como

-- una lista de pares donde los primeros elementos son la base y los

-- segundo son los exponentes. Por ejemplo,

-- factorizacion 3000 == [(2,3),(3,1),(5,3)]

-- ya que 3000 = 2^3*3*5^3

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

factorizacion n =

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

-- 3ª definición

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

ciclicos3 :: [Integer]

ciclicos3 = filter esCiclico3 [2..]

esCiclico3 :: Integer -> Bool

esCiclico3 n = gcd n (phi3 n) == 1

-- (phi3 n) es igual a φ(n). Por ejemplo,

-- phi3 15 == 8

-- phi3 21 == 12

-- phi3 2021 == 1932

phi3 :: Integer -> Integer

phi3 n =

product [(x-1) * product xs | (x:xs) <- group (primeFactors n)]

-- Comparación de eficiencia

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

-- La comparación es

-- λ> esCiclico1 (4*10^6)

-- False

-- (3.64 secs, 4,448,223,616 bytes)

-- λ> esCiclico2 (4*10^6)

-- False

-- (0.01 secs, 116,144 bytes)

-- λ> esCiclico3 (4*10^6)

-- False

-- (0.01 secs, 111,336 bytes)

-- λ> esCiclico2 (product [1..3*10^4])

-- False

-- (2.49 secs, 5,846,361,904 bytes)

-- λ> esCiclico3 (product [1..3*10^4])

-- False

-- (2.50 secs, 5,947,164,552 bytes)

-- Verificación de la propiedad

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

-- La propiedad es

prop_ciclicos :: Int -> Property

prop_ciclicos n =

n > 1 ==> esCiclico3 (primes !! n)

-- La comprobación es

-- λ> quickCheck prop_ciclicos

-- +++ OK, passed 100 tests.

verificacion :: IO ()

verificacion = quickCheck prop_ciclicos

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 duffinianos

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

Los números duffinianos, llamados así por Richard Duffy, son los números compuestos n que son coprimos con la suma de sus divisores; es decir, n y la suma de los divisores de n no tienen ningún factor primo común.

Por ejemplo, 35 es un número duffiniano ya que la suma de sus divisores es 1 + 5 + 7 + 35 = 48 que es coprimo con 35.

Definir las funciones

   esDuffiniano :: Integer -> Bool
   duffinianos :: [Integer]

1 2	esDuffiniano :: Integer -> Bool duffinianos :: [Integer]

tales que

(esDuffiniano n) se verifica si n es duffiniano. Por ejemplo,

     esDuffiniano 35    ==  True
     esDuffiniano 2021  ==  True
     esDuffiniano 11    ==  False
     esDuffiniano 12    ==  False
     esDuffiniano (product [1..2*10^4])  ==  False

esDuffiniano 35 == True

esDuffiniano 2021 == True

esDuffiniano 11 == False

esDuffiniano 12 == False

esDuffiniano (product [1..2*10^4]) == False

duffinianos es la sucesión de los números duffinianos. Por ejemplo,

     take 12 duffinianos  ==  [4,8,9,16,21,25,27,32,35,36,39,49]
     length (takeWhile (< 10^5) duffinianos)  ==  24434

1 2	take 12 duffinianos == [4,8,9,16,21,25,27,32,35,36,39,49] length (takeWhile (< 10^5) duffinianos) == 24434

Comprobar con QuickCheck que los números de la forma p^k, con p un primo mayor que 2 y k un entero mayor que 1, son duffinianos.

Soluciones

import Data.List (genericLength, group)
import Data.Numbers.Primes (isPrime, primeFactors, primes)
import Test.QuickCheck (Property, (==>), quickCheck)

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

duffinianos :: [Integer]
duffinianos = filter esDuffiniano [1..]

esDuffiniano :: Integer -> Bool
esDuffiniano n =
  n > 1 &&
  not (isPrime n) &&
  gcd n (sumaDivisores n) == 1

-- (sumaDivisores n) es la suma de los divisores de n. Por ejemplo.
--      sumaDivisores 35  ==  48
sumaDivisores :: Integer -> Integer
sumaDivisores = sum . divisores

-- (divisores n) es la lista de los divisores de n. Por ejemplo,
--      divisores 35  ==  [1,5,7,35]
divisores :: Integer -> [Integer]
divisores n = [x | x <- [1..n]
                 , n `mod` x == 0]

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

duffinianos2 :: [Integer]
duffinianos2 = filter esDuffiniano2 [1..]

esDuffiniano2 :: Integer -> Bool
esDuffiniano2 n =
  n > 1 &&
  not (isPrime n) &&
  gcd n (sumaDivisores2 n) == 1

-- Si la descomposición de x en factores primos es
--    x = p(1)^e(1) . p(2)^e(2) . .... . p(n)^e(n)
-- entonces la suma de los divisores de x es
--    p(1)^(e(1)+1) - 1     p(2)^(e(2)+1) - 1       p(n)^(e(2)+1) - 1
--   ------------------- . ------------------- ... -------------------
--        p(1)-1                p(2)-1                  p(n)-1
-- Ver la demostración en http://bit.ly/2zUXZPc

-- (sumaDivisores2 n) es la suma de los divisores de n. Por ejemplo.
--      sumaDivisores2 35  ==  48
sumaDivisores2 :: Integer -> Integer
sumaDivisores2 x =
  product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion x]

-- (factorizacion x) es la lista de las bases y exponentes de la
-- descomposición prima de x. Por ejemplo,
--    factorizacion 600  ==  [(2,3),(3,1),(5,2)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion = map primeroYlongitud . group . primeFactors

-- (primeroYlongitud xs) es el par formado por el primer elemento de xs
-- y la longitud de xs. Por ejemplo,
--    primeroYlongitud [3,2,5,7] == (3,4)
primeroYlongitud :: [a] -> (a,Integer)
primeroYlongitud (x:xs) = (x, 1 + genericLength xs)
primeroYlongitud _      = error "No tiene elementos"

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

-- La comparación es
--    λ> esDuffiniano (product [1..11])
--    False
--    (14.09 secs, 7,983,535,608 bytes)
--    λ> esDuffiniano2 (product [1..11])
--    False
--    (0.01 secs, 125,760 bytes)
--
--    λ> head (dropWhile (<10^4) duffinianos)
--    10000
--    (13.45 secs, 8,872,967,976 bytes)
--    λ> head (dropWhile (<10^4) duffinianos2)
--    10000
--    (0.15 secs, 280,668,240 bytes)
--
--    λ> length (takeWhile (<10^4) duffinianos)
--    2370
--    (13.43 secs, 8,966,138,016 bytes)
--    λ> length (takeWhile (<10^4) duffinianos2)
--    2370
--    (0.15 secs, 286,120,048 bytes)

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

-- La propiedad es
prop_duffinianos :: Int -> Int -> Property
prop_duffinianos n k =
  n >= 0 && k > 1 ==> esDuffiniano2 (p^k)
  where p = primes !! n

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