API tools faq
paste
Advertisement
tomasfdel

Estructuras II Práctica 3

tomasfdel
Apr 11th, 2018
1,121
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Haskell 8.86 KB | None | 0 0
raw download clone embed print report
  1. -- 1)
  2. type Color = (Float, Float, Float)
  3.  
  4. mezclar :: Color -> Color -> Color
  5. mezclar (r1, g1, b1) (r2, g2, b2) = ( (r1 + r2)/2 , (g1 + g2)/2, (b1 + b2)/2 )
  6.  
  7.  
  8. -- 2)
  9. type Linea = (Int, [Char])
  10.  
  11. vacia :: Linea
  12. vacia = (0, [])
  13.  
  14. moverIzq :: Linea -> Linea
  15. moverIzq (cursor, linea) = if cursor == 0 then (0, linea) else (cursor - 1, linea)
  16.  
  17. moverDer :: Linea -> Linea
  18. moverDer (cursor, linea) = if cursor == length(linea) then (cursor, linea) else (cursor + 1, linea)
  19.  
  20. moverIni :: Linea -> Linea
  21. moverIni (cursor, linea) = (0, linea)
  22.  
  23. moverFin :: Linea -> Linea
  24. moverFin (cursor, linea) = (length linea, linea)
  25.  
  26. insertar :: Char -> Linea -> Linea
  27. insertar caracter (cursor, linea) = (cursor, (take cursor linea)++ [caracter] ++ (drop cursor linea))
  28.  
  29. borrar :: Linea -> Linea
  30. borrar (0, linea) = (0, linea)
  31. borrar (cursor, linea) = (cursor - 1, (take (cursor - 1) linea) ++ (drop cursor linea))
  32.  
  33.  
  34.  
  35. -- 3)
  36. data CList a = EmptyCL | CUnit a | Consnoc a (CList a) a
  37.  
  38. headCL :: CList a -> a
  39. headCL (CUnit v) = v
  40. headCL (Consnoc v1 xs v2) = v1
  41.  
  42. rearmar :: CList a -> a -> CList a
  43. rearmar xs v = case xs of
  44.                           EmptyCL            -> (CUnit v)
  45.                           (CUnit v1)         -> (Consnoc v1 EmptyCL v)
  46.                           (Consnoc v1 ys v2) -> (Consnoc v1 (rearmar ys v2) v)
  47.  
  48. rearmar2 :: a -> CList a -> CList a
  49. rearmar2 v xs = case xs of
  50.                           EmptyCL            -> (CUnit v)
  51.                           (CUnit v1)         -> (Consnoc v EmptyCL v1)
  52.                           (Consnoc v1 ys v2) -> (Consnoc v (rearmar2 v1 ys) v2)
  53.  
  54. tailCL :: CList a -> CList a
  55. tailCL (CUnit v) = EmptyCL
  56. tailCL (Consnoc v1 xs v2) = rearmar xs v2
  57.  
  58. isEmptyCL :: CList a -> Bool
  59. isEmptyCL EmptyCL = True
  60. isEmptyCL _ = False
  61.  
  62. isCUnitCL :: CList a -> Bool
  63. isCUnitCL (CUnit v) = True
  64. isCUnitCL _ = False
  65. data CList a = EmptyCL | CUnit a | Consnoc a (CList a) a deriving Show
  66.  
  67. headCL :: CList a -> a
  68. headCL (CUnit v) = v
  69. headCL (Consnoc v1 xs v2) = v1
  70.  
  71. tailCL :: CList a -> CList a
  72. tailCL (CUnit v) = EmptyCL
  73. tailCL (Consnoc v1 xs v2) = snocCL xs v2
  74.  
  75. reverseCL :: CList a -> CList a
  76. reverseCL EmptyCL = EmptyCL
  77. reverseCL (CUnit v) = (CUnit v)
  78. reverseCL (Consnoc v1 xs v2) = Consnoc v2 (reverseCL xs) v1
  79.  
  80. consCL :: a -> CList a -> CList a
  81. consCL x EmptyCL = CUnit x
  82. consCL x (CUnit y) = Consnoc x EmptyCL y
  83. consCL x (Consnoc y1 z y2) = Consnoc x (consCL y1 z) y2
  84.  
  85.  
  86. snocCL :: CList a -> a -> CList a
  87. snocCL EmptyCL x = CUnit x
  88. snocCL (CUnit y) x = Consnoc y EmptyCL x
  89. snocCL (Consnoc y1 z y2) x = Consnoc y1 (snocCL z y2) x
  90.  
  91.  
  92. initsAux :: CList a -> [CList a]
  93. initsAux EmptyCL = [EmptyCL]
  94. initsAux lista = EmptyCL:(map (consCL (headCL lista)) (initsAux (tailCL lista)) )
  95.  
  96. listToCL :: [a] -> CList a
  97. listToCL [] = EmptyCL
  98. listToCL (x:xs) = consCL x (listToCL xs)
  99.  
  100.  
  101. inits :: CList a -> CList (CList a)
  102. inits lista = listToCL (initsAux lista)
  103.  
  104. lasts:: CList a -> CList (CList a)
  105. lasts lista = listToCL (map reverseCL (initsAux (reverseCL lista)))
  106.  
  107. concatDosCL :: CList a -> CList a -> CList a
  108. concatDosCL l1 EmptyCL = l1
  109. concatDosCL EmptyCL l2 = l2
  110. concatDosCL (CUnit v1) (CUnit v2) = Consnoc v1 EmptyCL v2
  111. concatDosCL (Consnoc v11 xs v12) (CUnit v2) = Consnoc v11 (rearmar xs v12) v2
  112. concatDosCL (CUnit v1) (Consnoc v21 xs v22) = Consnoc v1 (rearmar2 v21 xs) v22
  113. concatDosCL (Consnoc v11 xs v12) (Consnoc v21 ys v22) = Consnoc v11 (concatDosCL (rearmar xs v12) (rearmar2 v21 ys)) v22
  114.  
  115. concatCL :: CList (CList a) -> CList a
  116. concatCL EmptyCL = EmptyCL
  117. concatCL (CUnit l) = l
  118. concatCL (Consnoc l1 xs l2) = (concatDosCL((concatDosCL l1 (concatCL xs))) l2)
  119.  
  120.  
  121.  
  122. -- 4)
  123. import Prelude
  124. data Aexp = Num Int | Prod Aexp Aexp | Div Aexp Aexp
  125. --data Maybe a = Nothing | Just a
  126.  
  127. eval :: Aexp -> Int
  128. eval (Num n) = n
  129. eval (Prod n1 n2) = (eval n1) * (eval n2)
  130. eval (Div n1 n2) = div (eval n1) (eval n2)
  131.  
  132. seval :: Aexp -> Maybe Int
  133. seval (Num n) = Just n
  134. seval (Prod n1 n2) = case ((seval n1), (seval n2)) of
  135.                                                       (Nothing, v2) -> Nothing
  136.                                                       (v1, Nothing) -> Nothing
  137.                                                       ((Just v1), (Just v2)) -> Just (v1*v2)
  138. seval (Div n1 n2) = case ((seval n1), (seval n2)) of
  139.                                                       (Nothing, v2) -> Nothing
  140.                                                       (v1, Nothing) -> Nothing
  141.                                                       ((Just v1), (Just v2)) -> if v2 == 0 then Nothing else Just (div v1 v2)
  142.  
  143.  
  144.  
  145. -- 5)
  146. data Tree a = Hoja | Nodo (Tree a) a (Tree a) deriving Show
  147.  
  148. completo :: a -> Int -> Tree a
  149. completo dato 0 = Hoja
  150. completo dato n = let subarbol = (completo dato (n - 1))
  151.                   in (Nodo subarbol dato subarbol)
  152.  
  153. balanceado :: a -> Int -> Tree a
  154. balanceado dato 0 = Hoja
  155. balanceado dato 1 = Nodo Hoja dato Hoja
  156. balanceado dato n = if (mod (n - 1) 2) == 0 then let subarbol = (balanceado dato (div n 2))
  157.                                            in (Nodo subarbol dato subarbol)
  158.                                       else let subI = (balanceado dato (div n 2))
  159.                                                subD = (balanceado dato ((div n 2) - 1))
  160.                                            in (Nodo subI dato subD)
  161.  
  162.  
  163.  
  164.  
  165. -- 6)
  166. data GenTree a = EmptyG | NodeG a [GenTree a]
  167. data BinTree a = EmptyB | NodeB (BinTree a) a (BinTree a)
  168.  
  169. checkBT :: Eq a => BinTree a -> BinTree a -> Bool
  170. checkBT EmptyB EmptyB = True
  171. checkBT (NodeB l1 v1 r1) EmptyB = False
  172. checkBT EmptyB (NodeB l2 v2 r2) = False
  173. checkBT (NodeB l1 v1 r1) (NodeB l2 v2 r2) = (v1 == v2) && (checkBT l1 l2) && (checkBT r1 r2)
  174.  
  175.  
  176. g2btAux :: GenTree a -> [GenTree a] -> BinTree a
  177. g2btAux (NodeG v []) [] = (NodeB EmptyB v EmptyB)
  178. g2btAux (NodeG v []) (y:ys) = (NodeB EmptyB v (g2btAux y ys) )
  179. g2btAux (NodeG v (x:xs)) [] = (NodeB (g2btAux x xs) v EmptyB)
  180. g2btAux (NodeG v (x:xs)) (y:ys) = (NodeB (g2btAux x xs) v (g2btAux y ys))
  181.  
  182.  
  183. g2bt:: GenTree a -> BinTree a
  184. g2bt EmptyG = EmptyB
  185. g2bt (NodeG x lista) = g2btAux (NodeG x lista) []
  186.  
  187. test1 = (NodeB (NodeB (NodeB EmptyB 'M' (NodeB EmptyB 'N' EmptyB)) 'G' (NodeB EmptyB 'H' (NodeB EmptyB 'I' EmptyB))) 'B' EmptyB)
  188. test2 = (NodeG 'B' [(NodeG 'G' [(NodeG 'M' []), (NodeG 'N' [])]), (NodeG 'H' []), (NodeG 'I' []) ])
  189.  
  190.  
  191. -- 7 y 8)
  192. data Bin a = Hoja | Nodo (Bin a) a (Bin a)
  193.  
  194. minimumBST :: Bin a -> a
  195. minimumBST (Nodo Hoja a r) = a
  196. minimumBST (Nodo l a r) = minimumBST l
  197.  
  198. maximumBST :: Bin a -> a
  199. maximumBST (Nodo l a Hoja) = a
  200. maximumBST (Nodo l a r) = maximumBST r
  201.  
  202. checkBST :: Ord a => Bin a -> Bool
  203. checkBST Hoja = True
  204. checkBST (Nodo Hoja a Hoja) = True
  205. checkBST (Nodo l a Hoja) = (a >= (maximumBST l)) && (checkBST l)
  206. checkBST (Nodo Hoja a r) = (a <= (minimumBST r)) && (checkBST r)
  207. checkBST (Nodo l a r) = (a <= (maximumBST l)) && (a <= (minimumBST r)) && (checkBST l) && (checkBST r)
  208.  
  209. memberAux :: (Num a, Ord a) => a -> Bin a -> a -> Bool
  210. memberAux valor Hoja candidato = valor == candidato
  211. memberAux valor (Nodo l a r) candidato = if valor <= a then (memberAux valor l a) else (memberAux valor r candidato)
  212.  
  213.  
  214. member :: (Num a, Ord a) => a -> Bin a -> Bool
  215. member valor arbol = memberAux valor arbol (valor + 1)
  216.  
  217.  
  218.  
  219. -- 9)
  220. data Color = R | B
  221. data RBT a = E | T Color (RBT a) a (RBT a)
  222.  
  223. makeBlack :: RBT a -> RBT a
  224. makeBlack E = E
  225. makeBlack (T _ l x r) = T B l x r
  226.  
  227. lbalance :: Color -> RBT a -> a -> RBT a -> RBT a
  228. lbalance B (T R (T R a x b) y c) z d = T R (T B a x b) y (T B c z d)
  229. lbalance B (T R a x (T R b y c)) z d = T R (T B a x b) y (T B c z d)
  230. lbalance c l a r = T c l a r
  231.  
  232. rbalance :: Color -> RBT a -> a -> RBT a -> RBT a
  233. rbalance B a x (T R (T R b y c) z d) = T R (T B a x b) y (T B c z d)
  234. rbalance B a x (T R b y (T R c z d)) = T R (T B a x b) y (T B c z d)
  235. rbalance c l a r = T c l a r
  236.  
  237. insert :: Ord a => a -> RBT a -> RBT a
  238. insert x t = makeBlack (ins x t)
  239.        where ins x E = T R E x E
  240.              ins x (T c l y r) | x < y = lbalance c (ins x l) y r
  241.                                | x > y = rbalance c l y (ins x r)
  242.                                | otherwise = T c l y r
  243.  
  244.  
  245.  
  246. -- 10)
  247.  
  248. type Rank = Int
  249. data Heap a = E | N Rank a (Heap a) (Heap a)
  250.  
  251. rank :: Heap a -> Rank
  252. rank E = 0
  253. rank (N r _ _ _) = r
  254.  
  255. makeH:: a -> Heap a -> Heap a -> Heap a
  256. makeH x a b = if rank a >= rank b then N (rank b + 1) x a b
  257.                                   else N (rank a + 1) x b a
  258.  
  259. merge :: Ord a => Heap a -> Heap a -> Heap a
  260. merge h1 E = h1
  261. merge E h2 = h2
  262. merge h1@(N _ x a1 b1) h2@(N _ y a2 b2) =
  263.     if x <= y then makeH x a1 (merge b1 h2)
  264.               else makeH y a2 (merge h1 b2)
  265.  
  266.  
  267. fromHeapList :: Ord a => [Heap a] -> [Heap a]
  268. fromHeapList [] = []
  269. fromHeapList [x] = [x]
  270. fromHeapList (x:y:xs) = fromHeapList ( (merge x y) : (fromHeapList xs) )
  271.  
  272.  
  273. fromList :: Ord a => [a] -> Heap a
  274. fromList [] = E
  275. fromList xs = let [x] = fromHeapList (map (\x -> N 1 x E E) xs) in x
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!