Menu Close

Etiqueta: tail

Caminos reducidos

Un camino es una sucesión de pasos en una de las cuatros direcciones Norte, Sur, Este, Oeste. Ir en una dirección y a continuación en la opuesta es un esfuerzo que se puede reducir, Por ejemplo, el camino [Norte,Sur,Este,Sur] se puede reducir a [Este,Sur].

Un camino se dice que es reducido si no tiene dos pasos consecutivos en direcciones opuesta. Por ejemplo, [Este,Sur] es reducido y [Norte,Sur,Este,Sur] no lo es.

En Haskell, las direcciones y los caminos se pueden definir por

   data Direccion = N | S | E | O deriving (Show, Eq)
   type Camino = [Direccion]

Definir la función

   reducido :: Camino -> Camino

tal que (reducido ds) es el camino reducido equivalente al camino ds. Por ejemplo,

   reducido []                              ==  []
   reducido [N]                             ==  [N]
   reducido [N,O]                           ==  [N,O]
   reducido [N,O,E]                         ==  [N]
   reducido [N,O,E,S]                       ==  [] 
   reducido [N,O,S,E]                       ==  [N,O,S,E]
   reducido [S,S,S,N,N,N]                   ==  []
   reducido [N,S,S,E,O,N]                   ==  []
   reducido [N,S,S,E,O,N,O]                 ==  [O]
   reducido (take (10^7) (cycle [N,E,O,S])) ==  []

Nótese que en el penúltimo ejemplo las reducciones son

       [N,S,S,E,O,N,O]  
   --> [S,E,O,N,O]  
   --> [S,N,O]  
   --> [O]

Soluciones

data Direccion = N | S | E | O deriving (Show, Eq)
 
type Camino = [Direccion]
 
-- 1ª solución (por recursión):
reducido1 :: Camino -> Camino
reducido1 [] = []
reducido1 (d:ds) | null ds'                = [d]
                 | d == opuesta (head ds') = tail ds'
                 | otherwise               = d:ds'
    where ds' = reducido1 ds
 
opuesta :: Direccion -> Direccion
opuesta N = S
opuesta S = N
opuesta E = O
opuesta O = E
 
-- 2ª solución (por plegado)
reducido2 :: Camino -> Camino
reducido2 = foldr aux []
    where aux N (S:xs) = xs
          aux S (N:xs) = xs
          aux E (O:xs) = xs
          aux O (E:xs) = xs
          aux x xs     = x:xs
 
-- 3ª solución 
reducido3 :: Camino -> Camino
reducido3 []       = []
reducido3 (N:S:ds) = reducido3 ds
reducido3 (S:N:ds) = reducido3 ds
reducido3 (E:O:ds) = reducido3 ds
reducido3 (O:E:ds) = reducido3 ds
reducido3 (d:ds) | null ds'                = [d]
                 | d == opuesta (head ds') = tail ds'
                 | otherwise               = d:ds'
    where ds' = reducido3 ds
 
-- 4ª solución
reducido4 :: Camino -> Camino
reducido4 ds = reverse (aux ([],ds)) where 
    aux (N:xs, S:ys) = aux (xs,ys)
    aux (S:xs, N:ys) = aux (xs,ys)
    aux (E:xs, O:ys) = aux (xs,ys)
    aux (O:xs, E:ys) = aux (xs,ys)
    aux (  xs, y:ys) = aux (y:xs,ys)
    aux (  xs,   []) = xs
 
-- Comparación de eficiencia
--    ghci> reducido1 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (3.87 secs, 460160736 bytes)
--    ghci> reducido2 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (1.16 secs, 216582880 bytes)
--    ghci> reducido3 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (0.58 secs, 98561872 bytes)
--    ghci> reducido4 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (0.64 secs, 176154640 bytes)
--    
--    ghci> reducido3 (take (10^7) (cycle [N,E,O,S]))
--    []
--    (5.43 secs, 962694784 bytes)
--    ghci> reducido4 (take (10^7) (cycle [N,E,O,S]))
--    []
--    (9.29 secs, 1722601528 bytes)
-- 
--    ghci> length $ reducido3 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])
--    400002
--    (4.52 secs, 547004960 bytes)
--    ghci> length $ reducido4 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])
--    400002
--    
--    ghci> let n=10^6 in reducido1 (replicate n N ++ replicate n S)
--    []
--    (7.35 secs, 537797096 bytes)
--    ghci> let n=10^6 in reducido2 (replicate n N ++ replicate n S)
--    []
--    (2.30 secs, 244553404 bytes)
--    ghci> let n=10^6 in reducido3 (replicate n N ++ replicate n S)
--    []
--    (8.08 secs, 545043608 bytes)
--    ghci> let n=10^6 in reducido4 (replicate n N ++ replicate n S)
--    []
--    (1.96 secs, 205552240 bytes)

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

Sucesión fractal

La sucesión fractal

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

está construida de la siguiente forma:

  • los términos pares forman la sucesión de los números naturales
     0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ...
  • los términos impares forman la misma sucesión original
     0, 0, 1, 0, 2, 1, 3, 0, 4, 2, 5, 1, 6, 3, 7, ...

Definir las funciones

   sucFractal     :: [Integer]
   sumaSucFractal :: Integer -> Integer

tales que

  • sucFractal es la lista de los términos de la sucesión fractal. Por ejemplo,
     take 20 sucFractal   == [0,0,1,0,2,1,3,0,4,2,5,1,6,3,7,0,8,4,9,2]
     sucFractal !! 30     == 15
     sucFractal !! (10^7) == 5000000
  • (sumaSucFractal n) es la suma de los n primeros términos de la sucesión fractal. Por ejemplo,
     sumaSucFractal 10      == 13
     sumaSucFractal (10^5)  == 1666617368
     sumaSucFractal (10^10) == 16666666661668691669
     sumaSucFractal (10^15) == 166666666666666166673722792954
     sumaSucFractal (10^20) == 1666666666666666666616666684103392376198
     length (show (sumaSucFractal (10^15000))) == 30000
     sumaSucFractal (10^15000) `mod` (10^9)    == 455972157

Soluciones

 
-- 1ª definición de sucFractal
-- ===========================
 
sucFractal1 :: [Integer]
sucFractal1 = 
  map termino [0..]
 
-- (termino n) es el término n de la secuencia anterior. Por ejemplo,
--   termino 0            ==  0
--   termino 1            ==  0
--   map termino [0..10]  ==  [0,0,1,0,2,1,3,0,4,2,5]
termino :: Integer -> Integer
termino 0 = 0
termino n 
  | even n    = n `div` 2
  | otherwise = termino (n `div` 2)
 
-- 2ª definición de sucFractal
-- ===========================
 
sucFractal2 :: [Integer]
sucFractal2 =
  0 : 0 : mezcla [1..] (tail sucFractal2)
 
-- (mezcla xs ys) es la lista obtenida intercalando las listas infinitas
-- xs e ys. Por ejemplo,
--    take 10 (mezcla [0,2..] [0,-2..])  ==  [0,0,2,-2,4,-4,6,-6,8,-8]
mezcla :: [Integer] -> [Integer] -> [Integer]
mezcla (x:xs) (y:ys) =
  x : y : mezcla xs ys
 
-- Comparación de eficiencia de definiciones de sucFractal
-- =======================================================
 
--    λ> sum (take (10^6) sucFractal1)
--    166666169612
--    (5.56 secs, 842,863,264 bytes)
--    λ> sum (take (10^6) sucFractal2)
--    166666169612
--    (1.81 secs, 306,262,616 bytes)
 
-- En lo que sigue usaremos la 2ª definición
sucFractal :: [Integer]
sucFractal = sucFractal2
 
-- 1ª definición de sumaSucFractal
-- ===============================
 
sumaSucFractal1 :: Integer -> Integer
sumaSucFractal1 n =
  sum (map termino [0..n-1])
 
-- 2ª definición de sumaSucFractal
-- ===============================
 
sumaSucFractal2 :: Integer -> Integer
sumaSucFractal2 n =
  sum (take (fromIntegral n) sucFractal)
 
-- 3ª definición de sumaSucFractal
-- ===============================
 
sumaSucFractal3 :: Integer -> Integer
sumaSucFractal3 0 = 0
sumaSucFractal3 1 = 0
sumaSucFractal3 n
  | even n    = sumaN (n `div` 2) + sumaSucFractal3 (n `div` 2)
  | otherwise = sumaN ((n+1) `div` 2) + sumaSucFractal3 (n `div` 2)
  where sumaN n = (n*(n-1)) `div` 2
 
-- Comparación de eficiencia de definiciones de sumaSucFractal
-- ===========================================================
 
--    λ> sumaSucFractal1 (10^6)
--    166666169612
--    (5.25 secs, 810,622,504 bytes)
--    λ> sumaSucFractal2 (10^6)
--    166666169612
--    (1.72 secs, 286,444,048 bytes)
--    λ> sumaSucFractal3 (10^6)
--    166666169612
--    (0.01 secs, 0 bytes)
--    
--    λ> sumaSucFractal2 (10^7)
--    16666661685034
--    (17.49 secs, 3,021,580,920 bytes)
--    λ> sumaSucFractal3 (10^7)
--    16666661685034
--    (0.01 secs, 0 bytes)

Huecos de Aquiles

Un número de Aquiles es un número natural n que es potente (es decir, si p es un divisor primo de n, entonces p² también lo es) y no es una potencia perfecta (es decir, no existen números naturales m y k tales que n es igual a m^k). Por ejemplo,

  • 108 es un número de Aquiles proque es un número potente (ya que su factorización es 2^2 · 3^3, sus divisores primos son 2 and 3 y sus cuadrados (2^2 = 4 y 3^2 = 9) son divisores de 108. Además, 108 no es una potencia perfecta.
  • 360 no es un número de Aquiles ya que 5 es un divisor primo de 360, pero 5^2 = 15 no lo es.
  • 784 no es un número de Aquiles porque, aunque es potente, es una potencia perfecta ya que 784 = 28^2.

Los primeros números de Aquiles son

   72, 108, 200, 288, 392, 432, 500, 648, 675, 800, 864, 968, 972, ...

Definir las funciones

   esAquiles              :: Integer -> Bool
   huecosDeAquiles        :: [Integer]
   graficaHuecosDeAquiles :: Int -> IO ()

tales que

  • (esAquiles x) se verifica si x es un número de Aquiles. Por ejemplo,
     esAquiles 108         ==  True
     esAquiles 360         ==  False
     esAquiles 784         ==  False
     esAquiles 5425069447  ==  True
     esAquiles 5425069448  ==  True
  • huecosDeAquiles es la sucesión de la diferencias entre los números de Aquiles consecutivos. Por ejemplo,
     λ> take 15 huecosDeAquiles
     [36,92,88,104,40,68,148,27,125,64,104,4,153,27,171]
  • (graficaHuecosDeAquiles n) dibuja la gráfica de los n primeros huecos de Aquiles. Por ejemplo, (graficaHuecosDeAquiles 160) dibuja

Soluciones

import Data.List (group)
import Data.Numbers.Primes (primeFactors)
import Graphics.Gnuplot.Simple
 
-- Definición de esAquiles
-- =======================
 
esAquiles :: Integer -> Bool
esAquiles x = esPotente x && noEsPotenciaPerfecta x
 
-- (esPotente x) se verifica si x es potente. Por ejemplo,
--    esPotente 108  ==  True
--    esPotente 360  ==  False
--    esPotente 784  ==  True
esPotente :: Integer -> Bool
esPotente x = all (>1) (exponentes x)
 
-- (exponentes x) es la lista de los exponentes en la factorización de
-- x. Por ejemplo,
--    exponentes 108  ==  [2,3]
--    exponentes 360  ==  [3,2,1]
--    exponentes 784  ==  [4,2]
exponentes :: Integer -> [Int]
exponentes x = map length (group (primeFactors x))
 
-- (noEsPotenciaPerfecta x) se verifica si x no es una potencia
-- perfecta. Por ejemplo,
--    noEsPotenciaPerfecta 108  ==  True
--    noEsPotenciaPerfecta 360  ==  True
--    noEsPotenciaPerfecta 784  ==  False
noEsPotenciaPerfecta :: Integer -> Bool
noEsPotenciaPerfecta x = foldl1 gcd (exponentes x) == 1 
 
-- Definición de huecosDeAquiles
-- =============================
 
huecosDeAquiles :: [Integer]
huecosDeAquiles = zipWith (-) (tail aquiles) aquiles
 
-- aquiles es la sucesión de los números de Aquiles. Por ejemplo, 
--    λ> take 15 aquiles
--    [72,108,200,288,392,432,500,648,675,800,864,968,972,1125,1152]
aquiles :: [Integer]
aquiles = filter esAquiles [2..]
 
-- Definición de graficaHuecosDeAquiles
-- ====================================
 
graficaHuecosDeAquiles :: Int -> IO ()
graficaHuecosDeAquiles n =
  plotList [ Key Nothing
           , PNG "Huecos_de_Aquiles.png"
           ]
           (take n huecosDeAquiles)

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>

Hojas con caminos no decrecientes

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

   data Arbol = N Int [Arbol]
     deriving Show

Por ejemplo, los árboles

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

se representan por

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

Definir la función

   hojasEnNoDecreciente :: Arbol -> [Int]

tal que (hojasEnNoDecreciente a) es el conjunto de las hojas de a que se encuentran en alguna rama no decreciente. Por ejemplo,

   hojasEnNoDecreciente ej1  ==  [4,5,7]
   hojasEnNoDecreciente ej2  ==  [4,6,8]
   hojasEnNoDecreciente ej3  ==  []

Soluciones

import Data.List (sort, nub)
 
data Arbol = N Int [Arbol]
  deriving Show
 
ej1, ej2, ej3 :: Arbol
ej1 = N 1 [N 2 [N 4 [], N 5 []], N 6 [N 5 [], N 7 []]]
ej2 = N 1 [N 8 [], N 3 [N 4 [], N 2 [], N 6 []]]
ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 2 []]]
 
-- 1ª solución
-- ===========
 
hojasEnNoDecreciente :: Arbol -> [Int]
hojasEnNoDecreciente a =
  sort (nub (map last (ramasNoDecrecientes a)))
 
--    ramasNoDecrecientes ej1  ==  [[1,2,4],[1,2,5],[1,6,7]]
--    ramasNoDecrecientes ej2  ==  [[1,8],[1,3,4],[1,3,6]]
--    ramasNoDecrecientes ej3  ==  []
ramasNoDecrecientes :: Arbol -> [[Int]]
ramasNoDecrecientes a =
  filter esNoDecreciente (ramas a)
 
-- (ramas a) es la lista de las ramas del árbol a. Por ejemplo,
--    λ> ramas ej1
--    [[1,2,4],[1,2,5],[1,6,5],[1,6,7]]
--    λ> ramas ej2
--    [[1,8],[1,3,4],[1,3,2],[1,3,6]]
--    λ> ramas ej3
--    [[1,8,4],[1,8,5],[1,8,6],[1,3,2]]
ramas :: Arbol -> [[Int]]
ramas (N x []) = [[x]]
ramas (N x as) = map (x:) (concatMap ramas as)
 
-- (esNoDecreciente xs) se verifica si la lista xs es no
-- decreciente. Por ejemplo, 
--    esNoDecreciente [1,3,3,5]  ==  True
--    esNoDecreciente [1,3,5,3]  ==  False
esNoDecreciente :: [Int] -> Bool
esNoDecreciente xs =
  and (zipWith (<=) xs (tail xs))
 
-- 2ª solución
-- ===========
 
--    hojasEnNoDecreciente ej1  ==  [4,5,7]
--    hojasEnNoDecreciente ej2  ==  [4,6,8]
--    hojasEnNoDecreciente ej3  ==  []
hojasEnNoDecreciente2 :: Arbol -> [Int]
hojasEnNoDecreciente2 = sort . nub . aux
  where
    aux (N x []) = [x]
    aux (N x as) = concat [aux (N y bs) | (N y bs) <- as, x <= y]

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>

Orden de divisibilidad

El orden de divisibilidad de un número x es el mayor n tal que para todo i menor o igual que n, los i primeros dígitos de n es divisible por i. Por ejemplo, el orden de divisibilidad de 74156 es 3 porque

   7       es divisible por 1
   74      es divisible por 2
   741     es divisible por 3
   7415 no es divisible por 4

Definir la función

   ordenDeDivisibilidad :: Integer -> Int

tal que (ordenDeDivisibilidad x) es el orden de divisibilidad de x. Por ejemplo,

   ordenDeDivisibilidad 74156                      ==  3
   ordenDeDivisibilidad 12                         ==  2
   ordenDeDivisibilidad 7                          ==  1
   ordenDeDivisibilidad 3608528850368400786036725  ==  25

Soluciones

import Data.List (inits)
 
-- 1ª definición de ordenDeDivisibilidad
-- =====================================
 
ordenDeDivisibilidad :: Integer -> Int
ordenDeDivisibilidad n = 
  length (takeWhile (\(x,k) -> x `mod` k == 0) (zip (sucDigitos n) [1..]))
 
-- (sucDigitos x) es la sucesión de los dígitos de x. Por ejemplo,
--    sucDigitos 325    ==  [3,32,325]
--    sucDigitos 32050  ==  [3,32,320,3205,32050]
sucDigitos :: Integer -> [Integer]
sucDigitos n = 
    [n `div` (10^i) | i <- [k-1,k-2..0]]
    where k = length (show n)
 
-- 2ª definición de sucDigitos
sucDigitos2 :: Integer -> [Integer]
sucDigitos2 n = [read xs | xs <- aux (show n)]
  where aux []     = []
        aux (d:ds) = [d] : map (d:) (aux ds)
 
-- 3ª definición de sucDigitos
sucDigitos3 :: Integer -> [Integer]
sucDigitos3 n = 
  [read (take k ds) | k <- [1..length ds]]
  where ds = show n
 
-- 4ª definición de sucDigitos
sucDigitos4 :: Integer -> [Integer]
sucDigitos4 n = [read xs | xs <- tail (inits (show n))]
 
-- 5ª definición de sucDigitos
sucDigitos5 :: Integer -> [Integer]
sucDigitos5 n = map read (tail (inits (show n)))
 
-- 6ª definición de sucDigitos
sucDigitos6 :: Integer -> [Integer]
sucDigitos6 = map read . (tail . inits . show)
 
-- Eficiencia de las definiciones de sucDigitos
--    ghci> length (sucDigitos (10^5000))
--    5001
--    (0.01 secs, 1550688 bytes)
--    ghci> length (sucDigitos2 (10^5000))
--    5001
--    (1.25 secs, 729411872 bytes)
--    ghci> length (sucDigitos3 (10^5000))
--    5001
--    (0.02 secs, 2265120 bytes)
--    ghci> length (sucDigitos4 (10^5000))
--    5001
--    (1.10 secs, 728366872 bytes)
--    ghci> length (sucDigitos5 (10^5000))
--    5001
--    (1.12 secs, 728393864 bytes)
--    ghci> length (sucDigitos6 (10^5000))
--    5001
--    (1.20 secs, 728403052 bytes)
-- 
--    ghci> length (sucDigitos (10^3000000))
--    3000001
--    (2.73 secs, 820042696 bytes)
--    ghci> length (sucDigitos3 (10^3000000))
--    3000001
--    (3.69 secs, 820043688 bytes)
 
-- 2ª definición de ordenDeDivisibilidad
-- =====================================
 
ordenDeDivisibilidad2 :: Integer -> Int
ordenDeDivisibilidad2 x =
  length
  $ takeWhile (==0)
  $ zipWith (mod . read) (tail $ inits $ show x) [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>

La conjetura de Levy

Hyman Levy observó que

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

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)]
  • (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
    La_conjetura_de_Levy-200

Comprobar con QuickCheck la conjetura de Levy.

Soluciones

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 :: 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.

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

“Dios creó el número natural, y todo el resto es obra del hombre.”

Leopold Kronecker

La conjetura de Gilbreath

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

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

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

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]]
   conjeturaGilbreath  :: 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]
  • triangulo es el triángulo de Gilbreath. Por ejemplo,
     λ> 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,
     λ> 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

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

“La simplicidad es la última sofisticación.”

Leonardo da Vinci.

Suma de los elementos de las diagonales matrices espirales

Empezando con el número 1 y moviéndose en el sentido de las agujas del reloj se obtienen las matrices espirales

   |1 2|   |7 8 9|   | 7  8  9 10|   |21 22 23 24 25|
   |4 3|   |6 1 2|   | 6  1  2 11|   |20  7  8  9 10|
           |5 4 3|   | 5  4  3 12|   |19  6  1  2 11|
                     |16 15 14 13|   |18  5  4  3 12|
                                     |17 16 15 14 13|

La suma los elementos de sus diagonales es

+ en la 2x2: 1+3+2+4               =  10
+ en la 3x3: 1+3+5+7+9             =  25
+ en la 4x4: 1+2+3+4+7+10+13+16    =  56
+ en la 5x5: 1+3+5+7+9+13+17+21+25 = 101

Definir la función

   sumaDiagonales :: Integer -> Integer

tal que (sumaDiagonales n) es la suma de los elementos en las diagonales de la matriz espiral de orden nxn. Por ejemplo.

   sumaDiagonales 1         ==  1
   sumaDiagonales 2         ==  10
   sumaDiagonales 3         ==  25
   sumaDiagonales 4         ==  56
   sumaDiagonales 5         ==  101
   sumaDiagonales (10^6)    ==  666667166668000000
   sumaDiagonales (1+10^6)  ==  666669166671000001
 
   sumaDiagonales (10^2)  ==         671800
   sumaDiagonales (10^3)  ==        667168000
   sumaDiagonales (10^4)  ==       666716680000
   sumaDiagonales (10^5)  ==      666671666800000
   sumaDiagonales (10^6)  ==     666667166668000000
   sumaDiagonales (10^7)  ==    666666716666680000000
   sumaDiagonales (10^8)  ==   666666671666666800000000
   sumaDiagonales (10^9)  ==  666666667166666668000000000

Comprobar con QuickCheck que el último dígito de (sumaDiagonales n) es 0, 4 ó 6 si n es par y es 1, 5 ó 7 en caso contrario.

Soluciones

import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
sumaDiagonales :: Integer -> Integer
sumaDiagonales = sum . elementosEnDiagonales
 
-- (elementosEnDiagonales n) es la lista de los elementos en las
-- diagonales de la matriz espiral de orden nxn. Por ejemplo,
--    elementosEnDiagonales 1  ==  [1]
--    elementosEnDiagonales 2  ==  [1,2,3,4]
--    elementosEnDiagonales 3  ==  [1,3,5,7,9]
--    elementosEnDiagonales 4  ==  [1,2,3,4,7,10,13,16]
--    elementosEnDiagonales 5  ==  [1,3,5,7,9,13,17,21,25]
elementosEnDiagonales :: Integer -> [Integer]
elementosEnDiagonales n 
  | even n    = tail (scanl (+) 0 (concatMap (replicate 4) [1,3..n-1]))
  | otherwise = scanl (+) 1 (concatMap (replicate 4) [2,4..n-1])
 
-- 2ª solución
-- ===========
 
sumaDiagonales2 :: Integer -> Integer
sumaDiagonales2 n
  | even n    = (-1) + n `div` 2 + sum [2*k^2-k+1 | k <- [0..n]]
  | otherwise = 1 + sum [4*k^2-6*k+6 | k <- [3,5..n]]
 
-- 3ª solución
-- ===========
 
sumaDiagonales3 :: Integer -> Integer
sumaDiagonales3 n
  | even n    = n * (4*n^2 + 3*n + 8) `div` 6
  | otherwise = (4*n^3 + 3*n^2 + 8*n - 9) `div` 6
 
-- Equivalencia de las definiciones
-- ================================
 
-- La propiedad es
prop_sumaDiagonales_equiv :: (Positive Integer) -> Bool
prop_sumaDiagonales_equiv (Positive n) =
  all (== sumaDiagonales n) [ sumaDiagonales2 n 
                            , sumaDiagonales3 n]
 
-- La comprobación es
--    λ> quickCheck prop_sumaDiagonales_equiv
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> sumaDiagonales (2*10^6)
--    5333335333336000000
--    (2.30 secs, 1,521,955,848 bytes)
--    λ> sumaDiagonales2 (2*10^6)
--    5333335333336000000
--    (2.77 secs, 1,971,411,440 bytes)
--    λ> sumaDiagonales3 (2*10^6)
--    5333335333336000000
--    (0.01 secs, 139,520 bytes)
 
-- Propiedad
-- =========
 
-- La propiedad es
prop_sumaDiagonales :: (Positive Integer) -> Bool
prop_sumaDiagonales (Positive n) 
  | even n    = x `elem` [0,4,6] 
  | otherwise = x `elem` [1,5,7] 
  where x = sumaDiagonales n `mod` 10
 
-- La comprobación es
--    λ> quickCheck prop_sumaDiagonales
--    +++ OK, passed 100 tests.

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

“Un matemático que no sea también algo de poeta nunca será un matemático perfecto.”

Karl Weierstrass.

El sesgo de Chebyshev

Un número primo distinto de 2 tiene la forma 4k + 1 o 4k + 3. Chebyshev notó en 1853 que la mayoría de las veces hay más números primos de la forma 4k + 3 que números primos de la forma 4k + 1 menores que un número dado. Esto se llama el sesgo de Chebyshev.

Definir las funciones

   distribucionPrimosModulo4 :: [(Integer, Integer, Integer)]
   empatesRestosModulo4 :: [Integer]
   mayoria1RestosModulo4 :: [Integer]
   grafica_Chebyshev :: Int -> IO ()

tales que

  • distribucionPrimosModulo4 es la lista de las ternas (p,a,b) tales que p es un números primo, a es la cantidad de primos menores o iguales que p congruentes con 1 módulo 4 y b es la cantidad de primos menores o iguales que p congruentes con 3 módulo 4. Por ejemplo,
     λ> take 7 distribucionPrimosModulo4
     [(2,0,0),(3,0,1),(5,1,1),(7,1,2),(11,1,3),(13,2,3),(17,3,3)]
     λ> distribucionPrimosModulo4 !! (5*10^5)
     (7368791,249888,250112)
  • empatesRestosModulo4 es la lista de los primos p tales que la cantidad de primos menores o iguales que p congruentes con 1 módulo 4 es igual a la cantidad de primos menores o iguales que p congruentes con 3 módulo 4. Por ejemplo,
     λ> take 10 empatesRestosModulo4
     [2,5,17,41,461,26833,26849,26863,26881,26893]
     λ> length (takeWhile (<= 10^6) empatesRestosModulo4)
     112
  • mayoria1RestosModulo4 es la lista de los primos p tales que la cantidad de primos menores o iguales que p congruentes con 1 módulo 4 es mayor que la cantidad de primos menores o iguales que p congruentes con 3 módulo 4. Por ejemplo,
     λ> take 10 mayoria1RestosModulo4
     [26861,616841,616849,616877,616897,616909,616933,616943,616951,616961]
     λ> length (takeWhile (<= 10^6) mayoria1RestosModulo4)
     239
  • (graficaChebyshev n) dibuja la gráfica de los puntos (p,b-a) donde p es uno de los n primeros primos impares, a es la cantidad de primos menores o iguales que p congruentes con 1 módulo 4 y b es la cantidad de primos menores o iguales que p congruentes con 3 módulo 4. Por ejemplo, (graficaChebyshev 5000) dibuja la figura

Soluciones