-
Notifications
You must be signed in to change notification settings - Fork 1
/
Emparejamiento_de_arboles.hs
117 lines (98 loc) · 3.8 KB
/
Emparejamiento_de_arboles.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
-- Emparejamiento_de_arboles.hs
-- Emparejamiento de árboles.
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 18-abril-2022
-- ---------------------------------------------------------------------
-- ---------------------------------------------------------------------
-- 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 []]]
-- ---------------------------------------------------------------------
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
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)