Listas infinitas – Página 3

Operaciones con series de potencias

PorJosé A. Alonso 29-abril-201625-marzo-2022

Una serie de potencias es una serie de la forma

   a₀ + a₁x + a₂x² + a₃x³ + ...

1	a₀ + a₁x + a₂x² + a₃x³ + ...

Las series de potencias se pueden representar mediante listas
infinitas. Por ejemplo, la serie de la función exponencial es

   e^x = 1 + x + x²/2! + x³/3! + ...

1	e^x = 1 + x + x²/2! + x³/3! + ...

y se puede representar por [1, 1, 1/2, 1/6, 1/24, 1/120, …]

Las operaciones con series se pueden ver como una generalización de las de los polinomios.

En lo que sigue, usaremos el tipo (Serie a) para representar las series de potencias con coeficientes en a y su definición es

   type Serie a = [a]

1	type Serie a = [a]

Definir las siguientes funciones

   opuesta      :: Num a => Serie a -> Serie a
   suma         :: Num a => Serie a -> Serie a -> Serie a
   resta        :: Num a => Serie a -> Serie a -> Serie a
   producto     :: Num a => Serie a -> Serie a -> Serie a
   cociente     :: Fractional a => Serie a -> Serie a -> Serie a
   derivada     :: (Num a, Enum a) => Serie a -> Serie a
   integral     :: (Fractional a, Enum a) => Serie a -> Serie a
   expx         :: Serie Rational

opuesta :: Num a => Serie a -> Serie a

suma :: Num a => Serie a -> Serie a -> Serie a

resta :: Num a => Serie a -> Serie a -> Serie a

producto :: Num a => Serie a -> Serie a -> Serie a

cociente :: Fractional a => Serie a -> Serie a -> Serie a

derivada :: (Num a, Enum a) => Serie a -> Serie a

integral :: (Fractional a, Enum a) => Serie a -> Serie a

expx :: Serie Rational

tales que

(opuesta xs) es la opuesta de la serie xs. Por ejemplo,

     λ> take 7 (opuesta [-6,-4..])
     [6,4,2,0,-2,-4,-6]

1 2	λ> take 7 (opuesta [-6,-4..]) [6,4,2,0,-2,-4,-6]

(suma xs ys) es la suma de las series xs e ys. Por ejemplo,

     λ> take 7 (suma [1,3..] [2,4..])
     [3,7,11,15,19,23,27]

1 2	λ> take 7 (suma [1,3..] [2,4..]) [3,7,11,15,19,23,27]

(resta xs ys) es la resta de las series xs es ys. Por ejemplo,

     λ> take 7 (resta [3,5..] [2,4..])
     [1,1,1,1,1,1,1]
     λ> take 7 (resta ([3,7,11,15,19,23,27] ++ repeat 0) [1,3..])
     [2,4,6,8,10,12,14]

λ> take 7 (resta [3,5..] [2,4..])

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

λ> take 7 (resta ([3,7,11,15,19,23,27] ++ repeat 0) [1,3..])

[2,4,6,8,10,12,14]

(producto xs ys) es el producto de las series xs e ys. Por ejemplo,

     λ> take 7 (producto [3,5..] [2,4..])
     [6,22,52,100,170,266,392]

1 2	λ> take 7 (producto [3,5..] [2,4..]) [6,22,52,100,170,266,392]

(cociente xs ys) es el cociente de las series xs e ys. Por ejemplo,

     λ> take 7 (cociente ([6,22,52,100,170,266,392] ++ repeat 0) [3,5..])
     [2.0,4.0,6.0,8.0,10.0,12.0,14.0]

1 2	λ> take 7 (cociente ([6,22,52,100,170,266,392] ++ repeat 0) [3,5..]) [2.0,4.0,6.0,8.0,10.0,12.0,14.0]

(derivada xs) es la derivada de la serie xs. Por ejemplo,

     λ> take 7 (derivada [2,4..])
     [4,12,24,40,60,84,112]

1 2	λ> take 7 (derivada [2,4..]) [4,12,24,40,60,84,112]

(integral xs) es la integral de la serie xs. Por ejemplo,

     λ> take 7 (integral ([4,12,24,40,60,84,112] ++ repeat 0))
     [0.0,4.0,6.0,8.0,10.0,12.0,14.0]

1 2	λ> take 7 (integral ([4,12,24,40,60,84,112] ++ repeat 0)) [0.0,4.0,6.0,8.0,10.0,12.0,14.0]

expx es la serie de la función exponencial. Por ejemplo,

     λ> take 8 expx
     [1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]
     λ> take 8 (derivada expx)
     [1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]
     λ> take 8 (integral expx)
     [0 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

λ> take 8 expx

[1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

λ> take 8 (derivada expx)

[1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

λ> take 8 (integral expx)

[0 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

Soluciones

type Serie a = [a] 

opuesta :: Num a => Serie a -> Serie a
opuesta = map negate

suma :: Num a => Serie a -> Serie a -> Serie a
suma = zipWith (+)

resta :: Num a => Serie a -> Serie a -> Serie a
resta xs ys = suma xs (opuesta ys)

producto :: Num a => Serie a -> Serie a -> Serie a
producto (x:xs) zs@(y:ys) = 
    x*y : suma (producto xs zs) (map (x*) ys)

cociente :: Fractional a => Serie a -> Serie a -> Serie a
cociente (x:xs) (y:ys) = zs 
    where zs = x/y : map (/y) (resta xs (producto zs ys))  

derivada :: (Num a, Enum a) => Serie a -> Serie a
derivada (_:xs) = zipWith (*) xs [1..]

integral :: (Fractional a, Enum a) => Serie a -> Serie a
integral xs = 0 : zipWith (/) xs [1..]

expx :: Serie Rational
expx = map (1/) (map fromIntegral factoriales)

-- factoriales es la lista de los factoriales. Por ejemplo, 
--    take 7 factoriales  ==  [1,1,2,6,24,120,720]
factoriales :: [Integer]
factoriales = 1 : scanl1 (*) [1..]

type Serie a = [a]

opuesta :: Num a => Serie a -> Serie a

opuesta = map negate

suma :: Num a => Serie a -> Serie a -> Serie a

suma = zipWith (+)

resta :: Num a => Serie a -> Serie a -> Serie a

resta xs ys = suma xs (opuesta ys)

producto :: Num a => Serie a -> Serie a -> Serie a

producto (x:xs) zs@(y:ys) =

x*y : suma (producto xs zs) (map (x*) ys)

cociente :: Fractional a => Serie a -> Serie a -> Serie a

cociente (x:xs) (y:ys) = zs

where zs = x/y : map (/y) (resta xs (producto zs ys))

derivada :: (Num a, Enum a) => Serie a -> Serie a

derivada (_:xs) = zipWith (*) xs [1..]

integral :: (Fractional a, Enum a) => Serie a -> Serie a

integral xs = 0 : zipWith (/) xs [1..]

expx :: Serie Rational

expx = map (1/) (map fromIntegral factoriales)

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

-- take 7 factoriales == [1,1,2,6,24,120,720]

factoriales :: [Integer]

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

Números cuyos dígitos coinciden con los de sus factores primos

PorJosé A. Alonso 30-marzo-201625-marzo-2022

Un número n es especial si al unir los dígitos de sus factores primos, se obtienen exactamente los dígitos de n, aunque puede ser en otro orden. Por ejemplo, 1255 es especial, pues los factores primos de 1255 son 5 y 251.

Definir la función

   esEspecial :: Integer -> Bool

1	esEspecial :: Integer -> Bool

tal que (esEspecial n) se verifica si un número n es especial. Por ejemplo,

   esEspecial 1255 == True
   esEspecial 125  == False
   esEspecial 132  == False

esEspecial 1255 == True

esEspecial 125 == False

esEspecial 132 == False

Comprobar con QuickCheck que todo número primo es especial.

Calcular los 5 primeros números especiales que no son primos.

Soluciones

import Data.List (nub, sort)
import Data.Numbers.Primes (isPrime, primeFactors)
import Test.QuickCheck

esEspecial :: Integer -> Bool
esEspecial n = 
    sort (show n) == sort (concatMap show (nub (primeFactors n)))

-- La propiedad es
prop_primos:: Integer -> Property
prop_primos n = 
    isPrime (abs n) ==> esEspecial (abs n)

-- La comprobación es
--    ghci> quickCheck prop_primos
--    +++ OK, passed 100 tests.

-- El cálculo es
--    ghci> take 5 [n | n <- [2..], esEspecial n, not (isPrime n)]
--    [735,1255,3792,7236,11913]

import Data.List (nub, sort)

import Data.Numbers.Primes (isPrime, primeFactors)

import Test.QuickCheck

esEspecial :: Integer -> Bool

esEspecial n =

sort (show n) == sort (concatMap show (nub (primeFactors n)))

-- La propiedad es

prop_primos:: Integer -> Property

prop_primos n =

isPrime (abs n) ==> esEspecial (abs n)

-- La comprobación es

-- ghci> quickCheck prop_primos

-- +++ OK, passed 100 tests.

-- El cálculo es

-- ghci> take 5 [n | n <- [2..], esEspecial n, not (isPrime n)]

-- [735,1255,3792,7236,11913]

Índices de números de Fibonacci

PorJosé A. Alonso 2-marzo-201626-marzo-2022

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

   0, 1, 1, 2, 3, 5, 8, 13, 21, 34

1	0, 1, 1, 2, 3, 5, 8, 13, 21, 34

Se observa que el 6º término de la sucesión (comenzando a contar en 0) es el número 8.

Definir la función

   indiceFib :: Integer -> Maybe Integer

1	indiceFib :: Integer -> Maybe Integer

tal que (indiceFib x) es justo el número n si x es el n-ésimo términos de la sucesión de Fibonacci o Nothing en el caso de que x no pertenezca a la sucesión. Por ejemplo,

    indiceFib 8                                           == Just 6
    indiceFib 9                                           == Nothing
    indiceFib 21                                          == Just 8
    indiceFib 22                                          == Nothing
    indiceFib 280571172992510140037611932413038677189525  == Just 200
    indiceFib 123456789012345678901234567890123456789012  == Nothing

indiceFib 8 == Just 6

indiceFib 9 == Nothing

indiceFib 21 == Just 8

indiceFib 22 == Nothing

indiceFib 280571172992510140037611932413038677189525 == Just 200

indiceFib 123456789012345678901234567890123456789012 == Nothing

Soluciones

indiceFib :: Integer -> Maybe Integer
indiceFib x | y == x    = Just n
            | otherwise = Nothing
    where (y,n) = head (dropWhile (\(z,m) -> z < x) fibsNumerados)

-- fibs es la lista de los términos de la sucesión de Fibonacci. Por
-- ejemplo, 
--    take 10 fibs  ==  [0,1,1,2,3,5,8,13,21,34]
fibs :: [Integer]
fibs = 0 : 1 : [x+y | (x,y) <- zip fibs (tail fibs)]

-- fibsNumerados es la lista de los términos de la sucesión de Fibonacci
-- juntos con sus posiciones. Por ejemplo,
--    ghci> take 10 fibsNumerados
--    [(0,0),(1,1),(1,2),(2,3),(3,4),(5,5),(8,6),(13,7),(21,8),(34,9)]
fibsNumerados :: [(Integer,Integer)]
fibsNumerados = zip fibs [0..]

indiceFib :: Integer -> Maybe Integer

indiceFib x | y == x = Just n

| otherwise = Nothing

where (y,n) = head (dropWhile (\(z,m) -> z < x) fibsNumerados)

-- fibs es la lista de los términos de la sucesión de Fibonacci. Por

-- ejemplo,

-- take 10 fibs == [0,1,1,2,3,5,8,13,21,34]

fibs :: [Integer]

fibs = 0 : 1 : [x+y | (x,y) <- zip fibs (tail fibs)]

-- fibsNumerados es la lista de los términos de la sucesión de Fibonacci

-- juntos con sus posiciones. Por ejemplo,

-- ghci> take 10 fibsNumerados

-- [(0,0),(1,1),(1,2),(2,3),(3,4),(5,5),(8,6),(13,7),(21,8),(34,9)]

fibsNumerados :: [(Integer,Integer)]

fibsNumerados = zip fibs [0..]

En Maxima

indiceFib (n) := block([a:0,b:1,c:1,p:0],
  unless n <= a do
   (a : b,
    b : c,
    c : a + b,
    p : p + 1),
  if n = a
  then Just (p)
  else Nothing)$

indiceFib (n) := block([a:0,b:1,c:1,p:0],

unless n <= a do

(a : b,

b : c,

c : a + b,

p : p + 1),

if n = a

then Just (p)

else Nothing)$

Sumas de potencias de 3 primos

PorJosé A. Alonso 24-febrero-201625-marzo-2022

Los primeros números de la forma p²+q³+r⁴, con p, q y r primos son

   28 = 2² + 2³ + 2⁴
   33 = 3² + 2³ + 2⁴
   47 = 2² + 3³ + 2⁴
   49 = 5² + 2³ + 2⁴

28 = 2² + 2³ + 2⁴

33 = 3² + 2³ + 2⁴

47 = 2² + 3³ + 2⁴

49 = 5² + 2³ + 2⁴

Definir la sucesión

   sumas3potencias :: [Integer]

1	sumas3potencias :: [Integer]

cuyos elementos son los números que se pueden escribir de la forma p²+q³+r⁴, con p, q y r primos. Por ejemplo,

   λ> take 15 sumas3potencias
   [28,33,47,49,52,68,73,92,93,98,112,114,117,133,138]
   λ> sumas3potencias !! 234567
   8953761

λ> take 15 sumas3potencias

[28,33,47,49,52,68,73,92,93,98,112,114,117,133,138]

λ> sumas3potencias !! 234567

8953761

Soluciones

import Data.Numbers.Primes (primes)

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

sumas3potencias1 :: [Integer]
sumas3potencias1 = filter esTripleSuma [1..]
 
-- (esTripleSuma n) se verifica si n se puede escribir de la forma
-- p²+q³+r⁴, con p, q y r primos. Por ejemplo, 
--    esTripleSuma 33  ==  True
--    esTripleSuma 45  ==  False
esTripleSuma :: Integer -> Bool
esTripleSuma = not . null . triplesSumas  

-- (triplesSumas n) es la lista de las ternas de primos (p,q,r) tales
-- que p²+q³+r⁴ = n. Por ejemplo,
--    triplesSumas 33   ==  [(3,2,2)]
--    triplesSumas 145  ==  [(11,2,2),(2,5,2)]
--    triplesSumas 45   ==  []
triplesSumas :: Integer -> [(Integer,Integer,Integer)]
triplesSumas n =  
    [(p,q,r) 
    | r <- xs, 
      q <- xs, 
      let p2 = n - q^3 - r^4,
      let p = (floor . sqrt . fromIntegral) p2,
      p*p == p2,
      isPrime p]
    where xs = takeWhile (< (ceiling $ sqrt $ fromIntegral n)) primes

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

sumas3potencias2 :: [Integer]
sumas3potencias2 = sumaOrdenadaInf as (sumaOrdenadaInf bs cs)

sumaOrdenadaInf:: [Integer] -> [Integer] -> [Integer]
sumaOrdenadaInf xs ys = mezclaTodas [map (+x) ys | x <- xs]

mezclaTodas :: Ord a => [[a]] -> [a]
mezclaTodas = foldr1 xmezcla
    where xmezcla (x:xs) ys = x : mezcla xs ys

mezcla :: Ord a => [a] -> [a] -> [a]
mezcla (x:xs) (y:ys) | x < y  = x : mezcla xs (y:ys)
                     | x == y = x : mezcla xs ys
                     | x > y  = y : mezcla (x:xs) ys
 
as = map (^2) primes
bs = map (^3) primes
cs = map (^4) primes

import Data.Numbers.Primes (primes)

-- 1ª solución

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

sumas3potencias1 :: [Integer]

sumas3potencias1 = filter esTripleSuma [1..]

-- (esTripleSuma n) se verifica si n se puede escribir de la forma

-- p²+q³+r⁴, con p, q y r primos. Por ejemplo,

-- esTripleSuma 33 == True

-- esTripleSuma 45 == False

esTripleSuma :: Integer -> Bool

esTripleSuma = not . null . triplesSumas

-- (triplesSumas n) es la lista de las ternas de primos (p,q,r) tales

-- que p²+q³+r⁴ = n. Por ejemplo,

-- triplesSumas 33 == [(3,2,2)]

-- triplesSumas 145 == [(11,2,2),(2,5,2)]

-- triplesSumas 45 == []

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

triplesSumas n =

[(p,q,r)

| r <- xs,

q <- xs,

let p2 = n - q^3 - r^4,

let p = (floor . sqrt . fromIntegral) p2,

p*p == p2,

isPrime p]

where xs = takeWhile (< (ceiling $ sqrt $ fromIntegral n)) primes

-- 2ª solución

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

sumas3potencias2 :: [Integer]

sumas3potencias2 = sumaOrdenadaInf as (sumaOrdenadaInf bs cs)

sumaOrdenadaInf:: [Integer] -> [Integer] -> [Integer]

sumaOrdenadaInf xs ys = mezclaTodas [map (+x) ys | x <- xs]

mezclaTodas :: Ord a => [[a]] -> [a]

mezclaTodas = foldr1 xmezcla

where xmezcla (x:xs) ys = x : mezcla xs ys

mezcla :: Ord a => [a] -> [a] -> [a]

mezcla (x:xs) (y:ys) | x < y = x : mezcla xs (y:ys)

| x == y = x : mezcla xs ys

| x > y = y : mezcla (x:xs) ys

as = map (^2) primes

bs = map (^3) primes

cs = map (^4) primes

Múltiplos con ceros y unos

PorJosé A. Alonso 23-febrero-201625-marzo-2022

Se observa que todos los primeros números naturales tienen al menos un múltiplo no nulo que está formado solamente por ceros y unos. Por ejemplo, 1×10=10, 2×5=10, 3×37=111, 4×25=100, 5×2=10, 6×185=1110; 7×143=1001; 8X125=1000; 9×12345679=111111111.

Definir la función

   multiplosCon1y0 :: Integer -> [Integer]

1	multiplosCon1y0 :: Integer -> [Integer]

tal que (multiplosCon1y0 n) es la lista de los múltiplos de n cuyos dígitos son 1 ó 0. Por ejemplo,

   take 4 (multiplosCon1y0 3)      ==  [111,1011,1101,1110]
   take 3 (multiplosCon1y0 23)     ==  [110101,1011011,1101010]
   head (multiplosCon1y0 1234658)  ==  110101101101000000110

take 4 (multiplosCon1y0 3) == [111,1011,1101,1110]

take 3 (multiplosCon1y0 23) == [110101,1011011,1101010]

head (multiplosCon1y0 1234658) == 110101101101000000110

Comprobar con QuickCheck que todo entero positivo tiene algún múltiplo cuyos dígitos son 1 ó 0.

Soluciones

import Test.QuickCheck

multiplosCon1y0 :: Integer -> [Integer] 
multiplosCon1y0 n = 
    [x | x <- numerosCon1y0, 
         x `rem` n == 0] 

-- numerosCon1y0 es la lista de los números cuyos dígitos son 1 ó 0. Por
-- ejemplo,  
--    ghci> take 15 numerosCon1y0
--    [1,10,11,100,101,110,111,1000,1001,1010,1011,1100,1101,1110,1111]
numerosCon1y0 :: [Integer]
numerosCon1y0 = 1 : concat [[10*x,10*x+1] | x <- numerosCon1y0]

-- La propiedad es
prop_existe_multiplosCon1y0 :: Integer -> Property
prop_existe_multiplosCon1y0 n = 
    n > 0 ==> multiplosCon1y0 n /= []

-- La comprobación es
--    ghci> quickCheck prop_existe_multiplosCon1y0
--    +++ OK, passed 100 tests.

import Test.QuickCheck

multiplosCon1y0 :: Integer -> [Integer]

multiplosCon1y0 n =

[x | x <- numerosCon1y0,

x `rem` n == 0]

-- numerosCon1y0 es la lista de los números cuyos dígitos son 1 ó 0. Por

-- ejemplo,

-- ghci> take 15 numerosCon1y0

-- [1,10,11,100,101,110,111,1000,1001,1010,1011,1100,1101,1110,1111]

numerosCon1y0 :: [Integer]

numerosCon1y0 = 1 : concat [[10*x,10*x+1] | x <- numerosCon1y0]

-- La propiedad es

prop_existe_multiplosCon1y0 :: Integer -> Property

prop_existe_multiplosCon1y0 n =

n > 0 ==> multiplosCon1y0 n /= []

-- La comprobación es

-- ghci> quickCheck prop_existe_multiplosCon1y0

-- +++ OK, passed 100 tests.

Antiimágenes en una función creciente

PorJosé A. Alonso 20-enero-201626-marzo-2022

Definir la función

   antiimagen :: (Int -> Int) -> Int -> Maybe Int

1	antiimagen :: (Int -> Int) -> Int -> Maybe Int

tal que (antiimagen f y) es justo el x tal que f(x) = y, si y pertenece a la imagen de la función creciente f, o nada, en caso contrario. Por ejemplo,

   antiimagen (^2) 25  ==  Just 5
   antiimagen (^3) 25  ==  Nothing

1 2	antiimagen (^2) 25 == Just 5 antiimagen (^3) 25 == Nothing

Nota. Se supone que f está definida sobre los números naturales.

Soluciones

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

antiimagen1 :: (Int -> Int) -> Int -> Maybe Int
antiimagen1 f y 
    | estaEnImagen f y = Just x
    | otherwise        = Nothing
    where x = head [x | x <- [0..], f x == y]

-- (estaEnImagen f y) se verifica si pertenece a la imagen de f. Por
-- ejemplo, 
--    estaEnImagen (^2) 25 == True
--    estaEnImagen (^2) 30 == False
estaEnImagen :: (Int -> Int) -> Int -> Bool
estaEnImagen f y = elem y (takeWhile (<=y) (imagen f)) 

-- (imagen f) es la imagen de f. Por ejemplo,
--    take 10 (imagen (^2))  ==  [0,1,4,9,16,25,36,49,64,81]
--    take 10 (imagen (*3))  ==  [0,3,6,9,12,15,18,21,24,27]
imagen :: (Int -> Int) -> [Int]
imagen f = map f [0..]

-- 2ª definición (con lookup y maxBound)
-- =====================================

antiimagen2 :: (Int -> Int) -> Int -> Maybe Int
antiimagen2 f y =
    lookup y (takeWhile (<= (y,maxBound)) [(f x, x) | x <- [0..]])

-- 1ª definición

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

antiimagen1 :: (Int -> Int) -> Int -> Maybe Int

antiimagen1 f y

| estaEnImagen f y = Just x

| otherwise = Nothing

where x = head [x | x <- [0..], f x == y]

-- (estaEnImagen f y) se verifica si pertenece a la imagen de f. Por

-- ejemplo,

-- estaEnImagen (^2) 25 == True

-- estaEnImagen (^2) 30 == False

estaEnImagen :: (Int -> Int) -> Int -> Bool

estaEnImagen f y = elem y (takeWhile (<=y) (imagen f))

-- (imagen f) es la imagen de f. Por ejemplo,

-- take 10 (imagen (^2)) == [0,1,4,9,16,25,36,49,64,81]

-- take 10 (imagen (*3)) == [0,3,6,9,12,15,18,21,24,27]

imagen :: (Int -> Int) -> [Int]

imagen f = map f [0..]

-- 2ª definición (con lookup y maxBound)

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

antiimagen2 :: (Int -> Int) -> Int -> Maybe Int

antiimagen2 f y =

lookup y (takeWhile (<= (y,maxBound)) [(f x, x) | x <- [0..]])

Siembra de listas

PorJosé A. Alonso 23-diciembre-201525-marzo-2022

Definir la función

   siembra :: [Int] -> [Int]

1	siembra :: [Int] -> [Int]

tal que (siembra xs) es la lista ys obtenida al repartir cada elemento x de la lista xs poniendo un 1 en las x siguientes posiciones de la lista ys. Por ejemplo,

   siembra [4]      ==  [0,1,1,1,1] 
   siembra [0,2]    ==  [0,0,1,1]
   siembra [4,2]    ==  [0,1,2,2,1]

siembra [4] == [0,1,1,1,1]

siembra [0,2] == [0,0,1,1]

siembra [4,2] == [0,1,2,2,1]

El tercer ejemplo se obtiene sumando la siembra de 4 en la posición 0 (como el ejemplo 1) y el 2 en la posición 1 (como el ejemplo 2). Otros ejemplos son

   siembra [0,4,2]          ==  [0,0,1,2,2,1]
   siembra [3]              ==  [0,1,1,1]
   siembra [3,4,2]          ==  [0,1,2,3,2,1]
   siembra [3,2,1]          ==  [0,1,2,3]
   sum $ siembra [1..2500]  ==  3126250

siembra [0,4,2] == [0,0,1,2,2,1]

siembra [3] == [0,1,1,1]

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

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

sum $ siembra [1..2500] == 3126250

Comprobar con QuickCheck que la suma de los elementos de (siembra xs) es igual que la suma de los de xs.

Nota 1: Se supone que el argumento es una lista de números no negativos y que se puede ampliar tanto como sea necesario para repartir los elementos.

Nota 2: Este ejercicio es parte del examen del grupo 3 del 2 de diciembre.

Soluciones

import Test.QuickCheck

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

siembra1 :: [Int] -> [Int]
siembra1 = suma . brotes

-- (brotes xs) es la lista de los brotes obtenido sembrando los
-- elementos de xs. Por ejemplo,
--    brotes [3,4,2]  ==  [[0,1,1,1],[0,0,1,1,1,1],[0,0,0,1,1]]
brotes :: [Int] -> [[Int]]
brotes xs = aux xs 1
    where aux (x:xs) n = (replicate n 0 ++ replicate x 1) : aux xs (n+1)
          aux _ _      = []

-- (suma xss) es la suma de los elementos de xss (suponiendo que al
-- final de cada elemento se continua con ceros). Por ejemplo,
--    suma [[0,1,1,1],[0,0,1,1,1,1],[0,0,0,1,1]]  ==  [0,1,2,3,2,1]
suma :: [[Int]] -> [Int]
suma = foldr1 aux
    where aux [] ys = ys
          aux xs [] = xs
          aux (x:xs) (y:ys) = (x+y) : aux xs ys

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

siembra2 :: [Int] -> [Int]
siembra2 [] = []
siembra2 (x:xs) = mezcla (siembraElemento x) (0 : siembra2 xs)

siembraElemento :: Int -> [Int]
siembraElemento x = 0 : replicate x 1

mezcla :: [Int] -> [Int] -> [Int]
mezcla xs ys =
    take (max (length xs) (length ys))
         (zipWith (+) (xs ++ repeat 0) (ys ++ repeat 0))

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

siembra3 :: [Int] -> [Int]
siembra3 [] = []
siembra3 xs = aux xs 0 (repeat 0) where
    aux []     _ ys = cosecha ys
    aux (x:xs) n ys = aux xs (n+1) (zipWith (+) brotes ys) 
        where brotes = replicate (n+1) 0 ++ replicate x 1 ++ repeat 0

-- (cosecha xs) es la lista formada por los ceros iniciales de xs y los
-- elementos siguientes hasta que vuelve a aparecer el 0. Por ejemplo,
--    cosecha [0,0,3,5,2,0,9]            ==  [0,0,3,5,2]
--    cosecha ([0,0,3,5,2] ++ repeat 0)  ==  [0,0,3,5,2]
cosecha :: [Int] -> [Int]              
cosecha xs = ys ++ takeWhile (>0) zs
    where (ys,zs) = span (==0) xs

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

siembra4 :: [Int] -> [Int]
siembra4 [] = []
siembra4 xs = aux xs [] (repeat 0) where
    aux []     ys zs     = reverse ys ++ takeWhile (>0) zs
    aux (x:xs) ys (z:zs) = aux xs (z:ys) (zipWith (+) brotes zs) 
        where brotes = replicate x 1 ++ repeat 0

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

--    λ> sum $ siembra1 [1..2000]
--    2001000
--    (9.44 secs, 1,894,065,928 bytes)
--    ghci> sum $ siembra2 [1..2000]
--    2001000
--    (5.92 secs, 936900576 bytes)
--    ghci> sum $ siembra3 [1..2000]
--    2001000
--    (1.59 secs, 836847072 bytes)
--    ghci> sum $ siembra4 [1..2000]
--    2001000
--    (1.68 secs, 570492392 bytes)

-- En lo que sigue usaremos la 2ª definición
siembra :: [Int] -> [Int]
siembra = siembra2

-- Verificación
-- ============

-- La propiedad es
prop_siembra :: [Int] -> Bool
prop_siembra xs =
    sum (siembra1 ys) == sum ys
    where ys = map (\x -> 1 + abs x) xs

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

100

import Test.QuickCheck

-- 1ª solución

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

siembra1 :: [Int] -> [Int]

siembra1 = suma . brotes

-- (brotes xs) es la lista de los brotes obtenido sembrando los

-- elementos de xs. Por ejemplo,

-- brotes [3,4,2] == [[0,1,1,1],[0,0,1,1,1,1],[0,0,0,1,1]]

brotes :: [Int] -> [[Int]]

brotes xs = aux xs 1

where aux (x:xs) n = (replicate n 0 ++ replicate x 1) : aux xs (n+1)

aux _ _ = []

-- (suma xss) es la suma de los elementos de xss (suponiendo que al

-- final de cada elemento se continua con ceros). Por ejemplo,

-- suma [[0,1,1,1],[0,0,1,1,1,1],[0,0,0,1,1]] == [0,1,2,3,2,1]

suma :: [[Int]] -> [Int]

suma = foldr1 aux

where aux [] ys = ys

aux xs [] = xs

aux (x:xs) (y:ys) = (x+y) : aux xs ys

-- 2ª solución

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

siembra2 :: [Int] -> [Int]

siembra2 [] = []

siembra2 (x:xs) = mezcla (siembraElemento x) (0 : siembra2 xs)

siembraElemento :: Int -> [Int]

siembraElemento x = 0 : replicate x 1

mezcla :: [Int] -> [Int] -> [Int]

mezcla xs ys =

take (max (length xs) (length ys))

(zipWith (+) (xs ++ repeat 0) (ys ++ repeat 0))

-- 3ª solución

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

siembra3 :: [Int] -> [Int]

siembra3 [] = []

siembra3 xs = aux xs 0 (repeat 0) where

aux [] _ ys = cosecha ys

aux (x:xs) n ys = aux xs (n+1) (zipWith (+) brotes ys)

where brotes = replicate (n+1) 0 ++ replicate x 1 ++ repeat 0

-- (cosecha xs) es la lista formada por los ceros iniciales de xs y los

-- elementos siguientes hasta que vuelve a aparecer el 0. Por ejemplo,

-- cosecha [0,0,3,5,2,0,9] == [0,0,3,5,2]

-- cosecha ([0,0,3,5,2] ++ repeat 0) == [0,0,3,5,2]

cosecha :: [Int] -> [Int]

cosecha xs = ys ++ takeWhile (>0) zs

where (ys,zs) = span (==0) xs

-- 4ª solución

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

siembra4 :: [Int] -> [Int]

siembra4 [] = []

siembra4 xs = aux xs [] (repeat 0) where

aux [] ys zs = reverse ys ++ takeWhile (>0) zs

aux (x:xs) ys (z:zs) = aux xs (z:ys) (zipWith (+) brotes zs)

where brotes = replicate x 1 ++ repeat 0

-- Comparación de eficiencia

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

-- λ> sum $ siembra1 [1..2000]

-- 2001000

-- (9.44 secs, 1,894,065,928 bytes)

-- ghci> sum $ siembra2 [1..2000]

-- 2001000

-- (5.92 secs, 936900576 bytes)

-- ghci> sum $ siembra3 [1..2000]

-- 2001000

-- (1.59 secs, 836847072 bytes)

-- ghci> sum $ siembra4 [1..2000]

-- 2001000

-- (1.68 secs, 570492392 bytes)

-- En lo que sigue usaremos la 2ª definición

siembra :: [Int] -> [Int]

siembra = siembra2

-- Verificación

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

-- La propiedad es

prop_siembra :: [Int] -> Bool

prop_siembra xs =

sum (siembra1 ys) == sum ys

where ys = map (\x -> 1 + abs x) xs

-- La comprobación es

-- λ> quickCheck prop_siembra

-- +++ OK, passed 100 tests.

Producto infinito

PorJosé A. Alonso 22-diciembre-201525-marzo-2022

Definir la función

   productoInfinito :: [Int] -> [Int]

1	productoInfinito :: [Int] -> [Int]

tal que (productoInfinito xs) es la lista infinita que en la posición N tiene el producto de los N primeros elementos de la lista infinita xs. Por ejemplo,

   take 5 (productoInfinito [1..])    ==  [1,2,6,24,120]
   take 5 (productoInfinito [2,4..])  ==  [2,8,48,384,3840]
   take 5 (productoInfinito [1,3..])  ==  [1,3,15,105,945]

take 5 (productoInfinito [1..]) == [1,2,6,24,120]

take 5 (productoInfinito [2,4..]) == [2,8,48,384,3840]

take 5 (productoInfinito [1,3..]) == [1,3,15,105,945]

Nota: Este ejercicio es parte del examen del grupo 3 del 2 de diciembre.

Soluciones

-- 1ª definición (por comprensión):
productoInfinito1 :: [Integer] -> [Integer]
productoInfinito1 xs = [product (take n xs) | n <- [1..]]

-- 2ª definición (por recursión)
productoInfinito2 :: [Integer] -> [Integer]
productoInfinito2 (x:y:zs) = x : productoInfinito2 (x*y:zs)

-- 2ª definición (por recursión y map)
productoInfinito3 :: [Integer] -> [Integer]
productoInfinito3 []     = [1]
productoInfinito3 (x:xs) = map (x*) (1 : productoInfinito3 xs)

-- 4ª definición (con scanl1)
productoInfinito4 :: [Integer] -> [Integer]
productoInfinito4 = scanl1 (*)

-- Comparación de eficiencia
--    λ> take 20 (show (productoInfinito1 [2,4..] !! 10000))
--    "11358071114466915693"
--    (0.35 secs, 98,287,328 bytes)
--    λ> take 20 (show (productoInfinito2 [2,4..] !! 10000))
--    "11358071114466915693"
--    (0.35 secs, 98,840,440 bytes)
--    λ> take 20 (show (productoInfinito3 [2,4..] !! 10000))
--    "11358071114466915693"
--    (7.36 secs, 6,006,360,472 bytes)
--    λ> take 20 (show (productoInfinito4 [2,4..] !! 10000))
--    "11358071114466915693"
--    (0.34 secs, 96,367,000 bytes)

-- 1ª definición (por comprensión):

productoInfinito1 :: [Integer] -> [Integer]

productoInfinito1 xs = [product (take n xs) | n <- [1..]]

-- 2ª definición (por recursión)

productoInfinito2 :: [Integer] -> [Integer]

productoInfinito2 (x:y:zs) = x : productoInfinito2 (x*y:zs)

-- 2ª definición (por recursión y map)

productoInfinito3 :: [Integer] -> [Integer]

productoInfinito3 [] = [1]

productoInfinito3 (x:xs) = map (x*) (1 : productoInfinito3 xs)

-- 4ª definición (con scanl1)

productoInfinito4 :: [Integer] -> [Integer]

productoInfinito4 = scanl1 (*)

-- Comparación de eficiencia

-- λ> take 20 (show (productoInfinito1 [2,4..] !! 10000))

-- "11358071114466915693"

-- (0.35 secs, 98,287,328 bytes)

-- λ> take 20 (show (productoInfinito2 [2,4..] !! 10000))

-- "11358071114466915693"

-- (0.35 secs, 98,840,440 bytes)

-- λ> take 20 (show (productoInfinito3 [2,4..] !! 10000))

-- "11358071114466915693"

-- (7.36 secs, 6,006,360,472 bytes)

-- λ> take 20 (show (productoInfinito4 [2,4..] !! 10000))

-- "11358071114466915693"

-- (0.34 secs, 96,367,000 bytes)

Año cúbico

PorJosé A. Alonso 14-diciembre-201525-marzo-2022

El año 2016 será un año cúbico porque se puede escribir como la suma de los cubos de 7 números consecutivos; en efecto,

   2016 = 3³+ 4³ +...+ 9³

1	2016 = 3³+ 4³ +...+ 9³

Definir la función

   esCubico :: Integer -> Bool

1	esCubico :: Integer -> Bool

tal que (esCubico x) se verifica si x se puede escribir como la suma de los cubos de 7 números consecutivos. Por ejemplo,

   esCubico 2016                ==  True
   esCubico 2017                ==  False
   esCubico 189005670081900441  ==  True
   esCubico 189005670081900442  ==  False

esCubico 2016 == True

esCubico 2017 == False

esCubico 189005670081900441 == True

esCubico 189005670081900442 == False

Soluciones

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

esCubico1 :: Integer -> Bool
esCubico1 x = pertenece x cubicos

-- cubicos es la lista de los números que se pueden escribir como la
-- suma de los cubos de 7 números consecutivos. Por ejemplo,
--    take 5 cubicos  ==  [784,1295,2016,2989,4256]
cubicos :: [Integer]
cubicos = [sum [x^3 | x <- [y..y+6]] | y <- [1..]]

-- (pertenece x ys) se verifica si x pertenece a la lista ordenada
-- ys. Por ejemplo,
--    pertenece 25 [0,3..]  ==  False
--    pertenece 27 [0,3..]  ==  True
pertenece :: Integer -> [Integer] ->  Bool
pertenece x ys = x == head (dropWhile (<x) ys)

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

esCubico2 :: Integer -> Bool
esCubico2 x = pertenece x (cubicosDesde k)
    where k = floor ((fromIntegral x/7)**(1/3))

cubicosDesde :: Integer -> [Integer]
cubicosDesde k = [sum [x^3 | x <- [y..y+6]] | y <- [k..]]

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

--    λ> esCubico1 189005670081900441
--    True
--    (7.49 secs, 1,917,868,024 bytes)
--    λ> esCubico2 189005670081900441
--    True
--    (0.01 secs, 0 bytes)

-- 1ª definición

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

esCubico1 :: Integer -> Bool

esCubico1 x = pertenece x cubicos

-- cubicos es la lista de los números que se pueden escribir como la

-- suma de los cubos de 7 números consecutivos. Por ejemplo,

-- take 5 cubicos == [784,1295,2016,2989,4256]

cubicos :: [Integer]

cubicos = [sum [x^3 | x <- [y..y+6]] | y <- [1..]]

-- (pertenece x ys) se verifica si x pertenece a la lista ordenada

-- ys. Por ejemplo,

-- pertenece 25 [0,3..] == False

-- pertenece 27 [0,3..] == True

pertenece :: Integer -> [Integer] -> Bool

pertenece x ys = x == head (dropWhile (<x) ys)

-- 2ª definición

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

esCubico2 :: Integer -> Bool

esCubico2 x = pertenece x (cubicosDesde k)

where k = floor ((fromIntegral x/7)**(1/3))

cubicosDesde :: Integer -> [Integer]

cubicosDesde k = [sum [x^3 | x <- [y..y+6]] | y <- [k..]]

-- Comparación de eficiencia

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

-- λ> esCubico1 189005670081900441

-- True

-- (7.49 secs, 1,917,868,024 bytes)

-- λ> esCubico2 189005670081900441

-- True

-- (0.01 secs, 0 bytes)

Números cuyas cifras coinciden con las de sus factores primos

PorJosé A. Alonso 4-mayo-201525-marzo-2022

Un número n es especial si al unir las cifras de sus factores primos, se obtienen exactamente las cifras de n, aunque puede ser en otro orden. Por ejemplo, 1255 es especial, pues los factores primos de 1255 son 5 y 251.

Definir la función

   esEspecial :: Integer -> Bool

1	esEspecial :: Integer -> Bool

tal que (esEspecial n) se verifica si un número n es especial. Por ejemplo,

   esEspecial 1255 == True
   esEspecial 125  == False

1 2	esEspecial 1255 == True esEspecial 125 == False

Comprobar con QuickCheck que todo número primo es especial.

Calcular los 5 primeros números especiales que no son primos.

Soluciones

import Data.List (nub, sort)
import Data.Numbers.Primes (isPrime, primeFactors)
import Test.QuickCheck

esEspecial :: Integer -> Bool
esEspecial n = 
    sort (show n) == sort (concatMap show (nub (primeFactors n)))

-- La propiedad es
prop_primos:: Integer -> Property
prop_primos n = 
    isPrime (abs n) ==> esEspecial (abs n)

-- La comprobación es
--    ghci> quickCheck prop_primos
--    +++ OK, passed 100 tests.

-- El cálculo es
--    ghci> take 5 [n | n <- [2..], esEspecial n, not (isPrime n)]
--    [735,1255,3792,7236,11913]

import Data.List (nub, sort)

import Data.Numbers.Primes (isPrime, primeFactors)

import Test.QuickCheck

esEspecial :: Integer -> Bool

esEspecial n =

sort (show n) == sort (concatMap show (nub (primeFactors n)))

-- La propiedad es

prop_primos:: Integer -> Property

prop_primos n =

isPrime (abs n) ==> esEspecial (abs n)

-- La comprobación es

-- ghci> quickCheck prop_primos

-- +++ OK, passed 100 tests.

-- El cálculo es

-- ghci> take 5 [n | n <- [2..], esEspecial n, not (isPrime n)]

-- [735,1255,3792,7236,11913]

Constante de Champernowne

PorJosé A. Alonso 15-abril-201525-marzo-2022

La constante de Champernowne es el número irracional

   0.12345678910111213141516171819202122232425262728293031323334 ...

1	0.12345678910111213141516171819202122232425262728293031323334 ...

cuya parte entera es 0 y la parte decimal se obtiene concatenado los números naturales a partir de 1.

Definir la función

   productoChampernowne :: [Int] -> Int

1	productoChampernowne :: [Int] -> Int

tal que (productoChampernowne ns) es el producto de los dígitos de la constante de Champernowne que ocupan las posiciones ns. Por ejemplo,

   productoChampernowne [0,1,2]                 ==  6
   productoChampernowne [8,20]                  ==  45
   productoChampernowne [10^i-1 | i <- [0..7]]  ==  1470

productoChampernowne [0,1,2] == 6

productoChampernowne [8,20] == 45

productoChampernowne [10^i-1 | i <- [0..7]] == 1470

Soluciones

import Data.Char (digitToInt)

productoChampernowne :: [Int] -> Int
productoChampernowne ns = product [champernowne !! n | n <- ns] 

-- champernowne  es la sucesión de champernowne. Por ejemplo,
--    ghci> take 20 champernowne
--    [1,2,3,4,5,6,7,8,9,1,0,1,1,1,2,1,3,1,4,1]
champernowne :: [Int] 
champernowne = map digitToInt (concatMap show [1..])

import Data.Char (digitToInt)

productoChampernowne :: [Int] -> Int

productoChampernowne ns = product [champernowne !! n | n <- ns]

-- champernowne es la sucesión de champernowne. Por ejemplo,

-- ghci> take 20 champernowne

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

champernowne :: [Int]

champernowne = map digitToInt (concatMap show [1..])

Pares de enteros con sólo un factor primo común

PorJosé A. Alonso 31-marzo-201525-marzo-2022

Dos enteros positivos a y b se dirán relacionados si poseen, exactamente, un factor primo en común. Por ejemplo, 12 y 20 están relacionados, pero 6 y 30 no lo están.

Definir la lista infinita

   paresRel :: [(Int,Int)]

1	paresRel :: [(Int,Int)]

tal que paresRel enumera todos los pares (a,b), con 1 ≤ a < b, tal que a y b están relacionados. Por ejemplo,

   ghci> take 10 paresRel
   [(2,4),(2,6),(3,6),(4,6),(2,8),(4,8),(6,8),(3,9),(6,9),(2,10)]

1 2	ghci> take 10 paresRel [(2,4),(2,6),(3,6),(4,6),(2,8),(4,8),(6,8),(3,9),(6,9),(2,10)]

¿Qué lugar ocupa el par (51,111) en la lista infinita paresRel?

Soluciones

import Data.List (group, intersect, nub)
import Data.Numbers.Primes (primeFactors)

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

paresRel1 :: [(Int,Int)]
paresRel1 = [(a,b) | b <- [1..], a <- [1..b-1], relacionados a b]

relacionados :: Int -> Int -> Bool
relacionados a b = 
    length (nub (primeFactors a `intersect` primeFactors b)) == 1

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

paresRel2 :: [(Int,Int)]
paresRel2 = [(x,y) | y <- [4..], x <- [2..y-2], rel x y]
    where rel x y = m /= 1 && all (== head ps) ps
              where m  = gcd x y
                    ps = primeFactors m

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

paresRel3 :: [(Int,Int)]
paresRel3 =
    [(x,y) | y <- [2..], x <- [2..y-1], relacionados3 x y]

relacionados3 :: Int -> Int -> Bool
relacionados3 x y =
    length (group (primeFactors (gcd x y))) == 1

-- Comparación de eficiencia
--    λ> paresRel1 !! 40000
--    (216,489)
--    (3.19 secs, 1,825,423,056 bytes)
--    λ> paresRel2 !! 40000
--    (216,489)
--    (0.96 secs, 287,174,864 bytes)
--    λ> paresRel3 !! 40000
--    (216,489)
--    (0.70 secs, 264,137,928 bytes)

-- Cálculo
-- =======

-- El cálculo es
--    ghci> 1 + length (takeWhile (/=(51,111)) paresRel1)
--    2016

import Data.List (group, intersect, nub)

import Data.Numbers.Primes (primeFactors)

-- 1ª solución

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

paresRel1 :: [(Int,Int)]

paresRel1 = [(a,b) | b <- [1..], a <- [1..b-1], relacionados a b]

relacionados :: Int -> Int -> Bool

relacionados a b =

length (nub (primeFactors a `intersect` primeFactors b)) == 1

-- 2ª solución

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

paresRel2 :: [(Int,Int)]

paresRel2 = [(x,y) | y <- [4..], x <- [2..y-2], rel x y]

where rel x y = m /= 1 && all (== head ps) ps

where m = gcd x y

ps = primeFactors m

-- 3ª solución

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

paresRel3 :: [(Int,Int)]

paresRel3 =

[(x,y) | y <- [2..], x <- [2..y-1], relacionados3 x y]

relacionados3 :: Int -> Int -> Bool

relacionados3 x y =

length (group (primeFactors (gcd x y))) == 1

-- Comparación de eficiencia

-- λ> paresRel1 !! 40000

-- (216,489)

-- (3.19 secs, 1,825,423,056 bytes)

-- λ> paresRel2 !! 40000

-- (216,489)

-- (0.96 secs, 287,174,864 bytes)

-- λ> paresRel3 !! 40000

-- (216,489)

-- (0.70 secs, 264,137,928 bytes)

-- Cálculo

-- =======

-- El cálculo es

-- ghci> 1 + length (takeWhile (/=(51,111)) paresRel1)

-- 2016

Números naturales separados por ceros

PorJosé A. Alonso 26-enero-201525-marzo-2022

Enunciado

Definir la sucesión

   naturales0 :: [Int]

1	naturales0 :: [Int]

cuyos elementos son los números naturales separados por 0. Por ejemplo,

   ghci> take 25 naturales0
   [0,0,1,0,2,0,3,0,4,0,5,0,6,0,7,0,8,0,9,0,10,0,11,0,12]

1 2	ghci> take 25 naturales0 [0,0,1,0,2,0,3,0,4,0,5,0,6,0,7,0,8,0,9,0,10,0,11,0,12]

Comprobar con QuickCheck que el n-ésimo término de la sucesión es n*(1+(-1)^n)/4.

Nota. En la comprobación usar

   quickCheckWith (stdArgs {maxSize=7}) prop_naturales0

1	quickCheckWith (stdArgs {maxSize=7}) prop_naturales0

Soluciones

import Test.QuickCheck

naturales0 :: [Int]
naturales0 = concat [[n,0] | n <- [0..]]

-- La propiedad es
prop_naturales0 :: Int -> Property
prop_naturales0 n = 
    n >= 0  ==>  naturales0 !! n == n*(1+(-1)^n) `div` 4

-- La comprobación es
--    ghci> quickCheckWith (stdArgs {maxSize=7}) prop_naturales0
--    +++ OK, passed 100 tests.

import Test.QuickCheck

naturales0 :: [Int]

naturales0 = concat [[n,0] | n <- [0..]]

-- La propiedad es

prop_naturales0 :: Int -> Property

prop_naturales0 n =

n >= 0 ==> naturales0 !! n == n*(1+(-1)^n) `div` 4

-- La comprobación es

-- ghci> quickCheckWith (stdArgs {maxSize=7}) prop_naturales0

-- +++ OK, passed 100 tests.

Enumeración de los números enteros

PorJosé A. Alonso 23-enero-201525-marzo-2022

Exercitium

Definir la sucesión

   enteros :: [Int]

1	enteros :: [Int]

tal que sus elementos son los números enteros comenzando en el 0 e intercalando los positivos y los negativos. Por ejemplo,

   ghci> take 23 enteros
   [0,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6,7,-7,8,-8,9,-9,10,-10,11,-11]

1 2	ghci> take 23 enteros [0,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6,7,-7,8,-8,9,-9,10,-10,11,-11]

Comprobar con QuickCheck que el n-ésimo término de la sucesión es (1-(2n+1)(-1)^n)/4.

Nota. En la comprobación usar

   quickCheckWith (stdArgs {maxSize=7}) prop_enteros

1	quickCheckWith (stdArgs {maxSize=7}) prop_enteros

Soluciones

import Test.QuickCheck

enteros :: [Int]
enteros = 0 : concat [[n,-n] | n <- [1..]]

-- La propiedad es
prop_enteros :: Int -> Property
prop_enteros n = 
    n >= 0 ==> enteros !! n == (1-(2*n+1)*(-1)^n) `div` 4

-- La comprobación es
--    ghci> quickCheckWith (stdArgs {maxSize=7}) prop_enteros
--    +++ OK, passed 100 tests.

import Test.QuickCheck

enteros :: [Int]

enteros = 0 : concat [[n,-n] | n <- [1..]]

-- La propiedad es

prop_enteros :: Int -> Property

prop_enteros n =

n >= 0 ==> enteros !! n == (1-(2*n+1)*(-1)^n) `div` 4

-- La comprobación es

-- ghci> quickCheckWith (stdArgs {maxSize=7}) prop_enteros

-- +++ OK, passed 100 tests.

Enumeración de los pares de números naturales

PorJosé A. Alonso 29-diciembre-201425-marzo-2022

Los pares de los números naturales se pueden ordenar por la suma de sus componentes y entre los pares con la misma suma elegir antes al que tiene mayos su primera componente.

Definir la función

   pares :: [(Int,Int)]

1	pares :: [(Int,Int)]

tal que pares es la lista de los pares de números naturales con el orden anterior. por ejemplo,

   ghci> take 10 pares
   [(0,0),(1,0),(0,1),(2,0),(1,1),(0,2),(3,0),(2,1),(1,2),(0,3)]

1 2	ghci> take 10 pares [(0,0),(1,0),(0,1),(2,0),(1,1),(0,2),(3,0),(2,1),(1,2),(0,3)]

Usando la definición de pares, definir la función

   posicion :: (Int,Int) -> Int

1	posicion :: (Int,Int) -> Int

tal que (posicion p) es la posición del par p en la lista pares. Por ejemplo,

   posicion (0,0)  ==  0
   posicion (2,0)  ==  3

1 2	posicion (0,0) == 0 posicion (2,0) == 3

Finalmente, comprobar con QuickCheck que para cualquier par (x,y) de números naturales, la (posicion (x,y)) es igual a (y + (x+y+1)*(x+y) div 2).

Nota. En la comprobación usar

   quickCheckWith (stdArgs {maxSize=7}) prop_posicion

1	quickCheckWith (stdArgs {maxSize=7}) prop_posicion

Soluciones

import Test.QuickCheck

pares :: [(Int,Int)]
pares = [(n-y,y) | n <- [0..], y <- [0..n]] 

posicion :: (Int,Int) -> Int
posicion p = length (takeWhile (/=p) pares)

-- La propiedad es
prop_posicion :: (Int,Int) -> Property
prop_posicion (x,y) =
    x >= 0 && y >= 0 ==> 
    posicion (x,y) == y + (x+y+1)*(x+y) `div` 2

-- La comprobación es
--    ghci> quickCheckWith (stdArgs {maxSize=7}) prop_posicion
--    +++ OK, passed 100 tests.

import Test.QuickCheck

pares :: [(Int,Int)]

pares = [(n-y,y) | n <- [0..], y <- [0..n]]

posicion :: (Int,Int) -> Int

posicion p = length (takeWhile (/=p) pares)

-- La propiedad es

prop_posicion :: (Int,Int) -> Property

prop_posicion (x,y) =

x >= 0 && y >= 0 ==>

posicion (x,y) == y + (x+y+1)*(x+y) `div` 2

-- La comprobación es

-- ghci> quickCheckWith (stdArgs {maxSize=7}) prop_posicion

-- +++ OK, passed 100 tests.

Números que sumados a su siguiente primo dan primos

PorJosé A. Alonso 11-diciembre-201425-marzo-2022

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.

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

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)

Aplicaciones alternativas

PorJosé A. Alonso 26-noviembre-201425-marzo-2022

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]

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

[schedule expon=’2014-12-03′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 3 de diciembre.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

[/schedule]

[schedule on=’2014-12-03′ at=»06:00″]

-- 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]

-- 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]

[/schedule]

Repetición cíclica

PorJosé A. Alonso 25-noviembre-201425-marzo-2022

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.

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

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.

Laberinto numérico

PorJosé A. Alonso 25-julio-201425-marzo-2022

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

-- 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]

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]

Soluciones

Soluciones

Soluciones

En Maxima

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Enunciado

Soluciones

Exercitium

Soluciones

Soluciones

Introducción

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Entradas recientes

Buscar

Correo electrónico