Menu Close

Etiqueta: zipWhith

Mínimo producto escalar

José A. Alonso, ,

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

Soluciones

module Minimo_producto_escalar where
 
import Data.List (sort, permutations)
import Test.QuickCheck (quickCheck)
 
-- 1ª solución
-- ===========
 
menorProductoEscalar1 :: (Ord a, Num a) => [a] -> [a] -> a
menorProductoEscalar1 xs ys =
  minimum [sum (zipWith (*) pxs pys) | pxs <- permutations xs,
                                       pys <- permutations ys]
 
-- 2ª solución
-- ===========
 
menorProductoEscalar2 :: (Ord a, Num a) => [a] -> [a] -> a
menorProductoEscalar2 xs ys =
  minimum [sum (zipWith (*) pxs ys) | pxs <- permutations xs]
 
-- 3ª solución
-- ===========
 
menorProductoEscalar3 :: (Ord a, Num a) => [a] -> [a] -> a
menorProductoEscalar3 xs ys =
  sum (zipWith (*) (sort xs) (reverse (sort ys)))
 
-- Equivalencia
-- ============
 
-- La propiedad es
prop_menorProductoEscalar :: [Integer] -> [Integer] -> Bool
prop_menorProductoEscalar xs ys =
  all (== menorProductoEscalar1 xs' ys')
      [menorProductoEscalar2 xs' ys',
       menorProductoEscalar3 xs' ys']
  where n   = min (length xs) (length ys)
        xs' = take n xs
        ys' = take n ys
 
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=7}) prop_menorProductoEscalar
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> menorProductoEscalar1 [0..5] [0..5]
--    20
--    (3.24 secs, 977385528 bytes)
--    λ> menorProductoEscalar2 [0..5] [0..5]
--    20
--    (0.01 secs, 4185776 bytes)
--
--    λ> menorProductoEscalar2 [0..9] [0..9]
--    120
--    (23.86 secs, 9342872784 bytes)
--    λ> menorProductoEscalar3 [0..9] [0..9]
--    120
--    (0.01 secs, 2580824 bytes)
--
--    λ> menorProductoEscalar3 [0..10^6] [0..10^6]
--    166666666666500000
--    (2.46 secs, 473,338,912 bytes)

El código se encuentra en GitHub.

Leer más →

Números triangulares con n cifras distintas

José A. Alonso, ,

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>
Leer más →

Trenzado de listas

José A. Alonso, ,

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>
Leer más →

Suma de segmentos iniciales

José A. Alonso, ,

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>
Leer más →

Hojas con caminos no decrecientes

José A. Alonso, ,

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>
Leer más →