foldr – Exercitium

Producto cartesiano de una familia de conjuntos

José A. Alonso, 27-abril-2022, Ejercicio

Definir la función

   producto :: [[a]] -> [[a]]

tal que (producto xss) es el producto cartesiano de los conjuntos xss. Por ejemplo,

   λ> producto [[1,3],[2,5]]
   [[1,2],[1,5],[3,2],[3,5]]
   λ> producto [[1,3],[2,5],[6,4]]
   [[1,2,6],[1,2,4],[1,5,6],[1,5,4],[3,2,6],[3,2,4],[3,5,6],[3,5,4]]
   λ> producto [[1,3,5],[2,4]]
   [[1,2],[1,4],[3,2],[3,4],[5,2],[5,4]]
   λ> producto []
   [[]]

Comprobar con QuickCheck que para toda lista de listas de números enteros, xss, se verifica que el número de elementos de (producto xss) es igual al producto de los números de elementos de cada una de las listas de xss.

Soluciones

module Producto_cartesiano where
 
import Test.QuickCheck (quickCheck)
import Control.Monad (liftM2)
import Control.Applicative (liftA2)
 
-- 1ª solución
-- ===========
 
producto1 :: [[a]] -> [[a]]
producto1 []       = [[]]
producto1 (xs:xss) = [x:ys | x <- xs, ys <- producto1 xss]
 
-- 2ª solución
-- ===========
 
producto2 :: [[a]] -> [[a]]
producto2 []       = [[]]
producto2 (xs:xss) = [x:ys | x <- xs, ys <- ps]
  where ps = producto2 xss
 
-- 3ª solución
-- ===========
 
producto3 :: [[a]] -> [[a]]
producto3 []       = [[]]
producto3 (xs:xss) = inserta3 xs (producto3 xss)
 
-- (inserta xs xss) inserta cada elemento de xs en los elementos de
-- xss. Por ejemplo,
--    λ> inserta [1,2] [[3,4],[5,6]]
--    [[1,3,4],[1,5,6],[2,3,4],[2,5,6]]
inserta3 :: [a] -> [[a]] -> [[a]]
inserta3 [] _       = []
inserta3 (x:xs) yss = [x:ys | ys <- yss] ++ inserta3 xs yss
 
-- 4ª solución
-- ===========
 
producto4 :: [[a]] -> [[a]]
producto4 = foldr inserta4 [[]]
 
inserta4 :: [a] -> [[a]] -> [[a]]
inserta4 []     _   = []
inserta4 (x:xs) yss = map (x:) yss ++ inserta4 xs yss
 
-- 5ª solución
-- ===========
 
producto5 :: [[a]] -> [[a]]
producto5 = foldr inserta5 [[]]
 
inserta5 :: [a] -> [[a]] -> [[a]]
inserta5 xs yss = [x:ys | x <- xs, ys <- yss]
 
-- 6ª solución
-- ===========
 
producto6 :: [[a]] -> [[a]]
producto6 = foldr inserta6 [[]]
 
inserta6 :: [a] -> [[a]] -> [[a]]
inserta6 xs yss = concatMap (\x -> map (x:) yss) xs
 
-- 7ª solución
-- ===========
 
producto7 :: [[a]] -> [[a]]
producto7 = foldr inserta7 [[]]
 
inserta7 :: [a] -> [[a]] -> [[a]]
inserta7 xs yss = xs >>= (\x -> map (x:) yss)
 
-- 8ª solución
-- ===========
 
producto8 :: [[a]] -> [[a]]
producto8 = foldr inserta8 [[]]
 
inserta8 :: [a] -> [[a]] -> [[a]]
inserta8 xs yss = (:) <$> xs <*> yss
 
-- 9ª solución
-- ===========
 
producto9 :: [[a]] -> [[a]]
producto9 = foldr inserta9 [[]]
 
inserta9 :: [a] -> [[a]] -> [[a]]
inserta9 = liftA2 (:)
 
-- 10ª solución
-- ============
 
producto10 :: [[a]] -> [[a]]
producto10 = foldr (liftM2 (:)) [[]]
 
-- 11ª solución
-- ============
 
producto11 :: [[a]] -> [[a]]
producto11 = sequence
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_producto :: [[Int]] -> Bool
prop_producto xss =
  all (== producto1 xss)
      [ producto2 xss
      , producto3 xss
      , producto4 xss
      , producto5 xss
      , producto6 xss
      , producto7 xss
      , producto8 xss
      , producto9 xss
      , producto10 xss
      , producto11 xss
      ]
 
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize = 9}) prop_producto
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> length (producto1 (replicate 7 [0..9]))
--    10000000
--    (10.51 secs, 10,169,418,496 bytes)
--    λ> length (producto2 (replicate 7 [0..9]))
--    10000000
--    (2.14 secs, 1,333,870,712 bytes)
--    λ> length (producto3 (replicate 7 [0..9]))
--    10000000
--    (3.33 secs, 1,956,102,056 bytes)
--    λ> length (producto4 (replicate 7 [0..9]))
--    10000000
--    (0.98 secs, 1,600,542,752 bytes)
--    λ> length (producto5 (replicate 7 [0..9]))
--    10000000
--    (2.10 secs, 1,333,870,288 bytes)
--    λ> length (producto6 (replicate 7 [0..9]))
--    10000000
--    (1.17 secs, 1,600,534,632 bytes)
--    λ> length (producto7 (replicate 7 [0..9]))
--    10000000
--    (0.35 secs, 1,600,534,352 bytes)
--    λ> length (producto8 (replicate 7 [0..9]))
--    10000000
--    (0.87 secs, 978,317,848 bytes)
--    λ> length (producto9 (replicate 7 [0..9]))
--    10000000
--    (1.38 secs, 1,067,201,016 bytes)
--    λ> length (producto10 (replicate 7 [0..9]))
--    10000000
--    (0.54 secs, 2,311,645,392 bytes)
--    λ> length (producto11 (replicate 7 [0..9]))
--    10000000
--    (1.32 secs, 1,067,200,992 bytes)
--
--    λ> length (producto7 (replicate 7 [1..14]))
--    105413504
--    (3.77 secs, 16,347,739,040 bytes)
--    λ> length (producto10 (replicate 7 [1..14]))
--    105413504
--    (5.11 secs, 23,613,162,016 bytes)
 
-- Comprobación de la propiedad
-- ============================
 
-- La propiedad es
prop_longitud :: [[Int]] -> Bool
prop_longitud xss =
  length (producto7 xss) == product (map length xss)
 
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize = 7}) prop_longitud
--    +++ OK, passed 100 tests.

module Producto_cartesiano where import Test.QuickCheck (quickCheck) import Control.Monad (liftM2) import Control.Applicative (liftA2) -- 1ª solución -- =========== producto1 :: [[a]] -> [[a]] producto1 [] = [[]] producto1 (xs:xss) = [x:ys | x <- xs, ys <- producto1 xss] -- 2ª solución -- =========== producto2 :: [[a]] -> [[a]] producto2 [] = [[]] producto2 (xs:xss) = [x:ys | x <- xs, ys <- ps] where ps = producto2 xss -- 3ª solución -- =========== producto3 :: [[a]] -> [[a]] producto3 [] = [[]] producto3 (xs:xss) = inserta3 xs (producto3 xss) -- (inserta xs xss) inserta cada elemento de xs en los elementos de -- xss. Por ejemplo, -- λ> inserta [1,2] [[3,4],[5,6]] -- [[1,3,4],[1,5,6],[2,3,4],[2,5,6]] inserta3 :: [a] -> [[a]] -> [[a]] inserta3 [] _ = [] inserta3 (x:xs) yss = [x:ys | ys <- yss] ++ inserta3 xs yss -- 4ª solución -- =========== producto4 :: [[a]] -> [[a]] producto4 = foldr inserta4 [[]] inserta4 :: [a] -> [[a]] -> [[a]] inserta4 [] _ = [] inserta4 (x:xs) yss = map (x:) yss ++ inserta4 xs yss -- 5ª solución -- =========== producto5 :: [[a]] -> [[a]] producto5 = foldr inserta5 [[]] inserta5 :: [a] -> [[a]] -> [[a]] inserta5 xs yss = [x:ys | x <- xs, ys <- yss] -- 6ª solución -- =========== producto6 :: [[a]] -> [[a]] producto6 = foldr inserta6 [[]] inserta6 :: [a] -> [[a]] -> [[a]] inserta6 xs yss = concatMap (\x -> map (x:) yss) xs -- 7ª solución -- =========== producto7 :: [[a]] -> [[a]] producto7 = foldr inserta7 [[]] inserta7 :: [a] -> [[a]] -> [[a]] inserta7 xs yss = xs >>= (\x -> map (x:) yss) -- 8ª solución -- =========== producto8 :: [[a]] -> [[a]] producto8 = foldr inserta8 [[]] inserta8 :: [a] -> [[a]] -> [[a]] inserta8 xs yss = (:) <$> xs <*> yss -- 9ª solución -- =========== producto9 :: [[a]] -> [[a]] producto9 = foldr inserta9 [[]] inserta9 :: [a] -> [[a]] -> [[a]] inserta9 = liftA2 (:) -- 10ª solución -- ============ producto10 :: [[a]] -> [[a]] producto10 = foldr (liftM2 (:)) [[]] -- 11ª solución -- ============ producto11 :: [[a]] -> [[a]] producto11 = sequence -- Comprobación de equivalencia -- ============================ -- La propiedad es prop_producto :: [[Int]] -> Bool prop_producto xss = all (== producto1 xss) [ producto2 xss , producto3 xss , producto4 xss , producto5 xss , producto6 xss , producto7 xss , producto8 xss , producto9 xss , producto10 xss , producto11 xss ] -- La comprobación es -- λ> quickCheckWith (stdArgs {maxSize = 9}) prop_producto -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> length (producto1 (replicate 7 [0..9])) -- 10000000 -- (10.51 secs, 10,169,418,496 bytes) -- λ> length (producto2 (replicate 7 [0..9])) -- 10000000 -- (2.14 secs, 1,333,870,712 bytes) -- λ> length (producto3 (replicate 7 [0..9])) -- 10000000 -- (3.33 secs, 1,956,102,056 bytes) -- λ> length (producto4 (replicate 7 [0..9])) -- 10000000 -- (0.98 secs, 1,600,542,752 bytes) -- λ> length (producto5 (replicate 7 [0..9])) -- 10000000 -- (2.10 secs, 1,333,870,288 bytes) -- λ> length (producto6 (replicate 7 [0..9])) -- 10000000 -- (1.17 secs, 1,600,534,632 bytes) -- λ> length (producto7 (replicate 7 [0..9])) -- 10000000 -- (0.35 secs, 1,600,534,352 bytes) -- λ> length (producto8 (replicate 7 [0..9])) -- 10000000 -- (0.87 secs, 978,317,848 bytes) -- λ> length (producto9 (replicate 7 [0..9])) -- 10000000 -- (1.38 secs, 1,067,201,016 bytes) -- λ> length (producto10 (replicate 7 [0..9])) -- 10000000 -- (0.54 secs, 2,311,645,392 bytes) -- λ> length (producto11 (replicate 7 [0..9])) -- 10000000 -- (1.32 secs, 1,067,200,992 bytes) -- -- λ> length (producto7 (replicate 7 [1..14])) -- 105413504 -- (3.77 secs, 16,347,739,040 bytes) -- λ> length (producto10 (replicate 7 [1..14])) -- 105413504 -- (5.11 secs, 23,613,162,016 bytes) -- Comprobación de la propiedad -- ============================ -- La propiedad es prop_longitud :: [[Int]] -> Bool prop_longitud xss = length (producto7 xss) == product (map length xss) -- La comprobación es -- λ> quickCheckWith (stdArgs {maxSize = 7}) prop_longitud -- +++ OK, passed 100 tests.

El código se encuentra en GitHub.

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

Leer más →

Separación por posición

José A. Alonso, 15-abril-2022, Ejercicio

Definir la función

   particion :: [a] -> ([a],[a])

tal que (particion xs) es el par cuya primera componente son los elementos de xs en posiciones pares y su segunda componente son los restantes elementos. Por ejemplo,

   particion [3,5,6,2]    ==  ([3,6],[5,2])
   particion [3,5,6,2,7]  ==  ([3,6,7],[5,2])
   particion "particion"  ==  ("priin","atco")

Soluciones

module Separacion_por_posicion where
 
import Data.List (partition)
import qualified Data.Vector as V ((!), fromList, length)
import Test.QuickCheck (quickCheck)
 
-- 1ª solución
-- ===========
 
particion1 :: [a] -> ([a],[a])
particion1 xs = ([x | (n,x) <- nxs, even n],
                 [x | (n,x) <- nxs, odd n])
  where nxs = enumeracion xs
 
--(numeracion xs) es la enumeración de xs. Por ejemplo,
--    enumeracion [7,9,6,8]  ==  [(0,7),(1,9),(2,6),(3,8)]
enumeracion :: [a] -> [(Int,a)]
enumeracion = zip [0..]
 
-- 2ª solución
-- ===========
 
particion2 :: [a] -> ([a],[a])
particion2 []     = ([],[])
particion2 (x:xs) = (x:zs,ys)
  where (ys,zs) = particion2 xs
 
-- 3ª solución
-- ===========
 
particion3 :: [a] -> ([a],[a])
particion3 = foldr f ([],[])
  where f x (ys,zs) = (x:zs,ys)
 
-- 4ª solución
-- ===========
 
particion4 :: [a] -> ([a],[a])
particion4 = foldr (\x (ys,zs) -> (x:zs,ys)) ([],[])
 
-- 5ª solución
-- ===========
 
particion5 :: [a] -> ([a],[a])
particion5 xs =
  ([xs!!k | k <- [0,2..n]],
   [xs!!k | k <- [1,3..n]])
  where n = length xs - 1
 
-- 6ª solución
-- ===========
 
particion6 :: [a] -> ([a],[a])
particion6 xs = (pares xs, impares xs)
 
-- (pares xs) es la lista de los elementos de xs en posiciones
-- pares. Por ejemplo,
--    pares [3,5,6,2]  ==  [3,6]
pares :: [a] -> [a]
pares []     = []
pares (x:xs) = x : impares xs
 
-- (impares xs) es la lista de los elementos de xs en posiciones
-- impares. Por ejemplo,
--    impares [3,5,6,2]  ==  [5,2]
impares :: [a] -> [a]
impares []     = []
impares (_:xs) = pares xs
 
-- 7ª solución
-- ===========
 
particion7 :: [a] -> ([a],[a])
particion7 [] = ([],[])
particion7 xs =
  ([v V.! k | k <- [0,2..n-1]],
   [v V.! k | k <- [1,3..n-1]])
  where v = V.fromList xs
        n = V.length v
 
-- 8ª solución
-- ===========
 
particion8 :: [a] -> ([a],[a])
particion8 xs =
  (map snd ys, map snd zs)
  where (ys,zs) = partition posicionPar (zip [0..] xs)
 
posicionPar :: (Int,a) -> Bool
posicionPar = even . fst
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_particion :: [Int] -> Bool
prop_particion xs =
  all (== particion1 xs)
      [particion2 xs,
       particion3 xs,
       particion4 xs,
       particion5 xs,
       particion6 xs,
       particion7 xs,
       particion8 xs]
 
-- La comprobación es
--    λ> quickCheck prop_particion
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> last (snd (particion1 [1..6*10^6]))
--    6000000
--    (2.74 secs, 2,184,516,080 bytes)
--    λ> last (snd (particion2 [1..6*10^6]))
--    6000000
--    (2.02 secs, 1,992,515,880 bytes)
--    λ> last (snd (particion3 [1..6*10^6]))
--    6000000
--    (3.17 secs, 1,767,423,240 bytes)
--    λ> last (snd (particion4 [1..6*10^6]))
--    6000000
--    (3.23 secs, 1,767,423,240 bytes)
--    λ> last (snd (particion5 [1..6*10^6]))
--    6000000
--    (1.62 secs, 1,032,516,192 bytes)
--    λ> last (snd (particion5 [1..6*10^6]))
--    6000000
--    (1.33 secs, 1,032,516,192 bytes)
--    λ> last (snd (particion6 [1..6*10^6]))
--    6000000
--    (1.80 secs, 888,515,960 bytes)
--    λ> last (snd (particion7 [1..6*10^6]))
--    6000000
--    (1.29 secs, 1,166,865,672 bytes)
--    λ> last (snd (particion8 [1..6*10^6]))
--    6000000
--    (0.87 secs, 3,384,516,616 bytes)
--
--    λ> last (snd (particion5 [1..10^7]))
--    10000000
--    (1.94 secs, 1,720,516,872 bytes)
--    λ> last (snd (particion7 [1..10^7]))
--    10000000
--    (2.54 secs, 1,989,215,176 bytes)
--    λ> last (snd (particion8 [1..10^7]))
--    10000000
--    (1.33 secs, 5,640,516,960 bytes)

module Separacion_por_posicion where import Data.List (partition) import qualified Data.Vector as V ((!), fromList, length) import Test.QuickCheck (quickCheck) -- 1ª solución -- =========== particion1 :: [a] -> ([a],[a]) particion1 xs = ([x | (n,x) <- nxs, even n], [x | (n,x) <- nxs, odd n]) where nxs = enumeracion xs --(numeracion xs) es la enumeración de xs. Por ejemplo, -- enumeracion [7,9,6,8] == [(0,7),(1,9),(2,6),(3,8)] enumeracion :: [a] -> [(Int,a)] enumeracion = zip [0..] -- 2ª solución -- =========== particion2 :: [a] -> ([a],[a]) particion2 [] = ([],[]) particion2 (x:xs) = (x:zs,ys) where (ys,zs) = particion2 xs -- 3ª solución -- =========== particion3 :: [a] -> ([a],[a]) particion3 = foldr f ([],[]) where f x (ys,zs) = (x:zs,ys) -- 4ª solución -- =========== particion4 :: [a] -> ([a],[a]) particion4 = foldr (\x (ys,zs) -> (x:zs,ys)) ([],[]) -- 5ª solución -- =========== particion5 :: [a] -> ([a],[a]) particion5 xs = ([xs!!k | k <- [0,2..n]], [xs!!k | k <- [1,3..n]]) where n = length xs - 1 -- 6ª solución -- =========== particion6 :: [a] -> ([a],[a]) particion6 xs = (pares xs, impares xs) -- (pares xs) es la lista de los elementos de xs en posiciones -- pares. Por ejemplo, -- pares [3,5,6,2] == [3,6] pares :: [a] -> [a] pares [] = [] pares (x:xs) = x : impares xs -- (impares xs) es la lista de los elementos de xs en posiciones -- impares. Por ejemplo, -- impares [3,5,6,2] == [5,2] impares :: [a] -> [a] impares [] = [] impares (_:xs) = pares xs -- 7ª solución -- =========== particion7 :: [a] -> ([a],[a]) particion7 [] = ([],[]) particion7 xs = ([v V.! k | k <- [0,2..n-1]], [v V.! k | k <- [1,3..n-1]]) where v = V.fromList xs n = V.length v -- 8ª solución -- =========== particion8 :: [a] -> ([a],[a]) particion8 xs = (map snd ys, map snd zs) where (ys,zs) = partition posicionPar (zip [0..] xs) posicionPar :: (Int,a) -> Bool posicionPar = even . fst -- Comprobación de equivalencia -- ============================ -- La propiedad es prop_particion :: [Int] -> Bool prop_particion xs = all (== particion1 xs) [particion2 xs, particion3 xs, particion4 xs, particion5 xs, particion6 xs, particion7 xs, particion8 xs] -- La comprobación es -- λ> quickCheck prop_particion -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> last (snd (particion1 [1..6*10^6])) -- 6000000 -- (2.74 secs, 2,184,516,080 bytes) -- λ> last (snd (particion2 [1..6*10^6])) -- 6000000 -- (2.02 secs, 1,992,515,880 bytes) -- λ> last (snd (particion3 [1..6*10^6])) -- 6000000 -- (3.17 secs, 1,767,423,240 bytes) -- λ> last (snd (particion4 [1..6*10^6])) -- 6000000 -- (3.23 secs, 1,767,423,240 bytes) -- λ> last (snd (particion5 [1..6*10^6])) -- 6000000 -- (1.62 secs, 1,032,516,192 bytes) -- λ> last (snd (particion5 [1..6*10^6])) -- 6000000 -- (1.33 secs, 1,032,516,192 bytes) -- λ> last (snd (particion6 [1..6*10^6])) -- 6000000 -- (1.80 secs, 888,515,960 bytes) -- λ> last (snd (particion7 [1..6*10^6])) -- 6000000 -- (1.29 secs, 1,166,865,672 bytes) -- λ> last (snd (particion8 [1..6*10^6])) -- 6000000 -- (0.87 secs, 3,384,516,616 bytes) -- -- λ> last (snd (particion5 [1..10^7])) -- 10000000 -- (1.94 secs, 1,720,516,872 bytes) -- λ> last (snd (particion7 [1..10^7])) -- 10000000 -- (2.54 secs, 1,989,215,176 bytes) -- λ> last (snd (particion8 [1..10^7])) -- 10000000 -- (1.33 secs, 5,640,516,960 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 →

Caminos reducidos

José A. Alonso, 5-junio-2020, Medio

Un camino es una sucesión de pasos en una de las cuatros direcciones Norte, Sur, Este, Oeste. Ir en una dirección y a continuación en la opuesta es un esfuerzo que se puede reducir, Por ejemplo, el camino [Norte,Sur,Este,Sur] se puede reducir a [Este,Sur].

Un camino se dice que es reducido si no tiene dos pasos consecutivos en direcciones opuesta. Por ejemplo, [Este,Sur] es reducido y [Norte,Sur,Este,Sur] no lo es.

En Haskell, las direcciones y los caminos se pueden definir por

   data Direccion = N | S | E | O deriving (Show, Eq)
   type Camino = [Direccion]

Definir la función

   reducido :: Camino -> Camino

tal que (reducido ds) es el camino reducido equivalente al camino ds. Por ejemplo,

   reducido []                              ==  []
   reducido [N]                             ==  [N]
   reducido [N,O]                           ==  [N,O]
   reducido [N,O,E]                         ==  [N]
   reducido [N,O,E,S]                       ==  [] 
   reducido [N,O,S,E]                       ==  [N,O,S,E]
   reducido [S,S,S,N,N,N]                   ==  []
   reducido [N,S,S,E,O,N]                   ==  []
   reducido [N,S,S,E,O,N,O]                 ==  [O]
   reducido (take (10^7) (cycle [N,E,O,S])) ==  []

Nótese que en el penúltimo ejemplo las reducciones son

       [N,S,S,E,O,N,O]  
   --> [S,E,O,N,O]  
   --> [S,N,O]  
   --> [O]

Soluciones

data Direccion = N | S | E | O deriving (Show, Eq)
 
type Camino = [Direccion]
 
-- 1ª solución (por recursión):
reducido1 :: Camino -> Camino
reducido1 [] = []
reducido1 (d:ds) | null ds'                = [d]
                 | d == opuesta (head ds') = tail ds'
                 | otherwise               = d:ds'
    where ds' = reducido1 ds
 
opuesta :: Direccion -> Direccion
opuesta N = S
opuesta S = N
opuesta E = O
opuesta O = E
 
-- 2ª solución (por plegado)
reducido2 :: Camino -> Camino
reducido2 = foldr aux []
    where aux N (S:xs) = xs
          aux S (N:xs) = xs
          aux E (O:xs) = xs
          aux O (E:xs) = xs
          aux x xs     = x:xs
 
-- 3ª solución 
reducido3 :: Camino -> Camino
reducido3 []       = []
reducido3 (N:S:ds) = reducido3 ds
reducido3 (S:N:ds) = reducido3 ds
reducido3 (E:O:ds) = reducido3 ds
reducido3 (O:E:ds) = reducido3 ds
reducido3 (d:ds) | null ds'                = [d]
                 | d == opuesta (head ds') = tail ds'
                 | otherwise               = d:ds'
    where ds' = reducido3 ds
 
-- 4ª solución
reducido4 :: Camino -> Camino
reducido4 ds = reverse (aux ([],ds)) where 
    aux (N:xs, S:ys) = aux (xs,ys)
    aux (S:xs, N:ys) = aux (xs,ys)
    aux (E:xs, O:ys) = aux (xs,ys)
    aux (O:xs, E:ys) = aux (xs,ys)
    aux (  xs, y:ys) = aux (y:xs,ys)
    aux (  xs,   []) = xs
 
-- Comparación de eficiencia
--    ghci> reducido1 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (3.87 secs, 460160736 bytes)
--    ghci> reducido2 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (1.16 secs, 216582880 bytes)
--    ghci> reducido3 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (0.58 secs, 98561872 bytes)
--    ghci> reducido4 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (0.64 secs, 176154640 bytes)
--    
--    ghci> reducido3 (take (10^7) (cycle [N,E,O,S]))
--    []
--    (5.43 secs, 962694784 bytes)
--    ghci> reducido4 (take (10^7) (cycle [N,E,O,S]))
--    []
--    (9.29 secs, 1722601528 bytes)
-- 
--    ghci> length $ reducido3 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])
--    400002
--    (4.52 secs, 547004960 bytes)
--    ghci> length $ reducido4 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])
--    400002
--    
--    ghci> let n=10^6 in reducido1 (replicate n N ++ replicate n S)
--    []
--    (7.35 secs, 537797096 bytes)
--    ghci> let n=10^6 in reducido2 (replicate n N ++ replicate n S)
--    []
--    (2.30 secs, 244553404 bytes)
--    ghci> let n=10^6 in reducido3 (replicate n N ++ replicate n S)
--    []
--    (8.08 secs, 545043608 bytes)
--    ghci> let n=10^6 in reducido4 (replicate n N ++ replicate n S)
--    []
--    (1.96 secs, 205552240 bytes)

data Direccion = N | S | E | O deriving (Show, Eq) type Camino = [Direccion] -- 1ª solución (por recursión): reducido1 :: Camino -> Camino reducido1 [] = [] reducido1 (d:ds) | null ds' = [d] | d == opuesta (head ds') = tail ds' | otherwise = d:ds' where ds' = reducido1 ds opuesta :: Direccion -> Direccion opuesta N = S opuesta S = N opuesta E = O opuesta O = E -- 2ª solución (por plegado) reducido2 :: Camino -> Camino reducido2 = foldr aux [] where aux N (S:xs) = xs aux S (N:xs) = xs aux E (O:xs) = xs aux O (E:xs) = xs aux x xs = x:xs -- 3ª solución reducido3 :: Camino -> Camino reducido3 [] = [] reducido3 (N:S:ds) = reducido3 ds reducido3 (S:N:ds) = reducido3 ds reducido3 (E:O:ds) = reducido3 ds reducido3 (O:E:ds) = reducido3 ds reducido3 (d:ds) | null ds' = [d] | d == opuesta (head ds') = tail ds' | otherwise = d:ds' where ds' = reducido3 ds -- 4ª solución reducido4 :: Camino -> Camino reducido4 ds = reverse (aux ([],ds)) where aux (N:xs, S:ys) = aux (xs,ys) aux (S:xs, N:ys) = aux (xs,ys) aux (E:xs, O:ys) = aux (xs,ys) aux (O:xs, E:ys) = aux (xs,ys) aux ( xs, y:ys) = aux (y:xs,ys) aux ( xs, []) = xs -- Comparación de eficiencia -- ghci> reducido1 (take (10^6) (cycle [N,E,O,S])) -- [] -- (3.87 secs, 460160736 bytes) -- ghci> reducido2 (take (10^6) (cycle [N,E,O,S])) -- [] -- (1.16 secs, 216582880 bytes) -- ghci> reducido3 (take (10^6) (cycle [N,E,O,S])) -- [] -- (0.58 secs, 98561872 bytes) -- ghci> reducido4 (take (10^6) (cycle [N,E,O,S])) -- [] -- (0.64 secs, 176154640 bytes) -- -- ghci> reducido3 (take (10^7) (cycle [N,E,O,S])) -- [] -- (5.43 secs, 962694784 bytes) -- ghci> reducido4 (take (10^7) (cycle [N,E,O,S])) -- [] -- (9.29 secs, 1722601528 bytes) -- -- ghci> length $ reducido3 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S]) -- 400002 -- (4.52 secs, 547004960 bytes) -- ghci> length $ reducido4 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S]) -- 400002 -- -- ghci> let n=10^6 in reducido1 (replicate n N ++ replicate n S) -- [] -- (7.35 secs, 537797096 bytes) -- ghci> let n=10^6 in reducido2 (replicate n N ++ replicate n S) -- [] -- (2.30 secs, 244553404 bytes) -- ghci> let n=10^6 in reducido3 (replicate n N ++ replicate n S) -- [] -- (8.08 secs, 545043608 bytes) -- ghci> let n=10^6 in reducido4 (replicate n N ++ replicate n S) -- [] -- (1.96 secs, 205552240 bytes)

Leer más →

Cálculo de pi mediante la fracción continua de Lange

José A. Alonso, 10-abril-2020, Medio

En 1999, L.J. Lange publicó el artículo An elegant new continued fraction for π.

En el primer teorema del artículo se demuestra la siguiente expresión de π mediante una fracción continua
$Calculo_de_pi_mediante_la_fraccion_continua_de_Lange$

La primeras aproximaciones son

   a(1) = 3+1                = 4.0
   a(2) = 3+(1/(6+9))        = 3.066666666666667
   a(3) = 3+(1/(6+9/(6+25))) = 3.158974358974359

Definir las funciones

   aproximacionPi :: Int -> Double
   grafica        :: [Int] -> IO ()

tales que

(aproximacionPi n) es la n-ésima aproximación de pi con la fracción continua de Lange. Por ejemplo,

     aproximacionPi 1     ==  4.0
     aproximacionPi 2     ==  3.066666666666667
     aproximacionPi 3     ==  3.158974358974359
     aproximacionPi 10    ==  3.141287132741557
     aproximacionPi 100   ==  3.141592398533554
     aproximacionPi 1000  ==  3.1415926533392926

(grafica xs) dibuja la gráfica de las k-ésimas aproximaciones de pi donde k toma los valores de la lista xs. Por ejemplo, (grafica [1..10]) dibuja
$Calculo_de_pi_mediante_la_fraccion_continua_de_Lange_2$
(grafica [10..100]) dibuja
$Calculo_de_pi_mediante_la_fraccion_continua_de_Lange_3$
y (grafica [100..200]) dibuja
$Calculo_de_pi_mediante_la_fraccion_continua_de_Lange_4$

Soluciones

import Graphics.Gnuplot.Simple
 
-- fraccionPi es la representación de la fracción continua de pi como un
-- par de listas infinitas.
fraccionPi :: [(Integer, Integer)]
fraccionPi = zip (3 : [6,6..]) (map (^2) [1,3..])
 
-- (aproximacionFC n fc) es la n-ésima aproximación de la fracción
-- continua fc (como un par de listas).  
aproximacionFC :: Int -> [(Integer, Integer)] -> Double
aproximacionFC n =
  foldr (\(a,b) z -> fromIntegral a + fromIntegral b / z) 1 . take n
 
aproximacionPi :: Int -> Double
aproximacionPi n =
  aproximacionFC n fraccionPi
 
grafica :: [Int] -> IO ()
grafica xs = 
  plotList [Key Nothing]
           [(k,aproximacionPi k) | k <- xs]

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 →

Máxima suma de los segmentos

José A. Alonso, 3-mayo-2019, Medio

Un segmento de una lista xs es una sublista de xs formada por elementos consecutivos en la lista. El problema de la máxima suma de segmentos consiste en dada una lista de números enteros calcular el máximo de las sumas de todos los segmentos de la lista. Por ejemplo, para la lista [-1,2,-3,5,-2,1,3,-2,-2,-3,6] la máxima suma de segmentos es 7 que es la suma del segmento [5,-2,1,3] y para la lista [-1,-2,-3] es 0 que es la suma de la lista vacía.

Definir la función

   mss :: [Integer] -> Integer

tal que (mss xs) es la máxima suma de los segmentos de xs. Por ejemplo,

   mss [-1,2,-3,5,-2,1,3,-2,-2,-3,6]  ==  7
   mss [-1,-2,-3]                     ==  0
   mss [1..500]                       ==  125250
   mss [1..1000]                      ==  500500
   mss [-500..3]                      ==  6
   mss [-1000..3]                     ==  6

Soluciones

import Data.List (inits,tails)
 
-- 1ª solución
mss :: [Integer] -> Integer
mss = maximum . map sum . segmentos
 
-- (segmentos xs) es la lista de los segmentos de xs. Por ejemplo,
--    ghci> segmentos "abc"
--    ["","a","ab","abc","","b","bc","","c",""]
segmentos :: [a] -> [[a]]
segmentos = concat . map inits . tails
 
-- 2ª definición:
mss2 :: [Integer] -> Integer
mss2 = maximum . map (maximum . scanl (+) 0) . tails
 
-- 3ª definición:
mss3 :: [Integer] -> Integer
mss3 = maximum . map sum . concatMap tails . inits 
 
-- 4ª definición
mss4 :: [Integer] -> Integer
mss4  = fst . foldr (\x (b,a) -> (max (a+x) b, max 0 (a+x))) (0,0) 
 
-- 5ª definición (con scanl):
mss5 :: [Integer] -> Integer
mss5 = maximum . scanl (\a x -> max 0 a + x) 0
 
-- Comparación de eficiencia
-- =========================
 
--    ghci> mss [1..500]
--    125250
--    (7.52 secs, 2022130824 bytes)
--    
--    ghci> mss2 [1..500]
--    125250
--    (0.01 secs, 10474956 bytes)
--    
--    ghci> mss3 [1..500]
--    125250
--    (0.98 secs, 841862016 bytes)
--    
--    ghci> mss4 [1..500]
--    125250
--    (0.01 secs, 552252 bytes)
--    
--    ghci> mss2 [1..1000]
--    500500
--    (0.06 secs, 54575712 bytes)
--    
--    ghci> mss3 [1..1000]
--    500500
--    (7.87 secs, 7061347900 bytes)
--
--    ghci> mss4 [1..1000]
--    500500
--    (0.01 secs, 549700 bytes)
--    
--    ghci> mss2 [1..2000]
--    2001000
--    (0.29 secs, 216424336 bytes)
--    
--    ghci> mss2 [1..5000]
--    12502500
--    (2.37 secs, 1356384840 bytes)
--    
--    ghci> mss4 [1..5000]
--    12502500
--    (0.02 secs, 1913548 bytes)
--
--    ghci> mss5 [1..5000]
--    12502500
--    (0.01 secs, 2886360 bytes)

Pensamiento

Nubes, sol, prado verde y caserío
en la loma, revueltos. Primavera
puso en el aire de este campo frío
la gracia de sus chopos de ribera.

Antonio Machado

Leer más →

Etiqueta: foldr

Producto cartesiano de una familia de conjuntos

Soluciones

Separación por posición

Soluciones

Nuevas soluciones

Caminos reducidos

Soluciones

Cálculo de pi mediante la fracción continua de Lange

Soluciones

Otras soluciones

Máxima suma de los segmentos

Soluciones

Pensamiento

Subscribe to Blog via Email

Entradas recientes

Etiquetas