Menu Close

Etiqueta: even

La sucesión de Thue-Morse

La serie de Thue-Morse comienza con el término [0] y sus siguientes términos se construyen añadiéndole al anterior su complementario. Los primeros términos de la serie son

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

De esta forma se va formando una sucesión

   0,1,1,0,1,0,0,1,1,0,0,1,0,1,1,0,...

que se conoce como la sucesión de Thue-Morse.

Definir la sucesión

   sucThueMorse :: [Int]

cuyos elementos son los de la sucesión de Thue-Morse. Por ejemplo,

   λ> take 30 sucThueMorse
   [0,1,1,0,1,0,0,1,1,0,0,1,0,1,1,0,1,0,0,1,0,1,1,0,0,1,1,0,1,0]
   λ> map (sucThueMorse4 !!) [1234567..1234596] 
   [1,1,0,0,1,0,1,1,0,1,0,0,1,0,1,1,0,0,1,1,0,1,0,0,1,1,0,0,1,0]
   λ> map (sucThueMorse4 !!) [4000000..4000030] 
   [1,0,0,1,0,1,1,0,0,1,1,0,1,0,0,1,0,1,1,0,1,0,0,1,1,0,0,1,0,1,1]

Comprobar con QuickCheck que si s(n) representa el término n-ésimo de la sucesión de Thue-Morse, entonces

   s(2n)   = s(n)
   s(2n+1) = 1 - s(n)

Soluciones

import Test.QuickCheck
 
-- 1ª definición (basada en la serie de Thue-Morse)
-- ================================================
 
sucThueMorse1 :: [Int]
sucThueMorse1 = map termSucThueMorse1 [0..]
 
-- (termSucThueMorse1 n) es el n-ésimo término de la sucesión de
-- Thue-Morse. Por ejemplo, 
--    termSucThueMorse1 0  ==  0
--    termSucThueMorse1 1  ==  1
--    termSucThueMorse1 2  ==  1
--    termSucThueMorse1 3  ==  0
--    termSucThueMorse1 4  ==  1
termSucThueMorse1 :: Int -> Int
termSucThueMorse1 0 = 0
termSucThueMorse1 n = 
    (serieThueMorse !! k) !! n
    where k = 1 + floor (logBase 2 (fromIntegral n))
 
-- serieThueMorse es la lista cuyos elementos son los términos de la
-- serie de Thue-Morse. Por ejemplo, 
--    λ> take 4 serieThueMorse3
--    [[0],[0,1],[0,1,1,0],[0,1,1,0,1,0,0,1]]
serieThueMorse :: [[Int]]
serieThueMorse = iterate paso [0]
    where paso xs = xs ++ map (1-) xs
 
-- Comprobación de la propiedad
-- ============================
 
-- La propiedad es
prop_termSucThueMorse :: Int -> Property
prop_termSucThueMorse n =
    n > 0 ==>
      sucThueMorse1 !! (2*n)   == sn &&
      sucThueMorse1 !! (2*n+1) == 1 - sn 
    where sn = sucThueMorse1 !! n
 
-- La comprobación es
--    λ> quickCheck prop_termSucThueMorse
--    +++ OK, passed 100 tests.
 
-- 2ª definición (basada en la propiedad anterior)
-- ===============================================
 
sucThueMorse2 :: [Int]
sucThueMorse2 = map termSucThueMorse2 [0..]
 
-- (termSucThueMorse2 n) es el n-ésimo término de la sucesión de
-- Thue-Morse. Por ejemplo, 
--    termSucThueMorse2 0  ==  0
--    termSucThueMorse2 1  ==  1
--    termSucThueMorse2 2  ==  1
--    termSucThueMorse2 3  ==  0
--    termSucThueMorse2 4  ==  1
termSucThueMorse2 :: Int -> Int
termSucThueMorse2 0 = 0
termSucThueMorse2 n 
    | even n    = termSucThueMorse2 (n `div` 2)
    | otherwise = 1 - termSucThueMorse2 (n `div` 2)
 
-- 3ª definición
-- =============
 
sucThueMorse3 :: [Int]
sucThueMorse3 = 
   0 : intercala (map (1-) sucThueMorse3) (tail sucThueMorse3)
 
-- (intercala xs ys) es la lista obtenida intercalando los elementos de
-- las listas infinitas xs e ys. Por ejemplo, 
--    take 10 (intercala [1,5..] [2,4..])  ==  [1,2,5,4,9,6,13,8,17,10]
intercala :: [a] -> [a] -> [a]
intercala (x:xs) ys = x : intercala ys xs 
 
-- 4ª definición
-- =============
 
sucThueMorse4 :: [Int]
sucThueMorse4 = 0 : aux [1]
    where aux xs = xs ++ aux (xs ++ map (1-) xs) 
 
-- 5ª definición
-- =============
 
sucThueMorse5 :: [Int]
sucThueMorse5 = 0 : 1 : aux (tail sucThueMorse5) 
    where aux = (\(x:xs) -> x : (1 - x) : aux xs)
 
-- Comparación de eficiencia
-- =========================
 
--    λ> sucThueMorse1 !! 2000000
--    1
--    (1.78 secs, 620,335,144 bytes)
--    λ> sucThueMorse2 !! 2000000
--    1
--    (0.34 secs, 197,790,760 bytes)
--    λ> sucThueMorse3 !! 2000000
--    1
--    (1.70 secs, 332,015,856 bytes)
--    λ> sucThueMorse4 !! 2000000
--    1
--    (0.17 secs, 0 bytes)
--    λ> sucThueMorse5 !! 2000000
--    1
--    (1.74 secs, 319,026,688 bytes)

Referencias

El algoritmo binario del mcd

El máximo común divisor (mcd) de dos números enteros no negativos se puede calcular mediante un algoritmo binario basado en las siguientes propiedades:

  1. Si a,b son pares, entonces mcd(a,b) = 2*mcd(a/2,b/2)
  2. Si a es par y b impar, entonces mcd(a,b) = mcd(a/2,b)
  3. Si a es impar y b par, entonces mcd(a,b) = mcd(a,b/2)
  4. Si a y b son impares y a > b, entonces mcd(a,b) = mcd((a-b)/2,b)
  5. Si a y b son impares y a < b, entonces mcd(a,b) = mcd(a,(b-a)/2)
  6. mcd(a,0) = a
  7. mcd(0,b) = b
  8. mcd(a,a) = a

Por ejemplo, el cálculo del mcd(660,420) es

   mcd(660,420)
   = 2*mcd(330,210)    [por 1]
   = 2*2*mcd(165,105)  [por 1]
   = 2*2*mcd(30,105)   [por 4]
   = 2*2*mcd(15,105)   [por 2]
   = 2*2*mcd(15,45)    [por 4]
   = 2*2*mcd(15,15)    [por 4]
   = 2*2*15            [por 8]
   = 60

Definir la función

   mcd :: Integer -> Integer -> Integer

Definir la función

tal que (mcd a b) es el máximo común divisor de a y b calculado mediante el algoritmo binario del mcd. Por ejemplo,

   mcd 660 420  ==  60
   mcd 3 0      ==  3
   mcd 0 3      ==  3

Comprobar con QuickCheck que, para los enteros no negativos, las funciones mcd y gcd son equivalentes.

Soluciones

import Test.QuickCheck
 
mcd :: Integer -> Integer -> Integer
mcd a 0 = a
mcd 0 b = b
mcd a b | a == b           = a
        | even a && even b = 2 * mcd (a `div` 2) (b `div` 2)
        | even a           = mcd (a `div` 2)     b
        | even b           = mcd a               (b `div` 2)
        | a > b            = mcd ((a-b) `div` 2) b
        | otherwise        = mcd a               ((b-a) `div` 2)
 
-- Propiedad de equivalencia 
prop_mcd :: Integer -> Integer -> Bool
prop_mcd a b = mcd a1 b1 == gcd a1 b1
    where a1 = abs a
          b1 = abs b
 
-- La comprobación es
--    λ> quickCheck prop_mcd
--    +++ OK, passed 100 tests.

Paridad de un árbol

Los árboles binarios con valores en las hojas y en los nodos se definen por

   data Arbol a = H a 
                 | N a (Arbol a) (Arbol a) 
                 deriving Show

Por ejemplo, el árbol

        5         
       / \        
      /   \       
     9     7      
    / \   / \     
   1   4 6   8

se puede representar por

   N 5 (N 9 (H 1) (H 4)) (N 7 (H 6) (H 8))

Decimos que un árbol binario es par si la mayoría de sus valores (en nodos u hojas) son pares e impar en caso contrario.

Para representar la paridad se define el tipo Paridad

   data Paridad = Par | Impar deriving (Eq, Show)

Definir la función

   paridad :: Arbol3 Int -> Paridad

tal que (paridad a) es la paridad del árbol a. Por ejemplo,

   paridad (N 8 (N 6 (H 3) (H 4)) (H 5))  ==  Par
   paridad (N 8 (N 9 (H 3) (H 4)) (H 5))  ==  Impar

Soluciones

data Arbol a = H a
             | N a (Arbol a) (Arbol a) 
             deriving Show
 
data Paridad = Par | Impar deriving (Eq, Show)  
 
paridad :: Arbol Int -> Paridad
paridad a | x > y     = Par 
          | otherwise = Impar
          where (x,y) = paridades a
 
-- (paridades a) es un par (x,y) donde x es el número de valores pares
-- en el árbol a e i es el número de valores impares en el árbol a. Por
-- ejemplo,  
--    paridades (N (N (H 3) 6 (H 4)) 8 (H 5))  ==  (3,2)
--    paridades (N (N (H 3) 9 (H 4)) 8 (H 5))  ==  (2,3)
paridades :: Arbol Int -> (Int,Int)
paridades (H x) | even x    = (1,0)
                | otherwise = (0,1)
paridades (N x i d) | even x    = (1+a1+a2,b1+b2)
                    | otherwise = (a1+a2,1+b1+b2)
                    where (a1,b1) = paridades i
                          (a2,b2) = paridades d

Separación y mezcla de listas

Definir las funciones

   separacion :: [a] -> ([a],[a])
   mezcla     :: ([a],[a]) -> [a]

tales que (separacion xs) es el par formado eligiendo alternativamente elementos de xs mientras que mezcla intercala los elementos de las dos listas. Por ejemplo,

   separacion [1..5]                   ==  ([1,3,5],[2,4])
   mezcla ([1,3,5],[2,4])              ==  [1,2,3,4,5]
   separacion "Telescopio"             ==  ("Tlsoi","eecpo")
   mezcla ("Tlsoi","eecpo")            ==  "Telescopio"
   take 5 (fst (separacion [2,4..]))   ==  [2,6,10,14,18]
   take 6 (mezcla ([2,4..],[7,14..]))  ==  [2,7,4,14,6,21]

Comprobar con QuickCheck que

   mezcla (separacion xs) == xs

Soluciones

import Test.QuickCheck
 
-- 1ª definición (por recursión):
separacion1 :: [a] -> ([a],[a])
separacion1 []       = ([],  [])
separacion1 [x]      = ([x], [])
separacion1 (x:y:zs) = (x:us,y:vs)
    where (us,vs) = separacion1 zs
 
-- 2ª definición (por comprensión):
separacion2 :: [a] -> ([a],[a])
separacion2 xs = ([x | (x,n) <- aux, even n], 
                  [x | (x,n) <- aux, odd n])
    where aux = zip xs [0..]                                           
 
-- 3ª definición 
separacion3 :: [a] -> ([a],[a])
separacion3 []       = ([],[])
separacion3 (x:xs)   = (x:zs, ys)
    where (ys, zs) = separacion3 xs 
 
-- Comprobación de eficiencia
--    ghci> last (snd (separacion1 [1..10000000]))
--    10000000
--    (10.73 secs, 2,945,794,552 bytes)
--
--    ghci> last (snd (separacion2 [1..10000000]))
--    10000000
--    (16.33 secs, 4,351,366,976 bytes)
--    
--    λ> last (snd (separacion3 [1..10000000]))
--    10000000
--    (15.67 secs, 4,423,573,048 bytes)
 
mezcla :: ([a],[a]) -> [a]
mezcla ([],ys)     = ys 
mezcla (xs,[])     = xs 
mezcla (x:xs,y:ys) = x : y : mezcla (xs,ys)
 
-- La propiedad es
prop_mezcla_separacion :: [Int] -> Bool
prop_mezcla_separacion xs =
    mezcla (separacion xs) == xs
 
-- La comprobación es
--    ghci> quickCheck prop_mezcla_separacion
--    +++ OK, passed 100 tests.

Números muy pares

Un entero positivo x es muy par si tanto x como x² sólo contienen cifras pares. Por ejemplo, 200 es muy par porque todas las cifras de 200 y 200² = 40000 son pares; pero 26 no lo es porque 26² = 676 tiene cifras impares.

Definir la función

   siguienteMuyPar :: Integer -> Integer

tal que (siguienteMuyPar x) es menor número mayor que x que es muy par. Por ejemplo,

   siguienteMuyPar 300           ==  668
   siguienteMuyPar 668           ==  680
   siguienteMuyPar 828268400000  ==  828268460602

Soluciones

siguienteMuyPar :: Integer -> Integer
siguienteMuyPar x = 
    head [n | n <- [y,y+2..], muyPar n]
    where y = siguientePar x
 
-- (siguientePar x) es el primer número mayor que x que es par. Por
-- ejemplo, 
--    siguientePar 3  ==  4
--    siguientePar 4  ==  6
siguientePar :: Integer -> Integer
siguientePar x | odd x     = x+1
               | otherwise = x+2
 
-- (muyPar x) se verifica si x es muy par. Por ejemplo,
--    muyPar 200           == True
--    muyPar 26            == False
muyPar :: Integer -> Bool
muyPar n = all even (digitos n) && all even (digitos (n*n))
 
-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 325  ==  [3,2,5]
digitos :: Integer -> [Int]
digitos n = [read [d] | d <- show n]

Suma de los elementos de las diagonales de las matrices espirales (14-15)

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 2×2: 1+3+2+4 = 10
  • en la 3×3: 1+3+5+7+9 = 25
  • en la 4×4: 1+2+3+4+7+10+13+16 = 56
  • en la 5×5: 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

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

-- 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 | odd  n = 1 + sum [4*n^2-6*n+6 | n <- [3,5..n]]

Polinomios pares

Un polinomio de coeficientes enteros se dirá par si todos sus coeficientes son números pares. Por ejemplo, el polinomio 2x³ – 4x² + 8 es par y el x² + 2x + 10 no lo es.

Definir el predicado

   parPol :: Integral a => Polinomio a -> Bool

tal que (parPol p) se verifica si p es un polinomio par. Por ejemplo,

   ghci> parPol (consPol 3 2 (consPol 2 (-4) (consPol 0 8 polCero)))
   True
   ghci> parPol (consPol 2 1 (consPol 1 2 (consPol 0 10 polCero)))
   False

Comprobar con QuickCheck que la suma de un polinomio con él mismo es un polinomio par.

Nota: Este ejercicio debe realizarse usando la librería I1M.Pol que se encuentra aquí y se describe aquí.

Soluciones

import I1M.PolOperaciones
import Test.QuickCheck
 
parPol :: Integral a => Polinomio a -> Bool
parPol p = esPolCero p || (even (coefLider p) && parPol (restoPol p))
 
-- La propiedad es
prop_parPol :: Integral a => Polinomio a -> Bool
prop_parPol p =
    parPol (sumaPol p p)
 
-- La comprobación es 
--    ghci> quickCheck prop_parPol
--    +++ OK, passed 100 tests.

Varios cuadrados encajados

Enunciado

Definir la función

   cuadrados :: Int -> Picture

tal que (cuadrados n) dibuje n cuadrados encajados como se muestra en las siguientes figuras:

  • para n=2
    Cuadrados_encajados_2

  • para n=4
    Cuadrados_encajados_4

  • para n=10
    Cuadrados_encajados_10

Nota: Escribir las soluciones usando la siguiente plantilla

import Graphics.Gloss
import System.IO
 
main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  putStr "Introduce el numero de cuadrados [1..10]: "
  n <- readLn
  display (InWindow (show n ++ " cuadrados encajados" ) 
                    (600,600) (20,20)) white (cuadrados n)
 
cuadrados :: Int -> Picture
cuadrados n = undefined

Soluciones

import Graphics.Gloss
import System.IO
 
main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  putStr "Introduce el numero de cuadrados [1..10]: "
  n <- readLn
  display (InWindow (show n ++ " cuadrados encajados" ) 
                    (600,600) (20,20)) white (cuadrados n)
 
-- 1ª solución (por comprensión):    
cuadrados :: Int -> Picture
cuadrados n = 
    pictures [scale (r^n) (r^n) $ rotate (g n) $ cuadrado | n <- [0..n-1]]
    where cuadrado        = rectangleWire 500 500
          g n | even n    = 0
              | otherwise = 45
          r               = 1 / sqrt 2
 
-- 2ª solución (por recursión):    
cuadrados2 :: Int -> Picture
cuadrados2 1 = rectangleWire 500 500
cuadrados2 n = 
    pictures [rectangleWire 500 500,
              rotate 45 $ scale (1/sqrt 2) (1/sqrt 2) (cuadrados2 (n-1))]

Último dígito no nulo del factorial

Enunciado

-- El factorial de 7 es
--    7! = 1 * 2 * 3 * 4 * 5 * 6 * 7 = 5040
-- por tanto, el último dígito no nulo del factorial de 7 es 4.
-- 
-- Definir la función
--    ultimoNoNuloFactorial :: Integer -> Integer
-- tal que (ultimoNoNuloFactorial n) es el último dígito no nulo del
-- factorial de n. Por ejemplo,
--    ultimoNoNuloFactorial  7  == 4
--    ultimoNoNuloFactorial 10  == 8
--    ultimoNoNuloFactorial 12  == 6
--    ultimoNoNuloFactorial 97  == 2
--    ultimoNoNuloFactorial  0  == 1
--
-- Comprobar con QuickCheck que si n es mayor que 4, entonces el último
-- dígito no nulo del factorial de n es par.

Soluciones

import Test.QuickCheck
 
ultimoNoNuloFactorial :: Integer -> Integer
ultimoNoNuloFactorial n = ultimoNoNulo (factorial n)
 
-- (ultimoNoNulo n) es el último dígito no nulo de n. Por ejemplo,
--    ultimoNoNulo 5040  ==  4
ultimoNoNulo :: Integer -> Integer
ultimoNoNulo n | m /= 0    = m
               | otherwise = ultimoNoNulo (n `div` 10)
               where m = n `rem` 10
 
-- 2ª definición (por comprensión)
ultimoNoNulo2 :: Integer -> Integer
ultimoNoNulo2 n = read [head (dropWhile (=='0') (reverse (show n)))]
 
-- (factorial n) es el factorial de n. Por ejemplo,
--    factorial 7  ==  5040
factorial :: Integer -> Integer
factorial n = product [1..n]
 
 
-- La propiedad es
prop_ultimoNoNuloFactorial :: Integer -> Property
prop_ultimoNoNuloFactorial n = 
    n > 4 ==> even (ultimoNoNuloFactorial n)
 
-- La comprobación es
--    ghci> quickCheck prop_ultimoNoNuloFactorial
--    +++ OK, passed 100 tests.

Rompecabeza matemático

Enunciado

-- Definir una función
--    f :: Int -> Int
-- tal que para todo n, f(f(n)) = -n y comprobar con QuickCheck que se
-- cumple la propiedad
--    prop_f :: Int -> Bool
--    prop_f n = f (f n) == -n
-- es decir,
--    ghci> quickCheck prop_f
--    +++ OK, passed 100 tests.

Soluciones

import Test.QuickCheck
 
-- 1ª definición (por casos)
f :: Int -> Int
f n | even n && n > 0 = n-1
    | even n && n < 0 = n+1
    | odd  n && n > 0 = -n-1
    | odd  n && n < 0 = -n+1
    | otherwise       = 0
 
-- La propiedad es
prop_f :: Int -> Bool
prop_f n = f (f n) == -n
 
-- La comprobación es
--    ghci> quickCheck prop_f
--    +++ OK, passed 100 tests.
 
-- 2ª definición (por casos y signo):
f2 :: Int -> Int
f2 n | even n    =  n - signum n
     | odd  n    = -n - signum n
     | otherwise = 0
 
-- La propiedad es
prop_f2 :: Int -> Bool
prop_f2 n = f2 (f2 n) == -n
 
-- La comprobación es
--    ghci> quickCheck prop_f2
--    +++ OK, passed 100 tests.
 
-- 3ª solución (sin casos):
f3 :: Int -> Int
f3 n = n * (2 * mod n 2 - 1) + signum n
 
-- La propiedad es
prop_f3 :: Int -> Bool
prop_f3 n = f3 (f3 n) == -n
 
-- La comprobación es
--    ghci> quickCheck prop_f3
--    +++ OK, passed 100 tests.
 
-- 4ª solución (sin casos):
f4 :: Int -> Int
f4 n = (-1)^(abs n)*n - signum n
 
-- La propiedad es
prop_f4 :: Int -> Bool
prop_f4 n = f4 (f4 n) == -n
 
-- La comprobación es
--    ghci> quickCheck prop_f4
--    +++ OK, passed 100 tests.