return – Exercitium

Ordenada cíclicamente

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

Se dice que una sucesión x(1), …, x(n) está ordenada cíclicamente si existe un índice i tal que la sucesión

   x(i), x(i+1), ..., x(n), x(1), ..., x(i-1)

está ordenada crecientemente de forma estricta.

Definir la función

   ordenadaCiclicamente :: Ord a => [a] -> Maybe Int

tal que (ordenadaCiclicamente xs) es el índice a partir del cual está ordenada, si la lista está ordenado cíclicamente y Nothing en caso contrario. Por ejemplo,

   ordenadaCiclicamente [1,2,3,4]      ==  Just 0
   ordenadaCiclicamente [5,8,1,3]      ==  Just 2
   ordenadaCiclicamente [4,6,7,5,1,3]  ==  Nothing
   ordenadaCiclicamente [1,0,3,2]      ==  Nothing
   ordenadaCiclicamente [1,2,0]        ==  Just 2
   ordenadaCiclicamente "cdeab"        ==  Just 3

Nota: Se supone que el argumento es una lista no vacía sin elementos repetidos.

Soluciones

module Ordenada_ciclicamente where
 
import Test.QuickCheck (Arbitrary, Gen, NonEmptyList (NonEmpty), Property,
                        arbitrary, chooseInt, collect, quickCheck)
import Data.List       (nub, sort)
import Data.Maybe      (isJust, listToMaybe)
 
-- 1ª solución
-- ===========
 
ordenadaCiclicamente1 :: Ord a => [a] -> Maybe Int
ordenadaCiclicamente1 xs = aux 0 xs
  where n = length xs
        aux i zs
          | i == n      = Nothing
          | ordenada zs = Just i
          | otherwise   = aux (i+1) (siguienteCiclo zs)
 
-- (ordenada xs) se verifica si la lista xs está ordenada
-- crecientemente. Por ejemplo,
--   ordenada "acd"   ==  True
--   ordenada "acdb"  ==  False
ordenada :: Ord a => [a] -> Bool
ordenada []     = True
ordenada (x:xs) = all (x <) xs && ordenada xs
 
-- (siguienteCiclo xs) es la lista obtenida añadiendo el primer elemento
-- de xs al final del resto de xs. Por ejemplo,
--   siguienteCiclo [3,2,5]  =>  [2,5,3]
siguienteCiclo :: [a] -> [a]
siguienteCiclo []     = []
siguienteCiclo (x:xs) = xs ++ [x]
 
-- 2ª solución
-- ===========
 
ordenadaCiclicamente2 :: Ord a => [a] -> Maybe Int
ordenadaCiclicamente2 xs =
  listToMaybe [n | n <- [0..length xs-1],
                   ordenada (drop n xs ++ take n xs)]
 
-- 3ª solución
-- ===========
 
ordenadaCiclicamente3 :: Ord a => [a] -> Maybe Int
ordenadaCiclicamente3 xs
  | ordenada (bs ++ as) = Just k
  | otherwise           = Nothing
  where (_,k)   = minimum (zip xs [0..])
        (as,bs) = splitAt k xs
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_ordenadaCiclicamente1 :: NonEmptyList Int -> Bool
prop_ordenadaCiclicamente1 (NonEmpty xs) =
  ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs
 
-- La comprobación es
--    λ> quickCheck prop_ordenadaCiclicamente1
--    +++ OK, passed 100 tests.
 
-- La propiedad para analizar los casos de prueba
prop_ordenadaCiclicamente2 :: NonEmptyList Int -> Property
prop_ordenadaCiclicamente2 (NonEmpty xs) =
  collect (isJust (ordenadaCiclicamente1 xs)) $
  ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs
 
-- El análisis es
--    λ> quickCheck prop_ordenadaCiclicamente2
--    +++ OK, passed 100 tests:
--    89% False
--    11% True
 
-- Tipo para generar listas
newtype Lista = L [Int]
  deriving Show
 
-- Generador de listas.
listaArbitraria :: Gen Lista
listaArbitraria = do
  x <- arbitrary
  xs <- arbitrary
  let ys = x : xs
  k <- chooseInt (0, length ys)
  let (as,bs) = splitAt k (sort (nub ys))
  return (L (bs ++ as))
 
-- Lista es una subclase de Arbitrary.
instance Arbitrary Lista where
  arbitrary = listaArbitraria
 
-- La propiedad para analizar los casos de prueba
prop_ordenadaCiclicamente3 :: Lista -> Property
prop_ordenadaCiclicamente3 (L xs) =
  collect (isJust (ordenadaCiclicamente1 xs)) $
  ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs
 
-- El análisis es
--    λ> quickCheck prop_ordenadaCiclicamente3
--    +++ OK, passed 100 tests (100% True).
 
-- Tipo para generar
newtype Lista2 = L2 [Int]
  deriving Show
 
-- Generador de listas
listaArbitraria2 :: Gen Lista2
listaArbitraria2 = do
  x' <- arbitrary
  xs <- arbitrary
  let ys = x' : xs
  k <- chooseInt (0, length ys)
  let (as,bs) = splitAt k (sort (nub ys))
  n <- chooseInt (0,1)
  return (if even n
          then L2 (bs ++ as)
          else L2 ys)
 
-- Lista es una subclase de Arbitrary.
instance Arbitrary Lista2 where
  arbitrary = listaArbitraria2
 
-- La propiedad para analizar los casos de prueba
prop_ordenadaCiclicamente4 :: Lista2 -> Property
prop_ordenadaCiclicamente4 (L2 xs) =
  collect (isJust (ordenadaCiclicamente1 xs)) $
  ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs
 
-- El análisis es
--    λ> quickCheck prop_ordenadaCiclicamente4
--    +++ OK, passed 100 tests:
--    51% True
--    49% False
 
-- La propiedad es
prop_ordenadaCiclicamente :: Lista2 -> Bool
prop_ordenadaCiclicamente (L2 xs) =
  all (== ordenadaCiclicamente1 xs)
      [ordenadaCiclicamente2 xs,
       ordenadaCiclicamente3 xs]
 
-- La comprobación es
--    λ> quickCheck prop_ordenadaCiclicamente
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> ordenadaCiclicamente1 ([100..4000] ++ [1..99])
--    Just 3901
--    (3.27 secs, 2,138,864,568 bytes)
--    λ> ordenadaCiclicamente2 ([100..4000] ++ [1..99])
--    Just 3901
--    (2.44 secs, 1,430,040,008 bytes)
--    λ> ordenadaCiclicamente3 ([100..4000] ++ [1..99])
--    Just 3901
--    (1.18 secs, 515,549,200 bytes)

module Ordenada_ciclicamente where import Test.QuickCheck (Arbitrary, Gen, NonEmptyList (NonEmpty), Property, arbitrary, chooseInt, collect, quickCheck) import Data.List (nub, sort) import Data.Maybe (isJust, listToMaybe) -- 1ª solución -- =========== ordenadaCiclicamente1 :: Ord a => [a] -> Maybe Int ordenadaCiclicamente1 xs = aux 0 xs where n = length xs aux i zs | i == n = Nothing | ordenada zs = Just i | otherwise = aux (i+1) (siguienteCiclo zs) -- (ordenada xs) se verifica si la lista xs está ordenada -- crecientemente. Por ejemplo, -- ordenada "acd" == True -- ordenada "acdb" == False ordenada :: Ord a => [a] -> Bool ordenada [] = True ordenada (x:xs) = all (x <) xs && ordenada xs -- (siguienteCiclo xs) es la lista obtenida añadiendo el primer elemento -- de xs al final del resto de xs. Por ejemplo, -- siguienteCiclo [3,2,5] => [2,5,3] siguienteCiclo :: [a] -> [a] siguienteCiclo [] = [] siguienteCiclo (x:xs) = xs ++ [x] -- 2ª solución -- =========== ordenadaCiclicamente2 :: Ord a => [a] -> Maybe Int ordenadaCiclicamente2 xs = listToMaybe [n | n <- [0..length xs-1], ordenada (drop n xs ++ take n xs)] -- 3ª solución -- =========== ordenadaCiclicamente3 :: Ord a => [a] -> Maybe Int ordenadaCiclicamente3 xs | ordenada (bs ++ as) = Just k | otherwise = Nothing where (_,k) = minimum (zip xs [0..]) (as,bs) = splitAt k xs -- Comprobación de equivalencia -- ============================ -- La propiedad es prop_ordenadaCiclicamente1 :: NonEmptyList Int -> Bool prop_ordenadaCiclicamente1 (NonEmpty xs) = ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs -- La comprobación es -- λ> quickCheck prop_ordenadaCiclicamente1 -- +++ OK, passed 100 tests. -- La propiedad para analizar los casos de prueba prop_ordenadaCiclicamente2 :: NonEmptyList Int -> Property prop_ordenadaCiclicamente2 (NonEmpty xs) = collect (isJust (ordenadaCiclicamente1 xs)) $ ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs -- El análisis es -- λ> quickCheck prop_ordenadaCiclicamente2 -- +++ OK, passed 100 tests: -- 89% False -- 11% True -- Tipo para generar listas newtype Lista = L [Int] deriving Show -- Generador de listas. listaArbitraria :: Gen Lista listaArbitraria = do x <- arbitrary xs <- arbitrary let ys = x : xs k <- chooseInt (0, length ys) let (as,bs) = splitAt k (sort (nub ys)) return (L (bs ++ as)) -- Lista es una subclase de Arbitrary. instance Arbitrary Lista where arbitrary = listaArbitraria -- La propiedad para analizar los casos de prueba prop_ordenadaCiclicamente3 :: Lista -> Property prop_ordenadaCiclicamente3 (L xs) = collect (isJust (ordenadaCiclicamente1 xs)) $ ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs -- El análisis es -- λ> quickCheck prop_ordenadaCiclicamente3 -- +++ OK, passed 100 tests (100% True). -- Tipo para generar newtype Lista2 = L2 [Int] deriving Show -- Generador de listas listaArbitraria2 :: Gen Lista2 listaArbitraria2 = do x' <- arbitrary xs <- arbitrary let ys = x' : xs k <- chooseInt (0, length ys) let (as,bs) = splitAt k (sort (nub ys)) n <- chooseInt (0,1) return (if even n then L2 (bs ++ as) else L2 ys) -- Lista es una subclase de Arbitrary. instance Arbitrary Lista2 where arbitrary = listaArbitraria2 -- La propiedad para analizar los casos de prueba prop_ordenadaCiclicamente4 :: Lista2 -> Property prop_ordenadaCiclicamente4 (L2 xs) = collect (isJust (ordenadaCiclicamente1 xs)) $ ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs -- El análisis es -- λ> quickCheck prop_ordenadaCiclicamente4 -- +++ OK, passed 100 tests: -- 51% True -- 49% False -- La propiedad es prop_ordenadaCiclicamente :: Lista2 -> Bool prop_ordenadaCiclicamente (L2 xs) = all (== ordenadaCiclicamente1 xs) [ordenadaCiclicamente2 xs, ordenadaCiclicamente3 xs] -- La comprobación es -- λ> quickCheck prop_ordenadaCiclicamente -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> ordenadaCiclicamente1 ([100..4000] ++ [1..99]) -- Just 3901 -- (3.27 secs, 2,138,864,568 bytes) -- λ> ordenadaCiclicamente2 ([100..4000] ++ [1..99]) -- Just 3901 -- (2.44 secs, 1,430,040,008 bytes) -- λ> ordenadaCiclicamente3 ([100..4000] ++ [1..99]) -- Just 3901 -- (1.18 secs, 515,549,200 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 →

Emparejamiento de árboles

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

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

   data Arbol a = N a [Arbol a]
     deriving (Show, Eq)

Por ejemplo, los árboles

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

se representan por

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

Definir la función

   emparejaArboles :: (a -> b -> c) -> Arbol a -> Arbol b -> Arbol c

tal que (emparejaArboles f a1 a2) es el árbol obtenido aplicando la función f a los elementos de los árboles a1 y a2 que se encuentran en la misma posición. Por ejemplo,

   λ> emparejaArboles (+) (N 1 [N 2 [], N 3[]]) (N 1 [N 6 []])
   N 2 [N 8 []]
   λ> emparejaArboles (+) ej1 ej2
   N 4 [N 11 [],N 7 []]
   λ> emparejaArboles (+) ej1 ej1
   N 2 [N 12 [],N 6 [N 10 []]]

Soluciones

module Emparejamiento_de_arboles where
 
import Data.Tree (Tree (..))
import Control.Monad.Zip (mzipWith)
import Test.QuickCheck (Arbitrary, Gen, arbitrary, sublistOf, sized, quickCheck)
 
data Arbol a = N a [Arbol a]
  deriving (Show, Eq)
 
ej1, ej2 :: Arbol Int
ej1 = N 1 [N 6 [],N 3 [N 5 []]]
ej2 = N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]]
 
-- 1ª solución
-- ===========
 
emparejaArboles1 :: (a -> b -> c) -> Arbol a -> Arbol b -> Arbol c
emparejaArboles1 f (N x xs) (N y ys) =
  N (f x y) (zipWith (emparejaArboles1 f) xs ys)
 
-- 2ª solución
-- ===========
 
emparejaArboles2 :: (a -> b -> c) -> Arbol a -> Arbol b -> Arbol c
emparejaArboles2 f x y =
  treeAarbol (mzipWith f (arbolAtree x) (arbolAtree y))
 
arbolAtree :: Arbol a -> Tree a
arbolAtree (N x xs) = Node x (map arbolAtree xs)
 
treeAarbol :: Tree a -> Arbol a
treeAarbol (Node x xs) = N x (map treeAarbol xs)
 
-- Comprobación de equivalencia
-- ============================
 
-- (arbolArbitrario n) es un árbol aleatorio de orden n. Por ejemplo,
--    λ> generate (arbolArbitrario 5 :: Gen (Arbol Int))
--    N (-26) [N 8 [N 6 [N 11 []]],N 7 []]
--    λ> generate (arbolArbitrario 5 :: Gen (Arbol Int))
--    N 1 []
--    λ> generate (arbolArbitrario 5 :: Gen (Arbol Int))
--    N (-19) [N (-11) [],N 25 [],N 19 [N (-27) [],N (-19) [N 17 []]]]
arbolArbitrario :: Arbitrary a => Int -> Gen (Arbol a)
arbolArbitrario n = do
  x  <- arbitrary
  ms <- sublistOf [0 .. n `div` 2]
  as <- mapM arbolArbitrario ms
  return (N x as)
 
-- Arbol es una subclase de Arbitraria
instance Arbitrary a => Arbitrary (Arbol a) where
  arbitrary = sized arbolArbitrario
 
-- La propiedad es
prop_emparejaArboles :: Arbol Int -> Arbol Int -> Bool
prop_emparejaArboles x y =
  emparejaArboles1 (+) x y == emparejaArboles2 (+) x y &&
  emparejaArboles1 (*) x y == emparejaArboles2 (*) x y
 
-- La comprobación es
--    λ> quickCheck prop_emparejaArboles
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> a500 <- generate (arbolArbitrario 500 :: Gen (Arbol Int))
--    λ> emparejaArboles1 (+) a500 a500 == emparejaArboles1 (+) a500 a500
--    True
--    (1.92 secs, 1,115,813,352 bytes)
--    λ> emparejaArboles2 (+) a500 a500 == emparejaArboles2 (+) a500 a500
--    True
--    (3.28 secs, 2,212,257,928 bytes)
--
--    λ> b500 = arbolAtree a500
--    λ> mzipWith (+) b500 b500 == mzipWith (+) b500 b500
--    True
--    (0.21 secs, 563,503,112 bytes)

module Emparejamiento_de_arboles where import Data.Tree (Tree (..)) import Control.Monad.Zip (mzipWith) import Test.QuickCheck (Arbitrary, Gen, arbitrary, sublistOf, sized, quickCheck) data Arbol a = N a [Arbol a] deriving (Show, Eq) ej1, ej2 :: Arbol Int ej1 = N 1 [N 6 [],N 3 [N 5 []]] ej2 = N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]] -- 1ª solución -- =========== emparejaArboles1 :: (a -> b -> c) -> Arbol a -> Arbol b -> Arbol c emparejaArboles1 f (N x xs) (N y ys) = N (f x y) (zipWith (emparejaArboles1 f) xs ys) -- 2ª solución -- =========== emparejaArboles2 :: (a -> b -> c) -> Arbol a -> Arbol b -> Arbol c emparejaArboles2 f x y = treeAarbol (mzipWith f (arbolAtree x) (arbolAtree y)) arbolAtree :: Arbol a -> Tree a arbolAtree (N x xs) = Node x (map arbolAtree xs) treeAarbol :: Tree a -> Arbol a treeAarbol (Node x xs) = N x (map treeAarbol xs) -- Comprobación de equivalencia -- ============================ -- (arbolArbitrario n) es un árbol aleatorio de orden n. Por ejemplo, -- λ> generate (arbolArbitrario 5 :: Gen (Arbol Int)) -- N (-26) [N 8 [N 6 [N 11 []]],N 7 []] -- λ> generate (arbolArbitrario 5 :: Gen (Arbol Int)) -- N 1 [] -- λ> generate (arbolArbitrario 5 :: Gen (Arbol Int)) -- N (-19) [N (-11) [],N 25 [],N 19 [N (-27) [],N (-19) [N 17 []]]] arbolArbitrario :: Arbitrary a => Int -> Gen (Arbol a) arbolArbitrario n = do x <- arbitrary ms <- sublistOf [0 .. n `div` 2] as <- mapM arbolArbitrario ms return (N x as) -- Arbol es una subclase de Arbitraria instance Arbitrary a => Arbitrary (Arbol a) where arbitrary = sized arbolArbitrario -- La propiedad es prop_emparejaArboles :: Arbol Int -> Arbol Int -> Bool prop_emparejaArboles x y = emparejaArboles1 (+) x y == emparejaArboles2 (+) x y && emparejaArboles1 (*) x y == emparejaArboles2 (*) x y -- La comprobación es -- λ> quickCheck prop_emparejaArboles -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> a500 <- generate (arbolArbitrario 500 :: Gen (Arbol Int)) -- λ> emparejaArboles1 (+) a500 a500 == emparejaArboles1 (+) a500 a500 -- True -- (1.92 secs, 1,115,813,352 bytes) -- λ> emparejaArboles2 (+) a500 a500 == emparejaArboles2 (+) a500 a500 -- True -- (3.28 secs, 2,212,257,928 bytes) -- -- λ> b500 = arbolAtree a500 -- λ> mzipWith (+) b500 b500 == mzipWith (+) b500 b500 -- True -- (0.21 secs, 563,503,112 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 →

Índices de valores verdaderos

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

Definir la función

   indicesVerdaderos :: [Int] -> [Bool]

tal que (indicesVerdaderos xs) es la lista infinita de booleanos tal que sólo son verdaderos los elementos cuyos índices pertenecen a la lista estrictamente creciente xs. Por ejemplo,

   λ> take 6 (indicesVerdaderos [1,4])
   [False,True,False,False,True,False]
   λ> take 6 (indicesVerdaderos [0,2..])
   [True,False,True,False,True,False]
   λ> take 3 (indicesVerdaderos [])
   [False,False,False]
   λ> take 6 (indicesVerdaderos [1..])
   [False,True,True,True,True,True]
   λ> last (take (8*10^7) (indicesVerdaderos [0,5..]))
   False

Soluciones

[schedule expon=’2022-04-19′ expat=»06:00″]

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

[/schedule]

[schedule on=’2022-04-19′ at=»06:00″]

import Data.List.Ordered (member)
import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
indicesVerdaderos1 :: [Int] -> [Bool]
indicesVerdaderos1 []     = repeat False
indicesVerdaderos1 (x:ys) =
  replicate x False ++ [True] ++ indicesVerdaderos1 [y-x-1 | y <- ys]
 
-- 2ª solución
-- ===========
 
indicesVerdaderos2 :: [Int] -> [Bool]
indicesVerdaderos2 = aux 0
  where aux _ []     = repeat False
        aux n (x:xs) | x == n    = True  : aux (n+1) xs
                     | otherwise = False : aux (n+1) (x:xs)
 
-- 3ª solución
-- ===========
 
indicesVerdaderos3 :: [Int] -> [Bool]
indicesVerdaderos3 = aux [0..]
  where aux _      []                 = repeat False
        aux (i:is) (x:xs) | i == x    = True  : aux is xs
                          | otherwise = False : aux is (x:xs)
 
-- 4ª solución
-- ===========
 
indicesVerdaderos4 :: [Int] -> [Bool]
indicesVerdaderos4 xs = [pertenece x xs | x <- [0..]]
 
-- (pertenece x ys) se verifica si x pertenece a la lista estrictamente
-- creciente (posiblemente infinita) ys. Por ejemplo,
--    pertenece 9 [1,3..]  ==  True
--    pertenece 6 [1,3..]  ==  False
pertenece :: Int -> [Int] -> Bool
pertenece x ys = x `elem` takeWhile (<=x) ys
 
-- 5ª solución
-- ===========
 
indicesVerdaderos5 :: [Int] -> [Bool]
indicesVerdaderos5 xs = map (`pertenece2` xs) [0..]
 
pertenece2 :: Int -> [Int] -> Bool
pertenece2 x = aux
  where aux [] = False
        aux (y:ys) = case compare x y of
                       LT -> False
                       EQ -> True
                       GT -> aux ys
 
-- 6ª solución
-- ===========
 
indicesVerdaderos6 :: [Int] -> [Bool]
indicesVerdaderos6 xs = map (`member` xs) [0..]
 
-- Comprobación de equivalencia
-- ============================
 
-- ListaCreciente es un tipo de dato para generar lista de enteros
-- crecientes arbitrarias.
newtype ListaCreciente = LC [Int]
  deriving Show
 
-- listaCrecienteArbitraria es un generador de lista de enteros
-- crecientes arbitrarias. Por ejemplo,
--    λ> sample listaCrecienteArbitraria
--    LC []
--    LC [2,5]
--    LC [4,8]
--    LC [6,13]
--    LC [7,15,20,28,33]
--    LC [11,15,20,29,35,40]
--    LC [5,17,25,36,42,50,52,64]
--    LC [9,16,31,33,46,59,74,83,85,89,104,113,118]
--    LC [9,22,29,35,37,49,53,62,68,77,83,100]
--    LC []
--    LC [3,22,25,34,36,51,72,75,89]
listaCrecienteArbitraria :: Gen ListaCreciente
listaCrecienteArbitraria = do
  xs <- arbitrary
  return (LC (listaCreciente xs))
 
-- (listaCreciente xs) es la lista creciente correspondiente a xs. Por ejemplo,
--    listaCreciente [-1,3,-4,3,0]   ==  [2,6,11,15,16]
listaCreciente :: [Int] -> [Int]
listaCreciente xs =
  scanl1 (+) (map (succ . abs) xs)
 
-- ListaCreciente está contenida en Arbitrary
instance Arbitrary ListaCreciente where
  arbitrary = listaCrecienteArbitraria
 
-- La propiedad es
prop_indicesVerdaderos :: ListaCreciente -> Bool
prop_indicesVerdaderos (LC xs) =
  all (== take n (indicesVerdaderos1 xs))
      [take n (f xs) | f <-[indicesVerdaderos2,
                            indicesVerdaderos3,
                            indicesVerdaderos4,
                            indicesVerdaderos5,
                            indicesVerdaderos6]]
  where n = length xs
 
-- La comprobación es
--    λ> quickCheck prop_indicesVerdaderos
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> last (take (2*10^4) (indicesVerdaderos1 [0,5..]))
--    False
--    (2.69 secs, 2,611,031,544 bytes)
--    λ> last (take (2*10^4) (indicesVerdaderos2 [0,5..]))
--    False
--    (0.03 secs, 10,228,880 bytes)
--
--    λ> last (take (4*10^6) (indicesVerdaderos2 [0,5..]))
--    False
--    (2.37 secs, 1,946,100,856 bytes)
--    λ> last (take (4*10^6) (indicesVerdaderos3 [0,5..]))
--    False
--    (1.54 secs, 1,434,100,984 bytes)
--
--    λ> last (take (6*10^6) (indicesVerdaderos3 [0,5..]))
--    False
--    (2.30 secs, 2,150,900,984 bytes)
--    λ> last (take (6*10^6) (indicesVerdaderos4 [0,5..]))
--    False
--    (1.55 secs, 1,651,701,184 bytes)
--    λ> last (take (6*10^6) (indicesVerdaderos5 [0,5..]))
--    False
--    (0.58 secs, 1,584,514,304 bytes)
--
--    λ> last (take (3*10^7) (indicesVerdaderos5 [0,5..]))
--    False
--    (2.74 secs, 7,920,514,360 bytes)
--    λ> last (take (3*10^7) (indicesVerdaderos6 [0,5..]))
--    False
--    (0.82 secs, 6,960,514,136 bytes)
 
--    λ> last (take (2*10^4) (indicesVerdaderos1 [0,5..]))
--    False
--    (2.69 secs, 2,611,031,544 bytes)
--    λ> last (take (2*10^4) (indicesVerdaderos6 [0,5..]))
--    False
--    (0.01 secs, 5,154,040 bytes)

import Data.List.Ordered (member) import Test.QuickCheck -- 1ª solución -- =========== indicesVerdaderos1 :: [Int] -> [Bool] indicesVerdaderos1 [] = repeat False indicesVerdaderos1 (x:ys) = replicate x False ++ [True] ++ indicesVerdaderos1 [y-x-1 | y <- ys] -- 2ª solución -- =========== indicesVerdaderos2 :: [Int] -> [Bool] indicesVerdaderos2 = aux 0 where aux _ [] = repeat False aux n (x:xs) | x == n = True : aux (n+1) xs | otherwise = False : aux (n+1) (x:xs) -- 3ª solución -- =========== indicesVerdaderos3 :: [Int] -> [Bool] indicesVerdaderos3 = aux [0..] where aux _ [] = repeat False aux (i:is) (x:xs) | i == x = True : aux is xs | otherwise = False : aux is (x:xs) -- 4ª solución -- =========== indicesVerdaderos4 :: [Int] -> [Bool] indicesVerdaderos4 xs = [pertenece x xs | x <- [0..]] -- (pertenece x ys) se verifica si x pertenece a la lista estrictamente -- creciente (posiblemente infinita) ys. Por ejemplo, -- pertenece 9 [1,3..] == True -- pertenece 6 [1,3..] == False pertenece :: Int -> [Int] -> Bool pertenece x ys = x `elem` takeWhile (<=x) ys -- 5ª solución -- =========== indicesVerdaderos5 :: [Int] -> [Bool] indicesVerdaderos5 xs = map (`pertenece2` xs) [0..] pertenece2 :: Int -> [Int] -> Bool pertenece2 x = aux where aux [] = False aux (y:ys) = case compare x y of LT -> False EQ -> True GT -> aux ys -- 6ª solución -- =========== indicesVerdaderos6 :: [Int] -> [Bool] indicesVerdaderos6 xs = map (`member` xs) [0..] -- Comprobación de equivalencia -- ============================ -- ListaCreciente es un tipo de dato para generar lista de enteros -- crecientes arbitrarias. newtype ListaCreciente = LC [Int] deriving Show -- listaCrecienteArbitraria es un generador de lista de enteros -- crecientes arbitrarias. Por ejemplo, -- λ> sample listaCrecienteArbitraria -- LC [] -- LC [2,5] -- LC [4,8] -- LC [6,13] -- LC [7,15,20,28,33] -- LC [11,15,20,29,35,40] -- LC [5,17,25,36,42,50,52,64] -- LC [9,16,31,33,46,59,74,83,85,89,104,113,118] -- LC [9,22,29,35,37,49,53,62,68,77,83,100] -- LC [] -- LC [3,22,25,34,36,51,72,75,89] listaCrecienteArbitraria :: Gen ListaCreciente listaCrecienteArbitraria = do xs <- arbitrary return (LC (listaCreciente xs)) -- (listaCreciente xs) es la lista creciente correspondiente a xs. Por ejemplo, -- listaCreciente [-1,3,-4,3,0] == [2,6,11,15,16] listaCreciente :: [Int] -> [Int] listaCreciente xs = scanl1 (+) (map (succ . abs) xs) -- ListaCreciente está contenida en Arbitrary instance Arbitrary ListaCreciente where arbitrary = listaCrecienteArbitraria -- La propiedad es prop_indicesVerdaderos :: ListaCreciente -> Bool prop_indicesVerdaderos (LC xs) = all (== take n (indicesVerdaderos1 xs)) [take n (f xs) | f <-[indicesVerdaderos2, indicesVerdaderos3, indicesVerdaderos4, indicesVerdaderos5, indicesVerdaderos6]] where n = length xs -- La comprobación es -- λ> quickCheck prop_indicesVerdaderos -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> last (take (2*10^4) (indicesVerdaderos1 [0,5..])) -- False -- (2.69 secs, 2,611,031,544 bytes) -- λ> last (take (2*10^4) (indicesVerdaderos2 [0,5..])) -- False -- (0.03 secs, 10,228,880 bytes) -- -- λ> last (take (4*10^6) (indicesVerdaderos2 [0,5..])) -- False -- (2.37 secs, 1,946,100,856 bytes) -- λ> last (take (4*10^6) (indicesVerdaderos3 [0,5..])) -- False -- (1.54 secs, 1,434,100,984 bytes) -- -- λ> last (take (6*10^6) (indicesVerdaderos3 [0,5..])) -- False -- (2.30 secs, 2,150,900,984 bytes) -- λ> last (take (6*10^6) (indicesVerdaderos4 [0,5..])) -- False -- (1.55 secs, 1,651,701,184 bytes) -- λ> last (take (6*10^6) (indicesVerdaderos5 [0,5..])) -- False -- (0.58 secs, 1,584,514,304 bytes) -- -- λ> last (take (3*10^7) (indicesVerdaderos5 [0,5..])) -- False -- (2.74 secs, 7,920,514,360 bytes) -- λ> last (take (3*10^7) (indicesVerdaderos6 [0,5..])) -- False -- (0.82 secs, 6,960,514,136 bytes) -- λ> last (take (2*10^4) (indicesVerdaderos1 [0,5..])) -- False -- (2.69 secs, 2,611,031,544 bytes) -- λ> last (take (2*10^4) (indicesVerdaderos6 [0,5..])) -- False -- (0.01 secs, 5,154,040 bytes)

El código se encuentra en [GitHub](https://github.com/jaalonso/Exercitium/blob/main/src/Indices_verdaderos.hs).

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>

[/schedule]

Leer más →

Elementos de una matriz con algún vecino menor

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

Las matrices pueden representarse mediante tablas cuyos índices son pares de números naturales. Su tipo se define por

   type Matriz = Array (Int,Int) Int

Por ejemplo, la matriz

   |9 4 6 5|
   |8 1 7 3|
   |4 2 5 4|

se define por

   ej :: Matriz
   ej = listArray ((1,1),(3,4)) [9,4,6,5,8,1,7,3,4,2,5,4]

Los vecinos de un elemento son los que están a un paso en la misma fila, columna o diagonal. Por ejemplo, en la matriz anterior, el 1 tiene 8 vecinos (el 9, 4, 6, 8, 7, 4, 2 y 5) pero el 9 sólo tiene 3 vecinos (el 4, 8 y 1).

Definir la función

   algunoMenor :: Matriz -> [Int]

tal que (algunoMenor p) es la lista de los elementos de p que tienen algún vecino menor que él. Por ejemplo,

   algunoMenor ej == [9,4,6,5,8,7,4,2,5,4]

pues sólo el 1 y el 3 no tienen ningún vecino menor en la matriz.

Soluciones

import Data.Array (Array, (!), bounds, indices, inRange, listArray)
import Test.QuickCheck (Arbitrary, Gen, arbitrary, chooseInt, quickCheck,
                        vectorOf)
 
type Matriz = Array (Int,Int) Int
 
ej :: Matriz
ej = listArray ((1,1),(3,4)) [9,4,6,5,8,1,7,3,4,2,5,4]
 
type Pos = (Int,Int)
 
-- 1ª solución
-- ===========
 
algunoMenor1 :: Matriz -> [Int]
algunoMenor1 a =
  [a!p| p <- indices a,
        any (< a!p) (vecinos1 a p)]
 
-- (vecinos q p) es la lista de los vecinos en la matriz a de la
-- posición p. Por ejemplo,
--    vecinos1 ej (2,2)  ==  [9,4,6,8,7,4,2,5]
--    vecinos1 ej (1,1)  ==  [4,8,1]
vecinos1 :: Matriz -> Pos -> [Int]
vecinos1 a p =
  [a!p' | p' <- posicionesVecinos1 a p]
 
-- (posicionesVecinos a p) es la lista de las posiciones de los
-- vecino de p en la matriz a. Por ejemplo,
--    λ> posicionesVecinos1 3 3 (2,2)
--    [(1,1),(1,2),(1,3),(2,1),(2,3),(3,1),(3,2),(3,3)]
--    λ> posicionesVecinos1 3 3 (1,1)
--    [(1,2),(2,1),(2,2)]
posicionesVecinos1 :: Matriz -> Pos -> [Pos]
posicionesVecinos1 a (i,j) =
  [(i+di,j+dj) | (di,dj) <- [(-1,-1),(-1,0),(-1,1),
                             ( 0,-1),       ( 0,1),
                             ( 1,-1),( 1,0),( 1,1)],
                 inRange (bounds a) (i+di,j+dj)]
 
-- 2ª solución
-- ===========
 
algunoMenor2 :: Matriz -> [Int]
algunoMenor2 a =
  [a!p | p <- indices a,
         any (<a!p) (vecinos2 p)]
  where
    vecinos2 p =
      [a!p' | p' <- posicionesVecinos2 p]
    posicionesVecinos2 (i,j) =
      [(i+di,j+dj) | (di,dj) <- [(-1,-1),(-1,0),(-1,1),
                                 ( 0,-1),       ( 0,1),
                                 ( 1,-1),( 1,0),( 1,1)],
                     inRange (bounds a) (i+di,j+dj)]
 
-- 3ª solución
-- ===========
 
algunoMenor3 :: Matriz -> [Int]
algunoMenor3 a =
  [a!p | p <- indices a,
         any (<a!p) (vecinos3 p)]
  where
    vecinos3 p =
      [a!p' | p' <- posicionesVecinos3 p]
    posicionesVecinos3 (i,j) =
      [(i',j') | i' <- [i-1..i+1],
                 j' <- [j-1..j+1],
                 (i',j') /= (i,j),
                 inRange (bounds a) (i',j')]
 
-- 4ª solución
-- ===========
 
algunoMenor4 :: Matriz -> [Int]
algunoMenor4 a =
  [a!p | p <- indices a,
         any (<a!p) (vecinos4 p)]
  where
    vecinos4 p =
      [a!p' | p' <- posicionesVecinos4 p]
    posicionesVecinos4 (i,j) =
      [(i',j') | i' <- [max 1 (i-1)..min m (i+1)],
                 j' <- [max 1 (j-1)..min n (j+1)],
                 (i',j') /= (i,j)]
      where (_,(m,n)) = bounds a
 
 
-- 5ª solución
-- ===========
 
algunoMenor5 :: Matriz -> [Int]
algunoMenor5 a =
  [a!p | p <- indices a,
         any (<a!p) (vecinos5 p)]
  where
    vecinos5 p =
      [a!p' | p' <- posicionesVecinos5 p]
    posicionesVecinos5 (i,j) =
      [(i-1,j-1) | i > 1, j > 1] ++
      [(i-1,j)   | i > 1]        ++
      [(i-1,j+1) | i > 1, j < n] ++
      [(i,j-1)   | j > 1]        ++
      [(i,j+1)   | j < n]        ++
      [(i+1,j-1) | i < m, j > 1] ++
      [(i+1,j)   | i < m]        ++
      [(i+1,j+1) | i < m, j < n]
      where (_,(m,n)) = bounds a
 
-- ---------------------------------------------------------------------
 
-- Comprobación de equivalencia
-- ============================
 
newtype Matriz2 = M Matriz
  deriving Show
 
-- Generador de matrices arbitrarias. Por ejemplo,
--    λ> generate matrizArbitraria
--    M (array ((1,1),(3,4))
--             [((1,1),18),((1,2),6), ((1,3),-23),((1,4),-13),
--              ((2,1),-2),((2,2),22),((2,3),-25),((2,4),-5),
--              ((3,1),2), ((3,2),16),((3,3),-15),((3,4),7)])
matrizArbitraria :: Gen Matriz2
matrizArbitraria = do
  m  <- chooseInt (1,10)
  n  <- chooseInt (1,10)
  xs <- vectorOf (m*n) arbitrary
  return (M (listArray ((1,1),(m,n)) xs))
 
-- Matriz es una subclase de Arbitrary.
instance Arbitrary Matriz2 where
  arbitrary = matrizArbitraria
 
-- La propiedad es
prop_algunoMenor :: Matriz2 -> Bool
prop_algunoMenor (M p) =
  all (== algunoMenor1 p)
      [algunoMenor2 p,
       algunoMenor3 p,
       algunoMenor4 p,
       algunoMenor5 p]
 
-- La comprobación es
--    λ> quickCheck prop_algunoMenor
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> maximum (algunoMenor1 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (2.20 secs, 1,350,075,240 bytes)
--    λ> maximum (algunoMenor2 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (2.24 secs, 1,373,139,968 bytes)
--    λ> maximum (algunoMenor3 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (2.08 secs, 1,200,734,112 bytes)
--    λ> maximum (algunoMenor4 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (2.76 secs, 1,287,653,136 bytes)
--    λ> maximum (algunoMenor5 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (1.67 secs, 953,937,600 bytes)

import Data.Array (Array, (!), bounds, indices, inRange, listArray) import Test.QuickCheck (Arbitrary, Gen, arbitrary, chooseInt, quickCheck, vectorOf) type Matriz = Array (Int,Int) Int ej :: Matriz ej = listArray ((1,1),(3,4)) [9,4,6,5,8,1,7,3,4,2,5,4] type Pos = (Int,Int) -- 1ª solución -- =========== algunoMenor1 :: Matriz -> [Int] algunoMenor1 a = [a!p| p <- indices a, any (< a!p) (vecinos1 a p)] -- (vecinos q p) es la lista de los vecinos en la matriz a de la -- posición p. Por ejemplo, -- vecinos1 ej (2,2) == [9,4,6,8,7,4,2,5] -- vecinos1 ej (1,1) == [4,8,1] vecinos1 :: Matriz -> Pos -> [Int] vecinos1 a p = [a!p' | p' <- posicionesVecinos1 a p] -- (posicionesVecinos a p) es la lista de las posiciones de los -- vecino de p en la matriz a. Por ejemplo, -- λ> posicionesVecinos1 3 3 (2,2) -- [(1,1),(1,2),(1,3),(2,1),(2,3),(3,1),(3,2),(3,3)] -- λ> posicionesVecinos1 3 3 (1,1) -- [(1,2),(2,1),(2,2)] posicionesVecinos1 :: Matriz -> Pos -> [Pos] posicionesVecinos1 a (i,j) = [(i+di,j+dj) | (di,dj) <- [(-1,-1),(-1,0),(-1,1), ( 0,-1), ( 0,1), ( 1,-1),( 1,0),( 1,1)], inRange (bounds a) (i+di,j+dj)] -- 2ª solución -- =========== algunoMenor2 :: Matriz -> [Int] algunoMenor2 a = [a!p | p <- indices a, any (<a!p) (vecinos2 p)] where vecinos2 p = [a!p' | p' <- posicionesVecinos2 p] posicionesVecinos2 (i,j) = [(i+di,j+dj) | (di,dj) <- [(-1,-1),(-1,0),(-1,1), ( 0,-1), ( 0,1), ( 1,-1),( 1,0),( 1,1)], inRange (bounds a) (i+di,j+dj)] -- 3ª solución -- =========== algunoMenor3 :: Matriz -> [Int] algunoMenor3 a = [a!p | p <- indices a, any (<a!p) (vecinos3 p)] where vecinos3 p = [a!p' | p' <- posicionesVecinos3 p] posicionesVecinos3 (i,j) = [(i',j') | i' <- [i-1..i+1], j' <- [j-1..j+1], (i',j') /= (i,j), inRange (bounds a) (i',j')] -- 4ª solución -- =========== algunoMenor4 :: Matriz -> [Int] algunoMenor4 a = [a!p | p <- indices a, any (<a!p) (vecinos4 p)] where vecinos4 p = [a!p' | p' <- posicionesVecinos4 p] posicionesVecinos4 (i,j) = [(i',j') | i' <- [max 1 (i-1)..min m (i+1)], j' <- [max 1 (j-1)..min n (j+1)], (i',j') /= (i,j)] where (_,(m,n)) = bounds a -- 5ª solución -- =========== algunoMenor5 :: Matriz -> [Int] algunoMenor5 a = [a!p | p <- indices a, any (<a!p) (vecinos5 p)] where vecinos5 p = [a!p' | p' <- posicionesVecinos5 p] posicionesVecinos5 (i,j) = [(i-1,j-1) | i > 1, j > 1] ++ [(i-1,j) | i > 1] ++ [(i-1,j+1) | i > 1, j < n] ++ [(i,j-1) | j > 1] ++ [(i,j+1) | j < n] ++ [(i+1,j-1) | i < m, j > 1] ++ [(i+1,j) | i < m] ++ [(i+1,j+1) | i < m, j < n] where (_,(m,n)) = bounds a -- --------------------------------------------------------------------- -- Comprobación de equivalencia -- ============================ newtype Matriz2 = M Matriz deriving Show -- Generador de matrices arbitrarias. Por ejemplo, -- λ> generate matrizArbitraria -- M (array ((1,1),(3,4)) -- [((1,1),18),((1,2),6), ((1,3),-23),((1,4),-13), -- ((2,1),-2),((2,2),22),((2,3),-25),((2,4),-5), -- ((3,1),2), ((3,2),16),((3,3),-15),((3,4),7)]) matrizArbitraria :: Gen Matriz2 matrizArbitraria = do m <- chooseInt (1,10) n <- chooseInt (1,10) xs <- vectorOf (m*n) arbitrary return (M (listArray ((1,1),(m,n)) xs)) -- Matriz es una subclase de Arbitrary. instance Arbitrary Matriz2 where arbitrary = matrizArbitraria -- La propiedad es prop_algunoMenor :: Matriz2 -> Bool prop_algunoMenor (M p) = all (== algunoMenor1 p) [algunoMenor2 p, algunoMenor3 p, algunoMenor4 p, algunoMenor5 p] -- La comprobación es -- λ> quickCheck prop_algunoMenor -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> maximum (algunoMenor1 (listArray ((1,1),(600,800)) [0..])) -- 479999 -- (2.20 secs, 1,350,075,240 bytes) -- λ> maximum (algunoMenor2 (listArray ((1,1),(600,800)) [0..])) -- 479999 -- (2.24 secs, 1,373,139,968 bytes) -- λ> maximum (algunoMenor3 (listArray ((1,1),(600,800)) [0..])) -- 479999 -- (2.08 secs, 1,200,734,112 bytes) -- λ> maximum (algunoMenor4 (listArray ((1,1),(600,800)) [0..])) -- 479999 -- (2.76 secs, 1,287,653,136 bytes) -- λ> maximum (algunoMenor5 (listArray ((1,1),(600,800)) [0..])) -- 479999 -- (1.67 secs, 953,937,600 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 →

Enumeración de árboles binarios

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

Los árboles binarios se pueden representar mediante el tipo Arbol definido por

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

Por ejemplo, el árbol

        "B"
        / \
       /   \
      /     \
    "B"     "A"
    / \     / \
  "A" "B" "C" "C"

se puede definir por

   ej1 :: Arbol String
   ej1 = N (N (H "A") "B" (H "B")) "B" (N (H "C") "A" (H "C"))

Definir la función

   enumeraArbol :: Arbol t -> Arbol Int

tal que (enumeraArbol a) es el árbol obtenido numerando las hojas y los nodos de a desde la hoja izquierda hasta la raíz. Por ejemplo,

   λ> enumeraArbol ej1
   N (N (H 0) 1 (H 2)) 3 (N (H 4) 5 (H 6))

Gráficamente,

         3
        / \
       /   \
      /     \
     1       5
    / \     / \
   0   2   4   6

Soluciones

import Test.QuickCheck (Arbitrary, Gen, arbitrary, quickCheck, sized)
import Control.Monad.State (State, evalState, get, put)
 
data Arbol a = H a
             | N (Arbol a) a (Arbol a)
  deriving (Show, Eq)
 
ej1 :: Arbol String
ej1 = N (N (H "A") "B" (H "B")) "B" (N (H "C") "A" (H "C"))
 
-- 1ª solución
-- ===========
 
enumeraArbol1 :: Arbol t -> Arbol Int
enumeraArbol1 a = fst (aux a 0)
  where aux :: Arbol t -> Int -> (Arbol Int, Int)
        aux (H _) n     = (H n, n+1)
        aux (N i _ d) n = (N i' n1 d', n2)
          where (i', n1) = aux i n
                (d', n2) = aux d (n1+1)
 
-- 2ª solución
-- ===========
 
enumeraArbol2 :: Arbol t -> Arbol Int
enumeraArbol2 a = evalState (aux a) 0
  where aux :: Arbol t -> State Int (Arbol Int)
        aux (H _)     = H <$> contador
        aux (N i _ d) = do
          i' <- aux i
          n1 <- contador
          d' <- aux d
          return (N i' n1 d')
 
contador :: State Int Int
contador = do
  n <- get
  put (n+1)
  return n
 
-- 3ª solución
-- ===========
 
enumeraArbol3 :: Arbol t -> Arbol Int
enumeraArbol3 a = evalState (aux a) 0
  where aux :: Arbol t -> State Int (Arbol Int)
        aux (H _)     = H <$> contador
        aux (N i _ d) = N <$> aux i <*> contador <*> aux d
 
-- Comprobación de equivalencia
-- ============================
 
-- (arbolArbitrario n) genera un árbol aleatorio de orden n. Por
-- ejemplo,
--    λ> generate (arbolArbitrario 3 :: Gen (Arbol Int))
--    N (N (H 19) 0 (H (-27))) 21 (N (H 2) 17 (H 26))
arbolArbitrario :: Arbitrary a => Int -> Gen (Arbol a)
arbolArbitrario n
  | n <= 0    = H <$> arbitrary
  | otherwise = N <$> subarbol <*> arbitrary <*> subarbol
  where subarbol = arbolArbitrario (n `div` 2)
 
-- Arbol es una subclase de Arbitrary.
instance Arbitrary a => Arbitrary (Arbol a) where
  arbitrary = sized arbolArbitrario
 
-- La propiedad es
prop_enumeraArbol :: Arbol Int -> Bool
prop_enumeraArbol a =
  all (== enumeraArbol1 a)
      [enumeraArbol2 a,
       enumeraArbol3 a]
 
-- La comprobación es
--    λ> quickCheck prop_enumeraArbol
--    +++ OK, passed 100 tests.

import Test.QuickCheck (Arbitrary, Gen, arbitrary, quickCheck, sized) import Control.Monad.State (State, evalState, get, put) data Arbol a = H a | N (Arbol a) a (Arbol a) deriving (Show, Eq) ej1 :: Arbol String ej1 = N (N (H "A") "B" (H "B")) "B" (N (H "C") "A" (H "C")) -- 1ª solución -- =========== enumeraArbol1 :: Arbol t -> Arbol Int enumeraArbol1 a = fst (aux a 0) where aux :: Arbol t -> Int -> (Arbol Int, Int) aux (H _) n = (H n, n+1) aux (N i _ d) n = (N i' n1 d', n2) where (i', n1) = aux i n (d', n2) = aux d (n1+1) -- 2ª solución -- =========== enumeraArbol2 :: Arbol t -> Arbol Int enumeraArbol2 a = evalState (aux a) 0 where aux :: Arbol t -> State Int (Arbol Int) aux (H _) = H <$> contador aux (N i _ d) = do i' <- aux i n1 <- contador d' <- aux d return (N i' n1 d') contador :: State Int Int contador = do n <- get put (n+1) return n -- 3ª solución -- =========== enumeraArbol3 :: Arbol t -> Arbol Int enumeraArbol3 a = evalState (aux a) 0 where aux :: Arbol t -> State Int (Arbol Int) aux (H _) = H <$> contador aux (N i _ d) = N <$> aux i <*> contador <*> aux d -- Comprobación de equivalencia -- ============================ -- (arbolArbitrario n) genera un árbol aleatorio de orden n. Por -- ejemplo, -- λ> generate (arbolArbitrario 3 :: Gen (Arbol Int)) -- N (N (H 19) 0 (H (-27))) 21 (N (H 2) 17 (H 26)) arbolArbitrario :: Arbitrary a => Int -> Gen (Arbol a) arbolArbitrario n | n <= 0 = H <$> arbitrary | otherwise = N <$> subarbol <*> arbitrary <*> subarbol where subarbol = arbolArbitrario (n `div` 2) -- Arbol es una subclase de Arbitrary. instance Arbitrary a => Arbitrary (Arbol a) where arbitrary = sized arbolArbitrario -- La propiedad es prop_enumeraArbol :: Arbol Int -> Bool prop_enumeraArbol a = all (== enumeraArbol1 a) [enumeraArbol2 a, enumeraArbol3 a] -- La comprobación es -- λ> quickCheck prop_enumeraArbol -- +++ OK, passed 100 tests.

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>

[/schedule]

Leer más →

Etiqueta: return

Ordenada cíclicamente

Soluciones

Nuevas soluciones

Emparejamiento de árboles

Soluciones

Nuevas soluciones

Índices de valores verdaderos

Soluciones

Nuevas soluciones

Elementos de una matriz con algún vecino menor

Soluciones

Nuevas soluciones

Enumeración de árboles binarios

Soluciones

Nuevas soluciones

Subscribe to Blog via Email

Entradas recientes

Etiquetas