Menu Close

Etiqueta: Listas infinitas

Números que sumados a su siguiente primo dan primos

José A. Alonso, ,

Introducción

La Enciclopedia electrónica de sucesiones de enteros (OEIS por sus siglas en inglés, de On-Line Encyclopedia of Integer Sequences) es una base de datos que registra sucesiones de números enteros. Está disponible libremente en Internet, en la dirección http://oeis.org.

La semana pasada Antonio Roldán añadió una nueva sucesión a la OEIS, la A249624 que sirve de base para el problema de hoy.

Enunciado

-- Definir la sucesión
--     a249624 :: [Integer]
-- tal que sus elementos son los números x tales que la suma de x y el
-- primo que le sigue es un número primo. Por ejemplo, 
--    ghci> take 20 a249624
--    [0,1,2,6,8,14,18,20,24,30,34,36,38,48,50,54,64,68,78,80]
-- 
-- El número 8 está en la sucesión porque su siguiente primo es 11 y
-- 8+11=19 es primo. El 12 no está en la sucesión porque su siguiente
-- primo es 13 y 12+13=25 no es primo.

Soluciones

import Data.Numbers.Primes (primes, isPrime)
import Data.List (genericReplicate)
 
-- 1ª definición
-- =============
 
a249624 :: [Integer]
a249624 = 0: 1: [x | x <- [2,4..], primo (x + siguientePrimo x)]
 
primo :: Integer -> Bool
primo x = [y | y <- [1..x], x `rem` y == 0] == [1,x]
 
siguientePrimo :: Integer -> Integer
siguientePrimo x = head [y | y <- [x+1..], primo y]
 
-- 2ª definición (por recursión)
-- =============================
 
a249624b :: [Integer]
a249624b = 0 : 1 : 2: aux [2,4..] primos where
    aux (x:xs) (y:ys) 
        | y < x                = aux (x:xs) ys
        | (x+y) `pertenece` ys = x : aux xs (y:ys)
        | otherwise            = aux xs (y:ys)
    pertenece x ys = x == head (dropWhile (<x) ys)
 
primos :: [Integer]
primos = 2 : [x | x <- [3,5..], primo x]
 
-- 3ª definición (con la librería de primos)
-- =========================================
 
a249624c :: [Integer]
a249624c = 0: 1: [x | x <- [2,4..], isPrime (x + siguientePrimo3 x)]
 
siguientePrimo3 x = head [y | y <- [x+1..], isPrime y]
 
-- 4ª definición (por recursión con la librería de primos)
-- =======================================================
 
a249624d :: [Integer]
a249624d = 0 : 1 : 2: aux [2,4..] primes where
    aux (x:xs) (y:ys) 
        | y < x                = aux (x:xs) ys
        | (x+y) `pertenece` ys = x : aux xs (y:ys)
        | otherwise            = aux xs (y:ys)
    pertenece x ys = x == head (dropWhile (<x) ys)
 
-- 5ª definición
-- =============
 
a249624e :: [Integer]
a249624e = [a | q <- primes, 
                let p = siguientePrimo3 (q `div` 2),
                let a = q-p,
                siguientePrimo3 a == p]
 
-- 6ª definición
-- =============
 
a249624f :: [Integer]
a249624f = [x | (x,y) <- zip [0..] ps, isPrime (x+y)]
    where ps = 2:2:concat (zipWith f primes (tail primes))
          f p q = genericReplicate (q-p) q
 
-- 7ª definición
-- =============
 
a249624g :: [Integer]
a249624g = 0:1:(aux primes (tail primes) primes)
    where aux (x:xs) (y:ys) zs
              | null rs   = aux xs ys zs2
              | otherwise = [r-y | r <- rs] ++ (aux xs ys zs2)
              where a = x+y
                    b = 2*y-1
                    zs1 = takeWhile (<=b) zs
                    rs = [r | r <- [a..b], r `elem` zs1]
                    zs2 = dropWhile (<=b) zs
 
-- ---------------------------------------------------------------------
-- § Comparación de eficiencia                                        --
-- ---------------------------------------------------------------------
 
-- La comparación es
--    ghci> :set +s
--    
--    ghci> a249624 !! 700
--    5670
--    (12.72 secs, 1245938184 bytes)
--    
--    ghci> a249624b !! 700
--    5670
--    (8.01 secs, 764775268 bytes)
-- 
--    ghci> a249624c !! 700
--    5670
--    (0.22 secs, 108982640 bytes)
--    
--    ghci> a249624d !! 700
--    5670
--    (0.20 secs, 4707384 bytes)
--    
--    ghci> a249624e !! 700
--    5670
--    (0.17 secs, 77283064 bytes)
--    
--    ghci> a249624f !! 700
--    5670
--    (0.08 secs, 31684408 bytes)
--    
--    ghci> a249624g !! 700
--    5670
--    (0.03 secs, 4651576 bytes)
Leer más →

Aplicaciones alternativas

José A. Alonso, ,

Enunciado

-- Definir la función
--    alternativa :: (a -> b) -> (a -> b) -> [a] -> [b]
-- tal que (alternativa f g xs) es la lista obtenida aplicando
-- alternativamente las funciones f y g a los elementos de xs. Por
-- ejemplo, 
--    alternativa (+1)  (+10) [1,2,3,4]    ==  [2,12,4,14]
--    alternativa (+10) (*10) [1,2,3,4,5]  ==  [11,20,13,40,15]

Soluciones

-- 1ª definición (por recursión):
alternativa1 :: (a -> b) -> (a -> b) -> [a] -> [b]
alternativa1 f g []     = []
alternativa1 f g (x:xs) = f x : alternativa1 g f xs
 
-- 2ª definición (por comprensión):
alternativa2 :: (a -> b) -> (a -> b) -> [a] -> [b]
alternativa2 f g xs = 
    [h x | (h,x) <- zip (cycle [f,g]) xs]
Leer más →

Repetición cíclica

José A. Alonso, ,

Enunciado

-- Definir la función
--    ciclica :: [a] -> [a]
-- tal que (ciclica xs) es la lista obtenida repitiendo cíclicamente los
-- elementos de xs. Por ejemplo,
--    take 10 (ciclica [3,5])    ==  [3,5,3,5,3,5,3,5,3,5]
--    take 10 (ciclica [3,5,7])  ==  [3,5,7,3,5,7,3,5,7,3]
--    take 10 (ciclica [3,5..])  ==  [3,5,7,9,11,13,15,17,19,1]
--    ciclica []                 ==  []
--
-- Comprobar con QuickCheck que la función ciclica es equivalente a la
-- predefinida cycle; es decir, para cualquier número entero n y
-- cualquier lista no vacía xs, se verifica que 
--    take n (ciclica xs) == take n (cycle xs)
-- 
-- Nota. Al hacer la comprobación limitar el tamaño de las pruebas como
-- se indica a continuación
--    ghci> quickCheckWith (stdArgs {maxSize=7}) prop_ciclica
--    +++ OK, passed 100 tests.

Soluciones

import Test.QuickCheck
 
-- 1ª definición
ciclica1 :: [a] -> [a]
ciclica1 [] = []
ciclica1 xs = xs ++ ciclica1 xs
 
-- 2ª definición
ciclica2 :: [a] -> [a]
ciclica2 [] = []
ciclica2 xs = ys where ys = xs ++ ys
 
-- Comprobación de eficiencia
--    ghci> last (take 10000000 (ciclica1 [1,2])) 
--    2
--    (3.69 secs, 1521758928 bytes)
--    
--    ghci> last (take 10000000 (ciclica2 [1,2])) 
--    2
--    (0.21 secs, 561468144 bytes)
-- La 2ª definición es más eficiente.
 
-- La propiedad es
prop_ciclica :: Int -> [Int] -> Property
prop_ciclica n xs =
    not (null xs) ==> 
    take n (ciclica2 xs) == take n (cycle xs)
 
-- La comprobación es
--    ghci> quickCheckWith (stdArgs {maxSize=7}) prop_ciclica
--    +++ OK, passed 100 tests.
Leer más →

Laberinto numérico

José A. Alonso, ,

Enunciado

-- El problema del laberinto numérico consiste en, dados un par de
-- números, encontrar la longitud del camino más corto entre ellos
-- usando sólo las siguientes operaciones:  
--    * multiplicar por 2,
--    * dividir por 2 (sólo para los pares) y
--    * sumar 2.
-- Por ejemplo, un camino mínimo 
--    * de  3 a 12 es [3,6,12], 
--    * de 12 a  3 es [12,6,3], 
--    * de  9 a  2 es [9,18,20,10,12,6,8,4,2] y 
--    * de  2 a  9 es [2,4,8,16,18,9].
-- 
-- Definir la función
--    longitudCaminoMinimo :: Int -> Int -> Int
-- tal que (longitudCaminoMinimo x y) es la longitud del camino mínimo
-- desde x hasta y en el laberinto numérico. 
--    longitudCaminoMinimo 3 12  ==  2
--    longitudCaminoMinimo 12 3  ==  2
--    longitudCaminoMinimo 9 2   ==  8
--    longitudCaminoMinimo 2 9   ==  5

Soluciones

longitudCaminoMinimo :: Int -> Int -> Int
longitudCaminoMinimo x y = 
    head [n | n <- [1..], y `elem` orbita n [x]] 
 
-- (orbita n xs) es el conjunto de números que se pueden obtener aplicando 
-- como máximo n veces las operaciones a los elementos de xs. Por ejemplo, 
--    orbita 0 [12]  ==  [12]
--    orbita 1 [12]  ==  [6,12,14,24]
--    orbita 2 [12]  ==  [3,6,7,8,12,14,16,24,26,28,48]
orbita :: Int -> [Int] -> [Int]
orbita 0 xs = sort xs
orbita n xs = sort (nub (ys ++ concat [sucesores x | x <- ys]))
    where ys = orbita (n-1) xs
          sucesores x | odd x     = [2*x, x+2]
                      | otherwise = [2*x, x `div` 2, x+2]
Leer más →