Menu Close

Etiqueta: iterate

Sucesión duplicadora

Para cada entero positivo n, existe una única sucesión que empieza en 1, termina en n y en la que cada uno de sus elementos es el doble de su anterior o el doble más uno. Dicha sucesión se llama la sucesión duplicadora de n. Por ejemplo, la sucesión duplicadora de 13 es [1, 3, 6, 13], ya que

    3 = 2*1 +1
    6 = 2*3
   13 = 2*6 +1

Definir la función

   duplicadora :: Integer -> [Integer]

tal que (duplicadora n) es la sucesión duplicadora de n. Por ejemplo,

   duplicadora 13                   ==  [1,3,6,13]
   duplicadora 17                   ==  [1,2,4,8,17]
   length (duplicadora (10^40000))  ==  132878

Soluciones

-- 1ª definición
duplicadora :: Integer -> [Integer]
duplicadora x =
  reverse (takeWhile (>=1) (iterate (`div` 2) x))
 
-- 2ª definición
duplicadora2 :: Integer -> [Integer]
duplicadora2  =
  reverse . takeWhile (>=1) . iterate (`div` 2)

Cadenas de primos complementarios

El complemento de un número positivo x se calcula por el siguiente procedimiento:

  • si x es mayor que 9, se toma cada dígito por su valor posicional y se resta del mayor los otro dígitos. Por ejemplo, el complemento de 1448 es 1000 – 400 – 40 – 8 = 552. Para
  • si x es menor que 10, su complemento es x.

Definir las funciones

   cadena    :: Integer -> [Integer]
   conCadena :: Int -> [Integer]

tales que

  • (cadena x) es la cadena de primos a partir de x tal que cada uno es el complemento del anterior. Por ejemplo,
     cadena 8         == []
     cadena 7         == [7]
     cadena 13        == [13,7]
     cadena 643       == [643,557,443]
     cadena 18127     == [18127,1873,127,73,67,53,47]
     cadena 18181213  == [18181213,1818787,181213,18787,1213,787,613,587]
  • (conCadena n) es la lista de números cuyas cadenas tienen n elementos. Por ejemplo,
     take 6 (conCadena 3)                == [23,31,61,67,103,307]
     [head (conCadena n) | n <- [4..8]]  == [37,43,157,18127,181873]

Soluciones

 
import Data.Numbers.Primes
 
-- (complemento x) es le complemento de x. Por ejemplo,
--    complemento 1448  == 552
--    complemento  639  == 561
--    complemento    7  == 7
complemento :: Integer -> Integer
complemento x = (div x c)*c - (rem x c)
  where c = 10^(length (show x) - 1)          
 
cadena :: Integer -> [Integer]
cadena x    
  | x < 10 && isPrime x = [x]
  | otherwise           = takeWhile isPrime (iterate f x)
  where f x | x < 10 && isPrime x = 0
            | otherwise           = complemento x
 
conCadena :: Int -> [Integer]
conCadena n =
  [y | y <- primes, length (cadena y) == n]

Las sucesiones de Loomis

La sucesión de Loomis generada por un número entero positivo x es la sucesión cuyos términos se definen por

  • f(0) es x
  • f(n) es la suma de f(n-1) y el producto de los dígitos no nulos de f(n-1)

Los primeros términos de las primeras sucesiones de Loomis son

  • Generada por 1: 1, 2, 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, …
  • Generada por 2: 2, 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, …
  • Generada por 3: 3, 6, 12, 14, 18, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, …
  • Generada por 4: 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, 138, …
  • Generada por 5: 5, 10, 11, 12, 14, 18, 26, 38, 62, 74, 102, 104, 108, 116, 122, …

Se observa que a partir de un término todas coinciden con la generada por 1. Dicho término se llama el punto de convergencia. Por ejemplo,

  • la generada por 2 converge a 2
  • la generada por 3 converge a 26
  • la generada por 4 converge a 4
  • la generada por 5 converge a 26

Definir las siguientes funciones

   sucLoomis           :: Integer -> [Integer]
   convergencia        :: Integer -> Integer
   graficaConvergencia :: [Integer] -> IO ()

tales que

  • (sucLoomis x) es la sucesión de Loomis generada por x. Por ejemplo,
     λ> take 15 (sucLoomis 1)
     [1,2,4,8,16,22,26,38,62,74,102,104,108,116,122]
     λ> take 15 (sucLoomis 2)
     [2,4,8,16,22,26,38,62,74,102,104,108,116,122,126]
     λ> take 15 (sucLoomis 3)
     [3,6,12,14,18,26,38,62,74,102,104,108,116,122,126]
     λ> take 15 (sucLoomis 4)
     [4,8,16,22,26,38,62,74,102,104,108,116,122,126,138]
     λ> take 15 (sucLoomis 5)
     [5,10,11,12,14,18,26,38,62,74,102,104,108,116,122]
     λ> take 15 (sucLoomis 20)
     [20,22,26,38,62,74,102,104,108,116,122,126,138,162,174]
     λ> take 15 (sucLoomis 100)
     [100,101,102,104,108,116,122,126,138,162,174,202,206,218,234]
     λ> sucLoomis 1 !! (2*10^5)
     235180736652
  • (convergencia x) es el término de convergencia de la sucesioń de Loomis generada por x xon la geerada por 1. Por ejemplo,
     convergencia  2      ==  2
     convergencia  3      ==  26
     convergencia  4      ==  4
     convergencia 17      ==  38
     convergencia 19      ==  102
     convergencia 43      ==  162
     convergencia 27      ==  202
     convergencia 58      ==  474
     convergencia 63      ==  150056
     convergencia 81      ==  150056
     convergencia 89      ==  150056
     convergencia (10^12) ==  1000101125092
  • (graficaConvergencia xs) dibuja la gráfica de los términos de convergencia de las sucesiones de Loomis generadas por los elementos de xs. Por ejemplo, (graficaConvergencia ([1..50]) dibuja
    Las_sucesiones_de_Loomis_1
    y graficaConvergencia ([1..148] \ [63,81,89,137]) dibuja
    Las_sucesiones_de_Loomis_2

Soluciones

import Data.List               ((\\))
import Data.Char               (digitToInt)
import Graphics.Gnuplot.Simple (plotList, Attribute (Key, Title, XRange, PNG))
 
-- 1ª definición de sucLoomis
-- ==========================
 
sucLoomis :: Integer -> [Integer]
sucLoomis x = map (loomis x) [0..]
 
loomis :: Integer -> Integer -> Integer
loomis x 0 = x
loomis x n = y + productoDigitosNoNulos y
  where y = loomis x (n-1)
 
productoDigitosNoNulos :: Integer -> Integer
productoDigitosNoNulos = product . digitosNoNulos
 
digitosNoNulos :: Integer -> [Integer]
digitosNoNulos x =
  [read [c] | c <- show x, c /= '0']
 
-- 2ª definición de sucLoomis
-- ==========================
 
sucLoomis2 :: Integer -> [Integer]
sucLoomis2 = iterate siguienteLoomis 
 
siguienteLoomis :: Integer -> Integer
siguienteLoomis y = y + productoDigitosNoNulos y
 
-- 3ª definición de sucLoomis
-- ==========================
 
sucLoomis3 :: Integer -> [Integer]
sucLoomis3 =
  iterate ((+) <*> product .
           map (toInteger . digitToInt) .
           filter (/= '0') . show)
 
-- Comparación de eficiencia
-- =========================
 
--    λ> sucLoomis 1 !! 30000
--    6571272766
--    (2.45 secs, 987,955,944 bytes)
--    λ> sucLoomis2 1 !! 30000
--    6571272766
--    (2.26 secs, 979,543,328 bytes)
--    λ> sucLoomis3 1 !! 30000
--    6571272766
--    (0.31 secs, 88,323,832 bytes)
 
-- 1ª definición de convergencia
-- =============================
 
convergencia1 :: Integer -> Integer
convergencia1 x =
  head (dropWhile noEnSucLoomisDe1 (sucLoomis x))
 
noEnSucLoomisDe1 :: Integer -> Bool
noEnSucLoomisDe1 x = not (pertenece x sucLoomisDe1)
 
sucLoomisDe1 :: [Integer]
sucLoomisDe1 = sucLoomis 1
 
pertenece :: Integer -> [Integer] -> Bool
pertenece x ys =
  x == head (dropWhile (<x) ys)
 
-- 2ª definición de convergencia
-- =============================
 
convergencia2 :: Integer -> Integer
convergencia2 = aux (sucLoomis3 1) . sucLoomis3
 where aux as@(x:xs) bs@(y:ys) | x == y    = x
                               | x < y     = aux xs bs
                               | otherwise = aux as ys
 
-- 3ª definición de convergencia
-- =============================
 
convergencia3 :: Integer -> Integer
convergencia3 = head . interseccion (sucLoomis3 1) . sucLoomis3
 
-- (interseccion xs ys) es la intersección entre las listas ordenadas xs
-- e ys. Por ejemplo,
--    λ> take 10 (interseccion (sucLoomis3 1) (sucLoomis3 2))
--    [2,4,8,16,22,26,38,62,74,102]
interseccion :: Ord a => [a] -> [a] -> [a]
interseccion = aux
  where aux as@(x:xs) bs@(y:ys) = case compare x y of
                                    LT ->     aux xs bs
                                    EQ -> x : aux xs ys
                                    GT ->     aux as ys
        aux _         _         = []                           
 
-- 4ª definición de convergencia
-- =============================
 
convergencia4 :: Integer -> Integer
convergencia4 x = perteneceA (sucLoomis3 x) 1
  where perteneceA (y:ys) n | y == c    = y
                            | otherwise = perteneceA ys c
          where c = head $ dropWhile (< y) $ sucLoomis3 n
 
-- Comparación de eficiencia
-- =========================
 
--    λ> convergencia1 (10^4)
--    150056
--    (2.94 secs, 1,260,809,808 bytes)
--    λ> convergencia2 (10^4)
--    150056
--    (0.03 secs, 700,240 bytes)
--    λ> convergencia3 (10^4)
--    150056
--    (0.03 secs, 1,165,496 bytes)
--    λ> convergencia4 (10^4)
--    150056
--    (0.02 secs, 1,119,648 bytes)
--    
--    λ> convergencia2 (10^12)
--    1000101125092
--    (1.81 secs, 714,901,080 bytes)
--    λ> convergencia3 (10^12)
--    1000101125092
--    (1.92 secs, 744,932,184 bytes)
--    λ> convergencia4 (10^12)
--    1000101125092
--    (1.82 secs, 941,053,328 bytes)
 
-- Definición de graficaConvergencia
-- ==================================
 
graficaConvergencia :: [Integer] -> IO ()
graficaConvergencia xs =
  plotList [ Key Nothing
           , Title "Convergencia de sucesiones de Loomis"
           , XRange (fromIntegral (minimum xs),fromIntegral (maximum xs))
           , PNG "Las_sucesiones_de_Loomis_2.png"
           ]
           [(x,convergencia2 x) | x <- xs]

Números de Perrin

Los números de Perrin se definen por la elación de recurrencia

   P(n) = P(n - 2) + P(n - 3) si n > 2,

con los valores iniciales

   P(0) = 3, P(1) = 0 y P(2) = 2.

Definir la sucesión

   sucPerrin :: [Integer]

cuyos elementos son los números de Perrin. Por ejemplo,

   λ> take 15 sucPerrin
   [3,0,2,3,2,5,5,7,10,12,17,22,29,39,51]
   λ> length (show (sucPerrin !! (2*10^5)))
   24425

Comprobar con QuickCheck si se verifica la siguiente propiedad: para todo entero n > 1, el n-ésimo término de la sucesión de Perrin es divisible por n si y sólo si n es primo.

Soluciones

import Data.List (genericIndex, unfoldr)
import Data.Numbers.Primes (isPrime)
import Test.QuickCheck
 
-- 1ª solución
sucPerrin1 :: [Integer]
sucPerrin1 = 3 : 0 : 2 : zipWith (+) sucPerrin1 (tail sucPerrin1)
 
-- 2ª solución
sucPerrin2 :: [Integer]
sucPerrin2 = [x | (x,_,_) <- iterate op (3,0,2)]
  where op (a,b,c) = (b,c,a+b)
 
-- 3ª solución
sucPerrin3 :: [Integer]
sucPerrin3 =
  unfoldr (\(a, (b,c)) -> Just (a, (b,(c,a+b)))) (3,(0,2))
 
-- 4ª solución
sucPerrin4 :: [Integer]
sucPerrin4 = [vectorPerrin n ! n | n <- [0..]]
 
vectorPerrin :: Integer -> Array Integer Integer
vectorPerrin n = v where
  v = array (0,n) [(i,f i) | i <- [0..n]]
  f 0 = 3
  f 1 = 0
  f 2 = 2
  f i = v ! (i-2) + v ! (i-3)
 
-- Comparación de eficiencia
--    λ> length (show (sucPerrin1 !! (3*10^5)))
--    36638
--    (1.62 secs, 2,366,238,984 bytes)
--    λ> length (show (sucPerrin2 !! (3*10^5)))
--    36638
--    (1.40 secs, 2,428,701,384 bytes)
--    λ> length (show (sucPerrin3 !! (3*10^5)))
--    36638
--    (1.14 secs, 2,409,504,864 bytes)
--    λ> length (show (sucPerrin4 !! (3*10^5)))
--    36638
--    (1.78 secs, 2,585,400,776 bytes)
 
 
-- Usaremos la 3ª
sucPerrin :: [Integer]
sucPerrin = sucPerrin3
 
-- La propiedad es  
conjeturaPerrin :: Integer -> Property
conjeturaPerrin n =
  n > 1 ==>
  (perrin n `mod` n == 0) == isPrime n
 
-- (perrin n) es el n-ésimo término de la sucesión de Perrin. Por
-- ejemplo,
--    perrin 4  ==  2
--    perrin 5  ==  5
--    perrin 6  ==  5
perrin :: Integer -> Integer
perrin n = sucPerrin `genericIndex` n
 
-- La comprobación es
--    λ> quickCheck conjeturaPerrin
--    +++ OK, passed 100 tests.
 
-- Nota: Aunque QuickCheck no haya encontrado contraejemplos, la
-- propiedad no es cierta. Sólo lo es una de las implicaciones: si n es
-- primo, entonces el  n-ésimo término de la sucesión de Perrin es
-- divisible por n. La otra es falsa y los primeros contraejemplos son
--    271441, 904631, 16532714, 24658561, 27422714, 27664033, 46672291

Avistamientos de la pelota

Un niño está jugando con una pelota en el noveno piso de un edificio alto. La altura de este piso, h, es conocida. Deja caer la pelota por la ventana. La pelota rebota una r-ésima parte de su altura (por ejemplo, dos tercios de su altura). Su madre mira por una ventana a w metros del suelo (por ejemplo, a 1.5 metros). ¿Cuántas veces verá la madre a la pelota pasar frente a su ventana incluyendo cuando está cayendo y rebotando?

Se deben cumplir tres condiciones para que el experimento sea válido:

  • La altura “h” debe ser mayor que 0
  • El rebote “r” debe ser mayor que 0 y menor que 1
  • La altura de la ventana debe ser mayor que 0 y menor que h.

Definir la función

   numeroAvistamientos :: Double -> Double -> Double -> Integer

tal que (numeroAvistamientos h r v) es el número de avistamientos de la pelota si se cumplen las tres condiciones anteriores y es -1 en caso contrario. Por ejemplo,

   numeroAvistamientos 3    0.66 1.5  ==  3
   numeroAvistamientos 30   0.66 1.5  ==  15
   numeroAvistamientos (-3) 0.66 1.5  ==  -1
   numeroAvistamientos 3    (-1) 1.5  ==  -1
   numeroAvistamientos 3    2    1.5  ==  -1
   numeroAvistamientos 3    0.5  (-1) ==  -1
   numeroAvistamientos 3    0.5  4    ==  -1

Soluciones

import Data.List (genericLength)
 
-- 1ª solución
-- ============
 
numeroAvistamientos :: Double -> Double -> Double -> Integer
numeroAvistamientos h r v
  | adecuados h r v = 2 * n - 1 
  | otherwise      = -1
  where n = genericLength (takeWhile (>=v) (iterate (*r) h))
 
-- (adecuados h r v) se verifica si los datos cumplen las condiciones
-- para que el experimento sea válido.
adecuados :: Double -> Double -> Double -> Bool
adecuados h r v =
  h > 0 && 0 < r && r < 1 && 0 < v && v < h
 
-- 2ª solución
-- ===========
 
numeroAvistamientos2 :: Double -> Double -> Double -> Integer
numeroAvistamientos2 h r v 
  | adecuados h r v = 2 + numeroAvistamientos2 (h * r) r v
  | otherwise       = -1
 
-- 3ª solución
numeroAvistamientos3 :: Double -> Double -> Double -> Integer
numeroAvistamientos3 h r v
  | adecuados h r v = 1 + 2 * floor (logBase r (v / h))
  | otherwise       = -1

Otras soluciones

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

Pensamiento

“Los patrones del matemático, como los del pintor o el poeta deben ser hermosos; las ideas, como los colores o las palabras deben encajar de manera armoniosa. La belleza es la primera prueba: no hay lugar permanente en este mundo para las matemáticas feas.”

G. H. Hardy.