Práctica 1 (Paradigmas)

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]

	((:) . (*2)) 1 (foldr ((:) . (*2)) [] [2])
	((:) . (*2)) 1 ((:) . (*2)) 2 (foldr ((:) . (*2)) [] [])
	((:) . (*2)) 1 ((:) . (*2)) 2 []
	((:) . (*2)) 1 [4]
	[2,4]

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

Incorrecto:

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

Problema: El codigo anterior no admite el caso armarPares _ [] Solucion:

armarPares :: [a] -> [a] -> [(a,a)]
armarPares = foldr
               (\a armarAs bs -> if null bs 
                                 then [] 
                                 else (a,head bs):armarAs (tail 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 1 = x
foldNat f x n = f x (foldNat f x (n-1))

II

--No funciona
potencia :: Integer -> Integer -> Integer

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

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)