Edición de «Práctica 1 (Paradigmas)»

__NOTOC__
{{Back|Paradigmas de Lenguajes de Programación}}
{{Revisar guías}}
== Funciones Auxiliares ==
 foldr :: (a -> b -> b) -> b -> [a] -> b
 foldr f z []     =  z
 foldr f z (x:xs) =  f x (foldr f z xs)

 foldr ((:) . (*2)) [] [1,2]
<pre>	((:) . (*2)) 1 (foldr ((:) . (*2)) [] [2])
	((:) . (*2)) 1 ((:) . (*2)) 2 (foldr ((:) . (*2)) [] [])
	((:) . (*2)) 1 ((:) . (*2)) 2 []
	((:) . (*2)) 1 [4]
	[2,4]</pre>

 foldl :: (a -> b -> a) -> a -> [b] -> a
 foldl f z []     =  z
 foldl f z (x:xs) =  foldl f (f z x) xs

 countElem :: Eq a => a -> [a] -> Int
 countElem i = length . filter (i==)

 tieneRepetidas xs = length [x | x <- xs, countElem x xs > 1] > 0

== Ejercicio 1 ==
 substract :: Float -> Float -> Float
 substract = flip (-)

 evaluarEn0 :: Num a => (a -> b) -> b
 evaluarEn0 = \f->f 0

 dosVeces :: (a -> a) -> a -> a
 dosVeces = \f -> f.f

 flipAll :: [a -> b -> c] -> [b -> a -> c]
 flipAll = map flip

== Ejercicio 2 ==
 curry2 :: ((a,b) -> c) -> a -> b -> c
 curry2 f a b = f (a,b)

 uncurry2 :: (a -> b -> c) -> (a,b) -> c
 uncurry2 f (a,b) = f a b

== Ejercicio 3 ==
[1,1,2]

== Ejercicio 4 ==
 pitagóricas :: [(Integer,Integer,Integer)]
 pitagóricas = [(a,b,c) | a <- [1..], b <-[1..], c <- [1..], a^2 + b^2 == c^2]
Se cuelga en (1, 1, inf)

 pitagóricas1 = [(a,b,c) | a <- [1..], b <- [1..(a^2)], c <- [1..(a^2 + b^2)], a^2 + b^2 == c^2]

 pitagóricas2 = [(a,b,c) | c <- [1..], a <- [1..c^2], b <- [1..c^2], a^2 + b^2 == c^2]

== Ejercicio 5 ==
 primos :: [Integer]
 primos = take 1000 allPrimes
 allPrimes :: [Integer]
 allPrimes = [x | x <- [1..], length (divisores x) == 2]
            where divisores x = [d | d <- [1..x], mod x d == 0]

== Ejercicio 6 ==
 partir :: [a] -> [([a],[a])]
 partir xs = [p | i <- [0..length xs], p <- [splitAt i xs]]

(bis)

 partir :: [a] -> [([a],[a])]
 partir xs = [(take i xs,drop i xs)|i<-[0..length xs]]

== Ejercicio 7 ==
 listasQueSuman :: Int -> [ [Int] ]
 listasQueSuman 0 = [[]]
 listasQueSuman n = [(x:xs) | x<-[1..n],xs<-listasQueSuman (n-x)]

== Ejercicio 8 ==
 listasPositivas :: [ [Int] ]
 listasPositivas = [xs | n<-[0..], xs<-listasQueSuman n]

== Ejercicio 9 ==
=== I ===
 sum2 :: [Integer] -> Integer
 sum2 xs = foldr (+) 0 xs

 elem2 :: Eq a => a -> [a] -> Bool
 elem2 x xs = foldr ((||) . (==x)) False xs

 concat2 :: [a] -> [a] -> [a]
 concat2 xs ys = foldr (:) ys xs

 filter2 :: (a -> Bool) -> [a] -> [a]
 filter2 f xs = foldr (\x -> concat_if (f x) x) [] xs
   where concat_if f = if f then (:) else (\_ -> id)

 map2 :: (a -> b) -> [a] -> [b]
 map2 f xs = foldr ((:) . f) [] xs

=== II ===
 sumaAlt :: [Integer] -> Integer
 sumaAlt = foldalt (+) (-) 0

 foldalt :: (a -> b -> b) -> (a -> b -> b) -> b -> [a] -> b
 foldalt _ _ b [] = b
 foldalt f g b (x:xs) = g x (foldalt g f b xs) OJO: USA RECURSIÓN EXPLÍCITA

(bis)
 sumaAlt :: [Integer] -> Integer
 sumaAlt = foldr (-) 0

=== III ===
 sumaAlt2:: [Integer] -> Integer
 sumaAlt2 xs = foldr (-) 0 (reverse xs)

== Ejercicio 10 ==
=== I ===
 partes :: [a] -> [[a]]
 partes = foldr
            (\x partes -> partes ++ map (x:) partes)
            [[]]

=== II ===
 prefijos :: [a] -> [[a]]
 prefijos = foldl
              (\pref x -> pref ++ [(pref !! (length pref - 1)) ++ [x]])
              [[]]


bis

 prefijos :: [a] -> [[a]]
 prefijos xs = [take i xs | i<-[0..length xs]]

=== III ===
 sufijos :: [a] -> [[a]]
 sufijos = foldr
             (\x pref -> pref ++ [x:(pref !! (length pref - 1))])
             [[]]

 sublistas :: Eq a => [a] -> [[a]]
 sublistas xs = [] : filter (/= []) (prefijosDe (sufijos xs))

 prefijosDe :: [[a]] -> [[a]]
 prefijosDe = foldr
                (\x suf -> prefijos x ++ suf)
                [[]]

(bis)

 sufijos :: [a] -> [[a]]
 sufijos xs = [drop i xs | i<-[0..length xs]]

 sublistas :: Eq a => [a] -> [[a]]
 sublistas xs = [] : filter (/= []) (concatMap prefijos (sufijos xs))

(bis bis)

 sublistas:: Eq a => [a] -> [ [a] ]
 sublistas xs = nub [take i (drop j xs) | j <-[0..length xs], i <-[0..length xs]]

== Ejercicio 11 ==
=== I ===
 sacarUna :: Eq a => a -> [a] -> [a]
 sacarUna x xs = fst(break (==x) xs) ++ tail(snd(break (==x) xs))

=== II ===
 permutaciones :: Eq a=>[a]->[[a]]
 permutaciones [] = [[]]
 permutaciones xs = [x:xs2 | x<-xs, xs2<-(permutaciones (sacarUna x xs))]

=== Solución alternativa, sin recursión explícita ===
 permutaciones :: [Char] -> [ [ Char ] ]
 permutaciones l = foldr (\head acum -> (concatMap (\perm -> [ (take i perm) ++ [head] ++ (drop i perm) | i <- [0..(length perm)] ]) acum)) [[]] l

== Ejercicio 12 ==
=== I ===
 genLista :: Integer -> a -> (a -> a) -> [a]
 genLista n a f = foldr
           (\x ls -> if null ls then [a] else ls ++ [f (last ls)])
           []
           [1..n]

=== II ===
 desdeHasta :: Integer -> Integer -> [Integer]
 desdeHasta d h = genLista (h-d) d (+1)

== Ejercicio 13 (zip, zipWith) ==
=== I ===
 mapPares :: (a -> a -> a) -> [(a,a)] -> [a]
 mapPares f xs = foldr ((:) . uncurry2 f) [] xs

=== II ===
 armarPares :: [a] -> [a] -> [(a,a)]
 armarPares = foldr
                (\a armarAs (b:bs) -> (a,b):armarAs bs)
                (const [])

=== III ===
 mapDoble :: (a -> a -> a) -> [a] -> [a] -> [a]
 mapDoble f xs ys = mapPares f (armarPares xs ys)

== Ejercicio 14 ==
=== I ===
 sumaMat :: [[Int]] -> [[Int]] -> [[Int]]
 sumaMat = foldr
            (\f1 sumarM1 (f2:m2) -> (zipWith (+) f1 f2) : sumarM1 m2)
            (const [])

(bis)

 sumaMat :: [[Int]] -> [[Int]] -> [[Int]]
 sumaMat=zipWith (zipWith (+))

=== II ===
 trasponer :: [[a]] -> [[a]]
 trasponer [] = []
 trasponer ([]:m) = trasponer m
 trasponer ((h:f) : m) =
     (h : [hi | (hi:fi) <- m])             == Unir cabezas de filas
     : trasponer (f : [fi | (hi:fi) <- m]) == Continuar trasponiendo matriz (sin cabezas)

(bis)

 trasponer :: [[a]] -> [[a]]
 trasponer mat = if null mat then [] else foldr (zipWith (:)) vacías mat
                 where vacías = map (const []) (head mat)

(Usando zipWithList)

 trasponer ::[[a]]->[[a]]
 trasponer = zipWithList (:) []

=== III ===

 zipWithList::(a->b->b)->b->[[a]]->[b]
 zipWithList f c = foldr (\x y-> if null y then map (flip f c) x else zipWith f x y) []

(Usando trasponer)

 zipWithList::(a->b->b)->b->[[a]]->[b]
 zipWithList f base xss = map (foldr f base) (trasponer xss)

== Ejercicio 16  ==
(divide and conquer)
 dac :: b -> (a -> b) -> ([a] -> ([a],[a])) -> ([a] -> b -> b -> b) -> [a] -> b
 dac base base1 divide combine [] = base
 dac base base1 divide combine [x] = base1 x
 dac base base1 divide combine input = combine input (rec izquierda) (rec derecha)
          where rec = dac base base1 divide combine
                izquierda = fst (divide input)
                derecha = snd (divide input)

=== I ===
 mapDac :: (a -> b) -> [a] -> [b]
 mapDac f xs = dac [] (\x -> [f x]) divide combine xs
   where divide = (\xs -> splitAt (length xs `div` 2) xs)
         combine xs as bs = as ++ bs

 filterDac :: (a -> Bool) -> [a] -> [a]
 filterDac f xs = dac [] (\x -> if f x then [x] else []) divide combine xs
   where divide = (\xs -> splitAt (length xs `div` 2) xs)
         combine xs as bs = as ++ bs

=== II ===
 mergeSort :: Ord a => [a] -> [a]
 mergeSort xs = dac [] (\x -> [x]) divide combine xs
   where divide = (\xs -> splitAt (length xs `div` 2) xs)
         combine xs as [] = as
         combine xs [] bs = bs
         combine xs (a:as) (b:bs) | a <= b = a : combine xs as (b:bs)
                                  | a > b  = b : combine xs (a:as) bs

=== III ===
 quickSort :: Ord a => [a] -> [a]
 quickSort xs = dac [] (\x -> [x]) divide combine xs
   where divide (x:xs) = qdivide x xs
         combine xs as [] = as
         combine xs [] bs = bs
         combine xs (a:as) (b:bs) | a <= b = (a:as) ++ (b:bs)
                                  | a > b  = (b:bs) ++ (a:as)
 qdivide :: Ord a => a -> [a] -> ([a],[a])
 qdivide x [] = ([], [x])
 qdivide x (y:ys) | x >= y = (y : fst(qdivide x ys), snd(qdivide x ys))
                  | x <  y = (fst(qdivide x ys), y : snd(qdivide x ys))

== Ejercicio 17 ==
=== I ===
 foldNat :: (Integer -> Integer -> Integer) -> Integer -> Integer -> Integer
 foldNat f x 0 = x
 foldNat f x n = f x (foldNat f x (n-1))

=== II ===
 potencia :: Integer -> Integer -> Integer
 potencia x = foldNat (\y res-> x * res) 1

== Ejercicio 18 ==
 data Num a => Polinomio a = X
     | Cte a
     | Suma (Polinomio a) (Polinomio a)
     | Prod (Polinomio a) (Polinomio a)

 foldPol :: Num a => b -> (a -> b) -> (b -> b -> b) -> (b -> b -> b) -> Polinomio a -> b
 foldPol f1 f2 f3 f4 X = f1
 foldPol f1 f2 f3 f4 (Cte y) = f2 y
 foldPol f1 f2 f3 f4 (Suma p1 p2) = f3 (foldPol f1 f2 f3 f4 p1) (foldPol f1 f2 f3 f4 p2)
 foldPol f1 f2 f3 f4 (Prod p1 p2) = f4 (foldPol f1 f2 f3 f4 p1) (foldPol f1 f2 f3 f4 p2)

 evaluar :: Num a => a -> Polinomio a -> a
 evaluar x p = (foldPol x (id) (+) (*) p)
 -- evaluar 8 (Suma (Cte 4) (Cte 70))
 -- evaluar 5 (Suma (Prod (Cte 4) X) (Cte 8))

== Ejercicio 19 ==
 type Conj a = (a -> Bool)

=== I ===
 vacío :: Conj a
 vacío = const False

 agregar :: Eq a => a -> Conj a -> Conj a
 agregar x c = \y -> (x == y || (c y))

=== II ===
 union :: Conj a -> Conj a -> Conj a
 union a b = \x -> (a x || b x)

 intersect :: Conj a -> Conj a -> Conj a
 intersect a b = \x -> (a x && b x)
 -- (intersect (add 2 (add 3 empty)) (add 3 (add 6 empty))) 3

=== III ===
Conjunto de funciones que aplicado a 3 da True
 -- infinity (\x -> (x > 1))
 -- infinity (\x -> (2*1+1 == x))
 infinity :: Conj (Int -> Bool)
 infinity = \f -> f 3

=== IV ===
 primeraAparición::a->[Conj a]->Int
 primeraAparición e xs = head ([i|i<-[0..],(xs!!i) e])

== Ejercicio 20 ==
 data AHD tInterno tHoja = Hoja tHoja
                           | Rama tInterno (AHD tInterno tHoja)
                           | Bin (AHD tInterno tHoja) tInterno (AHD tInterno tHoja)
                          deriving Show

=== I ===
 foldAHD :: (tHoja -> b) -> (tInterno -> b -> b) -> (b -> tInterno -> b -> b) -> AHD tInterno tHoja -> b
 foldAHD f1 f2 f3 (Hoja x)    = f1 x
 foldAHD f1 f2 f3 (Rama x a)  = f2 x (foldAHD f1 f2 f3 a)
 foldAHD f1 f2 f3 (Bin a x b) = f3 (foldAHD f1 f2 f3 a) x (foldAHD f1 f2 f3 b)

=== II ===
 mapAHD :: (a -> b) -> (c -> d) -> AHD a c -> AHD b d
 mapAHD fi fh = foldAHD
     (\x -> Hoja (fh x))
     (\x a -> Rama (fi x) a)
     (\a x b -> Bin a (fi x) b)
 -- mapAHD (+1) not (Bin(Rama 1 (Hoja False)) 2 (Bin(Hoja False) 3 (Rama 5 (Hoja True))))
 -- => (Bin (Rama 2 (Hoja True)) 3 (Bin (Hoja True) 4 (Rama 6 (Hoja False))))

=== III ===
 hojasAHD :: AHD tInterno tHoja -> [tHoja]
 hojasAHD = foldAHD
     (\h -> [h])
     (\_ a -> a)
     (\a x b -> a ++ b)

 nodosInternos :: AHD tInterno tHoja -> [tInterno]
 nodosInternos = foldAHD
     (\_ -> [])
     (\x a -> ([x] ++ a))
     (\a x b -> ([x] ++ a ++ b))

 analizar :: Eq tHoja => AHD tInterno tHoja -> Either (tHoja -> Int) [tInterno]
 analizar a = if tieneRepetidas (hojasAHD a)
              then Left (\h -> countElem h (hojasAHD a))
              else Right (nodosInternos a)

 l (Left a) = a
 r (Right a) = a

 -- l (analizar (Bin(Rama 1 (Hoja False)) 2 (Bin(Bin (Hoja False) 1 (Hoja False)) 3 (Rama 5 (Bin (Hoja True) 10 (Hoja True)))))) False
 -- r (analizar (Bin(Rama 1 (Hoja 'a')) 2 (Bin(Bin (Hoja 'b') 1 (Hoja 'c')) 3 (Rama 5 (Bin (Hoja 'd') 10 (Hoja 'e'))))))

== Ejercicio 21 ==
 -- (BinAB Nil 3 (BinAB (BinAB Nil 2 Nil) 1 (BinAB Nil 4 Nil)))
 data AB a = Nil | BinAB (AB a) a (AB a)
             deriving Show

 foldAB :: b -> (b -> a -> b -> b) -> AB a -> b
 foldAB cb f Nil = cb
 foldAB cb f (BinAB a x b) = f (foldAB cb f a) x (foldAB cb f b)

 altura :: AB a -> Int
 altura = foldAB 0 (\a x b -> 1 + max a b)

 nodos :: AB a -> Int
 nodos = foldAB 0 (\a x b -> 1 + a + b)

 -- Éste está mal
 hojas :: AB a -> Int
 hojas = foldAB 0 (\a x -> (+1))

 espejo :: AB a -> AB a
 espejo = foldAB Nil (\a x b -> BinAB b x a)

[[Category:Prácticas]]