Orden superior – Página 10

La conjetura de Levy

PorJosé A. Alonso 12-marzo-201825-abril-2021

    7 = 3 + 2 x 2
    9 = 3 + 2 x 3 =  5 + 2 x 2
   11 = 5 + 2 x 3 =  7 + 2 x 2
   13 = 3 + 2 x 5 =  7 + 2 x 3
   15 = 3 + 2 x 5 = 11 + 2 x 2
   17 = 3 + 2 x 7 =  7 + 2 x 5 = 11 + 2 x 3 = 13 + 2 x 2
   19 = 5 + 2 x 7 = 13 + 2 x 3

7 = 3 + 2 x 2

9 = 3 + 2 x 3 = 5 + 2 x 2

11 = 5 + 2 x 3 = 7 + 2 x 2

13 = 3 + 2 x 5 = 7 + 2 x 3

15 = 3 + 2 x 5 = 11 + 2 x 2

17 = 3 + 2 x 7 = 7 + 2 x 5 = 11 + 2 x 3 = 13 + 2 x 2

19 = 5 + 2 x 7 = 13 + 2 x 3

y conjeturó que todos los número impares mayores o iguales que 7 se pueden escribir como la suma de un primo y el doble de un primo. El objetivo de los siguientes ejercicios es comprobar la conjetura de Levy.

Definir las siguientes funciones

   descomposicionesLevy :: Integer -> [(Integer,Integer)]
   graficaLevy          :: Integer -> IO ()

1 2	descomposicionesLevy :: Integer -> [(Integer,Integer)] graficaLevy :: Integer -> IO ()

tales que

(descomposicionesLevy x) es la lista de pares de primos (p,q) tales que x = p + 2q. Por ejemplo,

     descomposicionesLevy  7  ==  [(3,2)]
     descomposicionesLevy  9  ==  [(3,3),(5,2)]
     descomposicionesLevy 17  ==  [(3,7),(7,5),(11,3),(13,2)]

descomposicionesLevy 7 == [(3,2)]

descomposicionesLevy 9 == [(3,3),(5,2)]

descomposicionesLevy 17 == [(3,7),(7,5),(11,3),(13,2)]

(graficaLevy n) dibuja los puntos (x,y) tales que x pertenece a [7,9..7+2x(n-1)] e y es el número de descomposiciones de Levy de x. Por ejemplo, (graficaLevy 200) dibuja

Comprobar con QuickCheck la conjetura de Levy.

Soluciones

[schedule on=’2018-03-19′ at=»06:00″]

import Data.Numbers.Primes
import Test.QuickCheck
import Graphics.Gnuplot.Simple

descomposicionesLevy :: Integer -> [(Integer,Integer)]
descomposicionesLevy x =
  [(p,q) | p <- takeWhile (< x) (tail primes)
         , let q = (x - p) `div` 2
         , isPrime q]

-- graficaLevy 300
graficaLevy :: Integer -> IO ()
graficaLevy n =
  plotList [ Key Nothing
           , XRange (7,fromIntegral (7+2*(n-1)))
           , PNG ("La_conjetura_de_Levy-" ++ show n ++ ".png")
           ]
           [(x, length (descomposicionesLevy x)) | x <- [7,9..7+2*(n-1)]] 

-- La propiedad es
prop_Levy :: Integer -> Bool
prop_Levy x =
  not (null (descomposicionesLevy (7 + 2 * abs x)))

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

import Data.Numbers.Primes

import Test.QuickCheck

import Graphics.Gnuplot.Simple

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

descomposicionesLevy x =

[(p,q) | p <- takeWhile (< x) (tail primes)

, let q = (x - p) `div` 2

, isPrime q]

-- graficaLevy 300

graficaLevy :: Integer -> IO ()

graficaLevy n =

plotList [ Key Nothing

, XRange (7,fromIntegral (7+2*(n-1)))

, PNG ("La_conjetura_de_Levy-" ++ show n ++ ".png")

]

[(x, length (descomposicionesLevy x)) | x <- [7,9..7+2*(n-1)]]

-- La propiedad es

prop_Levy :: Integer -> Bool

prop_Levy x =

not (null (descomposicionesLevy (7 + 2 * abs x)))

-- La comprobación es

-- λ> quickCheck prop_Levy

-- +++ OK, passed 100 tests.

Matrices de Pascal

PorJosé A. Alonso 9-marzo-201816-marzo-2018

El triángulo de Pascal es un triángulo de números

         1
        1 1
       1 2 1
     1  3 3  1
    1 4  6  4 1
   1 5 10 10 5 1
  ...............

1 1

1 2 1

1 3 3 1

1 4 6 4 1

1 5 10 10 5 1

...............

construido de la siguiente forma

la primera fila está formada por el número 1;
las filas siguientes se construyen sumando los números adyacentes de la fila superior y añadiendo un 1 al principio y al final de la fila.

La matriz de Pascal es la matriz cuyas filas son los elementos de la
correspondiente fila del triángulo de Pascal completadas con ceros. Por ejemplo, la matriz de Pascal de orden 6 es

   |1 0  0  0 0 0|
   |1 1  0  0 0 0|
   |1 2  1  0 0 0|
   |1 3  3  1 0 0|
   |1 4  6  4 1 0|
   |1 5 10 10 5 1|

|1 0 0 0 0 0|

|1 1 0 0 0 0|

|1 2 1 0 0 0|

|1 3 3 1 0 0|

|1 4 6 4 1 0|

|1 5 10 10 5 1|

Definir la función

   matrizPascal :: Int -> Matrix Integer

1	matrizPascal :: Int -> Matrix Integer

tal que (matrizPascal n) es la matriz de Pascal de orden n. Por ejemplo,

   λ> matrizPascal 6
   (  1  0  0  0  0  0 )
   (  1  1  0  0  0  0 )
   (  1  2  1  0  0  0 )
   (  1  3  3  1  0  0 )
   (  1  4  6  4  1  0 )
   (  1  5 10 10  5  1 )

λ> matrizPascal 6

( 1 0 0 0 0 0 )

( 1 1 0 0 0 0 )

( 1 2 1 0 0 0 )

( 1 3 3 1 0 0 )

( 1 4 6 4 1 0 )

( 1 5 10 10 5 1 )

Soluciones

import Data.Matrix

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

matrizPascal :: Int -> Matrix Integer 
matrizPascal 1 = fromList 1 1 [1]
matrizPascal n = matrix n n f 
  where f (i,j) | i < n && j <  n  = p!(i,j)
                | i < n && j == n  = 0
                | j == 1 || j == n = 1
                | otherwise        = p!(i-1,j-1) + p!(i-1,j)
        p = matrizPascal (n-1)

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

matrizPascal2 :: Int -> Matrix Integer
matrizPascal2 n = fromLists xss
  where yss = take n pascal
        xss = map (take n) (map (++ repeat 0) yss)
        
pascal :: [[Integer]]
pascal = [1] : map f pascal
    where f xs = zipWith (+) (0:xs) (xs ++ [0])

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

matrizPascal3 :: Int -> Matrix Integer
matrizPascal3 n =  matrix n n f
  where f (i,j) | i >=  j   = comb (i-1) (j-1)
                | otherwise = 0

-- (comb n k) es el número de combinaciones (o coeficiente binomial) de
-- n sobre k. Por ejemplo,
comb :: Int -> Int -> Integer
comb n k = product [n',n'-1..n'-k'+1] `div` product [1..k']
  where n' = fromIntegral n
        k' = fromIntegral k

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

matrizPascal4 :: Int -> Matrix Integer
matrizPascal4 n = p
  where p = matrix n n (\(i,j) -> f i j)
        f i 1 = 1
        f i j
          | j >  i    = 0
          | i == j    = 1
          | otherwise = p!(i-1,j) + p!(i-1,j-1)

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

--    λ> maximum (matrizPascal 150)
--    46413034868354394849492907436302560970058760
--    (2.58 secs, 394,030,504 bytes)
--    λ> maximum (matrizPascal2 150)
--    46413034868354394849492907436302560970058760
--    (0.03 secs, 8,326,784 bytes)
--    λ> maximum (matrizPascal3 150)
--    46413034868354394849492907436302560970058760
--    (0.38 secs, 250,072,360 bytes)
--    λ> maximum (matrizPascal4 150)
--    46413034868354394849492907436302560970058760
--    (0.10 secs, 13,356,360 bytes)
--    
--    λ> length (show (maximum (matrizPascal2 300)))
--    89
--    (0.06 secs, 27,286,296 bytes)
--    λ> length (show (maximum (matrizPascal3 300)))
--    89
--    (2.74 secs, 2,367,037,536 bytes)
--    λ> length (show (maximum (matrizPascal4 300)))
--    89
--    (0.36 secs, 53,934,792 bytes)
--    
--    λ> length (show (maximum (matrizPascal2 700)))
--    209
--    (0.83 secs, 207,241,080 bytes)
--    λ> length (show (maximum (matrizPascal4 700)))
--    209
--    (2.22 secs, 311,413,008 bytes)

import Data.Matrix

-- 1ª solución

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

matrizPascal :: Int -> Matrix Integer

matrizPascal 1 = fromList 1 1 [1]

matrizPascal n = matrix n n f

where f (i,j) | i < n && j < n = p!(i,j)

| i < n && j == n = 0

| j == 1 || j == n = 1

| otherwise = p!(i-1,j-1) + p!(i-1,j)

p = matrizPascal (n-1)

-- 2ª solución

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

matrizPascal2 :: Int -> Matrix Integer

matrizPascal2 n = fromLists xss

where yss = take n pascal

xss = map (take n) (map (++ repeat 0) yss)

pascal :: [[Integer]]

pascal = [1] : map f pascal

where f xs = zipWith (+) (0:xs) (xs ++ [0])

-- 3ª solución

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

matrizPascal3 :: Int -> Matrix Integer

matrizPascal3 n = matrix n n f

where f (i,j) | i >= j = comb (i-1) (j-1)

| otherwise = 0

-- (comb n k) es el número de combinaciones (o coeficiente binomial) de

-- n sobre k. Por ejemplo,

comb :: Int -> Int -> Integer

comb n k = product [n',n'-1..n'-k'+1] `div` product [1..k']

where n' = fromIntegral n

k' = fromIntegral k

-- 4ª solución

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

matrizPascal4 :: Int -> Matrix Integer

matrizPascal4 n = p

where p = matrix n n (\(i,j) -> f i j)

f i 1 = 1

f i j

| j > i = 0

| i == j = 1

| otherwise = p!(i-1,j) + p!(i-1,j-1)

-- Comparación de eficiencia

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

-- λ> maximum (matrizPascal 150)

-- 46413034868354394849492907436302560970058760

-- (2.58 secs, 394,030,504 bytes)

-- λ> maximum (matrizPascal2 150)

-- 46413034868354394849492907436302560970058760

-- (0.03 secs, 8,326,784 bytes)

-- λ> maximum (matrizPascal3 150)

-- 46413034868354394849492907436302560970058760

-- (0.38 secs, 250,072,360 bytes)

-- λ> maximum (matrizPascal4 150)

-- 46413034868354394849492907436302560970058760

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

-- λ> length (show (maximum (matrizPascal2 300)))

-- 89

-- (0.06 secs, 27,286,296 bytes)

-- λ> length (show (maximum (matrizPascal3 300)))

-- 89

-- (2.74 secs, 2,367,037,536 bytes)

-- λ> length (show (maximum (matrizPascal4 300)))

-- 89

-- (0.36 secs, 53,934,792 bytes)

-- λ> length (show (maximum (matrizPascal2 700)))

-- 209

-- (0.83 secs, 207,241,080 bytes)

-- λ> length (show (maximum (matrizPascal4 700)))

-- 209

-- (2.22 secs, 311,413,008 bytes)

La conjetura de Gilbreath

PorJosé A. Alonso 8-marzo-201825-abril-2021

Partiendo de los 5 primeros números primos y calculando el valor absoluto de la diferencia de cada dos números consecutivos hasta quedarse con un único número se obtiene la siguiente tabla:

   2, 3, 5, 7, 11
   1, 2, 2, 4 
   1, 0, 2
   1, 2 
   1

2, 3, 5, 7, 11

1, 2, 2, 4

1, 0, 2

1, 2

Se observa que todas las filas, salvo la inicial, comienzan con el número 1.

Repitiendo el proceso pero empezando con los 8 primeros números primos se obtiene la siguiente tabla:

   2, 3, 5, 7, 11, 13, 17, 19 
   1, 2, 2, 4,  2,  4,  2  
   1, 0, 2, 2,  2,  2 
   1, 2, 0, 0,  0 
   1, 2, 0, 0 
   1, 2, 0 
   1, 2 
   1

2, 3, 5, 7, 11, 13, 17, 19

1, 2, 2, 4, 2, 4, 2

1, 0, 2, 2, 2, 2

1, 2, 0, 0, 0

1, 2, 0, 0

1, 2, 0

1, 2

Se observa que, de nuevo, todas las filas, salvo la inicial, comienza con el número 1.

La conjetura de Gilbreath afirma que si escribimos la sucesión de números primos completa y después construimos las correspondientes sucesiones formadas por el valor absoluto de la resta de cada pareja de números consecutivos, entonces todas esas filas que obtenemos comienzan siempre por 1.

El objetivo de este ejercicio es comprobar experimentalmente dicha conjetura.

Para la representación, usaremos la simétrica de la que hemos comentado anteriormente; es decir,

    2
    3, 1
    5, 2, 1
    7, 2, 0, 1
   11, 4, 2, 2, 1
   13, 2, 2, 0, 2, 1
   17, 4, 2, 0, 0, 2, 1
   19, 2, 2, 0, 0, 0, 2, 1

3, 1

5, 2, 1

7, 2, 0, 1

11, 4, 2, 2, 1

13, 2, 2, 0, 2, 1

17, 4, 2, 0, 0, 2, 1

19, 2, 2, 0, 0, 0, 2, 1

en la que la primera columna son los números primos y el elemento de la fila i y columna j (con i, j > 1) es el valor absoluto de la diferencia de los elementos (i,j-1) e (i-1,j-1).

Definir las siguientes funciones

   siguiente           :: Integer -> [Integer] -> [Integer]
   triangulo           :: [[Integer]]
   conjetura_Gilbreath :: Int -> Bool

siguiente :: Integer -> [Integer] -> [Integer]

triangulo :: [[Integer]]

conjetura_Gilbreath :: Int -> Bool

tales que

(siguiente x ys) es la línea siguiente de la ys que empieza por x en la tabla de Gilbreath; es decir, si ys es [y1,y2,…,yn], entonces (siguiente x ys) es [x,|y1-x|,|y2-|y1-x||,…] Por ejemplo,

     siguiente  7 [5,2,1]               ==  [7,2,0,1]
     siguiente 29 [23,4,2,0,0,0,0,2,1]  ==  [29,6,2,0,0,0,0,0,2,1]

1 2	siguiente 7 [5,2,1] == [7,2,0,1] siguiente 29 [23,4,2,0,0,0,0,2,1] == [29,6,2,0,0,0,0,0,2,1]

triangulo es el triángulo de Gilbreath. Por ejemplo,

     ghci> take 10 triangulo
     [[ 2],
      [ 3,1],
      [ 5,2,1],
      [ 7,2,0,1],
      [11,4,2,2,1],
      [13,2,2,0,2,1],
      [17,4,2,0,0,2,1],
      [19,2,2,0,0,0,2,1],
      [23,4,2,0,0,0,0,2,1],
      [29,6,2,0,0,0,0,0,2,1]]

ghci> take 10 triangulo

[[ 2],

[ 3,1],

[ 5,2,1],

[ 7,2,0,1],

[11,4,2,2,1],

[13,2,2,0,2,1],

[17,4,2,0,0,2,1],

[19,2,2,0,0,0,2,1],

[23,4,2,0,0,0,0,2,1],

[29,6,2,0,0,0,0,0,2,1]]

(conjeturaGilbreath n) se verifica si se cumple la conjetura de Gilbreath para los n primeros números primos; es decir, en el triángulo de Gilbreath cuya primera columna son los n primeros números primos, todas las filas a partir de la segunda terminan en 1. Por ejemplo,

     ghci> conjeturaGilbreath 1000
     True

1 2	ghci> conjeturaGilbreath 1000 True

Soluciones

import Data.Numbers.Primes

siguiente :: Integer -> [Integer] -> [Integer]
siguiente x ys = scanl (\m n -> abs (m-n)) x ys 

triangulo :: [[Integer]]
triangulo = 
    [2] : [siguiente x ys | (x,ys) <- zip (tail primes) triangulo]

conjeturaGilbreath :: Int -> Bool
conjeturaGilbreath n = all p (tail (take n triangulo))
  where p xs = last xs == 1

import Data.Numbers.Primes

siguiente :: Integer -> [Integer] -> [Integer]

siguiente x ys = scanl (\m n -> abs (m-n)) x ys

triangulo :: [[Integer]]

triangulo =

[2] : [siguiente x ys | (x,ys) <- zip (tail primes) triangulo]

conjeturaGilbreath :: Int -> Bool

conjeturaGilbreath n = all p (tail (take n triangulo))

where p xs = last xs == 1

Suma de las sumas de los cuadrados de los divisores

PorJosé A. Alonso 7-marzo-201814-marzo-2018

La suma de las sumas de los cuadrados de los divisores de los 6 primeros números enteros positivos es

     1² + (1²+2²) + (1²+3²) + (1²+2²+4²) + (1²+5²) + (1²+2²+3²+6²)
   = 1  + 5       + 10      + 21         + 26      + 50
   = 113

1² + (1²+2²) + (1²+3²) + (1²+2²+4²) + (1²+5²) + (1²+2²+3²+6²)

= 1 + 5 + 10 + 21 + 26 + 50

= 113

Definir la función

   sumaSumasCuadradosDivisores :: Integer -> Integer

1	sumaSumasCuadradosDivisores :: Integer -> Integer

tal que (sumaSumasCuadradosDivisores n) es la suma de las sumas de los cuadrados de los divisores de los n primeros números enteros positivos. Por ejemplo,

   sumaSumasCuadradosDivisores 6       ==  113
   sumaSumasCuadradosDivisores (10^6)  ==  400686363385965077

1 2	sumaSumasCuadradosDivisores 6 == 113 sumaSumasCuadradosDivisores (10^6) == 400686363385965077

Soluciones

import Data.List (genericIndex)

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

sumaSumasCuadradosDivisores :: Integer -> Integer
sumaSumasCuadradosDivisores n =
  sum [sumaCuadradosDivisores k | k <- [1..n]]

-- (sumaCuadradosDivisores n) es la suma de los cuadrados de los
-- divisores de n. Por ejemplo,
--    sumaCuadradosDivisores 6  ==  50
sumaCuadradosDivisores :: Integer -> Integer
sumaCuadradosDivisores n = sum (map (^2) (divisores n))

-- (divisores n) es la lista de los divisores de n. Por ejemplo, 
--    divisores 6  ==  [1,6,2,3]
divisores :: Integer -> [Integer]
divisores 1 = [1]
divisores n = 1 : n : [x | x <- [2..n `div` 2], n `mod` x == 0]

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

sumaSumasCuadradosDivisores2 :: Integer -> Integer
sumaSumasCuadradosDivisores2 n =
  sumasSumasCuadradosDivisores `genericIndex` (n-1)

-- sumasSumasCuadradosDivisores es la sucesión cuyo n-ésimo término es
-- la suma de las sumas de los cuadrados de los divisores de n. Por
-- ejemplo, 
--    take 6 sumasSumasCuadradosDivisores  ==  [1,6,16,37,63,113]
sumasSumasCuadradosDivisores :: [Integer]
sumasSumasCuadradosDivisores = 1 : sig 1 2
  where sig m n = y : sig y (n+1)
          where y = m + sumaCuadradosDivisores n

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

sumaSumasCuadradosDivisores3 :: Integer -> Integer
sumaSumasCuadradosDivisores3 n =
  last (sumasSumasCuadradosDivisores3 n)

-- (sumasSumasCuadradosDivisores3 n) es la sucesión cuyo k-ésimo término
-- es la suma de las sumas de los cuadrados de los divisores de k, para
-- k entre 0 y n. Por ejemplo, 
--    sumasSumasCuadradosDivisores3 6  ==  [0,6,18,36,52,77,113]
sumasSumasCuadradosDivisores3 :: Integer -> [Integer]
sumasSumasCuadradosDivisores3 n = scanl f 0 [1..n]
  where f x k = x + k^2 * (n `div` k)

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

sumaSumasCuadradosDivisores4 :: Integer -> Integer
sumaSumasCuadradosDivisores4 n =
  last (sumasSumasCuadradosDivisores4 n)

-- (sumasSumasCuadradosDivisores4 n) es la sucesión cuyo k-ésimo término
-- es la suma de las sumas de los cuadrados de los divisores de k, para
-- k entre 0 y n. Por ejemplo, 
--    sumasSumasCuadradosDivisores4 6  ==  [0,6,18,36,52,77,113]
sumasSumasCuadradosDivisores4 :: Integer -> [Integer]
sumasSumasCuadradosDivisores4 n = scanl1 f [0,1..n]
  where f x k = x + k^2 * (n `div` k)

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

sumaSumasCuadradosDivisores5 :: Integer -> Integer
sumaSumasCuadradosDivisores5 n =
  last (sumasSumasCuadradosDivisores5 n)

-- (sumasSumasCuadradosDivisores5 n) es la sucesión cuyo k-ésimo término
-- es la suma de las sumas de los cuadrados de los divisores de k, para
-- k entre 0 y n. Por ejemplo, 
--    sumasSumasCuadradosDivisores5 6  ==  [0,6,18,36,52,77,113]
sumasSumasCuadradosDivisores5 :: Integer -> [Integer]
sumasSumasCuadradosDivisores5 n = scanl1 f [0,1..n]
  where f x k = x + k * (n - (n `mod` k))

-- 6ª solución
-- ===========

-- Cada elemento k de [1..n], al cuadrado, aparece tantas veces como la
-- parte entera de n/k; luego,
--    sumaSumasCuadradosDivisores n =
--       1^2*n + 2^2*(n `div` 2) + 3^2*(n `div` 3) + ... + n^2*1

sumaSumasCuadradosDivisores6 :: Integer -> Integer
sumaSumasCuadradosDivisores6 n = sum (zipWith (*) ds vs)
  where ds = map (^2) [1..n]
        vs = [n `div` k | k <- [1..n]]

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

--    λ> sumaSumasCuadradosDivisores (3*10^3)
--    10825397502
--    (3.29 secs, 468,721,192 bytes)
--    λ> sumaSumasCuadradosDivisores2 (3*10^3)
--    10825397502
--    (3.25 secs, 469,462,600 bytes)
--    λ> sumaSumasCuadradosDivisores3 (3*10^3)
--    10825397502
--    (0.03 secs, 2,788,752 bytes)
--    λ> sumaSumasCuadradosDivisores4 (3*10^3)
--    10825397502
--    (0.03 secs, 2,813,304 bytes)
--    λ> sumaSumasCuadradosDivisores5 (3*10^3)
--    10825397502
--    (0.03 secs, 1,467,056 bytes)
--    λ> sumaSumasCuadradosDivisores6 (3*10^3)
--    10825397502
--    (0.03 secs, 3,291,664 bytes)
--    
--    λ> sumaSumasCuadradosDivisores3 (5*10^5)
--    50085873311988831
--    (2.34 secs, 440,961,640 bytes)
--    λ> sumaSumasCuadradosDivisores4 (5*10^5)
--    50085873311988831
--    (2.29 secs, 444,962,904 bytes)
--    λ> sumaSumasCuadradosDivisores5 (5*10^5)
--    50085873311988831
--    (1.23 secs, 220,960,152 bytes)
--    λ> sumaSumasCuadradosDivisores6 (5*10^5)
--    50085873311988831
--    (2.76 secs, 524,962,464 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

import Data.List (genericIndex)

-- 1ª solución

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

sumaSumasCuadradosDivisores :: Integer -> Integer

sumaSumasCuadradosDivisores n =

sum [sumaCuadradosDivisores k | k <- [1..n]]

-- (sumaCuadradosDivisores n) es la suma de los cuadrados de los

-- divisores de n. Por ejemplo,

-- sumaCuadradosDivisores 6 == 50

sumaCuadradosDivisores :: Integer -> Integer

sumaCuadradosDivisores n = sum (map (^2) (divisores n))

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

-- divisores 6 == [1,6,2,3]

divisores :: Integer -> [Integer]

divisores 1 = [1]

divisores n = 1 : n : [x | x <- [2..n `div` 2], n `mod` x == 0]

-- 2ª solución

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

sumaSumasCuadradosDivisores2 :: Integer -> Integer

sumaSumasCuadradosDivisores2 n =

sumasSumasCuadradosDivisores `genericIndex` (n-1)

-- sumasSumasCuadradosDivisores es la sucesión cuyo n-ésimo término es

-- la suma de las sumas de los cuadrados de los divisores de n. Por

-- ejemplo,

-- take 6 sumasSumasCuadradosDivisores == [1,6,16,37,63,113]

sumasSumasCuadradosDivisores :: [Integer]

sumasSumasCuadradosDivisores = 1 : sig 1 2

where sig m n = y : sig y (n+1)

where y = m + sumaCuadradosDivisores n

-- 3ª solución

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

sumaSumasCuadradosDivisores3 :: Integer -> Integer

sumaSumasCuadradosDivisores3 n =

last (sumasSumasCuadradosDivisores3 n)

-- (sumasSumasCuadradosDivisores3 n) es la sucesión cuyo k-ésimo término

-- es la suma de las sumas de los cuadrados de los divisores de k, para

-- k entre 0 y n. Por ejemplo,

-- sumasSumasCuadradosDivisores3 6 == [0,6,18,36,52,77,113]

sumasSumasCuadradosDivisores3 :: Integer -> [Integer]

sumasSumasCuadradosDivisores3 n = scanl f 0 [1..n]

where f x k = x + k^2 * (n `div` k)

-- 4ª solución

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

sumaSumasCuadradosDivisores4 :: Integer -> Integer

sumaSumasCuadradosDivisores4 n =

last (sumasSumasCuadradosDivisores4 n)

-- (sumasSumasCuadradosDivisores4 n) es la sucesión cuyo k-ésimo término

-- es la suma de las sumas de los cuadrados de los divisores de k, para

-- k entre 0 y n. Por ejemplo,

-- sumasSumasCuadradosDivisores4 6 == [0,6,18,36,52,77,113]

sumasSumasCuadradosDivisores4 :: Integer -> [Integer]

sumasSumasCuadradosDivisores4 n = scanl1 f [0,1..n]

where f x k = x + k^2 * (n `div` k)

-- 5ª solución

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

sumaSumasCuadradosDivisores5 :: Integer -> Integer

sumaSumasCuadradosDivisores5 n =

last (sumasSumasCuadradosDivisores5 n)

-- (sumasSumasCuadradosDivisores5 n) es la sucesión cuyo k-ésimo término

-- es la suma de las sumas de los cuadrados de los divisores de k, para

-- k entre 0 y n. Por ejemplo,

-- sumasSumasCuadradosDivisores5 6 == [0,6,18,36,52,77,113]

sumasSumasCuadradosDivisores5 :: Integer -> [Integer]

sumasSumasCuadradosDivisores5 n = scanl1 f [0,1..n]

where f x k = x + k * (n - (n `mod` k))

-- 6ª solución

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

-- Cada elemento k de [1..n], al cuadrado, aparece tantas veces como la

-- parte entera de n/k; luego,

-- sumaSumasCuadradosDivisores n =

-- 1^2*n + 2^2*(n `div` 2) + 3^2*(n `div` 3) + ... + n^2*1

sumaSumasCuadradosDivisores6 :: Integer -> Integer

sumaSumasCuadradosDivisores6 n = sum (zipWith (*) ds vs)

where ds = map (^2) [1..n]

vs = [n `div` k | k <- [1..n]]

-- Comparación de eficiencia:

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

-- λ> sumaSumasCuadradosDivisores (3*10^3)

-- 10825397502

-- (3.29 secs, 468,721,192 bytes)

-- λ> sumaSumasCuadradosDivisores2 (3*10^3)

-- 10825397502

-- (3.25 secs, 469,462,600 bytes)

-- λ> sumaSumasCuadradosDivisores3 (3*10^3)

-- 10825397502

-- (0.03 secs, 2,788,752 bytes)

-- λ> sumaSumasCuadradosDivisores4 (3*10^3)

-- 10825397502

-- (0.03 secs, 2,813,304 bytes)

-- λ> sumaSumasCuadradosDivisores5 (3*10^3)

-- 10825397502

-- (0.03 secs, 1,467,056 bytes)

-- λ> sumaSumasCuadradosDivisores6 (3*10^3)

-- 10825397502

-- (0.03 secs, 3,291,664 bytes)

-- λ> sumaSumasCuadradosDivisores3 (5*10^5)

-- 50085873311988831

-- (2.34 secs, 440,961,640 bytes)

-- λ> sumaSumasCuadradosDivisores4 (5*10^5)

-- 50085873311988831

-- (2.29 secs, 444,962,904 bytes)

-- λ> sumaSumasCuadradosDivisores5 (5*10^5)

-- 50085873311988831

-- (1.23 secs, 220,960,152 bytes)

-- λ> sumaSumasCuadradosDivisores6 (5*10^5)

-- 50085873311988831

-- (2.76 secs, 524,962,464 bytes)

Nodos con máxima suma de hijos

PorJosé A. Alonso 1-marzo-201830-marzo-2020

Los árboles se pueden representar mediante el siguiente tipo de datos

   data Arbol a = N a [Arbol a]
                  deriving Show

1 2	data Arbol a = N a [Arbol a] deriving Show

Por ejemplo, los árboles

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

1 3

/ \ /|\

2 3 / | \

| 5 4 7

4 | /|\

6 2 8 6

se representan por

   ej1, ej2 :: Arbol Int
   ej1 = N 1 [N 2 [], N 3 [N 4 []]]
   ej2 = N 3 [N 5 [N 6 []], 
              N 4 [], 
              N 7 [N 2 [], N 8 [], N 6 []]]

ej1, ej2 :: Arbol Int

ej1 = N 1 [N 2 [], N 3 [N 4 []]]

ej2 = N 3 [N 5 [N 6 []],

N 4 [],

N 7 [N 2 [], N 8 [], N 6 []]]

Definir la función

   nodosSumaMaxima :: (Num t, Ord t) => Arbol t -> [t]

1	nodosSumaMaxima :: (Num t, Ord t) => Arbol t -> [t]

tal que (nodosSumaMaxima a) es la lista de los nodos del árbol a cuyos hijos tienen máxima suma. Por ejemplo,

   nodosSumaMaxima ej1  ==  [1]
   nodosSumaMaxima ej2  ==  [7,3]

1 2	nodosSumaMaxima ej1 == [1] nodosSumaMaxima ej2 == [7,3]

Soluciones

import Data.List     (groupBy, sort)
import Data.Function (on)

data Arbol a = N a [Arbol a]
  deriving Show

ej1, ej2 :: Arbol Int
ej1 = N 1 [N 2 [], N 3 [N 4 []]]
ej2 = N 3 [N 5 [N 6 []], 
           N 4 [], 
           N 7 [N 2 [], N 8 [], N 6 []]]

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

nodosSumaMaxima :: (Num t, Ord t) => Arbol t -> [t]
nodosSumaMaxima a =
  [x | (s,x) <- ns, s == m]
  where ns = reverse (sort (nodosSumas a))
        m  = fst (head ns)

-- (nodosSumas x) es la lista de los pares (s,n) donde n es un nodo del
-- árbol x y s es la suma de sus hijos. Por ejemplo,  
--    λ> nodosSumas ej1
--    [(5,1),(0,2),(4,3),(0,4)]
--    λ> nodosSumas ej2
--    [(16,3),(6,5),(0,6),(0,4),(16,7),(0,2),(0,8),(0,6)]
nodosSumas :: Num t => Arbol t -> [(t,t)]
nodosSumas (N x []) = [(0,x)]
nodosSumas (N x as) = (sum (raices as),x) : concatMap nodosSumas as

-- (raices b) es la lista de las raíces del bosque b. Por ejemplo,
--    raices [ej1,ej2]  ==  [1,3]
raices :: [Arbol t] -> [t]
raices = map raiz

-- (raiz a) es la raíz del árbol a. Por ejemplo,
--    raiz ej1  ==  1
--    raiz ej2  ==  3
raiz :: Arbol t -> t
raiz (N x _) = x

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

nodosSumaMaxima2 :: (Num t, Ord t) => Arbol t -> [t]
nodosSumaMaxima2 a =
  [x | (s,x) <- ns, s == m]
  where ns = sort (nodosOpSumas a)
        m  = fst (head ns)

-- (nodosOpSumas x) es la lista de los pares (s,n) donde n es un nodo del
-- árbol x y s es el opuesto de la suma de sus hijos. Por ejemplo,  
--    λ> nodosOpSumas ej1
--    [(-5,1),(0,2),(-4,3),(0,4)]
--    λ> nodosOpSumas ej2
--    [(-16,3),(-6,5),(0,6),(0,4),(-16,7),(0,2),(0,8),(0,6)]
nodosOpSumas :: Num t => Arbol t -> [(t,t)]
nodosOpSumas (N x []) = [(0,x)]
nodosOpSumas (N x as) = (-sum (raices as),x) : concatMap nodosOpSumas as


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

nodosSumaMaxima3 :: (Num t, Ord t) => Arbol t -> [t]
nodosSumaMaxima3 a =
  [x | (s,x) <- ns, s == m]
  where ns = sort (nodosOpSumas a)
        m  = fst (head ns)

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

nodosSumaMaxima4 :: (Num t, Ord t) => Arbol t -> [t]
nodosSumaMaxima4 a =
  map snd (head (groupBy (\p q -> fst p == fst q)
                         (sort (nodosOpSumas a))))

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

nodosSumaMaxima5 :: (Num t, Ord t) => Arbol t -> [t]
nodosSumaMaxima5 a =
  map snd (head (groupBy ((==) `on` fst)
                         (sort (nodosOpSumas a))))

-- 6ª solución
-- ===========

nodosSumaMaxima6 :: (Num t, Ord t) => Arbol t -> [t]
nodosSumaMaxima6 =
  map snd
  . head
  . groupBy ((==) `on` fst)
  . sort
  . nodosOpSumas

import Data.List (groupBy, sort)

import Data.Function (on)

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2 :: Arbol Int

ej1 = N 1 [N 2 [], N 3 [N 4 []]]

ej2 = N 3 [N 5 [N 6 []],

N 4 [],

N 7 [N 2 [], N 8 [], N 6 []]]

-- 1ª solución

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

nodosSumaMaxima :: (Num t, Ord t) => Arbol t -> [t]

nodosSumaMaxima a =

[x | (s,x) <- ns, s == m]

where ns = reverse (sort (nodosSumas a))

m = fst (head ns)

-- (nodosSumas x) es la lista de los pares (s,n) donde n es un nodo del

-- árbol x y s es la suma de sus hijos. Por ejemplo,

-- λ> nodosSumas ej1

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

-- λ> nodosSumas ej2

-- [(16,3),(6,5),(0,6),(0,4),(16,7),(0,2),(0,8),(0,6)]

nodosSumas :: Num t => Arbol t -> [(t,t)]

nodosSumas (N x []) = [(0,x)]

nodosSumas (N x as) = (sum (raices as),x) : concatMap nodosSumas as

-- (raices b) es la lista de las raíces del bosque b. Por ejemplo,

-- raices [ej1,ej2] == [1,3]

raices :: [Arbol t] -> [t]

raices = map raiz

-- (raiz a) es la raíz del árbol a. Por ejemplo,

-- raiz ej1 == 1

-- raiz ej2 == 3

raiz :: Arbol t -> t

raiz (N x _) = x

-- 2ª solución

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

nodosSumaMaxima2 :: (Num t, Ord t) => Arbol t -> [t]

nodosSumaMaxima2 a =

[x | (s,x) <- ns, s == m]

where ns = sort (nodosOpSumas a)

m = fst (head ns)

-- (nodosOpSumas x) es la lista de los pares (s,n) donde n es un nodo del

-- árbol x y s es el opuesto de la suma de sus hijos. Por ejemplo,

-- λ> nodosOpSumas ej1

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

-- λ> nodosOpSumas ej2

-- [(-16,3),(-6,5),(0,6),(0,4),(-16,7),(0,2),(0,8),(0,6)]

nodosOpSumas :: Num t => Arbol t -> [(t,t)]

nodosOpSumas (N x []) = [(0,x)]

nodosOpSumas (N x as) = (-sum (raices as),x) : concatMap nodosOpSumas as

-- 3ª solución

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

nodosSumaMaxima3 :: (Num t, Ord t) => Arbol t -> [t]

nodosSumaMaxima3 a =

[x | (s,x) <- ns, s == m]

where ns = sort (nodosOpSumas a)

m = fst (head ns)

-- 4ª solución

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

nodosSumaMaxima4 :: (Num t, Ord t) => Arbol t -> [t]

nodosSumaMaxima4 a =

map snd (head (groupBy (\p q -> fst p == fst q)

(sort (nodosOpSumas a))))

-- 5ª solución

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

nodosSumaMaxima5 :: (Num t, Ord t) => Arbol t -> [t]

nodosSumaMaxima5 a =

map snd (head (groupBy ((==) `on` fst)

(sort (nodosOpSumas a))))

-- 6ª solución

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

nodosSumaMaxima6 :: (Num t, Ord t) => Arbol t -> [t]

nodosSumaMaxima6 =

map snd

. head

. groupBy ((==) `on` fst)

. sort

. nodosOpSumas

Números cuyos factoriales son divisibles por x pero no por y

PorJosé A. Alonso 28-febrero-20187-marzo-2018

Hay 3 números (el 2, 3 y 4) cuyos factoriales son divisibles por 2 pero no por 5. Análogamente, hay números 5 (el 5, 6, 7, 8, 9) cuyos factoriales son divisibles por 15 pero no por 25.

Definir la función

   nNumerosConFactorialesDivisibles :: Integer -> Integer -> Integer

1	nNumerosConFactorialesDivisibles :: Integer -> Integer -> Integer

tal que (nNumerosConFactorialesDivisibles x y) es la cantidad de números cuyo factorial es divisible por x pero no por y. Por ejemplo,

  nNumerosConFactorialesDivisibles 2   5     ==  3
  nNumerosConFactorialesDivisibles 15  25    ==  5
  nNumerosConFactorialesDivisibles 100 2000  ==  5

nNumerosConFactorialesDivisibles 2 5 == 3

nNumerosConFactorialesDivisibles 15 25 == 5

nNumerosConFactorialesDivisibles 100 2000 == 5

Soluciones

import Data.List (genericLength)

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

nNumerosConFactorialesDivisibles :: Integer -> Integer -> Integer
nNumerosConFactorialesDivisibles x y =
  genericLength (numerosConFactorialesDivisibles x y)

-- (numerosConFactorialesDivisibles x y) es la lista de números
-- divisibles por el factorial de x pero no divisibles por el 
-- factorial de y. Por ejemplo,
--   numerosConFactorialesDivisibles 2  5   ==  [2,3,4]
--   numerosConFactorialesDivisibles 15 25  ==  [5,6,7,8,9]
numerosConFactorialesDivisibles :: Integer -> Integer -> [Integer]
numerosConFactorialesDivisibles x y =
  [z | z <- [0..y-1]
     , factorial z `mod` x == 0
     , factorial z `mod` y /= 0]

-- (factorial n) es el factorial de n. Por ejemplo, 
--   factorial 4  ==  24
factorial :: Integer -> Integer
factorial n = product [1..n]

-- 2ª solución (usando la función de Smarandache)
-- ==============================================

nNumerosConFactorialesDivisibles2 :: Integer -> Integer -> Integer
nNumerosConFactorialesDivisibles2 x y =
  max 0 (smarandache y - smarandache x)

--(smarandache n) es el menor número cuyo factorial es divisible por
-- n. Por ejemplo,   
--    smarandache 8   ==  4
--    smarandache 10  ==  5
--    smarandache 16  ==  6
smarandache :: Integer -> Integer
smarandache x =
  head [n | (n,y) <- zip [0..] factoriales
          , y `mod` x == 0]

-- factoriales es la lista de los factoriales. Por ejemplo, 
--    λ> take 12 factoriales
--    [1,1,2,6,24,120,720,5040,40320,362880,3628800,39916800]
factoriales :: [Integer]
factoriales = 1 : scanl1 (*) [1..]

-- Comparación de eficiencia
--    λ> nNumerosConFactorialesDivisibles 100 2000
--    5
--    (2.70 secs, 3,933,938,648 bytes)
--    λ> nNumerosConFactorialesDivisibles2 100 2000
--    5
--    (0.01 secs, 148,200 bytes)

import Data.List (genericLength)

-- 1ª solución

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

nNumerosConFactorialesDivisibles :: Integer -> Integer -> Integer

nNumerosConFactorialesDivisibles x y =

genericLength (numerosConFactorialesDivisibles x y)

-- (numerosConFactorialesDivisibles x y) es la lista de números

-- divisibles por el factorial de x pero no divisibles por el

-- factorial de y. Por ejemplo,

-- numerosConFactorialesDivisibles 2 5 == [2,3,4]

-- numerosConFactorialesDivisibles 15 25 == [5,6,7,8,9]

numerosConFactorialesDivisibles :: Integer -> Integer -> [Integer]

numerosConFactorialesDivisibles x y =

[z | z <- [0..y-1]

, factorial z `mod` x == 0

, factorial z `mod` y /= 0]

-- (factorial n) es el factorial de n. Por ejemplo,

-- factorial 4 == 24

factorial :: Integer -> Integer

factorial n = product [1..n]

-- 2ª solución (usando la función de Smarandache)

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

nNumerosConFactorialesDivisibles2 :: Integer -> Integer -> Integer

nNumerosConFactorialesDivisibles2 x y =

max 0 (smarandache y - smarandache x)

--(smarandache n) es el menor número cuyo factorial es divisible por

-- n. Por ejemplo,

-- smarandache 8 == 4

-- smarandache 10 == 5

-- smarandache 16 == 6

smarandache :: Integer -> Integer

smarandache x =

head [n | (n,y) <- zip [0..] factoriales

, y `mod` x == 0]

-- factoriales es la lista de los factoriales. Por ejemplo,

-- λ> take 12 factoriales

-- [1,1,2,6,24,120,720,5040,40320,362880,3628800,39916800]

factoriales :: [Integer]

factoriales = 1 : scanl1 (*) [1..]

-- Comparación de eficiencia

-- λ> nNumerosConFactorialesDivisibles 100 2000

-- 5

-- (2.70 secs, 3,933,938,648 bytes)

-- λ> nNumerosConFactorialesDivisibles2 100 2000

-- 5

-- (0.01 secs, 148,200 bytes)

La función de Smarandache

PorJosé A. Alonso 27-febrero-20186-marzo-2018

La función de Smarandache, también conocida como la función de Kempner, es la función que asigna a cada número entero positivo n el menor número cuyo factorial es divisible por n y se representa por S(n). Por ejemplo, el número 8 no divide a 1!, 2!, 3!, pero sí divide 4!; por tanto, S(8) = 4.

Definir las funciones

   smarandache        :: Integer -> Integer
   graficaSmarandache :: Integer -> IO ()

1 2	smarandache :: Integer -> Integer graficaSmarandache :: Integer -> IO ()

tales que

(smarandache n) es el menor número cuyo factorial es divisible por n. Por ejemplo,

     smarandache 8   ==  4
     smarandache 10  ==  5
     smarandache 16  ==  6

smarandache 8 == 4

smarandache 10 == 5

smarandache 16 == 6

(graficaSmarandache n) dibuja la gráfica de los n primeros términos de la sucesión de Smarandache. Por ejemplo, (graficaSmarandache 100) dibuja

(graficaSmarandache 500) dibuja

Soluciones

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

smarandache :: Integer -> Integer
smarandache x =
  head [n | (n,y) <- zip [0..] factoriales
          , y `mod` x == 0]

-- factoriales es la lista de los factoriales. Por ejemplo, 
--    λ> take 12 factoriales
--    [1,1,2,6,24,120,720,5040,40320,362880,3628800,39916800]
factoriales :: [Integer]
factoriales = 1 : scanl1 (*) [1..]

graficaSmarandache :: Integer -> IO ()
graficaSmarandache n =
  plotList [Key Nothing
           , PNG ("La_funcion_de_Smarandache_" ++ show n ++ ".png")
           ]
           (map smarandache [1..n])

import Data.List (genericLength)

import Graphics.Gnuplot.Simple

smarandache :: Integer -> Integer

smarandache x =

head [n | (n,y) <- zip [0..] factoriales

, y `mod` x == 0]

-- factoriales es la lista de los factoriales. Por ejemplo,

-- λ> take 12 factoriales

-- [1,1,2,6,24,120,720,5040,40320,362880,3628800,39916800]

factoriales :: [Integer]

factoriales = 1 : scanl1 (*) [1..]

graficaSmarandache :: Integer -> IO ()

graficaSmarandache n =

plotList [Key Nothing

, PNG ("La_funcion_de_Smarandache_" ++ show n ++ ".png")

]

(map smarandache [1..n])

Generación de progresiones geométricas

PorJosé A. Alonso 26-febrero-20186-marzo-2018

Definir la función

   geometrica :: Int -> Int -> Int -> [Int]

1	geometrica :: Int -> Int -> Int -> [Int]

tal que (geometrica a b c) es la lista de los términos de la progresión geométrica cuyo primer término es a, su segundo término es b (que se supone que es múltiplo de a) y los términos son menores o iguales que c. Por ejemplo,

   geometrica 1 3  27   ==  [1,3,9,27]
   geometrica 2 6  100  ==  [2,6,18,54]
   geometrica 3 12 57   ==  [3,12,48]
   geometrica 4 20 253  ==  [4,20,100]
   geometrica 5 25 625  ==  [5,25,125,625]
   geometrica 6 42 42   ==  [6,42]

geometrica 1 3 27 == [1,3,9,27]

geometrica 2 6 100 == [2,6,18,54]

geometrica 3 12 57 == [3,12,48]

geometrica 4 20 253 == [4,20,100]

geometrica 5 25 625 == [5,25,125,625]

geometrica 6 42 42 == [6,42]

Soluciones

-- 1ª definición
geometrica :: Int -> Int -> Int -> [Int]
geometrica a b c =
  takeWhile (<=c) (iterate (*r) a)
  where r = b `div` a

-- 2ª definición
geometrica2 :: Int -> Int -> Int -> [Int]
geometrica2 a b c = aux a b 
  where aux a b 
          | a > c     = []
          | otherwise = a : aux b (b * r)
        r = b `div` a

-- 1ª definición

geometrica :: Int -> Int -> Int -> [Int]

geometrica a b c =

takeWhile (<=c) (iterate (*r) a)

where r = b `div` a

-- 2ª definición

geometrica2 :: Int -> Int -> Int -> [Int]

geometrica2 a b c = aux a b

where aux a b

| a > c = []

| otherwise = a : aux b (b * r)

r = b `div` a

Ceros con los n primeros números

PorJosé A. Alonso 23-febrero-20182-marzo-2018

Los números del 1 al 3 se pueden escribir de dos formas, con el signo más o menos entre ellos, tales que su suma sea 0:

    1+2-3 = 0
   -1-2+3 = 0

1 2	1+2-3 = 0 -1-2+3 = 0

Definir la función

   ceros :: Int -> [[Int]]

1	ceros :: Int -> [[Int]]

tal que (ceros n) son las posibles formas de obtener cero sumando los números del 1 al n, con el signo más o menos entre ellos. Por ejemplo,

   ceros 3           ==  [[1,2,-3],[-1,-2,3]]
   ceros 4           ==  [[1,-2,-3,4],[-1,2,3,-4]]
   ceros 5           ==  []
   length (ceros 7)  ==  8
   take 3 (ceros 7)  ==  [[1,2,-3,4,-5,-6,7],[1,2,-3,-4,5,6,-7],[1,-2,3,4,-5,6,-7]]

ceros 3 == [[1,2,-3],[-1,-2,3]]

ceros 4 == [[1,-2,-3,4],[-1,2,3,-4]]

ceros 5 == []

length (ceros 7) == 8

take 3 (ceros 7) == [[1,2,-3,4,-5,-6,7],[1,2,-3,-4,5,6,-7],[1,-2,3,4,-5,6,-7]]

Soluciones

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

ceros :: Int -> [[Int]]
ceros n = [xs | xs <- candidatos n, sum xs == 0]

-- (candidatos n) es la lista de los números del 1 al n con los signos
-- más o menos. Por ejemplo,
--    λ> candidatos 1
--    [[1],[-1]]
--    λ> candidatos 2
--    [[1,2],[1,-2],[-1,2],[-1,-2]]
--    λ> candidatos 3
--    [[1,2,3],[1,2,-3],[1,-2,3],[1,-2,-3],[-1,2,3],[-1,2,-3],[-1,-2,3],[-1,-2,-3]]
candidatos :: Int -> [[Int]]
candidatos n = productoCartesiano [[i,-i] | i <- [1..n]]

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos
-- xss. Por ejemplo, 
--    λ> productoCartesiano [[1,3],[2,5],[6,4]]
--    [[1,2,6],[1,2,4],[1,5,6],[1,5,4],[3,2,6],[3,2,4],[3,5,6],[3,5,4]]
productoCartesiano :: [[a]] -> [[a]]
productoCartesiano []       = [[]]
productoCartesiano (xs:xss) =
  [x:ys | x <- xs, ys <- productoCartesiano xss]

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

ceros2 :: Int -> [[Int]]
ceros2 n = [xs | xs <- candidatos2 n, sum xs == 0]

candidatos2 :: Int -> [[Int]]
candidatos2 n = mapM (\i -> [i,-i]) [1..n]

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

ceros3 :: Int -> [[Int]]
ceros3 n = [xs | xs <- mapM (\i -> [i,-i]) [1..n], sum xs == 0]

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

ceros4 :: Integer -> [[Integer]]
ceros4 = map fst
       . filter ((==0) . snd)
       . sumas

-- (sumas n) es la lista de las candidatos con los n primeros números y
-- sus sumas. Por ejemplo,
--    λ> sumas 2
--    [([1,2],3),([-1,2],1),([1,-2],-1),([-1,-2],-3)]
--    λ> sumas 3
--    [([1,2,3],6),([-1,2,3],4),([1,-2,3],2),([-1,-2,3],0),([1,2,-3],0),
--     ([-1,2,-3],-2),([1,-2,-3],-4),([-1,-2,-3],-6)]
sumas :: Integer -> [([Integer],Integer)]
sumas = foldr aux [([], 0)]
      . enumFromTo 1
  where
    aux n = concatMap (\(ns', s') -> [(n : ns', s' + n), (-n : ns', s' - n)])

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

--    λ> length (ceros 18)
--    0
--    (4.14 secs, 1,094,854,776 bytes)
--    λ> length (ceros2 18)
--    0
--    (1.16 secs, 375,541,680 bytes)
--    λ> length (ceros3 18)
--    0
--    (1.13 secs, 375,540,192 bytes)
--    λ> length (ceros4 18)
--    0
--    (0.69 secs, 157,316,688 bytes)

-- 1ª solución

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

ceros :: Int -> [[Int]]

ceros n = [xs | xs <- candidatos n, sum xs == 0]

-- (candidatos n) es la lista de los números del 1 al n con los signos

-- más o menos. Por ejemplo,

-- λ> candidatos 1

-- [[1],[-1]]

-- λ> candidatos 2

-- [[1,2],[1,-2],[-1,2],[-1,-2]]

-- λ> candidatos 3

-- [[1,2,3],[1,2,-3],[1,-2,3],[1,-2,-3],[-1,2,3],[-1,2,-3],[-1,-2,3],[-1,-2,-3]]

candidatos :: Int -> [[Int]]

candidatos n = productoCartesiano [[i,-i] | i <- [1..n]]

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos

-- xss. Por ejemplo,

-- λ> productoCartesiano [[1,3],[2,5],[6,4]]

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

productoCartesiano :: [[a]] -> [[a]]

productoCartesiano [] = [[]]

productoCartesiano (xs:xss) =

[x:ys | x <- xs, ys <- productoCartesiano xss]

-- 2ª solución

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

ceros2 :: Int -> [[Int]]

ceros2 n = [xs | xs <- candidatos2 n, sum xs == 0]

candidatos2 :: Int -> [[Int]]

candidatos2 n = mapM (\i -> [i,-i]) [1..n]

-- 3ª solución

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

ceros3 :: Int -> [[Int]]

ceros3 n = [xs | xs <- mapM (\i -> [i,-i]) [1..n], sum xs == 0]

-- 4ª solución

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

ceros4 :: Integer -> [[Integer]]

ceros4 = map fst

. filter ((==0) . snd)

. sumas

-- (sumas n) es la lista de las candidatos con los n primeros números y

-- sus sumas. Por ejemplo,

-- λ> sumas 2

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

-- λ> sumas 3

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

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

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

sumas = foldr aux [([], 0)]

. enumFromTo 1

where

aux n = concatMap (\(ns', s') -> [(n : ns', s' + n), (-n : ns', s' - n)])

-- Comparación de eficiencia

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

-- λ> length (ceros 18)

-- 0

-- (4.14 secs, 1,094,854,776 bytes)

-- λ> length (ceros2 18)

-- 0

-- (1.16 secs, 375,541,680 bytes)

-- λ> length (ceros3 18)

-- 0

-- (1.13 secs, 375,540,192 bytes)

-- λ> length (ceros4 18)

-- 0

-- (0.69 secs, 157,316,688 bytes)

Menor potencia de 2 que comienza por n

PorJosé A. Alonso 22-febrero-201826-marzo-2022

Definir las funciones

   menorPotencia            :: Integer -> (Integer,Integer)
   graficaMenoresExponentes :: Integer -> IO ()

1 2	menorPotencia :: Integer -> (Integer,Integer) graficaMenoresExponentes :: Integer -> IO ()

tales que

(menorPotencia n) es el par (k,m) donde m es la menor potencia de 2 que empieza por n y k es su exponentes (es decir, 2^k = m). Por ejemplo,

     menorPotencia 3             ==  (5,32)
     menorPotencia 7             ==  (46,70368744177664)
     fst (menorPotencia 982)     ==  3973
     fst (menorPotencia 32627)   ==  28557
     fst (menorPotencia 158426)  ==  40000

menorPotencia 3 == (5,32)

menorPotencia 7 == (46,70368744177664)

fst (menorPotencia 982) == 3973

fst (menorPotencia 32627) == 28557

fst (menorPotencia 158426) == 40000

(graficaMenoresExponentes n) dibuja la gráfica de los exponentes de 2 en las menores potencias de los n primeros números enteros positivos. Por ejemplo, (graficaMenoresExponentes 200) dibuja

Soluciones

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

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

menorPotencia :: Integer -> (Integer,Integer)
menorPotencia n =
  head [(k,m) | (k,m) <- zip [0..] potenciasDe2
              , cs `isPrefixOf` show m]
  where cs = show n

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

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

menorPotencia2 :: Integer -> (Integer,Integer)
menorPotencia2 n = aux (0,1)
  where aux (k,m) | cs `isPrefixOf` show m = (k,m)
                  | otherwise              = aux (k+1,2*m)
        cs = show n

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

menorPotencia3 :: Integer -> (Integer,Integer)
menorPotencia3 n =
  until (isPrefixOf n1 . show . snd) (\(x,y) -> (x+1,2*y)) (0,1)
  where n1 = show n

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

--    λ> maximum [fst (menorPotencia n) | n <- [1..1000]]
--    3973
--    (3.69 secs, 1,094,923,696 bytes)
--    λ> maximum [fst (menorPotencia2 n) | n <- [1..1000]]
--    3973
--    (5.13 secs, 1,326,382,872 bytes)
--    λ> maximum [fst (menorPotencia3 n) | n <- [1..1000]]
--    3973
--    (4.71 secs, 1,240,498,128 bytes)

graficaMenoresExponentes :: Integer -> IO ()
graficaMenoresExponentes n =
  plotList [ Key Nothing
           , PNG "Menor_potencia_de_2_que_comienza_por_n.png"
           ]
           (map (fst . menorPotencia) [1..n])

import Data.List (isPrefixOf)

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

-- 1ª definición

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

menorPotencia :: Integer -> (Integer,Integer)

menorPotencia n =

head [(k,m) | (k,m) <- zip [0..] potenciasDe2

, cs `isPrefixOf` show m]

where cs = show n

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

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

potenciasDe2 :: [Integer]

potenciasDe2 = iterate (*2) 1

-- 2ª definición

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

menorPotencia2 :: Integer -> (Integer,Integer)

menorPotencia2 n = aux (0,1)

where aux (k,m) | cs `isPrefixOf` show m = (k,m)

| otherwise = aux (k+1,2*m)

cs = show n

-- 3ª definición

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

menorPotencia3 :: Integer -> (Integer,Integer)

menorPotencia3 n =

until (isPrefixOf n1 . show . snd) (\(x,y) -> (x+1,2*y)) (0,1)

where n1 = show n

-- Comparación de eficiencia

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

-- λ> maximum [fst (menorPotencia n) | n <- [1..1000]]

-- 3973

-- (3.69 secs, 1,094,923,696 bytes)

-- λ> maximum [fst (menorPotencia2 n) | n <- [1..1000]]

-- 3973

-- (5.13 secs, 1,326,382,872 bytes)

-- λ> maximum [fst (menorPotencia3 n) | n <- [1..1000]]

-- 3973

-- (4.71 secs, 1,240,498,128 bytes)

graficaMenoresExponentes :: Integer -> IO ()

graficaMenoresExponentes n =

plotList [ Key Nothing

, PNG "Menor_potencia_de_2_que_comienza_por_n.png"

]

(map (fst . menorPotencia) [1..n])

Representación ampliada de matrices dispersas

PorJosé A. Alonso 21-febrero-201828-febrero-2018

En el ejercicio anterior se explicó una representación reducida de las matrices dispersas. A partir del número de columnas y la representación reducida se puede construir la matriz.

Definir la función

   ampliada :: Num a => Int -> [[(Int,a)]] -> Matrix a

1	ampliada :: Num a => Int -> [[(Int,a)]] -> Matrix a

tal que (ampliada n xss) es la matriz con n columnas cuya representación reducida es xss. Por ejemplo,

   λ> ampliada 3 [[(3,4)],[(2,5)],[]]
   ( 0 0 4 )
   ( 0 5 0 )
   ( 0 0 0 )
   
   λ> ampliada 3 [[],[]]
   ( 0 0 0 )
   ( 0 0 0 )
   
   λ> ampliada 2 [[],[],[]]
   ( 0 0 )
   ( 0 0 )
   ( 0 0 )

λ> ampliada 3 [[(3,4)],[(2,5)],[]]

( 0 0 4 )

( 0 5 0 )

( 0 0 0 )

λ> ampliada 3 [[],[]]

( 0 0 0 )

λ> ampliada 2 [[],[],[]]

( 0 0 )

Soluciones

import Data.Matrix (Matrix, fromLists)
import Data.List   (lookup)

ampliada :: Num a => Int -> [[(Int,a)]] -> Matrix a
ampliada n xss =
  fromLists [filaAmpliada n xs | xs <- xss]

-- Se puede redefinir con un argumento
ampliada2 :: Num a => Int -> [[(Int,a)]] -> Matrix a
ampliada2 n = fromLists . map (filaAmpliada n)

-- Se puede redefinir sin argumentos usando las siguientes reducciones
--      fromLists . map (filaAmpliada n)
--    = fromLists . ((map . filaAmpliada) n)
--    = ((fromLists .) . (map . filaAmpliada)) n
--    = ((fromLists .) . map . filaAmpliada) n
ampliada3 :: Num a => Int -> [[(Int,a)]] -> Matrix a
ampliada3 = (fromLists .) . map . filaAmpliada

-- (filaAmpliada n xs) es la fila ampliada de la representación reducida
-- xs de una matriz con n columnas. Por ejemplo, 
--    filaAmpliada 3 [(2,5)]        ==  [0,5,0]
--    filaAmpliada 7 [(2,5),(1,3)]  ==  [3,5,0,0,0,0,0]
filaAmpliada :: Num a => Int -> [(Int,a)] -> [a]
filaAmpliada n xs =
  [f (lookup i xs) | i <- [1..n]]
  where f Nothing  = 0
        f (Just x) = x

import Data.Matrix (Matrix, fromLists)

import Data.List (lookup)

ampliada :: Num a => Int -> [[(Int,a)]] -> Matrix a

ampliada n xss =

fromLists [filaAmpliada n xs | xs <- xss]

-- Se puede redefinir con un argumento

ampliada2 :: Num a => Int -> [[(Int,a)]] -> Matrix a

ampliada2 n = fromLists . map (filaAmpliada n)

-- Se puede redefinir sin argumentos usando las siguientes reducciones

-- fromLists . map (filaAmpliada n)

-- = fromLists . ((map . filaAmpliada) n)

-- = ((fromLists .) . (map . filaAmpliada)) n

-- = ((fromLists .) . map . filaAmpliada) n

ampliada3 :: Num a => Int -> [[(Int,a)]] -> Matrix a

ampliada3 = (fromLists .) . map . filaAmpliada

-- (filaAmpliada n xs) es la fila ampliada de la representación reducida

-- xs de una matriz con n columnas. Por ejemplo,

-- filaAmpliada 3 [(2,5)] == [0,5,0]

-- filaAmpliada 7 [(2,5),(1,3)] == [3,5,0,0,0,0,0]

filaAmpliada :: Num a => Int -> [(Int,a)] -> [a]

filaAmpliada n xs =

[f (lookup i xs) | i <- [1..n]]

where f Nothing = 0

f (Just x) = x

Matrices dispersas

PorJosé A. Alonso 19-febrero-201826-febrero-2018

Una matriz es dispersa si la mayoriá de sus elementos son ceros. Por ejemplo, la primera de las siguientes matrices es dispersa y la segunda no lo es

   ( 0 0 4 )   ( 0 1 4 )
   ( 0 5 0 )   ( 0 5 1 )
   ( 0 0 0 )

( 0 0 4 ) ( 0 1 4 )

( 0 5 0 ) ( 0 5 1 )

( 0 0 0 )

Usando la librería Data.Matrix, las anteriores matrices se pueden definir por

   ej1, ej2 :: Matrix Int
   ej1 = fromList 3 3 [0,0,4,0,5,0,0,0,0]
   ej2 = fromList 2 3 [0,1,4,0,5,1]

ej1, ej2 :: Matrix Int

ej1 = fromList 3 3 [0,0,4,0,5,0,0,0,0]

ej2 = fromList 2 3 [0,1,4,0,5,1]

La dispersión de una matriz es el cociente entre el número de ceros de la matriz y el producto de sus números de filas y de columnas.

Definir las siguientes funciones

   dispersion :: (Num a, Eq a) => Matrix a -> Double
   esDispersa :: (Num a, Eq a) => Matrix a -> Bool

1 2	dispersion :: (Num a, Eq a) => Matrix a -> Double esDispersa :: (Num a, Eq a) => Matrix a -> Bool

tales que

(dispersion p) es la dispersión de la matriz p. Por ejemplo,

     dispersion ej1              ==  0.7777777777777778
     dispersion ej2              ==  0.3333333333333333
     dispersion (fmap (+1) ej1)  ==  0.0
     dispersion (identity 3)     ==  0.6666666666666666
     dispersion (zero 9 9)       ==  1.0

dispersion ej1 == 0.7777777777777778

dispersion ej2 == 0.3333333333333333

dispersion (fmap (+1) ej1) == 0.0

dispersion (identity 3) == 0.6666666666666666

dispersion (zero 9 9) == 1.0

(esDispersa p) se verifica si la matriz p es dispersa. Por ejemplo,

     esDispersa ej1              ==  True
     esDispersa ej2              ==  False
     esDispersa (fmap (+1) ej1)  ==  False
     esDispersa (identity 3)     ==  True
     esDispersa (zero 9 9)       ==  True

esDispersa ej1 == True

esDispersa ej2 == False

esDispersa (fmap (+1) ej1) == False

esDispersa (identity 3) == True

esDispersa (zero 9 9) == True

Soluciones

import Data.Matrix (Matrix, fromList, nrows, ncols, toList)

ej1, ej2 :: Matrix Int
ej1 = fromList 3 3 [0,0,4,0,5,0,0,0,0]
ej2 = fromList 2 3 [0,1,4,0,5,1]

dispersion :: (Num a, Eq a) => Matrix a -> Double
dispersion p =
  fi nCeros / (fi nrows * fi ncols)
  where fi f = (fromIntegral . f) p

-- (nCeros p) es el número de ceros de la matriz p. Por ejemplo,
--    nCeros ej1  ==  7
--    nCeros ej2  ==  2
nCeros :: (Num a, Eq a) => Matrix a -> Int
nCeros p = length (filter (== 0) (toList p))

-- La función anterior se puede definir sin argumentos:
nCeros2 :: (Num a, Eq a) => Matrix a -> Int
nCeros2 = length . filter (== 0) . toList

esDispersa :: (Num a, Eq a) => Matrix a -> Bool
esDispersa p = dispersion p > 0.5

-- La función anterior se puede definir sin argumentos:
esDispersa2 :: (Num a, Eq a) => Matrix a -> Bool
esDispersa2 = (> 0.5) . dispersion

import Data.Matrix (Matrix, fromList, nrows, ncols, toList)

ej1, ej2 :: Matrix Int

ej1 = fromList 3 3 [0,0,4,0,5,0,0,0,0]

ej2 = fromList 2 3 [0,1,4,0,5,1]

dispersion :: (Num a, Eq a) => Matrix a -> Double

dispersion p =

fi nCeros / (fi nrows * fi ncols)

where fi f = (fromIntegral . f) p

-- (nCeros p) es el número de ceros de la matriz p. Por ejemplo,

-- nCeros ej1 == 7

-- nCeros ej2 == 2

nCeros :: (Num a, Eq a) => Matrix a -> Int

nCeros p = length (filter (== 0) (toList p))

-- La función anterior se puede definir sin argumentos:

nCeros2 :: (Num a, Eq a) => Matrix a -> Int

nCeros2 = length . filter (== 0) . toList

esDispersa :: (Num a, Eq a) => Matrix a -> Bool

esDispersa p = dispersion p > 0.5

-- La función anterior se puede definir sin argumentos:

esDispersa2 :: (Num a, Eq a) => Matrix a -> Bool

esDispersa2 = (> 0.5) . dispersion

Vértices de un cuadrado

PorJosé A. Alonso 16-febrero-20187-marzo-2018

Definir la función

   esCuadrado :: (Num a, Ord a) => (a,a) -> (a,a) -> (a,a) -> (a,a) -> Bool

1	esCuadrado :: (Num a, Ord a) => (a,a) -> (a,a) -> (a,a) -> (a,a) -> Bool

tal que (esCuadrado p q r s) se verifica si los puntos p, q, r y s son los vértices de un cuadrado. Por ejemplo,

   esCuadrado (0,0) (0,1) (1,1) (1,0)    == True
   esCuadrado (0,0) (2,1) (3,-1) (1, -2) == True
   esCuadrado (0,0) (1,1) (0,1) (1,0)    == True
   esCuadrado (1,1) (1,1) (1,1) (1,1)    == True
   esCuadrado (0,0) (0,2) (3,2) (3,0)    == False
   esCuadrado (0,0) (3,4) (8,4) (5,0)    == False
   esCuadrado (0,0) (0,0) (1,1) (0,0)    == False
   esCuadrado (0,0) (0,0) (1,0) (0,1)    == False
   esCuadrado (0,0) (1,0) (0,1) (-1,-1)  == False

esCuadrado (0,0) (0,1) (1,1) (1,0) == True

esCuadrado (0,0) (2,1) (3,-1) (1, -2) == True

esCuadrado (0,0) (1,1) (0,1) (1,0) == True

esCuadrado (1,1) (1,1) (1,1) (1,1) == True

esCuadrado (0,0) (0,2) (3,2) (3,0) == False

esCuadrado (0,0) (3,4) (8,4) (5,0) == False

esCuadrado (0,0) (0,0) (1,1) (0,0) == False

esCuadrado (0,0) (0,0) (1,0) (0,1) == False

esCuadrado (0,0) (1,0) (0,1) (-1,-1) == False

Soluciones

import Data.List (sort, tails)

esCuadrado :: (Num a, Ord a) => (a,a) -> (a,a) -> (a,a) -> (a,a) -> Bool
esCuadrado p q r s = and [a == b, b == c, c == d, e == f, a + b == e]
  where [a,b,c,d,e,f] = sort (distancias p q r s)

-- (distancias p q r s) es la lista de los cuadrados de las longitudes
-- de los lados y de las diagonales del cuadrilátero cuyos vértices son
-- los puntos p, q, r y s. Por ejemplo,
--    distancias (0,0) (0,1) (1,1) (1,0)  ==  [1,2,1,1,2,1]
--    distancias (0,0) (3,4) (8,4) (5,0)  ==  [25,80,25,25,20,25]
--    distancias (0,0) (0,2) (3,2) (3,0)  ==  [4,13,9,9,13,4]
--    distancias (0,0) (0,0) (1,1) (0,0)  ==  [0,2,0,2,0,2]
--    distancias (0,0) (0,0) (1,0) (0,1)  ==  [0,1,1,1,1,2]
distancias :: Num a => (a,a) -> (a,a) -> (a,a) -> (a,a) -> [a]
distancias p q r s =
  [l | (h:t) <- tails [p,q,r,s], l <- map (dist h) t]

-- (dist p q) es el cuadrado de la distancia del punto p al q. Por
-- ejemplo,
--    dist (6,4) (3,8)  ==  25
dist :: Num a => (a,a) -> (a,a) -> a
dist (x1,y1) (x2,y2) = (x2-x1)^2 + (y2-y1)^2

import Data.List (sort, tails)

esCuadrado :: (Num a, Ord a) => (a,a) -> (a,a) -> (a,a) -> (a,a) -> Bool

esCuadrado p q r s = and [a == b, b == c, c == d, e == f, a + b == e]

where [a,b,c,d,e,f] = sort (distancias p q r s)

-- (distancias p q r s) es la lista de los cuadrados de las longitudes

-- de los lados y de las diagonales del cuadrilátero cuyos vértices son

-- los puntos p, q, r y s. Por ejemplo,

-- distancias (0,0) (0,1) (1,1) (1,0) == [1,2,1,1,2,1]

-- distancias (0,0) (3,4) (8,4) (5,0) == [25,80,25,25,20,25]

-- distancias (0,0) (0,2) (3,2) (3,0) == [4,13,9,9,13,4]

-- distancias (0,0) (0,0) (1,1) (0,0) == [0,2,0,2,0,2]

-- distancias (0,0) (0,0) (1,0) (0,1) == [0,1,1,1,1,2]

distancias :: Num a => (a,a) -> (a,a) -> (a,a) -> (a,a) -> [a]

distancias p q r s =

[l | (h:t) <- tails [p,q,r,s], l <- map (dist h) t]

-- (dist p q) es el cuadrado de la distancia del punto p al q. Por

-- ejemplo,

-- dist (6,4) (3,8) == 25

dist :: Num a => (a,a) -> (a,a) -> a

dist (x1,y1) (x2,y2) = (x2-x1)^2 + (y2-y1)^2

Números que no son cuadrados

PorJosé A. Alonso 15-febrero-201822-febrero-2018

Definir las funciones

   noCuadrados :: [Integer]
   graficaNoCuadrados :: Integer -> IO ()

1 2	noCuadrados :: [Integer] graficaNoCuadrados :: Integer -> IO ()

tales que

noCuadrados es la lista de los números naturales que no son cuadrados. Por ejemplo,

     λ> take 25 noCuadrados
     [2,3,5,6,7,8,10,11,12,13,14,15,17,18,19,20,21,22,23,24,26,27,28,29,30]

1 2	λ> take 25 noCuadrados [2,3,5,6,7,8,10,11,12,13,14,15,17,18,19,20,21,22,23,24,26,27,28,29,30]

(graficaNoCuadrados n) dibuja las diferencias entre los n primeros elementos de noCuadrados y sus posiciones. Por ejemplo, (graficaNoCuadrados 300) dibuja

(graficaNoCuadrados 3000) dibuja

(graficaNoCuadrados 30000) dibuja

Comprobar con QuickCheck que el término de noCuadrados en la posición n-1 es (n + floor(1/2 + sqrt(n))).

Soluciones

import Data.List (genericIndex)
import Graphics.Gnuplot.Simple
import Test.QuickCheck

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

noCuadrados :: [Integer]
noCuadrados = aux [0..] cuadrados
  where aux xs (y:ys) = as ++ aux bs ys
          where (as,_:bs) = span (<y) xs

cuadrados :: [Integer]
cuadrados = [x^2 | x <- [0..]]

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

noCuadrados2 :: [Integer]
noCuadrados2 = aux 2 [1..]
  where aux n (_:xs) = ys ++ aux (n+2) zs
          where (ys,zs) = splitAt n xs

-- Definición de graficaNoCuadrados
-- ================================

graficaNoCuadrados :: Integer -> IO ()
graficaNoCuadrados n =
  plotList [ Key Nothing
           , PNG ("Numeros_que_no_son_cuadrados_" ++ show n ++ ".png")
           ]
           (zipWith (-) noCuadrados [0..n-1])

-- La propiedad es
prop_noCuadrados :: Positive Integer -> Bool
prop_noCuadrados (Positive n) =
  noCuadrados `genericIndex` (n-1) ==
  n + floor (1/2 + sqrt (fromIntegral n))

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

import Data.List (genericIndex)

import Graphics.Gnuplot.Simple

import Test.QuickCheck

-- 1ª definición

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

noCuadrados :: [Integer]

noCuadrados = aux [0..] cuadrados

where aux xs (y:ys) = as ++ aux bs ys

where (as,_:bs) = span (<y) xs

cuadrados :: [Integer]

cuadrados = [x^2 | x <- [0..]]

-- 2ª definición

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

noCuadrados2 :: [Integer]

noCuadrados2 = aux 2 [1..]

where aux n (_:xs) = ys ++ aux (n+2) zs

where (ys,zs) = splitAt n xs

-- Definición de graficaNoCuadrados

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

graficaNoCuadrados :: Integer -> IO ()

graficaNoCuadrados n =

plotList [ Key Nothing

, PNG ("Numeros_que_no_son_cuadrados_" ++ show n ++ ".png")

]

(zipWith (-) noCuadrados [0..n-1])

-- La propiedad es

prop_noCuadrados :: Positive Integer -> Bool

prop_noCuadrados (Positive n) =

noCuadrados `genericIndex` (n-1) ==

n + floor (1/2 + sqrt (fromIntegral n))

-- La comprobación es

-- λ> quickCheck prop_noCuadrados

-- +++ OK, passed 100 tests.

Árboles binarios completos

PorJosé A. Alonso 14-febrero-201821-febrero-2018

Un árbol binario completo es un árbol en el que cada nodo tiene cero o dos hijos. Por ejemplo, el primero de los siguientes árboles es un árbol binario completo pero los otros no lo son

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

1 1 1

/ \ / \ / | \

2 3 2 3 2 7 3

/ \ / / \

4 5 4 4 5

Los árboles se pueden representar mediante el siguiente tipo de datos

   data Arbol a = N a [Arbol a]
     deriving Show

1 2	data Arbol a = N a [Arbol a] deriving Show

Por ejemplo, los árboles los árboles anteriores se puede representar por

   ej1, ej2, ej3 :: Arbol Int
   ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 []]
   ej2 = N 1 [N 2 [N 4 []], N 3 []]
   ej3 = N 1 [N 2 [N 4 [], N 5 []], N 7 [], N 3 []]

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 []]

ej2 = N 1 [N 2 [N 4 []], N 3 []]

ej3 = N 1 [N 2 [N 4 [], N 5 []], N 7 [], N 3 []]

Definir la función

   esBinarioCompleto :: Arbol t -> Bool

1	esBinarioCompleto :: Arbol t -> Bool

tal que (esBinarioCompleto a) se verifica si a es un árbol binario completo. Por ejemplo,

   esBinarioCompleto ej1  ==  True
   esBinarioCompleto ej2  ==  False
   esBinarioCompleto ej3  ==  False

esBinarioCompleto ej1 == True

esBinarioCompleto ej2 == False

esBinarioCompleto ej3 == False

Soluciones

data Arbol a = N a [Arbol a]
  deriving Show

ej1, ej2, ej3 :: Arbol Int
ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 []]
ej2 = N 1 [N 2 [N 4 []], N 3 []]
ej3 = N 1 [N 2 [N 4 [], N 5 []], N 7 [], N 3 []]
          
esBinarioCompleto :: Arbol t -> Bool
esBinarioCompleto (N _ []) = True
esBinarioCompleto (N x as) = length as `elem` [0,2] 
                             && all esBinarioCompleto as

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 []]

ej2 = N 1 [N 2 [N 4 []], N 3 []]

ej3 = N 1 [N 2 [N 4 [], N 5 []], N 7 [], N 3 []]

esBinarioCompleto :: Arbol t -> Bool

esBinarioCompleto (N _ []) = True

esBinarioCompleto (N x as) = length as `elem` [0,2]

&& all esBinarioCompleto as

Números trimórficos

PorJosé A. Alonso 12-febrero-201819-febrero-2018

Un número trimórfico es un número cuyo cubo termina en dicho número. Por ejemplo, 24 es trimórfico ya que 24^3 = 13824 termina en 24.

Para cada entero positivo n, la densidad de trimórficos hasta n es el cociente entre la cantidad de números trimórficos menores o iguales que n y el número n. Por ejemplo, hasta 10 hay 6 números trimórficos (0, 1, 4, 5, 6 y 9); por tanto, la densidad hasta 10 es 6/10 = 0.6.

Definir las funciones

   trimorficos         :: [Integer]
   densidadTrimorficos :: Integer -> Double

1 2	trimorficos :: [Integer] densidadTrimorficos :: Integer -> Double

tal que

trimorficos es la lista de los números trimórficos. Por ejemplo,

     λ> take 20 trimorficos
     [0,1,4,5,6,9,24,25,49,51,75,76,99,125,249,251,375,376,499,501]

1 2	λ> take 20 trimorficos [0,1,4,5,6,9,24,25,49,51,75,76,99,125,249,251,375,376,499,501]

(densidadTrimorficos n) es la densidad de trimórficos hasta n. Por ejemplo,

     densidadTrimorficos 10      ==  0.6
     densidadTrimorficos 100     ==  0.13
     densidadTrimorficos 1000    ==  2.6e-2
     densidadTrimorficos 10000   ==  3.7e-3
     densidadTrimorficos 100000  ==  4.8e-4

densidadTrimorficos 10 == 0.6

densidadTrimorficos 100 == 0.13

densidadTrimorficos 1000 == 2.6e-2

densidadTrimorficos 10000 == 3.7e-3

densidadTrimorficos 100000 == 4.8e-4

Soluciones

import Data.List (genericLength, isPrefixOf)

trimorficos :: [Integer]
trimorficos = filter esTrimorfico [0..]

-- (esTrimorfico n) se verifica si n es trimórfico. Por ejemplo,
--    esTrimorfico 24  ==  True
esTrimorfico :: Integer -> Bool
esTrimorfico n =
  reverse (show n) `isPrefixOf` reverse (show (n^3)) 

densidadTrimorficos :: Integer -> Double
densidadTrimorficos n =
  genericLength [x | x <- [0..n-1], esTrimorfico x] / fromIntegral n

import Data.List (genericLength, isPrefixOf)

trimorficos :: [Integer]

trimorficos = filter esTrimorfico [0..]

-- (esTrimorfico n) se verifica si n es trimórfico. Por ejemplo,

-- esTrimorfico 24 == True

esTrimorfico :: Integer -> Bool

esTrimorfico n =

reverse (show n) `isPrefixOf` reverse (show (n^3))

densidadTrimorficos :: Integer -> Double

densidadTrimorficos n =

genericLength [x | x <- [0..n-1], esTrimorfico x] / fromIntegral n

Períodos de Fibonacci

PorJosé A. Alonso 9-febrero-201819-febrero-2018

Los primeros términos de la sucesión de Fibonacci son

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

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

Al calcular sus restos módulo 3 se obtiene

   0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1

1	0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1

Se observa que es periódica y su período es

   0,1,1,2,0,2,2,1

1	0,1,1,2,0,2,2,1

Definir las funciones

   fibsMod                   :: Integer -> [Integer]
   periodoFibMod             :: Integer -> [Integer]
   longPeriodosFibMod        :: [Int]
   graficaLongPeriodosFibMod :: Int -> IO ()

fibsMod :: Integer -> [Integer]

periodoFibMod :: Integer -> [Integer]

longPeriodosFibMod :: [Int]

graficaLongPeriodosFibMod :: Int -> IO ()

tales que

(fibsMod n) es la lista de los términos de la sucesión de Fibonacci módulo n. Por ejemplo,

     λ> take 24 (fibsMod 3)
     [0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1]
     λ> take 24 (fibsMod 4)
     [0,1,1,2,3,1, 0,1,1,2,3,1, 0,1,1,2,3,1, 0,1,1,2,3,1]

λ> take 24 (fibsMod 3)

[0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1]

λ> take 24 (fibsMod 4)

[0,1,1,2,3,1, 0,1,1,2,3,1, 0,1,1,2,3,1, 0,1,1,2,3,1]

(periodoFibMod n) es la parte perioica de la sucesión de Fibonacci módulo n. Por ejemplo,

     periodoFibMod 3  ==  [0,1,1,2,0,2,2,1]
     periodoFibMod 4  ==  [0,1,1,2,3,1]
     periodoFibMod 7  ==  [0,1,1,2,3,5,1,6,0,6,6,5,4,2,6,1]

periodoFibMod 3 == [0,1,1,2,0,2,2,1]

periodoFibMod 4 == [0,1,1,2,3,1]

periodoFibMod 7 == [0,1,1,2,3,5,1,6,0,6,6,5,4,2,6,1]

longPeriodosFibMod es la sucesión de las longitudes de los períodos de las sucesiones de Fibonacci módulo n, para n > 0. Por ejemplo,

     λ> take 20 longPeriodosFibMod
     [1,3,8,6,20,24,16,12,24,60,10,24,28,48,40,24,36,24,18,60]

1 2	λ> take 20 longPeriodosFibMod [1,3,8,6,20,24,16,12,24,60,10,24,28,48,40,24,36,24,18,60]

(graficaLongPeriodosFibMod n) dibuja la gráfica de los n primeros términos de la sucesión longPeriodosFibMod. Por ejemplo, (graficaLongPeriodosFibMod n) dibuja

Soluciones

import Graphics.Gnuplot.Simple

fibsMod :: Integer -> [Integer]
fibsMod n = map (`mod` n) fibs

-- fibs es la sucesión de Fibonacci. Por ejemplo,
--    λ> take 20 fibs
--    [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]
fibs :: [Integer]
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)

periodoFibMod :: Integer -> [Integer]
periodoFibMod 1 = [0]
periodoFibMod n = 0 : 1 : aux (drop 2 (fibsMod n))
  where aux (0:1:xs) = []
        aux (a:b:xs) = a : aux (b:xs)

longPeriodosFibMod :: [Int]
longPeriodosFibMod =
  [length (periodoFibMod n) | n <- [1..]]

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

longPeriodosFibMod2 :: [Int]
longPeriodosFibMod2 = map longPeriodoFibMod [1..]

longPeriodoFibMod :: Integer -> Int
longPeriodoFibMod 1 = 1
longPeriodoFibMod n = aux 1 (tail (fibsMod n)) 0
  where aux 0 (1 : xs) k = k
        aux _ (x : xs) k = aux x xs (k + 1)

graficaLongPeriodosFibMod :: Int -> IO ()
graficaLongPeriodosFibMod n =
  plotList [ Key Nothing
           , Title ("graficaLongPeriodosFibMod " ++ show n)
           , PNG ("Periodos_de_Fibonacci " ++ show n ++ ".png")]
           (take n longPeriodosFibMod)

import Graphics.Gnuplot.Simple

fibsMod :: Integer -> [Integer]

fibsMod n = map (`mod` n) fibs

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

-- λ> take 20 fibs

-- [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]

fibs :: [Integer]

fibs = 0 : 1 : zipWith (+) fibs (tail fibs)

periodoFibMod :: Integer -> [Integer]

periodoFibMod 1 = [0]

periodoFibMod n = 0 : 1 : aux (drop 2 (fibsMod n))

where aux (0:1:xs) = []

aux (a:b:xs) = a : aux (b:xs)

longPeriodosFibMod :: [Int]

longPeriodosFibMod =

[length (periodoFibMod n) | n <- [1..]]

-- 2ª definición de longPeriodosFibMod

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

longPeriodosFibMod2 :: [Int]

longPeriodosFibMod2 = map longPeriodoFibMod [1..]

longPeriodoFibMod :: Integer -> Int

longPeriodoFibMod 1 = 1

longPeriodoFibMod n = aux 1 (tail (fibsMod n)) 0

where aux 0 (1 : xs) k = k

aux _ (x : xs) k = aux x xs (k + 1)

graficaLongPeriodosFibMod :: Int -> IO ()

graficaLongPeriodosFibMod n =

plotList [ Key Nothing

, Title ("graficaLongPeriodosFibMod " ++ show n)

, PNG ("Periodos_de_Fibonacci " ++ show n ++ ".png")]

(take n longPeriodosFibMod)

Recorrido de árboles en espiral

PorJosé A. Alonso 8-febrero-201825-abril-2021

Los árboles se pueden representar mediante el siguiente tipo de datos

   data Arbol a = N a [Arbol a]
     deriving Show

1 2	data Arbol a = N a [Arbol a] deriving Show

Por ejemplo, los árboles

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

1 1 1

/ \ / \ / \

/ \ 8 3 8 3

2 3 /|\ /|\ |

/ \ / \ 4 5 6 4 5 6 7

4 5 6 7

se representan por

   ej1, ej2, ej3 :: Arbol Int
   ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 [N 6 [], N 7 []]]
   ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]
   ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 [N 6 [], N 7 []]]

ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]

ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

Definir la función

   espiral :: Arbol a -> [a]

1	espiral :: Arbol a -> [a]

tal que (espiral x) es la lista de los nodos del árbol x recorridos en espiral; es decir, la raíz de x, los nodos del primer nivel de izquierda a derecha, los nodos del segundo nivel de derecha a izquierda y así sucesivamente. Por ejemplo,

   espiral ej1  ==  [1,2,3,7,6,5,4]
   espiral ej2  ==  [1,8,3,6,5,4]
   espiral ej3  ==  [1,8,3,7,6,5,4]

espiral ej1 == [1,2,3,7,6,5,4]

espiral ej2 == [1,8,3,6,5,4]

espiral ej3 == [1,8,3,7,6,5,4]

Soluciones

data Arbol a = N a [Arbol a]
  deriving Show
           
ej1, ej2, ej3 :: Arbol Int
ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 [N 6 [], N 7 []]]
ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]
ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

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

espiral :: Arbol a -> [a]
espiral x =
  concat [f xs | (f,xs) <- zip (cycle [reverse,id]) (niveles x)]

-- (niveles x) es la lista de los niveles del árbol x. Por ejemplo, 
--    niveles ej1 == [[1],[8,3],[4]]
--    niveles ej2 == [[1],[8,3],[4,5,6]]
--    niveles ej3 == [[1],[8,3],[4,5,6,7]]
niveles :: Arbol a -> [[a]]
niveles x = takeWhile (not . null) [nivel n x | n <- [0..]]

-- (nivel n x) es el nivel de nivel n del árbol x. Por ejemplo,
--    nivel 0 ej1  ==  [1]
--    nivel 1 ej1  ==  [8,3]
--    nivel 2 ej1  ==  [4]
--    nivel 4 ej1  ==  []
nivel :: Int -> Arbol a ->  [a]
nivel 0 (N x _)  = [x]
nivel n (N _ xs) = concatMap (nivel (n-1)) xs

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

espiral2 :: Arbol a -> [a]
espiral2 = 
  concat . zipWith ($) (cycle [reverse,id]) . niveles

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

espiral3 :: Arbol a -> [a]
espiral3 = concat . zipWith ($) (cycle [reverse,id]) . niveles3

niveles3 :: Arbol a -> [[a]]
niveles3 t = map (map raiz)
           . takeWhile (not . null)
           . iterate (concatMap subBosque) $ [t]

raiz :: Arbol a -> a
raiz (N x _) = x

subBosque :: Arbol a -> [Arbol a]
subBosque (N _ ts) = ts

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

espiral4 :: Arbol a -> [a]
espiral4 = concat . zipWith ($) (cycle [reverse,id]) . niveles4

niveles4 :: Arbol a -> [[a]]
niveles4 = map (map raiz)
         . takeWhile (not . null)
         . iterate (concatMap subBosque)
         . return  

-- 5ª definición
-- =============

espiral5 :: Arbol a -> [a]
espiral5 x = concat $ zipWith ($) (cycle [reverse,id]) $ niveles5 [x]

niveles5 :: [Arbol a] -> [[a]]
niveles5 [] = []
niveles5 xs = a : niveles5 (concat b)
  where (a,b) = unzip $ map (\(N x y) -> (x,y)) xs

-- 6ª definición
-- =============

espiral6 :: Arbol a -> [a]
espiral6 = concat . zipWith ($) (cycle [reverse,id]) . niveles5 . return

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 [N 6 [], N 7 []]]

ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]

ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

-- 1ª solución

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

espiral :: Arbol a -> [a]

espiral x =

concat [f xs | (f,xs) <- zip (cycle [reverse,id]) (niveles x)]

-- (niveles x) es la lista de los niveles del árbol x. Por ejemplo,

-- niveles ej1 == [[1],[8,3],[4]]

-- niveles ej2 == [[1],[8,3],[4,5,6]]

-- niveles ej3 == [[1],[8,3],[4,5,6,7]]

niveles :: Arbol a -> [[a]]

niveles x = takeWhile (not . null) [nivel n x | n <- [0..]]

-- (nivel n x) es el nivel de nivel n del árbol x. Por ejemplo,

-- nivel 0 ej1 == [1]

-- nivel 1 ej1 == [8,3]

-- nivel 2 ej1 == [4]

-- nivel 4 ej1 == []

nivel :: Int -> Arbol a -> [a]

nivel 0 (N x _) = [x]

nivel n (N _ xs) = concatMap (nivel (n-1)) xs

-- 2ª solución

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

espiral2 :: Arbol a -> [a]

espiral2 =

concat . zipWith ($) (cycle [reverse,id]) . niveles

-- 3ª solución

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

espiral3 :: Arbol a -> [a]

espiral3 = concat . zipWith ($) (cycle [reverse,id]) . niveles3

niveles3 :: Arbol a -> [[a]]

niveles3 t = map (map raiz)

. takeWhile (not . null)

. iterate (concatMap subBosque) $ [t]

raiz :: Arbol a -> a

raiz (N x _) = x

subBosque :: Arbol a -> [Arbol a]

subBosque (N _ ts) = ts

-- 4ª solución

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

espiral4 :: Arbol a -> [a]

espiral4 = concat . zipWith ($) (cycle [reverse,id]) . niveles4

niveles4 :: Arbol a -> [[a]]

niveles4 = map (map raiz)

. takeWhile (not . null)

. iterate (concatMap subBosque)

. return

-- 5ª definición

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

espiral5 :: Arbol a -> [a]

espiral5 x = concat $ zipWith ($) (cycle [reverse,id]) $ niveles5 [x]

niveles5 :: [Arbol a] -> [[a]]

niveles5 [] = []

niveles5 xs = a : niveles5 (concat b)

where (a,b) = unzip $ map (\(N x y) -> (x,y)) xs

-- 6ª definición

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

espiral6 :: Arbol a -> [a]

espiral6 = concat . zipWith ($) (cycle [reverse,id]) . niveles5 . return

Huecos binarios

PorJosé A. Alonso 7-febrero-201814-febrero-2018

Los huecos binarios de un número natural n son las listas de cer0 entre dos unos en la representación binaria de n. Por ejemplo, puesto que la representación binaria de 20 es 10100 tiene dos huecos binarios de longitudes 1 y 2. La longitud del mayor hueco binario de 529 es 4 ya que la representación binaria de 529 es 1000010001.

Definir las funciones

   longMayorHuecoBinario        :: Int -> Int
   graficaLongMayorHuecoBinario :: Int -> IO ()

1 2	longMayorHuecoBinario :: Int -> Int graficaLongMayorHuecoBinario :: Int -> IO ()

tales que

(longMayorHuecoBinario n) es la longitud del mayor hueco binario de n. Por ejemplo,

     longMayorHuecoBinario 20    ==  2
     longMayorHuecoBinario 529   ==  4
     longMayorHuecoBinario 2018  ==  3

longMayorHuecoBinario 20 == 2

longMayorHuecoBinario 529 == 4

longMayorHuecoBinario 2018 == 3

(graficaLongMayorHuecoBinario n) dibuja la gráfica de las longitudes de los mayores huecos binarios de los n primeros números naturales. Por ejemplo, (graficaLongMayorHuecoBinario 200) dibuja

Soluciones

import Data.List (group)
import Graphics.Gnuplot.Simple

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

longMayorHuecoBinario :: Int -> Int
longMayorHuecoBinario n =
  maximum (0 : map length (huecosBinarios (decimalAbinario n)))

-- (decimalAbinario x) es la representación binaria del número c. Por
-- ejemplo, 
--    decimalAbinario 20   ==  [0,0,1,0,1]
--    decimalAbinario 529  ==  [1,0,0,0,1,0,0,0,0,1] 
decimalAbinario :: Int -> [Int]
decimalAbinario x
  | x < 2     = [x]
  | otherwise = x `mod` 2 : decimalAbinario (x `div` 2)

-- (huecosBinarios xs) es la lista de los ceros consecutivos de xs entre
-- dos elementos distintos de cero. Por ejemplo,
--    huecosBinarios [0,0,1,0,1]            ==  [[0,0],[0]]
--    huecosBinarios [1,0,0,0,1,0,0,0,0,1]  ==  [[0,0,0],[0,0,0,0]]
huecosBinarios :: [Int] -> [[Int]]
huecosBinarios xs =
  [ys | ys <- group xs, 0 `elem` ys]

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

longMayorHuecoBinario2 :: Int -> Int
longMayorHuecoBinario2 =
  maximum . (0 :) . map length . huecosBinarios . decimalAbinario

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

longMayorHuecoBinario3 :: Int -> Int
longMayorHuecoBinario3 = maximum . longHuecosBinarios

-- (longHuecosBinarios n) es la lista de las longitudes de los huecos
-- binarios de n. Por ejemplo,
--    longHuecosBinarios 20  ==  [2,1,0]
--    longHuecosBinarios 529  ==  [3,4,0]
longHuecosBinarios :: Int -> [Int]
longHuecosBinarios 1 = [0]
longHuecosBinarios n | mod n 2 == 1 = longHuecosBinarios (div n 2)
                     | mod n 4 == 2 = 1 : h : t
                     | otherwise = 1 + h : t
  where (h : t) = longHuecosBinarios (div n 2)

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

--    λ> maximum [longMayorHuecoBinario x | x <- [1..100000]]
--    16
--    (5.51 secs, 941,090,272 bytes)
--    λ> maximum [longMayorHuecoBinario2 x | x <- [1..100000]]
--    16
--    (5.54 secs, 933,093,168 bytes)
--    λ> maximum [longMayorHuecoBinario3 x | x <- [1..100000]]
--    16
--    (6.00 secs, 966,584,848 bytes)

graficaLongMayorHuecoBinario :: Int -> IO ()
graficaLongMayorHuecoBinario n =
  plotList [ Key Nothing
           , Title ("graficaLongMayorHuecoBinario " ++ show n)
           , PNG ("Huecos_binarios_" ++ show n ++ ".png")
           ]
           [longMayorHuecoBinario k | k <- [0..n-1]]

import Data.List (group)

import Graphics.Gnuplot.Simple

-- 1ª solución

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

longMayorHuecoBinario :: Int -> Int

longMayorHuecoBinario n =

maximum (0 : map length (huecosBinarios (decimalAbinario n)))

-- (decimalAbinario x) es la representación binaria del número c. Por

-- ejemplo,

-- decimalAbinario 20 == [0,0,1,0,1]

-- decimalAbinario 529 == [1,0,0,0,1,0,0,0,0,1]

decimalAbinario :: Int -> [Int]

decimalAbinario x

| x < 2 = [x]

| otherwise = x `mod` 2 : decimalAbinario (x `div` 2)

-- (huecosBinarios xs) es la lista de los ceros consecutivos de xs entre

-- dos elementos distintos de cero. Por ejemplo,

-- huecosBinarios [0,0,1,0,1] == [[0,0],[0]]

-- huecosBinarios [1,0,0,0,1,0,0,0,0,1] == [[0,0,0],[0,0,0,0]]

huecosBinarios :: [Int] -> [[Int]]

huecosBinarios xs =

[ys | ys <- group xs, 0 `elem` ys]

-- 2ª solución

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

longMayorHuecoBinario2 :: Int -> Int

longMayorHuecoBinario2 =

maximum . (0 :) . map length . huecosBinarios . decimalAbinario

-- 3ª solución

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

longMayorHuecoBinario3 :: Int -> Int

longMayorHuecoBinario3 = maximum . longHuecosBinarios

-- (longHuecosBinarios n) es la lista de las longitudes de los huecos

-- binarios de n. Por ejemplo,

-- longHuecosBinarios 20 == [2,1,0]

-- longHuecosBinarios 529 == [3,4,0]

longHuecosBinarios :: Int -> [Int]

longHuecosBinarios 1 = [0]

longHuecosBinarios n | mod n 2 == 1 = longHuecosBinarios (div n 2)

| mod n 4 == 2 = 1 : h : t

| otherwise = 1 + h : t

where (h : t) = longHuecosBinarios (div n 2)

-- Comparación de eficiencia

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

-- λ> maximum [longMayorHuecoBinario x | x <- [1..100000]]

-- 16

-- (5.51 secs, 941,090,272 bytes)

-- λ> maximum [longMayorHuecoBinario2 x | x <- [1..100000]]

-- 16

-- (5.54 secs, 933,093,168 bytes)

-- λ> maximum [longMayorHuecoBinario3 x | x <- [1..100000]]

-- 16

-- (6.00 secs, 966,584,848 bytes)

graficaLongMayorHuecoBinario :: Int -> IO ()

graficaLongMayorHuecoBinario n =

plotList [ Key Nothing

, Title ("graficaLongMayorHuecoBinario " ++ show n)

, PNG ("Huecos_binarios_" ++ show n ++ ".png")

]

[longMayorHuecoBinario k | k <- [0..n-1]]

División equitativa

PorJosé A. Alonso 6-febrero-201826-marzo-2022

Definir la función

   divisionEquitativa :: [Int] -> Maybe ([Int],[Int])

1	divisionEquitativa :: [Int] -> Maybe ([Int],[Int])

tal que (divisionEquitativa xs) determina si la lista de números enteros positivos xs se puede dividir en dos partes (sin reordenar sus elementos) con la misma suma. Si es posible, su valor es el par formado por las dos partes. Si no lo es, su valor es Nothing. Por ejemplo,

   divisionEquitativa [1,2,3,4,5,15]  ==  Just ([1,2,3,4,5],[15])
   divisionEquitativa [15,1,2,3,4,5]  ==  Just ([15],[1,2,3,4,5])
   divisionEquitativa [1,2,3,4,7,15]  ==  Nothing
   divisionEquitativa [1,2,3,4,15,5]  ==  Nothing

divisionEquitativa [1,2,3,4,5,15] == Just ([1,2,3,4,5],[15])

divisionEquitativa [15,1,2,3,4,5] == Just ([15],[1,2,3,4,5])

divisionEquitativa [1,2,3,4,7,15] == Nothing

divisionEquitativa [1,2,3,4,15,5] == Nothing

Soluciones

import Data.Maybe (isNothing, fromJust, listToMaybe)
import Data.List  (elemIndex, inits, tails)

-- 1ª solución
divisionEquitativa1 :: [Int] -> Maybe ([Int],[Int])
divisionEquitativa1 xs = aux (particiones xs)
 where aux []                              = Nothing
       aux ((as,bs):ys) | sum as == sum bs = Just (as,bs)
                        | otherwise        = aux ys                   
       particiones xs = [splitAt i xs | i <- [1..length xs-1]]

-- 2ª solución
divisionEquitativa2 :: [Int] -> Maybe ([Int],[Int])
divisionEquitativa2 xs
  | 2 * b == suma = Just $ splitAt (length as + 1) xs
  | otherwise     = Nothing
  where suma        = sum xs
        (as,(b:bs)) = span (<suma `div` 2) $ scanl1 (+) xs

-- 3ª solución
divisionEquitativa3 :: [Int] -> Maybe ([Int],[Int])
divisionEquitativa3 xs
  | odd n       = Nothing
  | isNothing p = Nothing
  | otherwise   = Just (splitAt (1 + fromJust p) xs)
  where n  = sum xs
        ys = scanl1 (+) xs
        p  = elemIndex (n `div` 2) ys

-- 4ª solución
divisionEquitativa4 :: [Int] -> Maybe ([Int],[Int])
divisionEquitativa4 xs
  | odd (sum xs) = Nothing
  | otherwise    = aux [] xs
  where aux as bs@(b:bs') | sum as == sum bs = Just (reverse as, bs)
                          | sum as > sum bs  = Nothing
                          | otherwise        = aux (b:as) (bs')

-- 5ª solución
divisionEquitativa5 :: [Int] -> Maybe ([Int],[Int])
divisionEquitativa5 xs =
  listToMaybe
    [(ys, zs) | (ys,zs) <- zip (inits xs) (tails xs)
              , sum ys == sum zs ]

import Data.Maybe (isNothing, fromJust, listToMaybe)

import Data.List (elemIndex, inits, tails)

-- 1ª solución

divisionEquitativa1 :: [Int] -> Maybe ([Int],[Int])

divisionEquitativa1 xs = aux (particiones xs)

where aux [] = Nothing

aux ((as,bs):ys) | sum as == sum bs = Just (as,bs)

| otherwise = aux ys

particiones xs = [splitAt i xs | i <- [1..length xs-1]]

-- 2ª solución

divisionEquitativa2 :: [Int] -> Maybe ([Int],[Int])

divisionEquitativa2 xs

| 2 * b == suma = Just $ splitAt (length as + 1) xs

| otherwise = Nothing

where suma = sum xs

(as,(b:bs)) = span (<suma `div` 2) $ scanl1 (+) xs

-- 3ª solución

divisionEquitativa3 :: [Int] -> Maybe ([Int],[Int])

divisionEquitativa3 xs

| odd n = Nothing

| isNothing p = Nothing

| otherwise = Just (splitAt (1 + fromJust p) xs)

where n = sum xs

ys = scanl1 (+) xs

p = elemIndex (n `div` 2) ys

-- 4ª solución

divisionEquitativa4 :: [Int] -> Maybe ([Int],[Int])

divisionEquitativa4 xs

| odd (sum xs) = Nothing

| otherwise = aux [] xs

where aux as bs@(b:bs') | sum as == sum bs = Just (reverse as, bs)

| sum as > sum bs = Nothing

| otherwise = aux (b:as) (bs')

-- 5ª solución

divisionEquitativa5 :: [Int] -> Maybe ([Int],[Int])

divisionEquitativa5 xs =

listToMaybe

[(ys, zs) | (ys,zs) <- zip (inits xs) (tails xs)

, sum ys == sum zs ]

Celdas interiores de una retícula

PorJosé A. Alonso 5-febrero-201812-febrero-2018

Las celdas de una retícula cuadrada se numeran consecutivamente. Por ejemplo, la numeración de la retícula cuadrada de lado 4 es

   1, 2, 3, 4
   5, 6, 7, 8
   9,10,11,12
  13,14,15,16

1, 2, 3, 4

5, 6, 7, 8

9,10,11,12

13,14,15,16

Los números de sus celdas interiores son 6,7,10,11.

Definir la función

   interiores :: Int -> [Int]

1	interiores :: Int -> [Int]

tal que (interiores n) es la lista de los números de las celdas interiores de la retícula cuadrada de lado n. Por ejemplo,

   interiores 4  == [6,7,10,11]
   interiores 5  == [7,8,9,12,13,14,17,18,19]
   interiores 6  == [8,9,10,11,14,15,16,17,20,21,22,23,26,27,28,29]
   interiores 2  == []
   length (interiores 2018)  == 4064256

interiores 4 == [6,7,10,11]

interiores 5 == [7,8,9,12,13,14,17,18,19]

interiores 6 == [8,9,10,11,14,15,16,17,20,21,22,23,26,27,28,29]

interiores 2 == []

length (interiores 2018) == 4064256

Comprobar con QuickCheck que el número de celdas interiores de la retícula cuadrada de lado n, con n > 1, es (n-2)^2.

Soluciones

import Test.QuickCheck
import Data.List.Split (divvy)

-- 1ª solución
interiores :: Int -> [Int]
interiores n = [i | i <- [n..n*n-n], i `mod` n > 1]

-- 2ª solución
interiores2 :: Int -> [Int]
interiores2 n = aux [n+1..n^2-n]
  where aux xss@(x:xs) = take (n-2) xs ++ aux (drop n xss)
        aux []         = []

-- 3ª solución 
interiores3 :: Int -> [Int]
interiores3 n = concat (divvy (n-2) n [n+2..n*(n-1)-1])

-- 4ª solución
interiores4 :: Int -> [Int]
interiores4 n = concat [map (+(n*k)) [2..n-1] | k <- [1..n-2]]

-- 5ª solución
interiores5 :: Int -> [Int]
interiores5 n = concat (take (n-2) (iterate (map (+n)) [n+2..2*n-1]))

-- La propiedad es
prop_interiores :: Int -> Property
prop_interiores n =
  n > 1 ==> length (interiores n) == (n-2)^2

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

import Test.QuickCheck

import Data.List.Split (divvy)

-- 1ª solución

interiores :: Int -> [Int]

interiores n = [i | i <- [n..n*n-n], i `mod` n > 1]

-- 2ª solución

interiores2 :: Int -> [Int]

interiores2 n = aux [n+1..n^2-n]

where aux xss@(x:xs) = take (n-2) xs ++ aux (drop n xss)

aux [] = []

-- 3ª solución

interiores3 :: Int -> [Int]

interiores3 n = concat (divvy (n-2) n [n+2..n*(n-1)-1])

-- 4ª solución

interiores4 :: Int -> [Int]

interiores4 n = concat [map (+(n*k)) [2..n-1] | k <- [1..n-2]]

-- 5ª solución

interiores5 :: Int -> [Int]

interiores5 n = concat (take (n-2) (iterate (map (+n)) [n+2..2*n-1]))

-- La propiedad es

prop_interiores :: Int -> Property

prop_interiores n =

n > 1 ==> length (interiores n) == (n-2)^2

-- La comprobación es

-- λ> quickCheck prop_interiores

-- +++ OK, passed 100 tests.

Dígitos iniciales

PorJosé A. Alonso 2-febrero-201819-febrero-2018

Definir las funciones

   digitosIniciales        :: [Int]
   graficaDigitosIniciales :: Int -> IO ()

1 2	digitosIniciales :: [Int] graficaDigitosIniciales :: Int -> IO ()

tales que

digitosIniciales es la lista de los dígitos iniciales de los números naturales. Por ejemplo,

     λ> take 100 digitosIniciales
     [0,1,2,3,4,5,6,7,8,9,1,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,
      3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,
      6,6,6,6,6,6,6,6,6,6,7,7,7,7,7,7,7,7,7,7,8,8,8,8,8,8,8,8,8,8,
      9,9,9,9,9,9,9,9,9,9]

λ> take 100 digitosIniciales

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

3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,

6,6,6,6,6,6,6,6,6,6,7,7,7,7,7,7,7,7,7,7,8,8,8,8,8,8,8,8,8,8,

9,9,9,9,9,9,9,9,9,9]

(graficaDigitosIniciales n) dibuja la gráfica de los primeros n términos de la sucesión digitosIniciales. Por ejemplo, (graficaDigitosIniciales 100) dibuja

y (graficaDigitosIniciales 1000) dibuja

Soluciones

import Graphics.Gnuplot.Simple

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

digitosIniciales :: [Int]
digitosIniciales = map digitoInicial [0..]

digitoInicial :: Integer -> Int
digitoInicial n = read [head (show n)]

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

digitosIniciales2 :: [Int]
digitosIniciales2 = map (read . return . head . show) [0..]

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

digitosIniciales3 :: [Int]
digitosIniciales3 = map digitoInicial3 [0..]

digitoInicial3 :: Integer -> Int
digitoInicial3 = fromInteger . until (< 10) (`div` 10)

-- 4ª definición
-- =============

digitosIniciales4 :: [Int]
digitosIniciales4 = map (fromInteger . until (< 10) (`div` 10)) [0..]

-- 5ª definición
-- =============

digitosIniciales5 :: [Int]
digitosIniciales5 =
  0 : concat [replicate k x | k <- [10^n | n <- [0..]]
                            , x <- [1..9]]

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

--    λ> digitosIniciales !! (2*10^6)
--    2
--    (0.46 secs, 320,145,984 bytes)
--    λ> digitosIniciales2 !! (2*10^6)
--    2
--    (0.46 secs, 320,143,288 bytes)
--    λ> digitosIniciales3 !! (2*10^6)
--    2
--    (0.17 secs, 320,139,216 bytes)
--    λ> digitosIniciales4 !! (2*10^6)
--    2
--    (0.55 secs, 320,139,248 bytes)
--    λ> digitosIniciales5 !! (2*10^6)
--    2
--    (0.12 secs, 224,158,992 bytes)

graficaDigitosIniciales :: Int -> IO ()
graficaDigitosIniciales n =
  plotList [ Key Nothing
           , Title ("graficaDigitosIniciales " ++ show n)
           , PNG ("Digitos_iniciales_" ++ show n ++ ".png" )
           ]
           (take n digitosIniciales)

import Graphics.Gnuplot.Simple

-- 1ª definición

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

digitosIniciales :: [Int]

digitosIniciales = map digitoInicial [0..]

digitoInicial :: Integer -> Int

digitoInicial n = read [head (show n)]

-- 2ª definición

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

digitosIniciales2 :: [Int]

digitosIniciales2 = map (read . return . head . show) [0..]

-- 3ª definición

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

digitosIniciales3 :: [Int]

digitosIniciales3 = map digitoInicial3 [0..]

digitoInicial3 :: Integer -> Int

digitoInicial3 = fromInteger . until (< 10) (`div` 10)

-- 4ª definición

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

digitosIniciales4 :: [Int]

digitosIniciales4 = map (fromInteger . until (< 10) (`div` 10)) [0..]

-- 5ª definición

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

digitosIniciales5 :: [Int]

digitosIniciales5 =

0 : concat [replicate k x | k <- [10^n | n <- [0..]]

, x <- [1..9]]

-- Comparación de eficiencia

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

-- λ> digitosIniciales !! (2*10^6)

-- 2

-- (0.46 secs, 320,145,984 bytes)

-- λ> digitosIniciales2 !! (2*10^6)

-- 2

-- (0.46 secs, 320,143,288 bytes)

-- λ> digitosIniciales3 !! (2*10^6)

-- 2

-- (0.17 secs, 320,139,216 bytes)

-- λ> digitosIniciales4 !! (2*10^6)

-- 2

-- (0.55 secs, 320,139,248 bytes)

-- λ> digitosIniciales5 !! (2*10^6)

-- 2

-- (0.12 secs, 224,158,992 bytes)

graficaDigitosIniciales :: Int -> IO ()

graficaDigitosIniciales n =

plotList [ Key Nothing

, Title ("graficaDigitosIniciales " ++ show n)

, PNG ("Digitos_iniciales_" ++ show n ++ ".png" )

]

(take n digitosIniciales)

Exponentes de Hamming

PorJosé A. Alonso 1-febrero-20188-febrero-2018

Los números de Hamming forman una sucesión estrictamente creciente de números que cumplen las siguientes condiciones:

El número 1 está en la sucesión.
Si x está en la sucesión, entonces 2x, 3x y 5x también están.
Ningún otro número está en la sucesión.

Los primeros números de Hamming son 1, 2, 3, 4, 5, 6, 8, 9, 10, 12, 15, 16, …

Los exponentes de un número de Hamming n es una terna (x,y,z) tal que n = 2^x*3^y*5^z. Por ejemplo, los exponentes de 600 son (3,1,2) ya que 600 = 2^x*3^1*5^z.

Definir la sucesión

   sucExponentesHamming :: [(Int,Int,Int)]

1	sucExponentesHamming :: [(Int,Int,Int)]

cuyos elementos son los exponentes de los números de Hamming. Por ejemplo,

   λ> take 21 sucExponentesHamming
   [(0,0,0),(1,0,0),(0,1,0),(2,0,0),(0,0,1),(1,1,0),(3,0,0),
    (0,2,0),(1,0,1),(2,1,0),(0,1,1),(4,0,0),(1,2,0),(2,0,1),
    (3,1,0),(0,0,2),(0,3,0),(1,1,1),(5,0,0),(2,2,0),(3,0,1)]
   λ> sucExponentesHamming !! (5*10^5)
   (74,82,7)

λ> take 21 sucExponentesHamming

[(0,0,0),(1,0,0),(0,1,0),(2,0,0),(0,0,1),(1,1,0),(3,0,0),

(0,2,0),(1,0,1),(2,1,0),(0,1,1),(4,0,0),(1,2,0),(2,0,1),

(3,1,0),(0,0,2),(0,3,0),(1,1,1),(5,0,0),(2,2,0),(3,0,1)]

λ> sucExponentesHamming !! (5*10^5)

(74,82,7)

Soluciones

import Data.Numbers.Primes (primeFactors)

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

sucExponentesHamming :: [(Int,Int,Int)]
sucExponentesHamming = map exponentes hamming

-- (exponentes n) es la terna de exponentes del número de Hamming n. Por
-- ejemplo, 
--    exponentes 600  ==  (3,1,2)
exponentes :: Integer -> (Int,Int,Int)
exponentes x = (length as, length cs, length ds)
  where xs = primeFactors x
        (as,bs) = span (==2) xs
        (cs,ds) = span (==3) bs

-- hamming es la sucesión de los números de Hamming. Por ejemplo,
--    λ> take 21 hamming
--    [1,2,3,4,5,6,8,9,10,12,15,16,18,20,24,25,27,30,32,36,40]
hamming :: [Integer]
hamming = 1 : mezcla3 [2*i | i <- hamming]  
                      [3*i | i <- hamming]  
                      [5*i | i <- hamming]  

-- mezcla3 xs ys zs es la lista obtenida mezclando las listas ordenadas
-- xs, ys y zs y eliminando los elementos duplicados. Por ejemplo, 
--    mezcla3 [2,4,6,8,10] [3,6,9,12] [5,10]  ==  [2,3,4,5,6,8,9,10,12]
mezcla3 :: Ord a => [a] -> [a] -> [a] -> [a]
mezcla3 xs ys zs = mezcla2 xs (mezcla2 ys zs)  

-- mezcla2 xs ys zs es la lista obtenida mezclando las listas ordenadas
-- xs e ys y eliminando los elementos duplicados. Por ejemplo, 
--    mezcla2 [2,4,6,8,10,12] [3,6,9,12]  ==  [2,3,4,6,8,9,10,12]
mezcla2 :: Ord a => [a] -> [a] -> [a] 
mezcla2 p@(x:xs) q@(y:ys) | x < y     = x:mezcla2 xs q
                          | x > y     = y:mezcla2 p  ys  
                          | otherwise = x:mezcla2 xs ys
mezcla2 []       ys                   = ys
mezcla2 xs       []                   = xs

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

sucExponentesHamming2 :: [(Int,Int,Int)]
sucExponentesHamming2 = map exponentes2 hamming

exponentes2 :: Integer -> (Int,Int,Int)
exponentes2 = aux (0,0,0)
  where aux (a,b,c) 1 = (a,b,c)
        aux (a,b,c) x | mod x 2 == 0 = aux (a+1,b,c) (div x 2)
                      | mod x 3 == 0 = aux (a,b+1,c) (div x 3)
                      | otherwise    = aux (a,b,c+1) (div x 5)

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

sucExponentesHamming3 :: [(Int,Int,Int)]
sucExponentesHamming3 = map exponentes3 hamming

exponentes3 :: Integer -> (Int,Int,Int)
exponentes3 1 = (0,0,0)
exponentes3 x
  | x `mod` 2 == 0 = suma (1,0,0) (descomposicion (x `div` 2))
  | x `mod` 3 == 0 = suma (0,1,0) (descomposicion (x `div` 3))
  | otherwise      = suma (0,0,1) (descomposicion (x `div` 5))
  where suma (x,y,z) (a,b,c) = (x+a,y+b,z+c)

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

type Terna = (Int,Int,Int)

sucExponentesHamming4 :: [Terna]
sucExponentesHamming4 =
  (0,0,0) : mezclaT3 [(x+1,y,z) | (x,y,z) <- sucExponentesHamming4]
                     [(x,y+1,z) | (x,y,z) <- sucExponentesHamming4]
                     [(x,y,z+1) | (x,y,z) <- sucExponentesHamming4]
 
mezclaT3 :: [Terna] -> [Terna] -> [Terna] -> [Terna]
mezclaT3 t1 t2 t3 = mezclaT2 t1 (mezclaT2 t2 t3)

mezclaT2 :: [Terna] -> [Terna] -> [Terna]
mezclaT2 ts1@((i,j,k):xs) ts2@((a,b,c):ys)
  | x < y     = (i,j,k) : mezclaT2 xs ts2
  | x > y     = (a,b,c) : mezclaT2 ts1 ys
  | otherwise = (i,j,k) : mezclaT2 xs ys
  where x = 2^i*3^j*5^k
        y = 2^a*3^b*5^c

import Data.Numbers.Primes (primeFactors)

-- 1ª solución

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

sucExponentesHamming :: [(Int,Int,Int)]

sucExponentesHamming = map exponentes hamming

-- (exponentes n) es la terna de exponentes del número de Hamming n. Por

-- ejemplo,

-- exponentes 600 == (3,1,2)

exponentes :: Integer -> (Int,Int,Int)

exponentes x = (length as, length cs, length ds)

where xs = primeFactors x

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

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

-- hamming es la sucesión de los números de Hamming. Por ejemplo,

-- λ> take 21 hamming

-- [1,2,3,4,5,6,8,9,10,12,15,16,18,20,24,25,27,30,32,36,40]

hamming :: [Integer]

hamming = 1 : mezcla3 [2*i | i <- hamming]

[3*i | i <- hamming]

[5*i | i <- hamming]

-- mezcla3 xs ys zs es la lista obtenida mezclando las listas ordenadas

-- xs, ys y zs y eliminando los elementos duplicados. Por ejemplo,

-- mezcla3 [2,4,6,8,10] [3,6,9,12] [5,10] == [2,3,4,5,6,8,9,10,12]

mezcla3 :: Ord a => [a] -> [a] -> [a] -> [a]

mezcla3 xs ys zs = mezcla2 xs (mezcla2 ys zs)

-- mezcla2 xs ys zs es la lista obtenida mezclando las listas ordenadas

-- xs e ys y eliminando los elementos duplicados. Por ejemplo,

-- mezcla2 [2,4,6,8,10,12] [3,6,9,12] == [2,3,4,6,8,9,10,12]

mezcla2 :: Ord a => [a] -> [a] -> [a]

mezcla2 p@(x:xs) q@(y:ys) | x < y = x:mezcla2 xs q

| x > y = y:mezcla2 p ys

| otherwise = x:mezcla2 xs ys

mezcla2 [] ys = ys

mezcla2 xs [] = xs

-- 2ª solución

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

sucExponentesHamming2 :: [(Int,Int,Int)]

sucExponentesHamming2 = map exponentes2 hamming

exponentes2 :: Integer -> (Int,Int,Int)

exponentes2 = aux (0,0,0)

where aux (a,b,c) 1 = (a,b,c)

aux (a,b,c) x | mod x 2 == 0 = aux (a+1,b,c) (div x 2)

| mod x 3 == 0 = aux (a,b+1,c) (div x 3)

| otherwise = aux (a,b,c+1) (div x 5)

-- 3ª solución

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

sucExponentesHamming3 :: [(Int,Int,Int)]

sucExponentesHamming3 = map exponentes3 hamming

exponentes3 :: Integer -> (Int,Int,Int)

exponentes3 1 = (0,0,0)

exponentes3 x

| x `mod` 2 == 0 = suma (1,0,0) (descomposicion (x `div` 2))

| x `mod` 3 == 0 = suma (0,1,0) (descomposicion (x `div` 3))

| otherwise = suma (0,0,1) (descomposicion (x `div` 5))

where suma (x,y,z) (a,b,c) = (x+a,y+b,z+c)

-- 4ª solución

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

type Terna = (Int,Int,Int)

sucExponentesHamming4 :: [Terna]

sucExponentesHamming4 =

(0,0,0) : mezclaT3 [(x+1,y,z) | (x,y,z) <- sucExponentesHamming4]

[(x,y+1,z) | (x,y,z) <- sucExponentesHamming4]

[(x,y,z+1) | (x,y,z) <- sucExponentesHamming4]

mezclaT3 :: [Terna] -> [Terna] -> [Terna] -> [Terna]

mezclaT3 t1 t2 t3 = mezclaT2 t1 (mezclaT2 t2 t3)

mezclaT2 :: [Terna] -> [Terna] -> [Terna]

mezclaT2 ts1@((i,j,k):xs) ts2@((a,b,c):ys)

| x < y = (i,j,k) : mezclaT2 xs ts2

| x > y = (a,b,c) : mezclaT2 ts1 ys

| otherwise = (i,j,k) : mezclaT2 xs ys

where x = 2^i*3^j*5^k

y = 2^a*3^b*5^c

Recorrido del robot

PorJosé A. Alonso 31-enero-20187-febrero-2018

Los puntos de una retícula se representan mediante pares de enteros

   type Punto = (Int,Int)

1	type Punto = (Int,Int)

y los movimientos de un robot mediante el tipo

   data Movimiento = N Int
                   | S Int
                   | E Int
                   | O Int

data Movimiento = N Int

| S Int

| E Int

| O Int

donde (N x) significa que se mueve x unidades en la dirección norte y análogamente para las restantes direcciones (S es sur, E es este y O es oeste).

Definir la función

   posicion :: [Movimiento] -> Punto

1	posicion :: [Movimiento] -> Punto

tal que (posicion ms) es la posición final de un robot que inicialmente está en el el punto (0,0) y realiza los movimientos ms. Por ejemplo,

   posicion [N 3]                           ==  (0,3)
   posicion [N 3, E 5]                      ==  (5,3)
   posicion [N 3, E 5, S 1]                 ==  (5,2)
   posicion [N 3, E 5, S 1, O 4]            ==  (1,2)
   posicion [N 3, E 5, S 1, O 4, N 3]       ==  (1,5)
   posicion [N 3, E 5, S 1, O 4, N 3, S 3]  ==  (1,2)

posicion [N 3] == (0,3)

posicion [N 3, E 5] == (5,3)

posicion [N 3, E 5, S 1] == (5,2)

posicion [N 3, E 5, S 1, O 4] == (1,2)

posicion [N 3, E 5, S 1, O 4, N 3] == (1,5)

posicion [N 3, E 5, S 1, O 4, N 3, S 3] == (1,2)

Soluciones

type Punto = (Int,Int)

data Movimiento = N Int
                | S Int
                | E Int
                | O Int

-- 1ª solución                
posicion :: [Movimiento] -> Punto
posicion ms = aux ms (0,0)
  where aux [] p = p
        aux (N x:ms) (a,b) = aux ms (a,b+x)
        aux (S x:ms) (a,b) = aux ms (a,b-x)
        aux (E x:ms) (a,b) = aux ms (a+x,b)
        aux (O x:ms) (a,b) = aux ms (a-x,b)

-- 2ª solución
posicion2 :: [Movimiento] -> Punto
posicion2 []       = (0,0)
posicion2 (N x:ms) = suma (0 ,x)  (posicion2 ms)
posicion2 (S x:ms) = suma (0 ,-x) (posicion2 ms)
posicion2 (E x:ms) = suma (x ,0)  (posicion2 ms)
posicion2 (O x:ms) = suma (-x,0)  (posicion2 ms)

suma :: Punto -> Punto -> Punto
suma (x,y) (a,b) = (x+a,y+b)

-- 3ª solución
posicion3 :: [Movimiento] -> Punto
posicion3 []     = (0,0)
posicion3 (m:ms) = case m of
                     N x -> (a,b+x)
                     S x -> (a,b-x)
                     E x -> (a+x,b)
                     O x -> (a-x,b)
  where (a,b) = posicion3 ms

-- 4ª solución
posicion4 :: [Movimiento] -> Punto
posicion4 = foldl aux (0,0)
  where
    aux (x,y) (N j) = (x,y+j)
    aux (x,y) (S j) = (x,y-j)
    aux (x,y) (E i) = (x+i,y)
    aux (x,y) (O i) = (x-i,y)

--- 5ª solución
posicion5 :: [Movimiento] -> Punto
posicion5 xs = (sum hs, sum vs)
  where
    (hs,vs)   = unzip (map aux xs)
    aux (N j) = (0,j)
    aux (S j) = (0,-j)
    aux (E i) = (i,0)
    aux (O i) = (-i,0)

type Punto = (Int,Int)

data Movimiento = N Int

| S Int

| E Int

| O Int

-- 1ª solución

posicion :: [Movimiento] -> Punto

posicion ms = aux ms (0,0)

where aux [] p = p

aux (N x:ms) (a,b) = aux ms (a,b+x)

aux (S x:ms) (a,b) = aux ms (a,b-x)

aux (E x:ms) (a,b) = aux ms (a+x,b)

aux (O x:ms) (a,b) = aux ms (a-x,b)

-- 2ª solución

posicion2 :: [Movimiento] -> Punto

posicion2 [] = (0,0)

posicion2 (N x:ms) = suma (0 ,x) (posicion2 ms)

posicion2 (S x:ms) = suma (0 ,-x) (posicion2 ms)

posicion2 (E x:ms) = suma (x ,0) (posicion2 ms)

posicion2 (O x:ms) = suma (-x,0) (posicion2 ms)

suma :: Punto -> Punto -> Punto

suma (x,y) (a,b) = (x+a,y+b)

-- 3ª solución

posicion3 :: [Movimiento] -> Punto

posicion3 [] = (0,0)

posicion3 (m:ms) = case m of

N x -> (a,b+x)

S x -> (a,b-x)

E x -> (a+x,b)

O x -> (a-x,b)

where (a,b) = posicion3 ms

-- 4ª solución

posicion4 :: [Movimiento] -> Punto

posicion4 = foldl aux (0,0)

where

aux (x,y) (N j) = (x,y+j)

aux (x,y) (S j) = (x,y-j)

aux (x,y) (E i) = (x+i,y)

aux (x,y) (O i) = (x-i,y)

--- 5ª solución

posicion5 :: [Movimiento] -> Punto

posicion5 xs = (sum hs, sum vs)

where

(hs,vs) = unzip (map aux xs)

aux (N j) = (0,j)

aux (S j) = (0,-j)

aux (E i) = (i,0)

aux (O i) = (-i,0)

Relaciones arbóreas

PorJosé A. Alonso 30-enero-20186-febrero-2018

Como se explica en el ejercicio Relación definida por un árbol, cada árbol binario define una relación binaria donde un elemento x está relacionado con y si x es el padre de y.

Una relación binaria es arbórea si

hay exactamente un elemento que no tiene ningún (la raíz del árbol) y
todos los elementos tienen dos hijos (los nodos internos) o ninguno (las hojas del árbol).

Definir la función

   arborea :: Eq a => [(a,a)] -> Bool

1	arborea :: Eq a => [(a,a)] -> Bool

tal que (arborea r) se verifica si la relación r es arbórea. Por ejemplo,

   arborea [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)]  ==  True
   arborea [(8,3),(8,5),(10,2),(2,2),(2,0)]         ==  False
   arborea [(10,8),(8,3),(8,5),(10,2),(8,2),(2,0)]  ==  False

arborea [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)] == True

arborea [(8,3),(8,5),(10,2),(2,2),(2,0)] == False

arborea [(10,8),(8,3),(8,5),(10,2),(8,2),(2,0)] == False

Soluciones

import Data.List ((\\), elemIndices, isPrefixOf, nub, sort)

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

arborea :: Eq a => [(a,a)] -> Bool
arborea r =
  length [x | x <- nodos r, null (padres r x)] == 1 &&
  all (`elem` [0,2]) [length (hijos r x) | x <- nodos r]

-- (nodos r) es el conjunto de los nodos de la relación r. Por ejemplo,   
--    λ> nodos [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)]
--    [10,8,3,5,2,0]
nodos :: Eq a => [(a,a)] -> [a]
nodos r = nub (concat [[x,y] | (x,y) <- r])

-- (padres r x) es la lista de los padres de x en la relación r. Por
-- ejemplo, 
--    padres [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)] 8   ==  [10]
--    padres [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)] 10  ==  []
padres :: Eq a => [(a,a)] -> a -> [a]
padres r x = [y | (y,x') <- r, x' == x]

-- (hijos r x) es la lista de los hijos de x en la relación r. Por
-- ejemplo, 
--    hijos [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)] 10  ==  [8,2]
--    hijos [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)] 5   ==  []
hijos :: Eq a => [(a,a)] -> a -> [a]
hijos r x = [y | (x',y) <- r, x' == x]

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

arborea2 :: Eq a => [(a,a)] -> Bool
arborea2 xs =  length (nub padres \\ nub hijos) == 1
            && and [cuenta x padres == 2 | x <- nub padres]
  where
    (padres, hijos) = unzip xs

-- (cuenta x ys) es el número de ocurrencias de x en ys. Por ejemplo,
--    cuenta 7 [7,2,7,7,5]  ==  3
cuenta :: Eq a => a -> [a] -> Int
cuenta i = length . elemIndices i

import Data.List ((\\), elemIndices, isPrefixOf, nub, sort)

-- 1ª solución

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

arborea :: Eq a => [(a,a)] -> Bool

arborea r =

length [x | x <- nodos r, null (padres r x)] == 1 &&

all (`elem` [0,2]) [length (hijos r x) | x <- nodos r]

-- (nodos r) es el conjunto de los nodos de la relación r. Por ejemplo,

-- λ> nodos [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)]

-- [10,8,3,5,2,0]

nodos :: Eq a => [(a,a)] -> [a]

nodos r = nub (concat [[x,y] | (x,y) <- r])

-- (padres r x) es la lista de los padres de x en la relación r. Por

-- ejemplo,

-- padres [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)] 8 == [10]

-- padres [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)] 10 == []

padres :: Eq a => [(a,a)] -> a -> [a]

padres r x = [y | (y,x') <- r, x' == x]

-- (hijos r x) es la lista de los hijos de x en la relación r. Por

-- ejemplo,

-- hijos [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)] 10 == [8,2]

-- hijos [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)] 5 == []

hijos :: Eq a => [(a,a)] -> a -> [a]

hijos r x = [y | (x',y) <- r, x' == x]

-- 2ª solución

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

arborea2 :: Eq a => [(a,a)] -> Bool

arborea2 xs = length (nub padres \\ nub hijos) == 1

&& and [cuenta x padres == 2 | x <- nub padres]

where

(padres, hijos) = unzip xs

-- (cuenta x ys) es el número de ocurrencias de x en ys. Por ejemplo,

-- cuenta 7 [7,2,7,7,5] == 3

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

cuenta i = length . elemIndices i

Sucesión de Lichtenberg

PorJosé A. Alonso 25-enero-20181-febrero-2018

La sucesión de Lichtenberg esta formada por la representación decimal de los números binarios de la sucesión de dígitos 0 y 1 alternados Los primeros términos de ambas sucesiones son

   Alternada ..... Lichtenberg
   0 ....................... 0
   1 ....................... 1
   10 ...................... 2
   101 ..................... 5
   1010 ................... 10
   10101 .................. 21
   101010 ................. 42
   1010101 ................ 85
   10101010 .............. 170
   101010101 ............. 341
   1010101010 ............ 682
   10101010101 .......... 1365
   101010101010 ......... 2730

Alternada ..... Lichtenberg

0 ....................... 0

1 ....................... 1

10 ...................... 2

101 ..................... 5

1010 ................... 10

10101 .................. 21

101010 ................. 42

1010101 ................ 85

10101010 .............. 170

101010101 ............. 341

1010101010 ............ 682

10101010101 .......... 1365

101010101010 ......... 2730

Definir las funciones

   lichtenberg        :: [Integer]
   graficaLichtenberg :: Int -> IO ()

1 2	lichtenberg :: [Integer] graficaLichtenberg :: Int -> IO ()

tales que

lichtenberg es la lista cuyos elementos son los términos de la sucesión de Lichtenberg. Por ejemplo,

     λ> take 17 lichtenberg
     [0,1,2,5,10,21,42,85,170,341,682,1365,2730,5461,10922,21845,43690]

1 2	λ> take 17 lichtenberg [0,1,2,5,10,21,42,85,170,341,682,1365,2730,5461,10922,21845,43690]

(graficaLichtenberg n) dibuja la gráfica del número de dígitos de los n primeros términos de la sucesión de Lichtenberg. Por ejemlo, (graficaLichtenberg 100) dibuja

Comprobar con QuickCheck que todos los términos de la sucesión de Lichtenberg, a partir del 4º, son números compuestos.

Soluciones

import Data.Char (digitToInt)
import Graphics.Gnuplot.Simple
import Test.QuickCheck
import Data.Numbers.Primes (isPrime)

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

lichtenberg1 :: [Integer]
lichtenberg1 = map binarioAdecimal sucAlternada

-- sucAlternada es la lista cuyos elementos son los términos de la
-- sucesión de los dígitos 0 y 1 alternados. Por ejemplo,
--    λ> take 7 sucAlternada
--    ["0","1","10","101","1010","10101","101010"]
sucAlternada :: [String]
sucAlternada =
  ['0'] : [take n cadenaAlternada | n <- [1..]]

-- cadenaAltenada es la cadena formada alternando los caracteres 1 y
-- 0. Por ejemplo,
--    take 20 cadenaAlternada  ==  "10101010101010101010"
cadenaAlternada :: String
cadenaAlternada = cycle ['1','0']

-- (binarioAdecimal cs) es el número decimal correspondiente al número
-- binario cuya cadena de dígitos es cs. Por ejemplo,
--    binarioAdecimal "11101"  ==  29
binarioAdecimal :: String -> Integer
binarioAdecimal =
  foldl (\acc x -> acc * 2 + (toInteger . digitToInt) x) 0
  
-- 2ª solución
lichtenberg2 :: [Integer]
lichtenberg2 = map a [0..]
  where a 0 = 0
        a 1 = 1
        a n = a (n-1) + 2 * a (n-2) + 1

-- 3ª solución
lichtenberg3 :: [Integer]
lichtenberg3 =
  0 : 1 : map (+1) (zipWith (+) (tail lichtenberg3) (map (*2) lichtenberg3)) 

-- Comprobación de eficiencia
--    λ> length (show (lichtenberg1 !! 27))
--    8
--    (0.02 secs, 155,384 bytes)
--    λ> length (show (lichtenberg2 !! 27))
--    8
--    (2.22 secs, 311,157,760 bytes)
--    
--    λ> length (show (lichtenberg1 !! (8*10^4)))
--    24083
--    (1.28 secs, 664,207,040 bytes)
--    λ> length (show (lichtenberg3 !! (8*10^4)))
--    24083
--    (2.59 secs, 1,253,328,200 bytes)

-- La propiedad es
propLichtenberg :: Int -> Property
propLichtenberg n =
  n > 4 ==> not (isPrime (lichtenberg1 !! n))

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

graficaLichtenberg :: Int -> IO ()
graficaLichtenberg n =
  plotList [ Key Nothing
           , Title "Numero de digitos de la sucesion de Lichtenberg"
           , PNG "Sucesion_de_Lichtenberg.png"
           ]
           (take n (map (length . show) lichtenberg1))

import Data.Char (digitToInt)

import Graphics.Gnuplot.Simple

import Test.QuickCheck

import Data.Numbers.Primes (isPrime)

-- 1ª solución

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

lichtenberg1 :: [Integer]

lichtenberg1 = map binarioAdecimal sucAlternada

-- sucAlternada es la lista cuyos elementos son los términos de la

-- sucesión de los dígitos 0 y 1 alternados. Por ejemplo,

-- λ> take 7 sucAlternada

-- ["0","1","10","101","1010","10101","101010"]

sucAlternada :: [String]

sucAlternada =

['0'] : [take n cadenaAlternada | n <- [1..]]

-- cadenaAltenada es la cadena formada alternando los caracteres 1 y

-- 0. Por ejemplo,

-- take 20 cadenaAlternada == "10101010101010101010"

cadenaAlternada :: String

cadenaAlternada = cycle ['1','0']

-- (binarioAdecimal cs) es el número decimal correspondiente al número

-- binario cuya cadena de dígitos es cs. Por ejemplo,

-- binarioAdecimal "11101" == 29

binarioAdecimal :: String -> Integer

binarioAdecimal =

foldl (\acc x -> acc * 2 + (toInteger . digitToInt) x) 0

-- 2ª solución

lichtenberg2 :: [Integer]

lichtenberg2 = map a [0..]

where a 0 = 0

a 1 = 1

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

-- 3ª solución

lichtenberg3 :: [Integer]

lichtenberg3 =

0 : 1 : map (+1) (zipWith (+) (tail lichtenberg3) (map (*2) lichtenberg3))

-- Comprobación de eficiencia

-- λ> length (show (lichtenberg1 !! 27))

-- 8

-- (0.02 secs, 155,384 bytes)

-- λ> length (show (lichtenberg2 !! 27))

-- 8

-- (2.22 secs, 311,157,760 bytes)

-- λ> length (show (lichtenberg1 !! (8*10^4)))

-- 24083

-- (1.28 secs, 664,207,040 bytes)

-- λ> length (show (lichtenberg3 !! (8*10^4)))

-- 24083

-- (2.59 secs, 1,253,328,200 bytes)

-- La propiedad es

propLichtenberg :: Int -> Property

propLichtenberg n =

n > 4 ==> not (isPrime (lichtenberg1 !! n))

-- La comprobación es

-- λ> quickCheck propLichtenberg

-- +++ OK, passed 100 tests.

graficaLichtenberg :: Int -> IO ()

graficaLichtenberg n =

plotList [ Key Nothing

, Title "Numero de digitos de la sucesion de Lichtenberg"

, PNG "Sucesion_de_Lichtenberg.png"

]

(take n (map (length . show) lichtenberg1))

Sumas parciales de Juzuk

PorJosé A. Alonso 23-enero-201830-enero-2018

En 1939 Dov Juzuk extendió el método de Nicómaco del cálculo de los cubos. La extensión se basaba en los siguientes pasos:

se comienza con la lista de todos los enteros positivos

     [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ...

1	[1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ...

se agrupan tomando el primer elemento, los dos siguientes, los tres
siguientes, etc.

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

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

se seleccionan los elementos en posiciones pares

     [[1],         [4, 5, 6],                [11, 12, 13, 14, 15], ...

1	[[1], [4, 5, 6], [11, 12, 13, 14, 15], ...

se suman los elementos de cada grupo

     [1,           15,                       65,                   ...

1	[1, 15, 65, ...

se calculan las sumas acumuladas

     [1,           16,                       81,                   ...

1	[1, 16, 81, ...

Las sumas obtenidas son las cuantas potencias de los números enteros positivos.

Definir las funciones

   listasParcialesJuzuk :: [a] -> [[a]]
   sumasParcialesJuzuk  :: [Integer] -> [Integer]

1 2	listasParcialesJuzuk :: [a] -> [[a]] sumasParcialesJuzuk :: [Integer] -> [Integer]

tal que

(listasParcialesJuzuk xs) es lalista de ls listas parciales de Juzuk; es decir, la selección de los elementos en posiciones pares de la agrupación de los elementos de xs tomando el primer elemento, los dos siguientes, los tres siguientes, etc. Por ejemplo,

     λ> take 4 (listasParcialesJuzuk [1..])
     [[1],[4,5,6],[11,12,13,14,15],[22,23,24,25,26,27,28]]
     λ> take 4 (listasParcialesJuzuk [1,3..])
     [[1],[7,9,11],[21,23,25,27,29],[43,45,47,49,51,53,55]]

λ> take 4 (listasParcialesJuzuk [1..])

[[1],[4,5,6],[11,12,13,14,15],[22,23,24,25,26,27,28]]

λ> take 4 (listasParcialesJuzuk [1,3..])

[[1],[7,9,11],[21,23,25,27,29],[43,45,47,49,51,53,55]]

(sumasParcialesJuzuk xs) es la lista de las sumas acumuladas de los elementos de las listas de Juzuk generadas por xs. Por ejemplo,

     take 4 (sumasParcialesJuzuk [1..])  ==  [1,16,81,256]
     take 4 (sumasParcialesJuzuk [1,3..])  ==  [1,28,153,496]

1 2	take 4 (sumasParcialesJuzuk [1..]) == [1,16,81,256] take 4 (sumasParcialesJuzuk [1,3..]) == [1,28,153,496]

Comprobar con QuickChek que, para todo entero positivo n,

el elemento de (sumasParcialesJuzuk [1..]) en la posición (n-1) es n^4.
el elemento de (sumasParcialesJuzuk [1,3..]) en la posición (n-1) es n^2*(2*n^2 - 1).
el elemento de (sumasParcialesJuzuk [1,5..]) en la posición (n-1) es 4*n^4-3*n^2.
el elemento de (sumasParcialesJuzuk [2,3..]) en la posición (n-1) es n^2*(n^2+1).

Soluciones

import Data.List (genericIndex)
import Test.QuickCheck

listasParcialesJuzuk :: [a] -> [[a]]
listasParcialesJuzuk = elementosEnPares . listasParciales

-- (listasParciales xs) es la agrupación de los elementos de xs obtenida
-- tomando el primer elemento, los dos siguientes, los tres siguientes,
-- etc. Por ejemplo, 
--    λ> take 5 (listasParciales [1..])
--    [[1],[2,3],[4,5,6],[7,8,9,10],[11,12,13,14,15]]
listasParciales :: [a] -> [[a]]
listasParciales = aux 1
  where aux n xs = ys : aux (n+1) zs  
          where (ys,zs) = splitAt n xs

-- (elementosEnPares xs) es la lista de los elementos de xs en
-- posiciones pares. Por ejemplo,
--    λ> elementosEnPares [[1],[2,3],[4,5,6],[7,8,9,10],[11,12,13,14,15]]
--    [[1],[4,5,6],[11,12,13,14,15]]
elementosEnPares :: [a] -> [a]
elementosEnPares []       = []
elementosEnPares [x]      = [x]
elementosEnPares (x:_:xs) = x : elementosEnPares xs

sumasParcialesJuzuk :: [Integer] -> [Integer]
sumasParcialesJuzuk xs =
  scanl1 (+) (map sum (listasParcialesJuzuk xs))

-- La primera propiedad es
prop_sumasParcialesJuzuk :: (Positive Integer) -> Bool
prop_sumasParcialesJuzuk (Positive n) =
  sumasParcialesJuzuk [1..] `genericIndex` (n-1) == n^4

-- Su comprobación es
--    λ> quickCheck prop_sumasParcialesJuzuk
--    +++ OK, passed 100 tests.

-- La segunda propiedad es
prop_sumasParcialesJuzuk2 :: (Positive Integer) -> Bool
prop_sumasParcialesJuzuk2 (Positive n) =
  sumasParcialesJuzuk [1,3..] `genericIndex` (n-1) == n^2*(2*n^2 - 1)

-- Su comprobación es
--    λ> quickCheck prop_sumasParcialesJuzuk2
--    +++ OK, passed 100 tests.

-- La tercera propiedad es
prop_sumasParcialesJuzuk3 :: (Positive Integer) -> Bool
prop_sumasParcialesJuzuk3 (Positive n) =
  sumasParcialesJuzuk [1,5..] `genericIndex` (n-1) == 4*n^4-3*n^2

-- Su comprobación es
--    λ> quickCheck prop_sumasParcialesJuzuk3
--    +++ OK, passed 100 tests.

-- La cuarta propiedad es
prop_sumasParcialesJuzuk4 :: (Positive Integer) -> Bool
prop_sumasParcialesJuzuk4 (Positive n) =
  sumasParcialesJuzuk [2,3..] `genericIndex` (n-1) == n^2*(n^2+1)
  
-- Su comprobación es
--    λ> quickCheck prop_sumasParcialesJuzuk4
--    +++ OK, passed 100 tests.

import Data.List (genericIndex)

import Test.QuickCheck

listasParcialesJuzuk :: [a] -> [[a]]

listasParcialesJuzuk = elementosEnPares . listasParciales

-- (listasParciales xs) es la agrupación de los elementos de xs obtenida

-- tomando el primer elemento, los dos siguientes, los tres siguientes,

-- etc. Por ejemplo,

-- λ> take 5 (listasParciales [1..])

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

listasParciales :: [a] -> [[a]]

listasParciales = aux 1

where aux n xs = ys : aux (n+1) zs

where (ys,zs) = splitAt n xs

-- (elementosEnPares xs) es la lista de los elementos de xs en

-- posiciones pares. Por ejemplo,

-- λ> elementosEnPares [[1],[2,3],[4,5,6],[7,8,9,10],[11,12,13,14,15]]

-- [[1],[4,5,6],[11,12,13,14,15]]

elementosEnPares :: [a] -> [a]

elementosEnPares [] = []

elementosEnPares [x] = [x]

elementosEnPares (x:_:xs) = x : elementosEnPares xs

sumasParcialesJuzuk :: [Integer] -> [Integer]

sumasParcialesJuzuk xs =

scanl1 (+) (map sum (listasParcialesJuzuk xs))

-- La primera propiedad es

prop_sumasParcialesJuzuk :: (Positive Integer) -> Bool

prop_sumasParcialesJuzuk (Positive n) =

sumasParcialesJuzuk [1..] `genericIndex` (n-1) == n^4

-- Su comprobación es

-- λ> quickCheck prop_sumasParcialesJuzuk

-- +++ OK, passed 100 tests.

-- La segunda propiedad es

prop_sumasParcialesJuzuk2 :: (Positive Integer) -> Bool

prop_sumasParcialesJuzuk2 (Positive n) =

sumasParcialesJuzuk [1,3..] `genericIndex` (n-1) == n^2*(2*n^2 - 1)

-- Su comprobación es

-- λ> quickCheck prop_sumasParcialesJuzuk2

-- +++ OK, passed 100 tests.

-- La tercera propiedad es

prop_sumasParcialesJuzuk3 :: (Positive Integer) -> Bool

prop_sumasParcialesJuzuk3 (Positive n) =

sumasParcialesJuzuk [1,5..] `genericIndex` (n-1) == 4*n^4-3*n^2

-- Su comprobación es

-- λ> quickCheck prop_sumasParcialesJuzuk3

-- +++ OK, passed 100 tests.

-- La cuarta propiedad es

prop_sumasParcialesJuzuk4 :: (Positive Integer) -> Bool

prop_sumasParcialesJuzuk4 (Positive n) =

sumasParcialesJuzuk [2,3..] `genericIndex` (n-1) == n^2*(n^2+1)

-- Su comprobación es

-- λ> quickCheck prop_sumasParcialesJuzuk4

-- +++ OK, passed 100 tests.

Complemento potencial

PorJosé A. Alonso 22-enero-201829-enero-2018

El complemento potencial de un número entero positivo x es el menor número y tal que el producto de x por y es un una potencia perfecta. Por ejemplo,

el complemento potencial de 12 es 3 ya que 12 y 24 no son potencias perfectas pero 36 sí lo es;
el complemento potencial de 54 es 4 ya que 54, 108 y 162 no son potencias perfectas pero 216 = 6^3 sí lo es.

Definir las funciones

   complemento                 :: Integer -> Integer
   graficaComplementoPotencial :: Integer -> IO ()

1 2	complemento :: Integer -> Integer graficaComplementoPotencial :: Integer -> IO ()

tales que

(complemento x) es el complemento potencial de x; por ejemplo,

     complemento 12     ==  3
     complemento 54     ==  4
     complemento 720    ==  5
     complemento 24000  ==  9
     complemento 2018   ==  2018

complemento 12 == 3

complemento 54 == 4

complemento 720 == 5

complemento 24000 == 9

complemento 2018 == 2018

(graficaComplementoPotencial n) dibuja la gráfica de los complementos potenciales de los n primeros números enteros positivos. Por ejemplo, (graficaComplementoPotencial 100) dibuja

y (graficaComplementoPotencial 500) dibuja

Comprobar con QuickCheck que (complemento x) es menor o igual que x.

Soluciones

import Data.Numbers.Primes     (primeFactors)
import Data.List               (genericLength, group)
import Graphics.Gnuplot.Simple (plotList, Attribute (Key, PNG, Title))
import Test.QuickCheck

complemento :: Integer -> Integer
complemento 1 = 1
complemento x =
  head [y | y <- [1..]
          , esPotenciaPerfecta (x*y)]
  
-- (esPotenciaPerfecta x) se verifica si x es una potencia perfecta. Por
-- ejemplo, 
--    esPotenciaPerfecta 36  ==  True
--    esPotenciaPerfecta 72  ==  False
esPotenciaPerfecta :: Integer -> Bool
esPotenciaPerfecta x = mcd (exponentes x) > 1

-- (exponentes x) es la lista de los exponentes de la factorización prima
-- de x. Por ejemplos,
--    exponentes 36  ==  [2,2]
--    exponentes 72  ==  [3,2]
exponentes :: Integer -> [Integer]
exponentes = map snd . factorizacion
  
-- (factorizacion n) es la factorizacion prima de n. Por ejemplo,
--    factorizacion 1400  ==  [(2,3),(5,2),(7,1)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion n =
  [(x,genericLength xs) | xs@(x:_) <- group (primeFactors n)]

-- (mcd xs) es el máximo común divisor de la lista xs. Por ejemplo,
--    mcd [4,6,10]  ==  2
--    mcd [4,5,10]  ==  1
mcd :: [Integer] -> Integer
mcd = foldl1 gcd

-- La propiedad es
prop_complemento :: (Positive Integer) -> Bool
prop_complemento (Positive x) =
  complemento x <= x

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

graficaComplementoPotencial :: Integer -> IO ()
graficaComplementoPotencial n =
  plotList [Key Nothing
           , PNG ("Complemento_potencial_"  ++ show n ++ ".png")
           , Title ("(graficaComplementoPotencial " ++ show n ++ ")") 
           ]
           (map complemento [1..n])

import Data.Numbers.Primes (primeFactors)

import Data.List (genericLength, group)

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

import Test.QuickCheck

complemento :: Integer -> Integer

complemento 1 = 1

complemento x =

head [y | y <- [1..]

, esPotenciaPerfecta (x*y)]

-- (esPotenciaPerfecta x) se verifica si x es una potencia perfecta. Por

-- ejemplo,

-- esPotenciaPerfecta 36 == True

-- esPotenciaPerfecta 72 == False

esPotenciaPerfecta :: Integer -> Bool

esPotenciaPerfecta x = mcd (exponentes x) > 1

-- (exponentes x) es la lista de los exponentes de la factorización prima

-- de x. Por ejemplos,

-- exponentes 36 == [2,2]

-- exponentes 72 == [3,2]

exponentes :: Integer -> [Integer]

exponentes = map snd . factorizacion

-- (factorizacion n) es la factorizacion prima de n. Por ejemplo,

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

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

factorizacion n =

[(x,genericLength xs) | xs@(x:_) <- group (primeFactors n)]

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

-- mcd [4,6,10] == 2

-- mcd [4,5,10] == 1

mcd :: [Integer] -> Integer

mcd = foldl1 gcd

-- La propiedad es

prop_complemento :: (Positive Integer) -> Bool

prop_complemento (Positive x) =

complemento x <= x

-- La comprobación es

-- λ> quickCheck prop_complemento

-- +++ OK, passed 100 tests.

graficaComplementoPotencial :: Integer -> IO ()

graficaComplementoPotencial n =

plotList [Key Nothing

, PNG ("Complemento_potencial_" ++ show n ++ ".png")

, Title ("(graficaComplementoPotencial " ++ show n ++ ")")

]

(map complemento [1..n])

Escalada hasta un primo

PorJosé A. Alonso 18-enero-201819-febrero-2018

Este ejercicio está basado en el artículo La conjetura de la «escalada hasta un primo» publicado esta semana por Miguel Ángel Morales en su blog Gaussianos.

La conjetura de escalada hasta un primo trata, propuesta por John Horton Conway, es sencilla de plantear, pero primero vamos a ver qué es eso de escalar hasta un primo. Tomamos un número cualquiera y lo descomponemos en factores primos (colocados en orden ascendente). Si el número era primo, ya hemos acabado; si no era primo, construimos el número formado por los factores primos y los exponentes de los mismos colocados tal cual salen en la factorización. Con el número obtenido hacemos lo mismo que antes. La escalada finaliza cuando obtengamos un número primo. Por ejemplo, para obtener la escalada prima de 1400, como no es primo, se factoriza (obteniéndose 2^3 * 5^2 * 7) y se unen bases y exponentes (obteniéndose 23527). Con el 23527 se repite el proceso obteniéndose la factorización (7 * 3361) y su unión (73361). Como el 73361 es primo, termina la escalada. Por tanto, la escalada de 1400 es [1400,23527,73361].

La conjetura de Conway sobre «escalada hasta un primo» dice que todo número natural mayor o igual que 2 termina su escalada en un número primo.

Definir las funciones

   escaladaPrima                :: Integer -> [Integer]
   longitudEscaladaPrima        :: Integer -> Integer
   longitudEscaladaPrimaAcotada :: Integer -> Integer -> Integer
   graficaEscalada              :: Integer -> Integer -> IO ()

escaladaPrima :: Integer -> [Integer]

longitudEscaladaPrima :: Integer -> Integer

longitudEscaladaPrimaAcotada :: Integer -> Integer -> Integer

graficaEscalada :: Integer -> Integer -> IO ()

tales que

(escaladaPrima n) es la escalada prima de n. Por ejemplo,

     λ> escaladaPrima 1400
     [1400,23527,73361]
     λ> escaladaPrima 333
     [333,3237,31383,3211317,3217139151,39722974813]
     λ> take 10 (escaladaPrima 20)
     [20,225,3252,223271,297699,399233,715623,3263907,32347303,160720129]
     λ> take 3 (escaladaPrima 13532385396179)
     [13532385396179,13532385396179,13532385396179]
     λ> take 2 (escaladaPrima 45214884853168941713016664887087462487)
     [45214884853168941713016664887087462487,13532385396179]

λ> escaladaPrima 1400

[1400,23527,73361]

λ> escaladaPrima 333

[333,3237,31383,3211317,3217139151,39722974813]

λ> take 10 (escaladaPrima 20)

[20,225,3252,223271,297699,399233,715623,3263907,32347303,160720129]

λ> take 3 (escaladaPrima 13532385396179)

[13532385396179,13532385396179,13532385396179]

λ> take 2 (escaladaPrima 45214884853168941713016664887087462487)

[45214884853168941713016664887087462487,13532385396179]

(longitudEscaladaPrima n) es la longitud de la escalada prima de n. Por ejemplo,

     longitudEscaladaPrima 1400  ==  3
     longitudEscaladaPrima 333   ==  6

1 2	longitudEscaladaPrima 1400 == 3 longitudEscaladaPrima 333 == 6

(longitudEscaladaPrimaAcotada n k) es el mínimo entre la longitud de la escalada prima de n y k. Por ejemplo,

     longitudEscaladaPrimaAcotada 333 10  ==  6
     longitudEscaladaPrimaAcotada 333 4   ==  4
     longitudEscaladaPrimaAcotada 20 4    ==  4

longitudEscaladaPrimaAcotada 333 10 == 6

longitudEscaladaPrimaAcotada 333 4 == 4

longitudEscaladaPrimaAcotada 20 4 == 4

(graficaEscalada n k) dibuja la gráfica de (longitudEscaladaPrimaAcotada x k) para x entre 2 y n. Por ejemplo, (graficaEscalada 120 15) dibuja

Soluciones

import Data.List (genericLength, group)
import Data.Numbers.Primes
import Graphics.Gnuplot.Simple

-- Definición de escaladaPrima 
escaladaPrima :: Integer -> [Integer]
escaladaPrima n
  | isPrime n = [n]
  | otherwise = n : escaladaPrima (siguiente n)

-- (siguiente n) es el siguiente de n en la escalada hacia un primo. Por
-- ejemplo, 
--    siguiente 1400  ==  23527
siguiente :: Integer -> Integer
siguiente = paresAnumero . factorizacion

-- (factorizacion n) es la factorizacion prima de n. Por ejemplo,
--    factorizacion 1400  ==  [(2,3),(5,2),(7,1)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion n =
  [(x,genericLength xs) | xs@(x:_) <- group (primeFactors n)]

-- (paAnumero p) es el número obtenido pegando las dos componentes de p
-- (si la segunda es mayor que 1) o sólo la primera componente, en caso
-- contrario. Por ejemplo, 
--    parAnumero (7,1)  ==  7
--    parAnumero (23,5)  ==  235
parAnumero :: (Integer,Integer) -> Integer
parAnumero (n,1) = n
parAnumero (n,k) = read (show n ++ show k)

-- (paresA numeros ps) es el número obtenido aplicando parAnumero a cada
-- uno de los pares de ps. Por ejemplo,
--    paresAnumero [(2,3),(5,2),(7,1)]  ==  23527
paresAnumero :: [(Integer,Integer)] -> Integer
paresAnumero = read . concatMap (show . parAnumero)

-- Definición de longitudEscaladaPrima
longitudEscaladaPrima :: Integer -> Integer
longitudEscaladaPrima n
  | isPrime n = 1
  | otherwise = 1 + longitudEscaladaPrima (siguiente n)

-- Definición de longitudEscaladaPrimaAcotada
longitudEscaladaPrimaAcotada :: Integer -> Integer -> Integer
longitudEscaladaPrimaAcotada _ 0 = 0
longitudEscaladaPrimaAcotada n k
  | isPrime n = 1
  | otherwise = 1 + longitudEscaladaPrimaAcotada (siguiente n) (k-1)

-- Definición de graficaEscalada 
graficaEscalada :: Integer -> Integer -> IO ()
graficaEscalada n k =
  plotList [ Key Nothing
           , PNG "Escalada_hasta_un_primo.png"
           , Title ("graficaEscalada " ++ show n ++ " " ++ show k)
           , XLabel "Numeros"
           , YLabel "Longitud de escalada"
           ]
           [(x,longitudEscaladaPrimaAcotada x k) | x <- [2..n]]

import Data.List (genericLength, group)

import Data.Numbers.Primes

import Graphics.Gnuplot.Simple

-- Definición de escaladaPrima

escaladaPrima :: Integer -> [Integer]

escaladaPrima n

| isPrime n = [n]

| otherwise = n : escaladaPrima (siguiente n)

-- (siguiente n) es el siguiente de n en la escalada hacia un primo. Por

-- ejemplo,

-- siguiente 1400 == 23527

siguiente :: Integer -> Integer

siguiente = paresAnumero . factorizacion

-- (factorizacion n) es la factorizacion prima de n. Por ejemplo,

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

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

factorizacion n =

[(x,genericLength xs) | xs@(x:_) <- group (primeFactors n)]

-- (paAnumero p) es el número obtenido pegando las dos componentes de p

-- (si la segunda es mayor que 1) o sólo la primera componente, en caso

-- contrario. Por ejemplo,

-- parAnumero (7,1) == 7

-- parAnumero (23,5) == 235

parAnumero :: (Integer,Integer) -> Integer

parAnumero (n,1) = n

parAnumero (n,k) = read (show n ++ show k)

-- (paresA numeros ps) es el número obtenido aplicando parAnumero a cada

-- uno de los pares de ps. Por ejemplo,

-- paresAnumero [(2,3),(5,2),(7,1)] == 23527

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

paresAnumero = read . concatMap (show . parAnumero)

-- Definición de longitudEscaladaPrima

longitudEscaladaPrima :: Integer -> Integer

longitudEscaladaPrima n

| isPrime n = 1

| otherwise = 1 + longitudEscaladaPrima (siguiente n)

-- Definición de longitudEscaladaPrimaAcotada

longitudEscaladaPrimaAcotada :: Integer -> Integer -> Integer

longitudEscaladaPrimaAcotada _ 0 = 0

longitudEscaladaPrimaAcotada n k

| isPrime n = 1

| otherwise = 1 + longitudEscaladaPrimaAcotada (siguiente n) (k-1)

-- Definición de graficaEscalada

graficaEscalada :: Integer -> Integer -> IO ()

graficaEscalada n k =

plotList [ Key Nothing

, PNG "Escalada_hasta_un_primo.png"

, Title ("graficaEscalada " ++ show n ++ " " ++ show k)

, XLabel "Numeros"

, YLabel "Longitud de escalada"

]

[(x,longitudEscaladaPrimaAcotada x k) | x <- [2..n]]

Fractal hexagonal

PorJosé A. Alonso 16-enero-201819-febrero-2018

Escribir, usando CodeWorld, un programa para dibujar el fractal hexagonal que se muestra en la siguiente animación

Las 4 primeras fases de la animación son

Fase 0:
Fase 1:
Fase 2:
Fase 3:

Nota: Este ejercicio ha sido propuesto por Agustín Martín Aguera.

Soluciones

import CodeWorld

main :: IO()
main = animationOf (hexagono . s)

hexagono :: Int -> Picture
hexagono 0 =
  colored red $ solidPolygon [(9,0),(4.5,c),(-4.5,c),(-9,0),(-4.5,-c),(4.5,-c)]
  where c = 9 * sin (pi / 3)
hexagono n =
  pictures (hex : take 6 (iterate (rotated (pi / 3)) (translated 6 0 hex)))
  where hex = scaled (1/3) (1/3) $ hexagono (n-1)

s :: Double -> Int
s t = mod (floor t) 5

import CodeWorld

main :: IO()

main = animationOf (hexagono . s)

hexagono :: Int -> Picture

hexagono 0 =

colored red $ solidPolygon [(9,0),(4.5,c),(-4.5,c),(-9,0),(-4.5,-c),(4.5,-c)]

where c = 9 * sin (pi / 3)

hexagono n =

pictures (hex : take 6 (iterate (rotated (pi / 3)) (translated 6 0 hex)))

where hex = scaled (1/3) (1/3) $ hexagono (n-1)

s :: Double -> Int

s t = mod (floor t) 5

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico