Menu Close

Etiqueta: sized

Puntos en regiones rectangulares

José A. Alonso, ,

Los puntos se puede representar mediante pares de números

   type Punto = (Int,Int)

y las regiones rectangulares mediante el siguiente tipo de dato

   data Region = Rectangulo Punto  Punto
               | Union      Region Region
               | Diferencia Region Region
     deriving (Eq, Show)

donde

  • (Rectangulo p1 p2) es la región formada por un rectángulo cuyo vértice superior izquierdo es p1 y su vértice inferior derecho es p2.
  • (Union r1 r2) es la región cuyos puntos pertenecen a alguna de las regiones r1 y r2.
  • (Diferencia r1 r2) es la región cuyos puntos pertenecen a la región r1 pero no pertenecen a la r2.

Definir la función

   enRegion :: Punto -> Region -> Bool

tal que (enRegion p r) se verifica si el punto p pertenece a la región r. Por ejemplo, usando las regiones definidas por

   r0021, r3051, r4162 :: Region
   r0021 = Rectangulo (0,0) (2,1)
   r3051 = Rectangulo (3,0) (5,1)
   r4162 = Rectangulo (4,1) (6,2)

se tiene

   enRegion (1,0) r0021                                   ==  True
   enRegion (3,0) r0021                                   ==  False
   enRegion (1,1) (Union r0021 r3051)                     ==  True
   enRegion (4,0) (Union r0021 r3051)                     ==  True
   enRegion (4,2) (Union r0021 r3051)                     ==  False
   enRegion (3,1) (Diferencia r3051 r4162)                ==  True
   enRegion (4,1) (Diferencia r3051 r4162)                ==  False
   enRegion (4,2) (Diferencia r3051 r4162)                ==  False
   enRegion (4,2) (Union (Diferencia r3051 r4162) r4162)  ==  True

Comprobar con QuickCheck que si el punto p está en la región r1, entonces, para cualquier región r2, p está en (Union  r1 r2) y en (Union  r2 r1), pero no está en (Diferencia r2 r1).

Soluciones

module Puntos_en_regiones_rectangulares where
 
import Test.QuickCheck (Arbitrary, Gen, Property, (==>), arbitrary, oneof,
                        sized, generate, quickCheck, quickCheckWith, stdArgs,
                        Args(maxDiscardRatio))
 
type Punto = (Int,Int)
 
data Region = Rectangulo Punto  Punto
            | Union      Region Region
            | Diferencia Region Region
  deriving (Eq, Show)
 
r0021, r3051, r4162 :: Region
r0021 = Rectangulo (0,0) (2,1)
r3051 = Rectangulo (3,0) (5,1)
r4162 = Rectangulo (4,1) (6,2)
 
enRegion :: Punto -> Region -> Bool
enRegion (x,y) (Rectangulo (x1,y1) (x2,y2)) =
  x1 <= x && x <= x2 &&
  y1 <= y && y <= y2
enRegion p (Union  r1 r2) =
  enRegion p r1 || enRegion p r2
enRegion p (Diferencia r1 r2) =
  enRegion p r1 && not (enRegion p r2)
 
-- (regionArbitraria n) es un generador de regiones arbitrarias de orden
-- n. Por ejemplo,
--    λ> generate (regionArbitraria 2)
--    Rectangulo (30,-26) (-2,-8)
--    λ> generate (regionArbitraria 2)
--    Union (Union (Rectangulo (-2,-5) (6,1)) (Rectangulo(3,7) (11,15)))
--          (Diferencia (Rectangulo (9,8) (-2,6)) (Rectangulo (-2,2) (7,8)))
regionArbitraria :: Int -> Gen Region
regionArbitraria 0 =
  Rectangulo <$> arbitrary <*> arbitrary
regionArbitraria n =
  oneof [Rectangulo <$> arbitrary <*> arbitrary,
         Union <$> subregion <*> subregion,
         Diferencia <$> subregion <*> subregion]
  where subregion = regionArbitraria (n `div` 2)
 
-- Region está contenida en Arbitrary
instance Arbitrary Region where
  arbitrary = sized regionArbitraria
 
-- La propiedad es
prop_enRegion :: Punto -> Region -> Region -> Property
prop_enRegion p r1 r2 =
  enRegion p r1 ==>
  (enRegion p (Union  r1 r2) &&
   enRegion p (Union  r2 r1) &&
   not (enRegion p (Diferencia r2 r1)))
 
-- La comprobación es
--    λ> quickCheck prop_enRegion
--    *** Gave up! Passed only 78 tests; 1000 discarded tests.
--
--    λ> quickCheckWith (stdArgs {maxDiscardRatio=20}) prop_enRegion
--    +++ 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 →

Emparejamiento de árboles

José A. Alonso, ,

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)

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, ,

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.

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 →

Mayor producto de las ramas de un árbol

José A. Alonso, ,

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

   data Arbol a = N a [Arbol a]
     deriving Show

Por ejemplo, los árboles

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

se representan por

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

Definir la función

   mayorProducto :: (Ord a, Num a) => Arbol a -> a

tal que (mayorProducto a) es el mayor producto de las ramas del árbol a. Por ejemplo,

   λ> mayorProducto (N 1 [N 2 [], N  3 []])
   3
   λ> mayorProducto (N 1 [N 8 [], N  4 [N 3 []]])
   12
   λ> mayorProducto (N 1 [N 2 [],N 3 [N 4 []]])
   12
   λ> mayorProducto (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])
   90
   λ> mayorProducto (N (-8) [N 0 [N (-9) []],N 6 []])
   0
   λ> a = N (-4) [N (-7) [],N 14 [N 19 []],N (-1) [N (-6) [],N 21 []],N (-4) []]
   λ> mayorProducto a
   84

Soluciones

import Test.QuickCheck
 
data Arbol a = N a [Arbol a]
  deriving Show
 
-- 1ª solución
-- ===========
 
mayorProducto1 :: (Ord a, Num a) => Arbol a -> a
mayorProducto1 a = maximum [product xs | xs <- ramas a]
 
-- (ramas a) es la lista de las ramas del árbol a. Por ejemplo,
--    λ> ramas (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])
--    [[3,5,6],[3,4],[3,7,2],[3,7,1]]
ramas :: Arbol b -> [[b]]
ramas (N x []) = [[x]]
ramas (N x as) = [x : xs | a <- as, xs <- ramas a]
 
-- 2ª solución
-- ===========
 
mayorProducto2 :: (Ord a, Num a) => Arbol a -> a
mayorProducto2 a = maximum (map product (ramas a))
 
-- 3ª solución
-- ===========
 
mayorProducto3 :: (Ord a, Num a) => Arbol a -> a
mayorProducto3 = maximum . map product . ramas
 
-- 4º solución
-- ===========
 
mayorProducto4 :: (Ord a, Num a) => Arbol a -> a
mayorProducto4 = maximum . productosRamas
 
-- (productosRamas a) es la lista de los productos de las ramas
-- del árbol a. Por ejemplo,
--    λ> productosRamas (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])
--    [90,12,42,21]
productosRamas :: (Ord a, Num a) => Arbol a -> [a]
productosRamas (N x []) = [x]
productosRamas (N x xs) = [x * y | a <- xs, y <- productosRamas a]
 
-- 5ª solución
-- ===========
 
mayorProducto5 :: (Ord a, Num a) => Arbol a -> a
mayorProducto5 (N x []) = x
mayorProducto5 (N x xs)
  | x > 0     = x * maximum (map mayorProducto5 xs)
  | x == 0    = 0
  | otherwise = x * minimum (map menorProducto xs)
 
-- (menorProducto a) es el menor producto de las ramas del árbol
-- a. Por ejemplo,
--    λ> menorProducto (N 1 [N 2 [], N  3 []])
--    2
--    λ> menorProducto (N 1 [N 8 [], N  4 [N 3 []]])
--    8
--    λ> menorProducto (N 1 [N 2 [],N 3 [N 4 []]])
--    2
--    λ> menorProducto (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])
--    12
menorProducto :: (Ord a, Num a) => Arbol a -> a
menorProducto (N x []) = x
menorProducto (N x xs)
  | x > 0     = x * minimum (map menorProducto xs)
  | x == 0    = 0
  | otherwise = x * maximum (map mayorProducto2 xs)
 
-- 6ª solución
-- ===========
 
mayorProducto6 :: (Ord a, Num a) => Arbol a -> a
mayorProducto6 = maximum . aux
  where aux (N a []) = [a]
        aux (N a b)  = [v,u]
          where u = maximum g
                v = minimum g
                g = map (*a) (concatMap aux b)
 
-- Comprobación de equivalencia
-- ============================
 
-- (arbolArbitrario n) es un árbol aleatorio de orden n. Por ejemplo,
--   > sample (arbolArbitrario 5 :: Gen (Arbol Int))
--   N 0 [N 0 []]
--   N (-2) []
--   N 4 []
--   N 2 [N 4 []]
--   N 8 []
--   N (-2) [N (-9) [],N 7 []]
--   N 11 []
--   N (-11) [N 4 [],N 14 []]
--   N 10 [N (-3) [],N 13 []]
--   N 12 [N 11 []]
--   N 20 [N (-18) [],N (-13) []]
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_mayorProducto :: Arbol Integer -> Bool
prop_mayorProducto a =
  all (== mayorProducto1 a)
      [f a | f <- [ mayorProducto2
                  , mayorProducto3
                  , mayorProducto4
                  , mayorProducto5
                  , mayorProducto6
                  ]]
 
-- La comprobación es
--    λ> quickCheck prop_mayorProducto
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> ejArbol <- generate (arbolArbitrario 600 :: Gen (Arbol Integer))
--    λ> mayorProducto1 ejArbol
--    2419727651266241493467136000
--    (1.87 secs, 1,082,764,480 bytes)
--    λ> mayorProducto2 ejArbol
--    2419727651266241493467136000
--    (1.57 secs, 1,023,144,008 bytes)
--    λ> mayorProducto3 ejArbol
--    2419727651266241493467136000
--    (1.55 secs, 1,023,144,248 bytes)
--    λ> mayorProducto4 ejArbol
--    2419727651266241493467136000
--    (1.60 secs, 824,473,800 bytes)
--    λ> mayorProducto5 ejArbol
--    2419727651266241493467136000
--    (0.83 secs, 732,370,352 bytes)
--    λ> mayorProducto6 ejArbol
--    2419727651266241493467136000
--    (0.98 secs, 817,473,344 bytes)
--
--    λ> ejArbol2 <- generate (arbolArbitrario 700 :: Gen (Arbol Integer))
--    λ> mayorProducto5 ejArbol2
--    1044758937398026715504640000000
--    (4.94 secs, 4,170,324,376 bytes)
--    λ> mayorProducto6 ejArbol2
--    1044758937398026715504640000000
--    (5.88 secs, 4,744,782,024 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 →