Menu Close

Etiqueta: plotList

La sucesión ECG

La sucesión ECG estás definida por a(1) = 1, a(2) = 2 y, para n >= 3, a(n) es el menor natural que aún no está en la sucesión tal que a(n) tiene algún divisor común con a(n-1).

Los primeros términos de la sucesión son 1, 2, 4, 6, 3, 9, 12, 8, 10, 5, 15, …

Al dibujar su gráfica, se parece a la de los electrocardiogramas (abreviadamente, ECG). Por ello, la sucesión se conoce como la sucesión ECG.

Definir las funciones

   sucECG :: [Integer]
   graficaSucECG :: Int -> IO ()

tales que

  • sucECG es la lista de los términos de la sucesión ECG. Por ejemplo,
     λ> take 20 sucECG
     [1,2,4,6,3,9,12,8,10,5,15,18,14,7,21,24,16,20,22,11]
     λ> sucECG !! 6000
     6237
  • (graficaSucECG n) dibuja la gráfica de los n primeros términos de la sucesión ECG. Por ejemplo, (graficaSucECG 160) dibuja

Soluciones

import Data.List (delete)
import Graphics.Gnuplot.Simple
 
sucECG :: [Integer]
sucECG = 1 : ecg 2 [2..]
  where ecg x zs = f zs
          where f (y:ys) | gcd x y > 1 = y : ecg y (delete y zs)
                         | otherwise   = f ys
 
graficaSucECG :: Int -> IO ()
graficaSucECG n =
  plotList [ Key Nothing
           , PNG "La_sucesion_ECG.png" 
           ]
           (take n sucECG)

Pensamiento

Algunos desesperados
sólo se curan con soga;
otros, con siete palabras:
la fe se ha puesto de moda.

Antonio Machado

Números cíclopes

Un número cíclope es un número natural cuya representación binaria sólo tiene un cero en el centro. Por ejemplo,

     0      es ciclope porque su representación binaria es 0       
     1   no es ciclope porque su representación binaria es 1       
     5      es ciclope porque su representación binaria es 101     
     9   no es ciclope porque su representación binaria es 1001    
    10   no es ciclope porque su representación binaria es 1010    
    27      es ciclope porque su representación binaria es 11011   
    85   no es ciclope porque su representación binaria es 1010101 
   101   no es ciclope porque su representación binaria es 1100101 
   111   no es ciclope porque su representación binaria es 1101111 
   119      es ciclope porque su representación binaria es 1110111

Definir las funciones

   esCiclope       :: Integer -> Bool
   ciclopes        :: [Integer]
   graficaCiclopes :: Int -> IO ()

tales que

  • (esCiclope n) se verifica si el número natual n es cíclope. Por ejemplo,
      esCiclope 0    ==  True
      esCiclope 1    ==  False
      esCiclope 5    ==  True
      esCiclope 9    ==  False
      esCiclope 10   ==  False
      esCiclope 27   ==  True
      esCiclope 85   ==  False
      esCiclope 101  ==  False
      esCiclope 111  ==  False
      esCiclope 119  ==  True
  • ciclopes es la lista de los número cíclopes. Por ejemplo,
     λ> take 12 ciclopes
     [0,5,27,119,495,2015,8127,32639,130815,523775,2096127,8386559]
     λ> length (show (ciclopes !! (10^5)))
     60207
  • (graficaCiclopes n) dibuja la gráfica del último dígito de los n primeros números cíclopes. Por ejemplo, (graficaCiclopes n) dibuja

Soluciones

import Graphics.Gnuplot.Simple
 
-- 1ª solución
-- ===========
 
--    esCiclope 5  ==  True
--    esCiclope 6  ==  False
esCiclope :: Integer -> Bool
esCiclope n =
  esCiclopeBinario (decimalAbinario n)
 
--    decimalAbinario 4  ==  [0,0,1]
--    decimalAbinario 5  ==  [1,0,1]
--    decimalAbinario 6  ==  [0,1,1]
decimalAbinario :: Integer -> [Integer]
decimalAbinario 0 = [0]
decimalAbinario 1 = [1]
decimalAbinario n = r : decimalAbinario q
  where (q,r) = quotRem n 2
 
--    esCiclopeBinario [1,1,0,1,1]  ==  True
--    esCiclopeBinario [1,1,0,1]  ==  False
--    esCiclopeBinario [1,1,2,1,1]  ==  False
--    esCiclopeBinario [2,2,0,2,2]  ==  False
esCiclopeBinario :: [Integer] -> Bool
esCiclopeBinario xs =
  odd n && xs == ys ++ 0 : ys
  where n  = length xs
        m  = n `div` 2
        ys = replicate m 1
 
--    take 8 ciclopes  ==  [0,5,27,119,495,2015,8127,32639]
ciclopes :: [Integer]
ciclopes = filter esCiclope [0..]
 
-- 2ª solución
-- ===========
 
--    take 8 ciclopes2  ==  [0,5,27,119,495,2015,8127,32639]
ciclopes2 :: [Integer]
ciclopes2 =
  [binarioAdecimal (replicate n 1 ++ 0 : replicate n 1) | n <- [0..]]
 
--    binarioAdecimal [0,1,1]  ==  6
binarioAdecimal :: [Integer] -> Integer
binarioAdecimal [x]    = x
binarioAdecimal (x:xs) = x + 2 * binarioAdecimal xs
 
esCiclope2 :: Integer -> Bool
esCiclope2 n =
  n `pertenece` ciclopes2
 
pertenece :: Integer -> [Integer] -> Bool
pertenece x ys =
  x == head (dropWhile (<x) ys)
 
-- 3ª solución
-- ===========
 
--    take 8 ciclopes3  ==  [0,5,27,119,495,2015,8127,32639]
ciclopes3 :: [Integer]
ciclopes3 =
  [sum [2^k | k <- [0..n-1]] + sum [2^k | k <- [n+1..n+n]] | n <- [0..]]
 
esCiclope3 :: Integer -> Bool
esCiclope3 n =
  n `pertenece` ciclopes3
 
-- 4ª solución
-- ===========
 
--    take 8 ciclopes3  ==  [0,5,27,119,495,2015,8127,32639]
ciclopes4 :: [Integer]
ciclopes4 =
  [2^(2*n+1) - 1 - 2^n | n <- [0..]]
 
esCiclope4 :: Integer -> Bool
esCiclope4 n =
  n `pertenece` ciclopes4
 
 
-- 5ª solución
-- ===========
 
--    take 8 ciclopes5  ==  [0,5,27,119,495,2015,8127,32639]
ciclopes5 :: [Integer]
ciclopes5 =
  [2*4^n - 1 - 2^n | n <- [0..]]
 
esCiclope5 :: Integer -> Bool
esCiclope5 n =
  n `pertenece` ciclopes5
 
-- 6ª solución
-- ===========
 
--    take 8 ciclopes6  ==  [0,5,27,119,495,2015,8127,32639]
ciclopes6 :: [Integer]
ciclopes6 =
  [2*x*x - 1 - x | x <- iterate (*2) 1]
 
esCiclope6 :: Integer -> Bool
esCiclope6 n =
  n `pertenece` ciclopes6
 
 
 
-- Comparación de eficiencia
-- =========================
 
--    λ> ciclopes !! 9
--    523775
--    (6.68 secs, 4,696,734,960 bytes)
--    λ> ciclopes2 !! 9
--    523775
--    (0.00 secs, 134,664 bytes)
--    λ> ciclopes3 !! 9
--    523775
--    (0.00 secs, 150,920 bytes)
--    λ> ciclopes4 !! 9
--    523775
--    (0.01 secs, 131,936 bytes)
--    λ> ciclopes5 !! 9
--    523775
--    (0.00 secs, 132,064 bytes)
--
--    λ> length (show (ciclopes2 !! (3*10^4)))
--    18063
--    (0.65 secs, 486,437,480 bytes)
--    λ> length (show (ciclopes3 !! (3*10^4)))
--    18063
--    (2.94 secs, 1,188,645,584 bytes)
--    λ> length (show (ciclopes4 !! (3*10^4)))
--    18063
--    (0.02 secs, 6,769,592 bytes)
--    λ> length (show (ciclopes5 !! (3*10^4)))
--    18063
--    (0.02 secs, 6,773,552 bytes)
--
--    λ> length (show (ciclopes2 !! (10^5)))
--    60207
--    (6.42 secs, 5,148,671,368 bytes)
--    λ> length (show (ciclopes4 !! (10^5)))
--    60207
--    (0.07 secs, 22,291,480 bytes)
--    λ> length (show (ciclopes5 !! (10^5)))
--    60207
--    (0.04 secs, 22,316,216 bytes)
--    
--    λ> length (show (ciclopes4 !! (5*10^6)))
--    3010301
--    (2.34 secs, 1,116,327,832 bytes)
--    λ> length (show (ciclopes5 !! (5*10^6)))
--    3010301
--    (2.39 secs, 1,099,177,056 bytes)
 
-- Definición de graficaCiclopes
-- =============================
 
graficaCiclopes :: Int -> IO ()
graficaCiclopes n =
  plotList [ Key Nothing
           -- , PNG "Numeros_ciclopes.png"
           ]
           [x `mod` 10 | x <- take n ciclopes5]

Pensamiento

¿Sabes cuando el agua suena,
si es agua de cumbre o valle,
de plaza, jardín o huerta?
Cantores, dejad
palmas y jaleo
para los demás.

Antonio Machado

Número de descomposiciones en sumas de cuatro cuadrados

Definir la función

   nDescomposiciones       :: Int -> Int
   graficaDescomposiciones :: Int -> IO ()

tales que

  • (nDescomposiciones x) es el número de listas de los cuadrados de cuatro números enteros positivos cuya suma es x. Por ejemplo.
     nDescomposiciones 4      ==  1
     nDescomposiciones 5      ==  0
     nDescomposiciones 7      ==  4
     nDescomposiciones 10     ==  6
     nDescomposiciones 15     ==  12
     nDescomposiciones 50000  ==  5682
  • (graficaDescomposiciones n) dibuja la gráfica del número de descomposiciones de los n primeros números naturales. Por ejemplo, (graficaDescomposiciones 500) dibuja

Soluciones

import Data.Array
import Graphics.Gnuplot.Simple
import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
nDescomposiciones :: Int -> Int
nDescomposiciones = length . descomposiciones
 
-- (descomposiciones x) es la lista de las listas de los cuadrados de
-- cuatro números enteros positivos cuya suma es x. Por  ejemplo. 
--    λ> descomposiciones 4
--    [[1,1,1,1]]
--    λ> descomposiciones 5
--    []
--    λ> descomposiciones 7
--    [[1,1,1,4],[1,1,4,1],[1,4,1,1],[4,1,1,1]]
--    λ> descomposiciones 10
--    [[1,1,4,4],[1,4,1,4],[1,4,4,1],[4,1,1,4],[4,1,4,1],[4,4,1,1]]
--    λ> descomposiciones 15
--    [[1,1,4,9],[1,1,9,4],[1,4,1,9],[1,4,9,1],[1,9,1,4],[1,9,4,1],
--     [4,1,1,9],[4,1,9,1],[4,9,1,1],[9,1,1,4],[9,1,4,1],[9,4,1,1]]
descomposiciones :: Int -> [[Int]]
descomposiciones x = aux x 4
  where 
    aux 0 1 = []
    aux 1 1 = [[1]]
    aux 2 1 = []
    aux 3 1 = []
    aux y 1 | esCuadrado y = [[y]]
            | otherwise    = []
    aux y n = [x^2 : zs | x <- [1..raizEntera y]
                        , zs <- aux (y - x^2) (n-1)]
 
-- (esCuadrado x) se verifica si x es un número al cuadrado. Por
-- ejemplo,
--    esCuadrado 25  ==  True
--    esCuadrado 26  ==  False
esCuadrado :: Int -> Bool
esCuadrado x = (raizEntera x)^2 == x
 
-- (raizEntera n) es el mayor entero cuya raíz cuadrada es menor o igual
-- que n. Por ejemplo,
--    raizEntera 15  ==  3
--    raizEntera 16  ==  4
--    raizEntera 17  ==  4
raizEntera :: Int -> Int
raizEntera = floor . sqrt . fromIntegral 
 
-- 2ª solución
-- =============
 
nDescomposiciones2 :: Int -> Int
nDescomposiciones2 = length . descomposiciones2
 
descomposiciones2 :: Int -> [[Int]]
descomposiciones2 x = a ! (x,4)
  where
    a = array ((0,1),(x,4)) [((i,j), f i j) | i <- [0..x], j <- [1..4]]
    f 0 1 = []
    f 1 1 = [[1]]
    f 2 1 = []
    f 3 1 = []
    f i 1 | esCuadrado i = [[i]]
          | otherwise    = []
    f i j = [x^2 : zs | x <- [1..raizEntera i]
                      , zs <- a ! (i - x^2,j-1)]
 
-- 3ª solución
-- ===========
 
nDescomposiciones3 :: Int -> Int
nDescomposiciones3 x = aux x 4
  where
    aux 0 1 = 0
    aux 1 1 = 1
    aux 2 1 = 0
    aux 3 1 = 0
    aux y 1 | esCuadrado y = 1
            | otherwise    = 0
    aux y n = sum [aux (y - x^2) (n-1) | x <- [1..raizEntera y]]
 
-- 4ª solución
-- ===========
 
nDescomposiciones4 :: Int -> Int
nDescomposiciones4 x = a ! (x,4)
  where
    a = array ((0,1),(x,4)) [((i,j), f i j) | i <- [0..x], j <- [1..4]]
    f 0 1 = 0
    f 1 1 = 1
    f 2 1 = 0
    f 3 1 = 0
    f i 1 | esCuadrado i = 1
          | otherwise    = 0
    f i j = sum [a ! (i- x^2,j-1) | x <- [1..raizEntera i]]
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_nDescomposiciones :: Positive Int -> Bool
prop_nDescomposiciones (Positive x) =
  all (== nDescomposiciones x) [f x | f <- [ nDescomposiciones2
                                           , nDescomposiciones3
                                           , nDescomposiciones4]]
 
-- La comprobación es
--    λ> quickCheck prop_nDescomposiciones
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
--    λ> nDescomposiciones 20000
--    1068
--    (3.69 secs, 3,307,250,128 bytes)
--    λ> nDescomposiciones2 20000
--    1068
--    (0.72 secs, 678,419,328 bytes)
--    λ> nDescomposiciones3 20000
--    1068
--    (3.94 secs, 3,485,725,552 bytes)
--    λ> nDescomposiciones4 20000
--    1068
--    (0.74 secs, 716,022,456 bytes)
--    
--    λ> nDescomposiciones2 50000
--    5682
--    (2.64 secs, 2,444,206,000 bytes)
--    λ> nDescomposiciones4 50000
--    5682
--    (2.77 secs, 2,582,443,448 bytes)
 
-- Definición de graficaDescomposiciones
-- =====================================
 
graficaDescomposiciones :: Int -> IO ()
graficaDescomposiciones n =
  plotList [ Key Nothing
           , PNG ("Numero_de_descomposiciones_en_sumas_de_cuadrados.png")
           ]
           (map nDescomposiciones3 [0..n])

Pensamiento

Ya habrá cigüeñas al sol,
mirando la tarde roja,
entre Moncayo y Urbión.

Antonio Machado

Número de sumandos en suma de cuadrados

El teorema de Lagrange de los cuatro cuadrados asegura que cualquier número entero positivo es la suma de, como máximo,cuatro cuadrados de números enteros. Por ejemplo,

   16 = 4²
   29 = 2² + 5²  
   14 = 1² + 2² + 3²
   15 = 1² + 1² + 2² + 3²

Definir las funciones

   ordenLagrange        :: Integer -> Int
   graficaOrdenLagrange :: Integer -> IO ()

tales que

  • (ordenLagrange n) es el menor número de cuadrados necesarios para escribir n como suma de cuadrados. Por ejemplo.
     ordenLagrange 16     ==  1
     ordenLagrange 29     ==  2
     ordenLagrange 14     ==  3
     ordenLagrange 15     ==  4
     ordenLagrange 10000  ==  1
     ordenLagrange 10001  ==  2
     ordenLagrange 10002  ==  3
     ordenLagrange 10007  ==  4
  • (graficaOrdenLagrange n) dibuja la gráfica de los órdenes de Lagrange de los n primeros números naturales. Por ejemplo, (graficaOrdenLagrange 100) dibuja

Comprobar con QuickCheck que. para todo entero positivo k, el orden de Lagrange de k es menos o igual que 4, el de 4k+3 es distinto de 2 y el de 8k+7 es distinto de 3.

Soluciones

import Data.Array (Array, (!), array)
import Graphics.Gnuplot.Simple
 
import Test.QuickCheck
 
-- 1ª definición
-- =============
 
ordenLagrange :: Integer -> Int
ordenLagrange n
  | esCuadrado n = 1
  | otherwise    = 1 + minimum [ ordenLagrange (n - x^2)
                               | x <- [1..raizEntera n]]
 
-- (esCuadrado x) se verifica si x es un número al cuadrado. Por
-- ejemplo,
--    esCuadrado 25  ==  True
--    esCuadrado 26  ==  False
esCuadrado :: Integer -> Bool
esCuadrado x = (raizEntera x)^2 == x
 
-- (raizEntera n) es el mayor entero cuya raíz cuadrada es menor o igual
-- que n. Por ejemplo,
--    raizEntera 15  ==  3
--    raizEntera 16  ==  4
--    raizEntera 17  ==  4
raizEntera :: Integer -> Integer
raizEntera = floor . sqrt . fromIntegral 
 
-- 2ª definición
-- =============
 
ordenLagrange2 :: Integer -> Int
ordenLagrange2 n = (vectorOrdenLagrange n) ! n
 
vectorOrdenLagrange :: Integer -> Array Integer Int
vectorOrdenLagrange n = v where
  v = array (0,n) [(i,f i) | i <- [0..n]]
  f i | esCuadrado i = 1
      | otherwise    = 1 + minimum [ v ! (i - j^2)
                                   | j <- [1..raizEntera i]]
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> ordenLagrange 50
--    2
--    (10.39 secs, 1,704,144,464 bytes)
--    λ> ordenLagrange2 50
--    2
--    (0.01 secs, 341,920 bytes)
 
-- Definición de graficaOrdenLagrange
-- ==================================
 
graficaOrdenLagrange :: Integer -> IO ()
graficaOrdenLagrange n = 
  plotList [ Key Nothing
           , PNG ("Numero_de_sumandos_en_suma_de_cuadrados.png")
           ]
           (map ordenLagrange2 [0..n-1])
 
-- Comprobación de la propiedad
-- ============================
 
-- La propiedad es
prop_OrdenLagrange :: Positive Integer -> Bool
prop_OrdenLagrange (Positive k) =
  ordenLagrange2 k <= 4 &&
  ordenLagrange2 (4*k+3) /= 2 &&
  ordenLagrange2 (8*k+7) /= 3
 
-- La comprobación es
--    λ> quickCheck prop_OrdenLagrange
--    +++ OK, passed 100 tests.

Pensamiento

— Nuestro español bosteza.
¿Es hambre? ¿Sueño? ¿Hastío?
Doctor, ¿tendrá el estómago vacío?
— El vacío es más bien en la cabeza.

Antonio Machado

Sucesión de Cantor de números innombrables

Un número es innombrable si es divisible por 7 o alguno de sus dígitos es un 7. Un juego infantil consiste en contar saltándose los números innombrables:

   1 2 3 4 5 6 ( ) 8 9 10 11 12 13 ( ) 15 16 ( ) 18 ...

La sucesión de Cantor se obtiene llenando los huecos de la sucesión anterior:

  1 2 3 4 5 6 (1) 8 9 10 11 12 13 (2) 15 16 (3) 18 19 20 (4) 22 23
  24 25 26 (5) (6) 29 30 31 32 33 34 (1) 36 (8) 38 39 40 41  (9) 43
  44 45 46 (10) 48 (11) 50 51 52 53 54 55 (12) (13) 58 59 60 61 62
  (2) 64 65 66 (15) 68 69 (16) (3) (18) (19) (20) (4) (22) (23) (24)
  (25) 80 81 82 83 (26) 85 86 (5) 88 89 90 (6) 92 93 94 95 96 (29)
  (30) 99 100

Definir las funciones

   sucCantor        :: [Integer]
   graficaSucCantor :: Int -> IO ()

tales que

  • sucCantor es la lista cuyos elementos son los términos de la sucesión de Cantor. Por ejemplo,
     λ> take 100 sucCantor
     [1,2,3,4,5,6, 1 ,8,9,10,11,12,13, 2, 15,16, 3, 18,19,20, 4,
      22,23,24,25,26, 5 , 6 ,29,30,31,32,33,34, 1 ,36 , 8 ,38,39,
      40,41, 9 ,43,44,45,46, 10 ,48, 11 ,50,51,52,53,54,55 , 12 ,
      13, 58,59,60,61,62, 2 ,64,65,66, 15 ,68,69, 16 , 3 , 18, 19,
      20, 4, 22, 23, 24 ,25 ,80,81,82,83, 26 ,85,86, 5 ,88,89,90,
      6, 92,93,94,95,96, 29, 30 ,99,100]
     λ> sucCantor2 !! (5+10^6)
     544480
     λ> sucCantor2 !! (6+10^6)
     266086
  • (graficaSucCantor n) es la gráfica de los n primeros términos de la sucesión de Cantor. Por ejemplo, (graficaSucCantor 200) dibuja

Soluciones

import Graphics.Gnuplot.Simple
 
-- 1ª solución
-- ===========
 
sucCantor1 :: [Integer]
sucCantor1 = map fst $ scanl f (1,0) [2..]
  where f (a,i) x
          | esInnombrable x = (sucCantor1 !! i, i+1)
          | otherwise       = (x,i)
 
esInnombrable :: Integer -> Bool
esInnombrable x =
  rem x 7 == 0 || '7' `elem` show x
 
-- 2ª solución
-- ===========
 
sucCantor2 :: [Integer]
sucCantor2 = aux 0 1
  where aux i x
          | esInnombrable x = sucCantor2 !! i : aux (i+1) (x+1)
          | otherwise       = x : aux i (x+1) 
 
-- 3ª solución
-- ===========
 
sucCantor3 :: [Integer]
sucCantor3 = 1 : aux [2..] sucCantor3
  where aux [] _ = []
        aux (x:xs) a@(y:ys)
          | esInnombrable x = y : aux xs ys
          | otherwise       = x : aux xs a
 
-- Definición de graficaSucCantor
-- ========================================
 
graficaSucCantor :: Int -> IO ()
graficaSucCantor n =
  plotList [ Key Nothing
           , PNG ("Sucesion_de_Cantor_de_numeros_innombrables.png")
           ]
           (take n sucCantor3)

Pensamiento

Dices que nada se pierde
y acaso dices verdad;
pero todo lo perdemos
y todo nos perderá.

Antonio Machado