Menu Close

Etiqueta: zipWhith

Mínimo producto escalar

El producto escalar de los vectores [a1,a2,…,an] y [b1,b2,…, bn] es

   a1 * b1 + a2 * b2 + ··· + an * bn.

Definir la función

   menorProductoEscalar :: (Ord a, Num a) => [a] -> [a] -> a

tal que (menorProductoEscalar xs ys) es el mínimo de los productos escalares de las permutaciones de xs y de las permutaciones de ys. Por ejemplo,

   menorProductoEscalar [3,2,5]  [1,4,6]    == 29
   menorProductoEscalar [3,2,5]  [1,4,-6]   == -19
   menorProductoEscalar [1..10^2] [1..10^2] == 171700
   menorProductoEscalar [1..10^3] [1..10^3] == 167167000
   menorProductoEscalar [1..10^4] [1..10^4] == 166716670000
   menorProductoEscalar [1..10^5] [1..10^5] == 166671666700000
   menorProductoEscalar [1..10^6] [1..10^6] == 166667166667000000

Números triangulares con n cifras distintas

Los números triangulares se forman como sigue

   *     *      *
        * *    * *
              * * *
   1     3      6

La sucesión de los números triangulares se obtiene sumando los números naturales. Así, los 5 primeros números triangulares son

    1 = 1
    3 = 1 + 2
    6 = 1 + 2 + 3
   10 = 1 + 2 + 3 + 4
   15 = 1 + 2 + 3 + 4 + 5

Definir la función

   triangularesConCifras :: Int -> [Integer]

tal que (triangulares n) es la lista de los números triangulares con n cifras distintas. Por ejemplo,

   take 6 (triangularesConCifras 1)   ==  [1,3,6,55,66,666]
   take 6 (triangularesConCifras 2)   ==  [10,15,21,28,36,45]
   take 6 (triangularesConCifras 3)   ==  [105,120,136,153,190,210]
   take 5 (triangularesConCifras 4)   ==  [1035,1275,1326,1378,1485]
   take 2 (triangularesConCifras 10)  ==  [1062489753,1239845706]

Soluciones

import Data.List (nub)
import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
triangularesConCifras1 :: Int -> [Integer]
triangularesConCifras1 n =
  [x | x <- triangulares1,
       nCifras x == n]
 
-- triangulares1 es la lista de los números triangulares. Por ejemplo,
--    take 10 triangulares1 == [1,3,6,10,15,21,28,36,45,55]
triangulares1 :: [Integer]
triangulares1 = map triangular [1..]
 
triangular :: Integer -> Integer
triangular 1 = 1
triangular n = triangular (n-1) + n
 
-- (nCifras x) es el número de cifras distintas del número x. Por
-- ejemplo,
--    nCifras 325275  ==  4
nCifras :: Integer -> Int
nCifras = length . nub . show
 
-- 2ª solución
-- ===========
 
triangularesConCifras2 :: Int -> [Integer]
triangularesConCifras2 n =
  [x | x <- triangulares2,
       nCifras x == n]
 
triangulares2 :: [Integer]
triangulares2 = [(n*(n+1)) `div` 2 | n <- [1..]]
 
-- 3ª solución
-- ===========
 
triangularesConCifras3 :: Int -> [Integer]
triangularesConCifras3 n =
  [x | x <- triangulares3,
       nCifras x == n]
 
triangulares3 :: [Integer]
triangulares3 = 1 : [x+y | (x,y) <- zip [2..] triangulares3]
 
-- 4ª solución
-- ===========
 
triangularesConCifras4 :: Int -> [Integer]
triangularesConCifras4 n =
  [x | x <- triangulares4,
       nCifras x == n]
 
triangulares4 :: [Integer]
triangulares4 = 1 : zipWith (+) [2..] triangulares4
 
-- 5ª solución
-- ===========
 
triangularesConCifras5 :: Int -> [Integer]
triangularesConCifras5 n =
  [x | x <- triangulares5,
       nCifras x == n]
 
triangulares5 :: [Integer]
triangulares5 = scanl (+) 1 [2..]
 
-- Comprobación de equivalencia
-- ============================
 
-- La 1ª propiedad es
prop_triangularesConCifras1 :: Bool
prop_triangularesConCifras1 =
  [take 2 (triangularesConCifras1 n) | n <- [1..7]] ==
  [take 2 (triangularesConCifras2 n) | n <- [1..7]]
 
-- La comprobación es
--    λ> prop_triangularesConCifras1
--    True
 
-- La 2ª propiedad es
prop_triangularesConCifras2 :: Int -> Bool
prop_triangularesConCifras2 n =
  all (== take 5 (triangularesConCifras2 n'))
      [take 5 (triangularesConCifras3 n'),
       take 5 (triangularesConCifras4 n'),
       take 5 (triangularesConCifras5 n')]
  where n' = 1 + n `mod` 9
 
-- La comprobación es
--    λ> quickCheck prop_triangularesConCifras
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> (triangularesConCifras1 3) !! 220
--    5456556
--    (2.48 secs, 1,228,690,120 bytes)
--    λ> (triangularesConCifras2 3) !! 220
--    5456556
--    (0.01 secs, 4,667,288 bytes)
--
--    λ> (triangularesConCifras2 3) !! 600
--    500010500055
--    (1.76 secs, 1,659,299,872 bytes)
--    λ> (triangularesConCifras3 3) !! 600
--    500010500055
--    (1.67 secs, 1,603,298,648 bytes)
--    λ> (triangularesConCifras4 3) !! 600
--    500010500055
--    (1.20 secs, 1,507,298,248 bytes)
--    λ> (triangularesConCifras5 3) !! 600
--    500010500055
--    (1.15 secs, 1,507,298,256 bytes)

El código se encuentra en GitHub.

La elaboración de las soluciones se describe en el siguiente vídeo

Nuevas soluciones

  • En los comentarios se pueden escribir nuevas soluciones.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Trenzado de listas

Definir la función

   trenza :: [a] -> [a] -> [a]

tal que (trenza xs ys) es la lista obtenida intercalando los elementos de xs e ys. Por ejemplo,

   trenza [5,1] [2,7,4]             ==  [5,2,1,7]
   trenza [5,1,7] [2..]             ==  [5,2,1,3,7,4]
   trenza [2..] [5,1,7]             ==  [2,5,3,1,4,7]
   take 8 (trenza [2,4..] [1,5..])  ==  [2,1,4,5,6,9,8,13]

Soluciones

import Test.QuickCheck (quickCheck)
 
-- 1ª solución
-- ===========
 
trenza1 :: [a] -> [a] -> [a]
trenza1 []     _      = []
trenza1 _      []     = []
trenza1 (x:xs) (y:ys) = x : y : trenza1 xs ys
 
-- 2ª solución
-- ===========
 
trenza2 :: [a] -> [a] -> [a]
trenza2 (x:xs) (y:ys) = x : y : trenza2 xs ys
trenza2 _      _      = []
 
-- 3ª solución
-- ===========
 
trenza3 :: [a] -> [a] -> [a]
trenza3 xs ys = concat [[x,y] | (x,y) <- zip xs ys]
 
-- 4ª solución
-- ===========
 
trenza4 :: [a] -> [a] -> [a]
trenza4 xs ys = concat (zipWith par xs ys)
 
par :: a -> a -> [a]
par x y = [x,y]
 
-- 5ª solución
-- ===========
 
-- Explicación de eliminación de argumentos en composiciones con varios
-- argumentos:
 
f :: Int -> Int
f x = x + 1
 
g :: Int -> Int -> Int
g x y = x + y
 
h1, h2, h3, h4, h5, h6, h7 :: Int -> Int -> Int
h1 x y  = f (g x y)
h2 x y  = f ((g x) y)
h3 x y  = (f . (g x)) y
h4 x    = f . (g x)
h5 x    = (f .) (g x)
h6 x    = ((f .) . g) x
h7      = (f .) . g
 
prop_composicion :: Int -> Int -> Bool
prop_composicion x y =
  all (== h1 x y)
      [p x y | p <- [h2, h3, h4, h5, h6, h7]]
 
-- λ> quickCheck prop_composicion
-- +++ OK, passed 100 tests.
 
-- En general,
--    f . g             --> \x -> f (g x)
--    (f .) . g         --> \x y -> f (g x y)
--    ((f .) .) . g     --> \x y z -> f (g x y z)
--    (((f .) .) .) . g --> \w x y z -> f (g w x y z)
 
trenza5 :: [a] -> [a] -> [a]
trenza5 = (concat .) . zipWith par
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_trenza :: [Int] -> [Int] -> Bool
prop_trenza xs ys =
  all (== trenza1 xs ys)
      [trenza2 xs ys,
       trenza3 xs ys,
       trenza4 xs ys,
       trenza5 xs ys]
 
-- La comprobación es
--    λ> quickCheck prop_trenza
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> last (trenza1 [1,1..] [1..4*10^6])
--    4000000
--    (2.33 secs, 1,472,494,952 bytes)
--    λ> last (trenza2 [1,1..] [1..4*10^6])
--    4000000
--    (2.24 secs, 1,376,494,928 bytes)
--    λ> last (trenza3 [1,1..] [1..4*10^6])
--    4000000
--    (1.33 secs, 1,888,495,048 bytes)
--    λ> last (trenza4 [1,1..] [1..4*10^6])
--    4000000
--    (0.76 secs, 1,696,494,968 bytes)
--    λ> last (trenza5 [1,1..] [1..4*10^6])
--    4000000
--    (0.76 secs, 1,696,495,064 bytes)

El código se encuentra en GitHub.

La elaboración de las soluciones se describe en el siguiente vídeo

Nuevas soluciones

  • En los comentarios se pueden escribir nuevas soluciones.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Suma de segmentos iniciales

Los segmentos iniciales de [3,1,2,5] son [3], [3,1], [3,1,2] y [3,1,2,5]. Sus sumas son 3, 4, 6 y 9, respectivamente. La suma de dichas sumas es 24.

Definir la función

   sumaSegmentosIniciales :: [Integer] -> Integer

tal que (sumaSegmentosIniciales xs) es la suma de las sumas de los segmentos iniciales de xs. Por ejemplo,

   sumaSegmentosIniciales [3,1,2,5]     ==  24
   sumaSegmentosIniciales [1..3*10^6]  ==  4500004500001000000

Comprobar con QuickCheck que la suma de las sumas de los segmentos iniciales de la lista formada por n veces el número uno es el n-ésimo número triangular; es decir que

   sumaSegmentosIniciales (genericReplicate n 1)

es igual a

   n * (n + 1) `div` 2

Soluciones

import Data.List (genericLength, genericReplicate)
import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
sumaSegmentosIniciales :: [Integer] -> Integer
sumaSegmentosIniciales xs =
  sum [sum (take k xs) | k <- [1.. length xs]]
 
-- 2ª solución
-- ===========
 
sumaSegmentosIniciales2 :: [Integer] -> Integer
sumaSegmentosIniciales2 xs =
  sum (zipWith (*) [n,n-1..1] xs)
  where n = genericLength xs
 
-- 3ª solución
-- ===========
 
sumaSegmentosIniciales3 :: [Integer] -> Integer
sumaSegmentosIniciales3 xs =
  sum (scanl1 (+) xs)
 
-- Comprobación de la equivalencia
-- ===============================
 
-- La propiedad es
prop_sumaSegmentosInicialesEquiv :: [Integer] -> Bool
prop_sumaSegmentosInicialesEquiv xs =
  all (== sumaSegmentosIniciales xs) [f xs | f <- [ sumaSegmentosIniciales2
                                                  , sumaSegmentosIniciales3]]
 
-- La comprobación es
--   λ> quickCheck prop_sumaSegmentosInicialesEquiv
--   +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
--   λ> sumaSegmentosIniciales [1..10^4]
--   166716670000
--   (2.42 secs, 7,377,926,824 bytes)
--   λ> sumaSegmentosIniciales2 [1..10^4]
--   166716670000
--   (0.01 secs, 4,855,176 bytes)
--   
--   λ> sumaSegmentosIniciales2 [1..3*10^6]
--   4500004500001000000
--   (2.68 secs, 1,424,404,168 bytes)
--   λ> sumaSegmentosIniciales3 [1..3*10^6]
--   4500004500001000000
--   (1.54 secs, 943,500,384 bytes)
 
-- Comprobación de la propiedad
-- ============================
 
-- La propiedad es
prop_sumaSegmentosIniciales :: Positive Integer -> Bool
prop_sumaSegmentosIniciales (Positive n) =
  sumaSegmentosIniciales3 (genericReplicate n 1) ==
  n * (n + 1) `div` 2
 
-- La compronación es
--   λ> quickCheck prop_sumaSegmentosIniciales
--   +++ OK, passed 100 tests.

Otras soluciones

  • Se pueden escribir otras soluciones en los comentarios.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Hojas con caminos no decrecientes

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

   data Arbol = N Int [Arbol]
     deriving Show

Por ejemplo, los árboles

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

se representan por

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

Definir la función

   hojasEnNoDecreciente :: Arbol -> [Int]

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

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

Soluciones

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

Otras soluciones

  • Se pueden escribir otras soluciones en los comentarios.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Producto de Fibonaccis consecutivos

Los números de Fibonacci son los números F(n) de la siguiente sucesión

   0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, ...

que comienza con 0 y 1 y los siguientes términos son las sumas de los dos anteriores.

Un número x es el producto de dos números de Fibonacci consecutivos si existe un n tal que

   F(n) * F(n+1) = x

y su prueba es (F(n),F(n+1),True). Por ejemplo, 714 es el producto de dos números de Fibonacci consecutivos ya que

F(8) = 21, F(9) = 34 y 714 = 21 * 34.

Su prueba es (21, 34, True).

Un número x no es el producto de dos números de Fibonacci consecutivos si no existe un n tal que

   F(n) * F(n+1) = x

y su prueba es (F(m),F(m+1),False) donde m es el menor número tal que

   F(m) * F(m+1) > x

Por ejemplo, 800 no es el producto de dos números de Fibonacci consecutivos, ya que

 F(8) = 21, F(9) = 34, F(10) = 55 y 21 * 34 < 800 < 34 * 55.

Su prueba es (34, 55, False),

Definir la función

   productoFib :: Integer -> (Integer, Integer, Bool)

tal que (productoFib x) es la prueba de que es, o no es, el producto de dos números de Fibonacci consecutivos. Por ejemplo,

   productoFib 714  == (21,  34, True)
   productoFib 800  == (34,  55, False)
   productoFib 4895 == (55,  89, True)
   productoFib 5895 == (89, 144, False)

Soluciones

-- 1ª solución
-- ===========
 
productoFib :: Integer -> (Integer, Integer, Bool)
productoFib n
  | c == n    = (a,b,True)
  | otherwise = (a,b,False)
  where (a,b,c) = head (dropWhile (\(x,y,z) -> z < n) productos) 
 
-- fibs es la sucesión de números de Fibonacci. Por ejemplo,
--    take 14 fibs  ==  [0,1,1,2,3,5,8,13,21,34,55,89,144,233]
fibs :: [Integer]
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
 
-- productos es la lista de las ternas (a,b,c) tales que a y b son dos
-- números de Fibonacci consecutivos y c es su producto. Por ejemplo,
--    λ> take 7 productos
--    [(0,1,0),(1,1,1),(1,2,2),(2,3,6),(3,5,15),(5,8,40),(8,13,104)]
productos :: [(Integer,Integer,Integer)]
productos = [(x,y,x*y) | (x,y) <- zip fibs (tail fibs)] 
 
-- 2ª solución
-- ===========
 
productoFib2 :: Integer -> (Integer, Integer, Bool)
productoFib2 n = aux 0 1 n
  where
    aux a b c
        | a * b >= c = (a, b, a * b == c)
        | otherwise  = aux b (a + b) c
 
-- 3ª solución
-- ===========
 
productoFib3 :: Integer -> (Integer, Integer, Bool)
productoFib3 x = aux 0 1
  where
    aux a b | a * b >= x = (a, b, x == a * b)
            | otherwise  = aux b (a + b)
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> let (x,_,_) = productoFib (10^20000) in length (show x)
--    10000
--    (1.15 secs, 323,396,360 bytes)
--    λ> let (x,_,_) = productoFib2 (10^20000) in length (show x)
--    10000
--    (1.10 secs, 317,268,672 bytes)
--    λ> let (x,_,_) = productoFib3 (10^20000) in length (show x)
--    10000
--    (1.08 secs, 314,972,440 bytes)

Otras soluciones

  • Se pueden escribir otras soluciones en los comentarios.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Pensamiento

“El placer que obtenemos de la música proviene de contar, pero contando inconscientemente. La música no es más que aritmética inconsciente.”

Gottfried Wilhelm Leibniz.

Teorema de Carmichael

La sucesión de Fibonacci, F(n), es la siguiente sucesión infinita de números naturales:

   0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, ...

La sucesión comieanza con los números 0 y 1. A partir de estos, cada término es la suma de los dos anteriores.

El teorema de Carmichael establece que para todo n mayor que 12, el n-ésimo número de Fibonacci F(n) tiene al menos un factor primo que no es factor de ninguno de los términos anteriores de la sucesión.

Si un número primo p es un factor de F(n) y no es factor de ningún F(m) con m < n, entonces se dice que p es un factor característico o un divisor primitivo de F(n).

Definir la función

   factoresCaracteristicos :: Int -> [Integer]

tal que (factoresCaracteristicos n) es la lista de los factores característicos de F(n). Por ejemplo,

   factoresCaracteristicos  4  ==  [3]
   factoresCaracteristicos  6  ==  []
   factoresCaracteristicos 19  ==  [37,113]
   factoresCaracteristicos 20  ==  [41]
   factoresCaracteristicos 37  ==  [73,149,2221]

Comprobar con QuickCheck el teorema de Carmichael; es decir, para todo número entero (factoresCaracteristicos (13 + abs n)) es una lista no vacía.

Soluciones

import Data.List (nub)
import Data.Numbers.Primes
import Test.QuickCheck
 
factoresCaracteristicos :: Int -> [Integer]
factoresCaracteristicos n =
  [x | x <- factoresPrimos (fib n)
     , and [fib m `mod` x /= 0 | m <- [1..n-1]]]
 
-- (fib n) es el n-ésimo término de la sucesión de Fibonacci. Por
-- ejemplo,
--    fib 6  ==  8
fib :: Int -> Integer
fib n = fibs !! n
 
-- fibs es la lista de términos de la sucesión de Fibonacci. Por ejemplo,
--    λ> take 20 fibs
--    [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]
fibs :: [Integer]
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
 
-- (factoresPrimos n) es la lista de los factores primos de n. Por
-- ejemplo, 
--    factoresPrimos 600  ==  [2,3,5]
factoresPrimos :: Integer -> [Integer]
factoresPrimos 0 = []
factoresPrimos n = nub (primeFactors n)
 
-- Teorema
-- =======
 
-- El teorema es
teorema_de_Carmichael :: Int -> Bool
teorema_de_Carmichael n =
  not (null (factoresCaracteristicos n'))
  where n' = 13 + abs n
 
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=50}) teorema_de_Carmichael
--    +++ OK, passed 100 tests.

Pensamiento

No puede ser
amor de tanta fortuna:
dos soledades en una.

Antonio Machado

Triángulo de Euler

El triángulo de Euler se construye a partir de las siguientes relaciones

   A(n,1) = A(n,n) = 1
   A(n,m) = (n-m)A(n-1,m-1) + (m+1)A(n-1,m).

Sus primeros términos son

   1 
   1 1                                                       
   1 4   1                                            
   1 11  11    1                                    
   1 26  66    26    1                             
   1 57  302   302   57     1                    
   1 120 1191  2416  1191   120   1            
   1 247 4293  15619 15619  4293  247   1   
   1 502 14608 88234 156190 88234 14608 502 1

Definir las siguientes funciones:

  numeroEuler        :: Integer -> Integer -> Integer
  filaTrianguloEuler :: Integer -> [Integer]
  trianguloEuler     :: [[Integer]]

tales que

  • (numeroEuler n k) es el número de Euler A(n,k). Por ejemplo,
     numeroEuler 8 3  == 15619
     numeroEuler 20 6 == 21598596303099900
     length (show (numeroEuler 1000 500)) == 2567
  • (filaTrianguloEuler n) es la n-ésima fila del triángulo de Euler. Por ejemplo,
     filaTrianguloEuler 7  ==  [1,120,1191,2416,1191,120,1]
     filaTrianguloEuler 8  ==  [1,247,4293,15619,15619,4293,247,1]
     length (show (maximum (filaTrianguloEuler 1000)))  ==  2567
  • trianguloEuler es la lista con las filas del triángulo de Euler
     λ> take 6 trianguloEuler
     [[1],[1,1],[1,4,1],[1,11,11,1],[1,26,66,26,1],[1,57,302,302,57,1]]
     λ> length (show (maximum (trianguloEuler !! 999)))
     2567

Soluciones

import Data.List  (genericLength, genericIndex)
import Data.Array (Array, (!), array)
 
-- 1ª solución
-- ===========
 
trianguloEuler :: [[Integer]]
trianguloEuler = iterate siguiente [1]
 
-- (siguiente xs) es la fila siguiente a la xs en el triángulo de
-- Euler. Por ejemplo,
--    λ> siguiente [1]
--    [1,1]
--    λ> siguiente it
--    [1,4,1]
--    λ> siguiente it
--    [1,11,11,1]
siguiente :: [Integer] -> [Integer]
siguiente xs = zipWith (+) us vs
  where n = genericLength xs
        us = zipWith (*) (0:xs) [n+1,n..1]
        vs = zipWith (*) (xs++[0]) [1..n+1]
 
filaTrianguloEuler :: Integer -> [Integer]
filaTrianguloEuler n = trianguloEuler `genericIndex` (n-1)
 
numeroEuler :: Integer -> Integer -> Integer
numeroEuler n k = filaTrianguloEuler n `genericIndex` k
 
-- 2ª solución
-- ===========
 
numeroEuler2 :: Integer -> Integer -> Integer
numeroEuler2 n 0 = 1
numeroEuler2 n m 
  | n == m    = 0
  | otherwise = (n-m) * numeroEuler2 (n-1) (m-1) + (m+1) * numeroEuler2 (n-1) m
 
filaTrianguloEuler2 :: Integer -> [Integer]
filaTrianguloEuler2 n = map (numeroEuler2 n) [0..n-1]
 
trianguloEuler2 :: [[Integer]]
trianguloEuler2 = map filaTrianguloEuler2 [1..]
 
-- 3ª solución
-- ===========
 
numeroEuler3 :: Integer -> Integer -> Integer
numeroEuler3 n k = (matrizEuler n k) ! (n,k)
 
-- (matrizEuler n m) es la matriz de n+1 filas y m+1 columnsa formada
-- por los números de Euler. Por ejemplo,
--   λ> [[matrizEuler 6 6 ! (i,j) | j <- [0..i-1]] | i <- [1..6]]
--   [[1],[1,1],[1,4,1],[1,11,11,1],[1,26,66,26,1],[1,57,302,302,57,1]]
matrizEuler :: Integer -> Integer -> Array (Integer,Integer) Integer
matrizEuler n m = q
  where q = array ((0,0),(n,m)) [((i,j), f i j) | i <- [0..n], j <- [0..m]]
        f i 0 = 1
        f i j
          | i == j    = 0
          | otherwise = (i-j) * q!(i-1,j-1) + (j+1)* q!(i-1,j)
 
filaTrianguloEuler3 :: Integer -> [Integer]
filaTrianguloEuler3 n = map (numeroEuler3 n) [0..n-1]
 
trianguloEuler3 :: [[Integer]]
trianguloEuler3 = map filaTrianguloEuler3 [1..]
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--   λ> numeroEuler 22 11
--   301958232385734088196
--   (0.01 secs, 118,760 bytes)
--   λ> numeroEuler2 22 11
--   301958232385734088196
--   (3.96 secs, 524,955,384 bytes)
--   λ> numeroEuler3 22 11
--   301958232385734088196
--   (0.01 secs, 356,296 bytes)
--   
--   λ> length (show (numeroEuler 800 400))
--   1976
--   (0.01 secs, 383,080 bytes)
--   λ> length (show (numeroEuler3 800 400))
--   1976
--   (2.13 secs, 508,780,696 bytes)

Pensamiento

Señor San Jerónimo,
suelte usted la piedra
con que se machaca.
Me pegó con ella.

Antonio Machado

Suma de segmentos iniciales

Los segmentos iniciales de [3,1,2,5] son [3], [3,1], [3,1,2] y [3,1,2,5]. Sus sumas son 3, 4, 6 y 9, respectivamente. La suma de dichas sumas es 24.

Definir la función

   sumaSegmentosIniciales :: [Integer] -> Integer

tal que (sumaSegmentosIniciales xs) es la suma de las sumas de los segmentos iniciales de xs. Por ejemplo,

   sumaSegmentosIniciales [3,1,2,5]     ==  24
   sumaSegmentosIniciales3 [1..3*10^6]  ==  4500004500001000000

Comprobar con QuickCheck que la suma de las sumas de los segmentos iniciales de la lista formada por n veces el número uno es el n-ésimo número triangular; es decir que

   sumaSegmentosIniciales (genericReplicate n 1)

es igual a

   n * (n + 1) `div` 2

Soluciones

import Data.List (genericLength, genericReplicate)
import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
sumaSegmentosIniciales :: [Integer] -> Integer
sumaSegmentosIniciales xs =
  sum [sum (take k xs) | k <- [1.. length xs]]
 
-- 2ª solución
-- ===========
 
sumaSegmentosIniciales2 :: [Integer] -> Integer
sumaSegmentosIniciales2 xs =
  sum (zipWith (*) [n,n-1..1] xs)
  where n = genericLength xs
 
-- 3ª solución
-- ===========
 
sumaSegmentosIniciales3 :: [Integer] -> Integer
sumaSegmentosIniciales3 xs =
  sum (scanl1 (+) xs)
 
-- Comprobación de la equivalencia
-- ===============================
 
-- La propiedad es
prop_sumaSegmentosInicialesEquiv :: [Integer] -> Bool
prop_sumaSegmentosInicialesEquiv xs =
  all (== sumaSegmentosIniciales xs) [f xs | f <- [ sumaSegmentosIniciales2
                                                  , sumaSegmentosIniciales3]]
 
-- La comprobación es
--   λ> quickCheck prop_sumaSegmentosInicialesEquiv
--   +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
--   λ> sumaSegmentosIniciales [1..10^4]
--   166716670000
--   (2.42 secs, 7,377,926,824 bytes)
--   λ> sumaSegmentosIniciales2 [1..10^4]
--   166716670000
--   (0.01 secs, 4,855,176 bytes)
--   
--   λ> sumaSegmentosIniciales2 [1..3*10^6]
--   4500004500001000000
--   (2.68 secs, 1,424,404,168 bytes)
--   λ> sumaSegmentosIniciales3 [1..3*10^6]
--   4500004500001000000
--   (1.54 secs, 943,500,384 bytes)
 
-- Comprobación de la propiedad
-- ============================
 
-- La propiedad es
prop_sumaSegmentosIniciales :: Positive Integer -> Bool
prop_sumaSegmentosIniciales (Positive n) =
  sumaSegmentosIniciales3 (genericReplicate n 1) ==
  n * (n + 1) `div` 2
 
-- La compronación es
--   λ> quickCheck prop_sumaSegmentosIniciales
--   +++ OK, passed 100 tests.

Pensamiento

Al andar se hace camino,
y al volver la vista atrás
se ve la senda que nunca
se ha de volver a pisar.

Antonio Machado

Hojas con caminos no decrecientes

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

   data Arbol = N Int [Arbol]
     deriving Show

Por ejemplo, los árboles

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

se representan por

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

Definir la función

   hojasEnNoDecreciente :: Arbol -> [Int]

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

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

Soluciones

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

Pensamiento

Para dialogar,
preguntad, primero;
después … escuchad.

Antonio Machado