diciembre 2015 – Exercitium

Elementos óptimos

PorJosé A. Alonso 31-diciembre-20157-enero-2016

Definir la función

   optimos :: Eq b => (b -> b -> Bool) -> (a -> b) -> [a] -> [a]

1	optimos :: Eq b => (b -> b -> Bool) -> (a -> b) -> [a] -> [a]

tal que (optimos r f xs) es la lista de los elementos de xs donde la función f alcanza sus valores óptimos respecto de la relación r. Por ejemplo,

   optimos (<) length ["ab","c","de","f"]  ==  ["c","f"]
   optimos (>) length ["ab","c","de","f"]  ==  ["ab","de"]

1 2	optimos (<) length ["ab","c","de","f"] == ["c","f"] optimos (>) length ["ab","c","de","f"] == ["ab","de"]

Soluciones

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

optimos1 :: Eq a => (b -> b -> Bool) -> (a -> b) -> [a] -> [a]
optimos1 r f xs = 
    [x | x <- xs, null [y | y <- xs, x /= y, r (f y) (f x)]]

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

optimos2 :: Eq b => (b -> b -> Bool) -> (a -> b) -> [a] -> [a]
optimos2 r f xs = [x | x <- xs, f x `elem` ms]
    where ms = maximales r (map f xs) 

-- (maximales r xs) es la lista de los elementos de xs para los que no
-- hay ningún otro elemento de xs mayor según la relación r. Por
-- ejemplo, 
--    maximales (>) [2,3,4,6]                     ==  [6]
--    maximales (<) [2,3,4,6]                     ==  [2]
--    maximales (\x y -> mod x y == 0) [2,3,4,6]  ==  [4,6]
--    maximales (\x y -> mod y x == 0) [2,3,4,6]  ==  [2,3]
maximales :: Eq a => (a -> a -> Bool) -> [a] -> [a]
maximales r xs = [x | x <- xs, null [y | y <- xs, y /= x, r y x]]

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

--    λ> length $ optimos1 (>) length [replicate n 'a' | n <- [1..1000]]
--    1
--    (16.74 secs, 153,957,400 bytes)
--    λ> length $ optimos2 (>) length [replicate n 'a' | n <- [1..1000]]
--    1
--    (0.64 secs, 85,520,896 bytes)

-- 1ª definición

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

optimos1 :: Eq a => (b -> b -> Bool) -> (a -> b) -> [a] -> [a]

optimos1 r f xs =

[x | x <- xs, null [y | y <- xs, x /= y, r (f y) (f x)]]

-- 2ª definición

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

optimos2 :: Eq b => (b -> b -> Bool) -> (a -> b) -> [a] -> [a]

optimos2 r f xs = [x | x <- xs, f x `elem` ms]

where ms = maximales r (map f xs)

-- (maximales r xs) es la lista de los elementos de xs para los que no

-- hay ningún otro elemento de xs mayor según la relación r. Por

-- ejemplo,

-- maximales (>) [2,3,4,6] == [6]

-- maximales (<) [2,3,4,6] == [2]

-- maximales (\x y -> mod x y == 0) [2,3,4,6] == [4,6]

-- maximales (\x y -> mod y x == 0) [2,3,4,6] == [2,3]

maximales :: Eq a => (a -> a -> Bool) -> [a] -> [a]

maximales r xs = [x | x <- xs, null [y | y <- xs, y /= x, r y x]]

-- Comparación de eficiencia

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

-- λ> length $ optimos1 (>) length [replicate n 'a' | n <- [1..1000]]

-- 1

-- (16.74 secs, 153,957,400 bytes)

-- λ> length $ optimos2 (>) length [replicate n 'a' | n <- [1..1000]]

-- 1

-- (0.64 secs, 85,520,896 bytes)

Elementos maximales

PorJosé A. Alonso 30-diciembre-20157-enero-2016

Definir la función

   maximales :: Eq a => (a -> a -> Bool) -> [a] -> [a]

1	maximales :: Eq a => (a -> a -> Bool) -> [a] -> [a]

tal que (maximales r xs) es la lista de los elementos de xs para los que no hay ningún otro elemento de xs mayor según la relación r. Por ejemplo,

   maximales (>) [2,3,4,6]                     ==  [6]
   maximales (<) [2,3,4,6]                     ==  [2]
   maximales (\x y -> mod x y == 0) [2,3,4,6]  ==  [4,6]
   maximales (\x y -> mod y x == 0) [2,3,4,6]  ==  [2,3]

maximales (>) [2,3,4,6] == [6]

maximales (<) [2,3,4,6] == [2]

maximales (\x y -> mod x y == 0) [2,3,4,6] == [4,6]

maximales (\x y -> mod y x == 0) [2,3,4,6] == [2,3]

Soluciones

maximales :: Eq a => (a -> a -> Bool) -> [a] -> [a]
maximales r xs = [x | x <- xs, null [y | y <- xs, y /= x, r y x]]

1 2	maximales :: Eq a => (a -> a -> Bool) -> [a] -> [a] maximales r xs = [x \| x <- xs, null [y \| y <- xs, y /= x, r y x]]

Reconocimiento de anterior

PorJosé A. Alonso 29-diciembre-20151-mayo-2016

Definir la función

   esAnterior :: Eq a => [a] -> a -> a -> Bool

1	esAnterior :: Eq a => [a] -> a -> a -> Bool

tal que (esAnterior xs y z) se verifica si y ocurre en xs antes que z (que puede no pertenecer a xs). Por ejemplo,

   esAnterior [1,3,7,2] 3 2  ==  True
   esAnterior [1,3,7,2] 3 1  ==  False
   esAnterior [1,3,7,2] 3 5  ==  True
   esAnterior [1,3,7,2] 5 3  ==  False

esAnterior [1,3,7,2] 3 2 == True

esAnterior [1,3,7,2] 3 1 == False

esAnterior [1,3,7,2] 3 5 == True

esAnterior [1,3,7,2] 5 3 == False

Soluciones

-- 1ª definición (por recursión)
esAnterior1 :: Eq a => [a] -> a -> a -> Bool
esAnterior1 [] _ _     = False
esAnterior1 (x:xs) y z = x /= z && (x == y || esAnterior1 xs y z) 

-- 2ª definición
esAnterior2 :: Eq a => [a] -> a -> a -> Bool
esAnterior2 xs y z = z `notElem` (takeWhile (/=y) xs)

-- Comparación de eficiencia
--    λ> let n = 1000000 in esAnterior1 [1..n] (n-1) n
--    True
--    (2.19 secs, 384,717,008 bytes)
--    λ> let n = 1000000 in esAnterior2 [1..n] (n-1) n
--    True
--    (0.34 secs, 135,479,936 bytes)

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

esAnterior1 :: Eq a => [a] -> a -> a -> Bool

esAnterior1 [] _ _ = False

esAnterior1 (x:xs) y z = x /= z && (x == y || esAnterior1 xs y z)

-- 2ª definición

esAnterior2 :: Eq a => [a] -> a -> a -> Bool

esAnterior2 xs y z = z `notElem` (takeWhile (/=y) xs)

-- Comparación de eficiencia

-- λ> let n = 1000000 in esAnterior1 [1..n] (n-1) n

-- True

-- (2.19 secs, 384,717,008 bytes)

-- λ> let n = 1000000 in esAnterior2 [1..n] (n-1) n

-- True

-- (0.34 secs, 135,479,936 bytes)

Operación sobre todos los pares

PorJosé A. Alonso 28-diciembre-20154-enero-2016

Definir la función

   todosPares :: (a -> b -> c) -> [a] -> [b] -> [c]

1	todosPares :: (a -> b -> c) -> [a] -> [b] -> [c]

tal que (todosPares f xs ys) es el resultado de aplicar la operación f a todos los pares de xs e ys. Por ejemplo,

   todosPares (*) [2,3,5] [7,11]            == [14,22,21,33,35,55]
   todosPares (\x y -> x:show y) "ab" [7,5] == ["a7","a5","b7","b5"]

1 2	todosPares (*) [2,3,5] [7,11] == [14,22,21,33,35,55] todosPares (\x y -> x:show y) "ab" [7,5] == ["a7","a5","b7","b5"]

Soluciones

-- 1ª definición (por comprensión)
todosPares1 :: (a -> b -> c) -> [a] -> [b] -> [c]
todosPares1 f xs ys = [f x y | x <- xs, y <- ys] 

-- 2ª definición (por recursión)
todosPares2 :: (a -> b -> c) -> [a] -> [b] -> [c]
todosPares2 _ []     _  = []
todosPares2 f (x:xs) ys = map (f x) ys ++ todosPares2 f xs ys

-- 3ª definición (recursión con auxiliar)
todosPares3 :: (a -> b -> c) -> [a] -> [b] -> [c]
todosPares3 f xs ys = aux xs where
   aux []     = []
   aux (x:xs) = map (f x) ys ++ aux xs

-- 4ª definición (recursión con auxiliar)
todosPares4 :: (a -> b -> c) -> [a] -> [b] -> [c]
todosPares4 f xs ys = 
    (foldr (\x zs -> map (f x) ys ++ zs) []) xs

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

todosPares1 :: (a -> b -> c) -> [a] -> [b] -> [c]

todosPares1 f xs ys = [f x y | x <- xs, y <- ys]

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

todosPares2 :: (a -> b -> c) -> [a] -> [b] -> [c]

todosPares2 _ [] _ = []

todosPares2 f (x:xs) ys = map (f x) ys ++ todosPares2 f xs ys

-- 3ª definición (recursión con auxiliar)

todosPares3 :: (a -> b -> c) -> [a] -> [b] -> [c]

todosPares3 f xs ys = aux xs where

aux [] = []

aux (x:xs) = map (f x) ys ++ aux xs

-- 4ª definición (recursión con auxiliar)

todosPares4 :: (a -> b -> c) -> [a] -> [b] -> [c]

todosPares4 f xs ys =

(foldr (\x zs -> map (f x) ys ++ zs) []) xs

Inserciones por posición

PorJosé A. Alonso 25-diciembre-20151-enero-2016

Definir la función

   inserta :: [a] -> [[a]] -> [[a]]

1	inserta :: [a] -> [[a]] -> [[a]]

tal que (inserta xs yss) es la lista obtenida insertando

el primer elemento de xs como primero en la primera lista de yss,
el segundo elemento de xs como segundo en la segunda lista de yss (si la segunda lista de yss tiene al menos un elemento),
el tercer elemento de xs como tercero en la tercera lista de yss (si la tercera lista de yss tiene al menos dos elementos),

y así sucesivamente. Por ejemplo,

   inserta [1,2,3] [[4,7],[6],[9,5,8]]  ==  [[1,4,7],[6,2],[9,5,3,8]]
   inserta [1,2,3] [[4,7],[] ,[9,5,8]]  ==  [[1,4,7],[],   [9,5,3,8]]
   inserta [1,2]   [[4,7],[6],[9,5,8]]  ==  [[1,4,7],[6,2],[9,5,8]]
   inserta [1,2,3] [[4,7],[6]]          ==  [[1,4,7],[6,2]]
   inserta "tad"   ["odo","pra","naa"]  ==  ["todo","para","nada"]

inserta [1,2,3] [[4,7],[6],[9,5,8]] == [[1,4,7],[6,2],[9,5,3,8]]

inserta [1,2,3] [[4,7],[] ,[9,5,8]] == [[1,4,7],[], [9,5,3,8]]

inserta [1,2] [[4,7],[6],[9,5,8]] == [[1,4,7],[6,2],[9,5,8]]

inserta [1,2,3] [[4,7],[6]] == [[1,4,7],[6,2]]

inserta "tad" ["odo","pra","naa"] == ["todo","para","nada"]

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

Soluciones

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

inserta :: [a] -> [[a]] -> [[a]]
inserta xs yss = aux xs yss 0 where
    aux [] yss _ = yss
    aux xs []  _ = []
    aux (x:xs) (ys:yss) n 
        | length us == n = (us ++ x : vs) : aux xs yss (n+1)
        | otherwise      = ys : aux xs yss (n+1)
        where (us,vs) = splitAt n ys

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

inserta2 :: [a] -> [[a]] -> [[a]]
inserta2 xs yss =  
    [ins n x ys | (n,x,ys) <- zip3 [0..] xs yss] ++ drop (length xs) yss
 
ins :: Int -> a -> [a] -> [a]
ins n x ys | length ys < n  = ys
           | otherwise      = take n ys ++ x : drop n ys

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

--    λ> let n = 10000 in length (inserta [1..n] (replicate n (replicate n 0)))
--    10000
--    (3.28 secs, 6,400,568,776 bytes)
--    λ> let n = 10000 in length (inserta2 [1..n] (replicate n (replicate n 0)))
--    10000
--    (0.02 secs, 0 bytes)

-- 1ª solución

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

inserta :: [a] -> [[a]] -> [[a]]

inserta xs yss = aux xs yss 0 where

aux [] yss _ = yss

aux xs [] _ = []

aux (x:xs) (ys:yss) n

| length us == n = (us ++ x : vs) : aux xs yss (n+1)

| otherwise = ys : aux xs yss (n+1)

where (us,vs) = splitAt n ys

-- 2ª solución

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

inserta2 :: [a] -> [[a]] -> [[a]]

inserta2 xs yss =

[ins n x ys | (n,x,ys) <- zip3 [0..] xs yss] ++ drop (length xs) yss

ins :: Int -> a -> [a] -> [a]

ins n x ys | length ys < n = ys

| otherwise = take n ys ++ x : drop n ys

-- Comparación de eficiencia

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

-- λ> let n = 10000 in length (inserta [1..n] (replicate n (replicate n 0)))

-- 10000

-- (3.28 secs, 6,400,568,776 bytes)

-- λ> let n = 10000 in length (inserta2 [1..n] (replicate n (replicate n 0)))

-- 10000

-- (0.02 secs, 0 bytes)

Árbol de Navidad

PorJosé A. Alonso 24-diciembre-201531-diciembre-2015

Definir el procedimiento

   arbol :: Int -> IO ()

1	arbol :: Int -> IO ()

tal que (arbol n) dibuja el árbol de Navidad con una copa de altura n y un tronco de altura la mitad de n. Por ejemplo,

   λ> arbol 5
   
        X
       XXX
      XXXXX
     XXXXXXX
    XXXXXXXXX
        X
        X
   
   λ> arbol 6
   
         X
        XXX
       XXXXX
      XXXXXXX
     XXXXXXXXX
    XXXXXXXXXXX
         X
         X
         X
   
   λ> arbol 7
   
          X
         XXX
        XXXXX
       XXXXXXX
      XXXXXXXXX
     XXXXXXXXXXX
    XXXXXXXXXXXXX
          X
          X
          X

λ> arbol 5

XXX

XXXXX

XXXXXXX

XXXXXXXXX

λ> arbol 6

XXX

XXXXX

XXXXXXX

XXXXXXXXX

XXXXXXXXXXX

λ> arbol 7

XXX

XXXXX

XXXXXXX

XXXXXXXXX

XXXXXXXXXXX

XXXXXXXXXXXXX

Soluciones

arbol :: Int -> IO ()
arbol n = do
  putStrLn ""
  sequence_ [putStrLn c | c <- triangulo n]
  sequence_ [putStrLn c | c <- rectangulo n]
  putStrLn ""

triangulo :: Int -> [String]
triangulo n =
    [replicate (n-k) ' ' ++ replicate (1+2*k) 'X' | k <- [0..n-1]]

rectangulo :: Int -> [String]
rectangulo n =
    [replicate n ' ' ++ "X" | _ <- [1..n `div` 2]]

arbol :: Int -> IO ()

arbol n = do

putStrLn ""

sequence_ [putStrLn c | c <- triangulo n]

sequence_ [putStrLn c | c <- rectangulo n]

putStrLn ""

triangulo :: Int -> [String]

triangulo n =

[replicate (n-k) ' ' ++ replicate (1+2*k) 'X' | k <- [0..n-1]]

rectangulo :: Int -> [String]

rectangulo n =

[replicate n ' ' ++ "X" | _ <- [1..n `div` 2]]

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)

Listas hermanadas

PorJosé A. Alonso 21-diciembre-201528-diciembre-2015

Una lista hermanada es una lista de números estrictamente positivos en la que cada elemento tiene algún factor primo en común con el siguiente, en caso de que exista, o alguno de los dos es un 1. Por ejemplo,

[2,6,3,9,1,5] es una lista hermanada pues 2 y 6 tienen un factor en común (2); 6 y 3 tienen un factor en común (3); 3 y 9 tienen un factor en común (3); de 9 y 1 uno es el número 1; y de 1 y 5 uno es el número 1.
[2,3,5] no es una lista hermanada pues 2 y 3 no tienen ningún factor primo en común.

Definir la función

   hermanada :: [Int] -> Bool

1	hermanada :: [Int] -> Bool

tal que (hermanada xs) se verifica si la lista xs es hermanada según la definición anterior. Por ejemplo,

   hermanada [2,6,3,9,1,5]   ==  True
   hermanada [2,3,5]         ==  False
   hermanada [2,4..1000000]  ==  True

hermanada [2,6,3,9,1,5] == True

hermanada [2,3,5] == False

hermanada [2,4..1000000] == True

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

Soluciones

-- 1ª definición (por comprensión)
hermanada1 :: [Int] -> Bool
hermanada1 xs = and [hermanos p | p <- zip xs (tail xs)]

-- (hermanos (x,y)) se verifica si x e y son hermanos; es decir, alguno es
-- igual a 1 o tienen algún factor primo en común
hermanos :: (Int, Int) -> Bool
hermanos (x,y) = x == 1 || y == 1 || gcd x y /= 1

-- 2ª definición (con all)
hermanada2 :: [Int] -> Bool
hermanada2 xs = all hermanos (zip xs (tail xs))

-- 3ª definición (por recursión)
hermanada3 :: [Int] -> Bool
hermanada3 (x1:x:xs) = hermanos (x1,x) && hermanada3 (x:xs)
hermanada3 _          = True

-- 4ª definición (por plegado)
hermanada4 :: [Int] -> Bool
hermanada4 xs =
    foldl (\ws p -> hermanos p && ws) True (zip xs (tail xs))

-- Comparación de eficiencia
--    λ> hermanada1 [2,4..1000000]
--    True
--    (2.33 secs, 476,586,552 bytes)
--    λ> hermanada2 [2,4..1000000]
--    True
--    (1.80 secs, 422,879,072 bytes)
--    λ> hermanada3 [2,4..1000000]
--    True
--    (2.58 secs, 477,251,896 bytes)
--    λ> hermanada4 [2,4..1000000]
--    True
--    (2.36 secs, 440,047,520 bytes)

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

hermanada1 :: [Int] -> Bool

hermanada1 xs = and [hermanos p | p <- zip xs (tail xs)]

-- (hermanos (x,y)) se verifica si x e y son hermanos; es decir, alguno es

-- igual a 1 o tienen algún factor primo en común

hermanos :: (Int, Int) -> Bool

hermanos (x,y) = x == 1 || y == 1 || gcd x y /= 1

-- 2ª definición (con all)

hermanada2 :: [Int] -> Bool

hermanada2 xs = all hermanos (zip xs (tail xs))

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

hermanada3 :: [Int] -> Bool

hermanada3 (x1:x:xs) = hermanos (x1,x) && hermanada3 (x:xs)

hermanada3 _ = True

-- 4ª definición (por plegado)

hermanada4 :: [Int] -> Bool

hermanada4 xs =

foldl (\ws p -> hermanos p && ws) True (zip xs (tail xs))

-- Comparación de eficiencia

-- λ> hermanada1 [2,4..1000000]

-- True

-- (2.33 secs, 476,586,552 bytes)

-- λ> hermanada2 [2,4..1000000]

-- True

-- (1.80 secs, 422,879,072 bytes)

-- λ> hermanada3 [2,4..1000000]

-- True

-- (2.58 secs, 477,251,896 bytes)

-- λ> hermanada4 [2,4..1000000]

-- True

-- (2.36 secs, 440,047,520 bytes)

Suma de elementos en posiciones dadas

PorJosé A. Alonso 17-diciembre-201524-diciembre-2015

Definir la función

   sumaEnPosicion :: [Int] -> [Int] -> Int

1	sumaEnPosicion :: [Int] -> [Int] -> Int

tal que (sumaEnPosicion xs ys) es la suma de todos los elementos de xs cuyas posiciones se indican en ys. Por ejemplo,

   sumaEnPosicion [1,2,3] [0,2]  ==  4
   sumaEnPosicion [4,6,2] [1,3]  ==  6
   sumaEnPosicion [3,5,1] [0,1]  ==  8

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

sumaEnPosicion [4,6,2] [1,3] == 6

sumaEnPosicion [3,5,1] [0,1] == 8

Soluciones

-- 1ª solución
sumaEnPosicion1 :: [Int] -> [Int] -> Int
sumaEnPosicion1 xs ys = sum [xs !! y | y <- ys, 0 <= y, y < n]
    where n = length xs

-- 2ª solución
sumaEnPosicion2 :: [Int] -> [Int] -> Int
sumaEnPosicion2 xs ys = aux xs [y | y <- ys, 0 <= y, y < n] 0
    where n = length xs
          aux _  []     r = r
          aux xs (y:ys) r = aux xs ys (r + xs!!y)

-- 1ª solución

sumaEnPosicion1 :: [Int] -> [Int] -> Int

sumaEnPosicion1 xs ys = sum [xs !! y | y <- ys, 0 <= y, y < n]

where n = length xs

-- 2ª solución

sumaEnPosicion2 :: [Int] -> [Int] -> Int

sumaEnPosicion2 xs ys = aux xs [y | y <- ys, 0 <= y, y < n] 0

where n = length xs

aux _ [] r = r

aux xs (y:ys) r = aux xs ys (r + xs!!y)

Factorizable respecto de una lista

PorJosé A. Alonso 16-diciembre-201523-diciembre-2015

Definir la función

   factorizable :: Integer -> [Integer] -> Bool

1	factorizable :: Integer -> [Integer] -> Bool

tal que (factorizable x ys) se verifica si x se puede escribir como producto de potencias de elementos de ys. Por ejemplo,

   factorizable 1  [2,5,6]                           ==  True
   factorizable 12 [2,5,3]                           ==  True
   factorizable 12 [2,5,6]                           ==  True
   factorizable 12 [7,5,12]                          ==  True
   factorizable 12 [2,3,1]                           ==  True
   factorizable 12 [2,3,0]                           ==  True
   factorizable 24 [12,4,6]                          ==  True
   factorizable 0  [2,3,0]                           ==  True
   factorizable 12 [5,6]                             ==  False
   factorizable 12 [2,5,1]                           ==  False
   factorizable 0  [2,3,5]                           ==  False
   factorizable (product [1..3000])     [1..100000]  ==  True
   factorizable (1 + product [1..3000]) [1..100000]  ==  False

factorizable 1 [2,5,6] == True

factorizable 12 [2,5,3] == True

factorizable 12 [2,5,6] == True

factorizable 12 [7,5,12] == True

factorizable 12 [2,3,1] == True

factorizable 12 [2,3,0] == True

factorizable 24 [12,4,6] == True

factorizable 0 [2,3,0] == True

factorizable 12 [5,6] == False

factorizable 12 [2,5,1] == False

factorizable 0 [2,3,5] == False

factorizable (product [1..3000]) [1..100000] == True

factorizable (1 + product [1..3000]) [1..100000] == False

Soluciones

-- 1ª definición
factorizable1 :: Integer -> [Integer] -> Bool
factorizable1 1 _  = True
factorizable1 0 ys = 0 `elem` ys
factorizable1 x ys = 
    or [ factorizable1 (x `div` y) ys | y <- ys
                                       , y /= 0 && y /= 1
                                       , x `mod` y == 0 ]

-- 2ª definición
factorizable2 :: Integer -> [Integer] -> Bool
factorizable2 1 _  = True
factorizable2 0 ys = 0 `elem` ys
factorizable2 x ys = 
    aux x [y | y <- ys, y > 1, x `mod` y == 0]
    where aux _ [] = False
          aux 1 _  = True
          aux x ys | null zs   = False
                   | otherwise = or [aux (x `div` z) ys | z <- zs] 
                   where zs = [y | y <- ys, x `mod` y == 0]

-- 3ª definición
factorizable3 :: Integer -> [Integer] -> Bool
factorizable3 1 _  = True
factorizable3 0 ys = 0 `elem` ys
factorizable3 x ys = 
    aux x [y | y <- ys, y > 1, x `mod` y == 0]
    where aux _ [] = False
          aux 1 _  = True
          aux x (y:ys) 
              | rem x y == 0 = aux (div x y) (y:ys) || aux x ys
              | otherwise    = aux x ys

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

--    λ> factorizable1 (product [1..3000]) [1..100000]
--    True
--    (3.55 secs, 322,471,488 bytes)
--    λ> factorizable2 (product [1..3000]) [1..100000]
--    True
--    (2.46 secs, 274,024,832 bytes)
--    λ> factorizable3 (product [1..3000]) [1..100000]
--    True
--    (0.30 secs, 47,606,400 bytes)
--    
--    λ> factorizable1 (1 + product [1..3000]) [1..100000]
--    False
--    (2.41 secs, 147,221,760 bytes)
--    λ> factorizable2 (1 + product [1..3000]) [1..100000]
--    False
--    (0.45 secs, 40,472,168 bytes)
--    λ> factorizable3 (1 + product [1..3000]) [1..100000]
--    False
--    (0.43 secs, 29,949,680 bytes)

-- 1ª definición

factorizable1 :: Integer -> [Integer] -> Bool

factorizable1 1 _ = True

factorizable1 0 ys = 0 `elem` ys

factorizable1 x ys =

or [ factorizable1 (x `div` y) ys | y <- ys

, y /= 0 && y /= 1

, x `mod` y == 0 ]

-- 2ª definición

factorizable2 :: Integer -> [Integer] -> Bool

factorizable2 1 _ = True

factorizable2 0 ys = 0 `elem` ys

factorizable2 x ys =

aux x [y | y <- ys, y > 1, x `mod` y == 0]

where aux _ [] = False

aux 1 _ = True

aux x ys | null zs = False

| otherwise = or [aux (x `div` z) ys | z <- zs]

where zs = [y | y <- ys, x `mod` y == 0]

-- 3ª definición

factorizable3 :: Integer -> [Integer] -> Bool

factorizable3 1 _ = True

factorizable3 0 ys = 0 `elem` ys

factorizable3 x ys =

aux x [y | y <- ys, y > 1, x `mod` y == 0]

where aux _ [] = False

aux 1 _ = True

aux x (y:ys)

| rem x y == 0 = aux (div x y) (y:ys) || aux x ys

| otherwise = aux x ys

-- Comparación de eficiencia

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

-- λ> factorizable1 (product [1..3000]) [1..100000]

-- True

-- (3.55 secs, 322,471,488 bytes)

-- λ> factorizable2 (product [1..3000]) [1..100000]

-- True

-- (2.46 secs, 274,024,832 bytes)

-- λ> factorizable3 (product [1..3000]) [1..100000]

-- True

-- (0.30 secs, 47,606,400 bytes)

-- λ> factorizable1 (1 + product [1..3000]) [1..100000]

-- False

-- (2.41 secs, 147,221,760 bytes)

-- λ> factorizable2 (1 + product [1..3000]) [1..100000]

-- False

-- (0.45 secs, 40,472,168 bytes)

-- λ> factorizable3 (1 + product [1..3000]) [1..100000]

-- False

-- (0.43 secs, 29,949,680 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)

Los números de Smith

PorJosé A. Alonso 4-diciembre-201511-diciembre-2015

Un número de Smith es un número natural compuesto que cumple que la suma de sus dígitos es igual a la suma de los dígitos de todos sus factores primos (si tenemos algún factor primo repetido lo sumamos tantas veces como aparezca). Por ejemplo, el 22 es un número de Smith ya que

    22 = 2*11 y
   2+2 = 2+(1+1)

1 2	22 = 2*11 y 2+2 = 2+(1+1)

y el 4937775 también lo es ya que

   4937775       = 3*5*5*65837 y 
   4+9+3+7+7+7+5 = 3+5+5+(6+5+8+3+7)

1 2	4937775 = 355*65837 y 4+9+3+7+7+7+5 = 3+5+5+(6+5+8+3+7)

Definir las funciones

   esSmith :: Integer -> Bool
   smith :: [Integer]

1 2	esSmith :: Integer -> Bool smith :: [Integer]

tales que

(esSmith x) se verifica si x es un número de Smith. Por ejemplo,

     esSmith 22          ==  True
     esSmith 29          ==  False
     esSmith 2015        ==  False
     esSmith 4937775     ==  True
     esSmith 4567597056  ==  True

esSmith 22 == True

esSmith 29 == False

esSmith 2015 == False

esSmith 4937775 == True

esSmith 4567597056 == True

smith es la lista cuyos elementos son los números de Smith. Por ejemplo,

     λ> take 17 smith
     [4,22,27,58,85,94,121,166,202,265,274,319,346,355,378,382,391]
     λ> smith !! 2000
     62158

λ> take 17 smith

[4,22,27,58,85,94,121,166,202,265,274,319,346,355,378,382,391]

λ> smith !! 2000

62158

Soluciones

import Data.Numbers.Primes

esSmith :: Integer -> Bool
esSmith x = 
    not (isPrime x) && 
    sumaDigitos x == sum (map sumaDigitos (primeFactors x))

sumaDigitos :: Integer -> Integer
sumaDigitos x | x < 10 = x
              | otherwise = x `mod` 10 + sumaDigitos (x `div` 10)

smith :: [Integer]
smith = [x | x <- [1..], esSmith x]

import Data.Numbers.Primes

esSmith :: Integer -> Bool

esSmith x =

not (isPrime x) &&

sumaDigitos x == sum (map sumaDigitos (primeFactors x))

sumaDigitos :: Integer -> Integer

sumaDigitos x | x < 10 = x

| otherwise = x `mod` 10 + sumaDigitos (x `div` 10)

smith :: [Integer]

smith = [x | x <- [1..], esSmith x]

Los números de Armstrong

PorJosé A. Alonso 3-diciembre-201510-diciembre-2015

Un número de n dígitos es un número de Armstrong si es igual a la suma de las n-ésimas potencias de sus dígitos. Por ejemplo, 371, 8208 y 4210818 son números de Armstrong ya que

       371 = 3^3 + 7 + 1³ y  
      8208 = 8^4 + 2^4 + 0^4 + 8^4 
   4210818 = 4^7 + 2^7 + 1^7 + 0^7 + 8^7 + 1^7 + 8^7

371 = 3^3 + 7 + 1³ y

8208 = 8^4 + 2^4 + 0^4 + 8^4

4210818 = 4^7 + 2^7 + 1^7 + 0^7 + 8^7 + 1^7 + 8^7

Definir las funciones

   esArmstrong :: Integer -> Bool
   armstrong   :: [Integer]

1 2	esArmstrong :: Integer -> Bool armstrong :: [Integer]

tales que

(esArmstrong x) se verifica si x es un número de Armstrong. Por ejemplo,

     esArmstrong 371                                      ==  True
     esArmstrong 8208                                     ==  True
     esArmstrong 4210818                                  ==  True
     esArmstrong 2015                                     ==  False
     esArmstrong 115132219018763992565095597973971522401  ==  True
     esArmstrong 115132219018763992565095597973971522402  ==  False

esArmstrong 371 == True

esArmstrong 8208 == True

esArmstrong 4210818 == True

esArmstrong 2015 == False

esArmstrong 115132219018763992565095597973971522401 == True

esArmstrong 115132219018763992565095597973971522402 == False

armstrong es la lista cuyos elementos son los números de Armstrong. Por ejemplo,

     λ> take 18 armstrong
     [1,2,3,4,5,6,7,8,9,153,370,371,407,1634,8208,9474,54748,92727]

1 2	λ> take 18 armstrong [1,2,3,4,5,6,7,8,9,153,370,371,407,1634,8208,9474,54748,92727]

Comprobar con QuickCheck que los números mayores que
115132219018763992565095597973971522401 no son números de Armstrong.

Soluciones

import Test.QuickCheck

esArmstrong :: Integer -> Bool
esArmstrong x = 
    x == sum [d^n | d <- digitos x]
    where n = length (show x)

-- (digitos x) es la lista de los dígitos de x. Por ejemplo,
--    digitos 325  ==  [3,2,5]
digitos :: Integer -> [Integer]
digitos x = [read [d] | d <- show x]

armstrong :: [Integer]
armstrong = [n | n <- [1..], esArmstrong n]

-- La propiedad es
prop_Armstrong :: Integer -> Bool
prop_Armstrong n =
    not (esArmstrong (115132219018763992565095597973971522401 + abs n + 1))

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

import Test.QuickCheck

esArmstrong :: Integer -> Bool

esArmstrong x =

x == sum [d^n | d <- digitos x]

where n = length (show x)

-- (digitos x) es la lista de los dígitos de x. Por ejemplo,

-- digitos 325 == [3,2,5]

digitos :: Integer -> [Integer]

digitos x = [read [d] | d <- show x]

armstrong :: [Integer]

armstrong = [n | n <- [1..], esArmstrong n]

-- La propiedad es

prop_Armstrong :: Integer -> Bool

prop_Armstrong n =

not (esArmstrong (115132219018763992565095597973971522401 + abs n + 1))

-- La comprobación es

-- λ> quickCheck prop_Armstrong

-- +++ OK, passed 100 tests.

Raíces enteras de los números primos

PorJosé A. Alonso 2-diciembre-20151-mayo-2016

Definir la sucesión

   raicesEnterasDePrimos :: [Integer]

1	raicesEnterasDePrimos :: [Integer]

cuyos elementos son las partes enteras de las raíces cuadradas de los números primos. Por ejemplo,

   λ> take 30 raicesEnterasDePrimos
   [1,1,2,2,3,3,4,4,4,5,5,6,6,6,6,7,7,7,8,8,8,8,9,9,9,10,10,10,10,10]
   λ> raicesEnterasDePrimos !!  9963
   322
   λ> raicesEnterasDePrimos !!  9964
   323

λ> take 30 raicesEnterasDePrimos

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

λ> raicesEnterasDePrimos !! 9963

322

λ> raicesEnterasDePrimos !! 9964

323

Comprobar con QuickCheck que la diferencia entre dos términos consecutivos de la sucesión es como máximo igual a 1.

Soluciones

import Data.Numbers.Primes (primes)
import Test.QuickCheck

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

raicesEnterasDePrimos1 :: [Integer]
raicesEnterasDePrimos1 = map raizEntera primes

-- (raizEntera x) es la parte entera de la raíz cuadrada de x. Por
-- ejemplo,
--    raizEntera  8  ==  2
--    raizEntera  9  ==  3
--    raizEntera 10  ==  3
raizEntera :: Integer -> Integer
raizEntera = floor . sqrt . fromIntegral 

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

raicesEnterasDePrimos2 :: [Integer]
raicesEnterasDePrimos2 = map raizEntera2 primes

raizEntera2 :: Integer -> Integer
raizEntera2 n = aux 1
    where aux k | k*k > n   = k-1
                | otherwise = aux (k+1)

-- 3º solución
-- ===========

raicesEnterasDePrimos3 :: [Integer]
raicesEnterasDePrimos3 = aux primes [1..]
    where aux (p:ps) (x:xs) | p > x*x   = aux (p:ps) xs
                            | otherwise = (x-1) : aux ps (x:xs)


-- Comparación de eficiencia
--    ghci> raicesEnterasDePrimos1 !! 400000
--    2408
--    (2.86 secs, 1177922500 bytes)
--    ghci> raicesEnterasDePrimos2 !! 400000
--    2408
--    (3.08 secs, 1177432260 bytes)
--    ghci> raicesEnterasDePrimos3 !! 400000
--    2408
--    (3.88 secs, 1260772112 bytes)

-- En lo sucesivo usaremos la 1ª definición
raicesEnterasDePrimos :: [Integer]
raicesEnterasDePrimos = raicesEnterasDePrimos3

-- La propiedad es
prop_raicesEnterasDePrimos :: Int -> Property
prop_raicesEnterasDePrimos n =
    n >= 0 ==> 
    raicesEnterasDePrimos !! (n+1) - raicesEnterasDePrimos !! n <= 1

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

import Data.Numbers.Primes (primes)

import Test.QuickCheck

-- 1ª solución

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

raicesEnterasDePrimos1 :: [Integer]

raicesEnterasDePrimos1 = map raizEntera primes

-- (raizEntera x) es la parte entera de la raíz cuadrada de x. Por

-- ejemplo,

-- raizEntera 8 == 2

-- raizEntera 9 == 3

-- raizEntera 10 == 3

raizEntera :: Integer -> Integer

raizEntera = floor . sqrt . fromIntegral

-- 2ª solución

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

raicesEnterasDePrimos2 :: [Integer]

raicesEnterasDePrimos2 = map raizEntera2 primes

raizEntera2 :: Integer -> Integer

raizEntera2 n = aux 1

where aux k | k*k > n = k-1

| otherwise = aux (k+1)

-- 3º solución

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

raicesEnterasDePrimos3 :: [Integer]

raicesEnterasDePrimos3 = aux primes [1..]

where aux (p:ps) (x:xs) | p > x*x = aux (p:ps) xs

| otherwise = (x-1) : aux ps (x:xs)

-- Comparación de eficiencia

-- ghci> raicesEnterasDePrimos1 !! 400000

-- 2408

-- (2.86 secs, 1177922500 bytes)

-- ghci> raicesEnterasDePrimos2 !! 400000

-- 2408

-- (3.08 secs, 1177432260 bytes)

-- ghci> raicesEnterasDePrimos3 !! 400000

-- 2408

-- (3.88 secs, 1260772112 bytes)

-- En lo sucesivo usaremos la 1ª definición

raicesEnterasDePrimos :: [Integer]

raicesEnterasDePrimos = raicesEnterasDePrimos3

-- La propiedad es

prop_raicesEnterasDePrimos :: Int -> Property

prop_raicesEnterasDePrimos n =

n >= 0 ==>

raicesEnterasDePrimos !! (n+1) - raicesEnterasDePrimos !! n <= 1

-- La comprobación es

-- λ> quickCheck prop_raicesEnterasDePrimos

-- +++ OK, passed 100 tests.

Paridad de un árbol

PorJosé A. Alonso 1-diciembre-20158-diciembre-2015

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

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving Show

Por ejemplo, el árbol

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

/ \

9 7

/ \ / \

1 4 6 8

se puede representar por

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

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

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

Definir la función

   paridad :: Arbol3 Int -> Paridad

1	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

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

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

Meses: diciembre 2015

Elementos óptimos

Soluciones

Elementos maximales

Soluciones

Reconocimiento de anterior

Soluciones

Operación sobre todos los pares

Soluciones

Inserciones por posición

Soluciones

Árbol de Navidad

Soluciones

Siembra de listas

Soluciones

Producto infinito

Soluciones

Listas hermanadas

Soluciones

Suma de elementos en posiciones dadas

Soluciones

Factorizable respecto de una lista

Soluciones

Año cúbico

Soluciones

Los números de Smith

Soluciones

Los números de Armstrong

Soluciones

Raíces enteras de los números primos

Soluciones

Paridad de un árbol

Soluciones

Entradas recientes

Buscar

Correo electrónico