¡Esta es una revisión vieja del documento!
Tabla de Contenidos
Wiki de Scripts Haskell
Esta página Wiki se puede modificar libremente. La idea es poner pedazos de código Haskell con los programas que vayamos haciendo del problemario.
A manera de inicio contribuyo con un Haskell script que contiene algunas soluciones del problemario.
{-nicolasw-}
ambospositivos :: Int -> Int -> Bool
ambospositivos x y | x>0 && y>0 = True
| otherwise = False
Pueden seguir contribuyendo programas aquí abajo.
No hay soluciones absolutamente malas ni absolutamente buenas, es por eso que instamos a que cada uno que haya hecho algo “distinto”, mejore este rincón con su script de Haskell.
Funciones Simples
entre0y9
{-nicolasw-}
entre0y9 :: Int -> Bool
entre0y9 x = 0<=x && x<=9
{-nicolasw-}
entre0y9 :: Int -> Bool
entre0y9 x | 0<=x = if x<=9 then True else False
(nicolasw) upps, tenia un error,entre0y9 (-1)no estaba contemplado, acá va una versión mejorada
entre0y9 :: Int -> Bool
entre0y9 x | 0<=x = if x<=9 then True else False
| not(0<=x) = False
{-JDiaz-}
--Las soluciones son usando funciones de listas
entre0y9 :: Int -> Bool
entre0y9 x = elem x [0..9]
entre0y9' :: Int -> Bool entre0y9' x = any (==x) [0..9]
entre0y9'' :: Int -> Bool entre0y9'' x = head ( filter (==True) ( map (==x) [0..9] ) )
entre0y9''' :: Int -> Bool entre0y9''' x = length ( filter (==x) [0..9] ) == 1
rangoEdad
{-aLaN-}
rangoEdad :: Int -> String
rangoEdad x |x<0 = "Error"
| x<35 && 0<x = "Joven"
| x<65 && 35<x = "Adulto"
| x>65 = "Mayor"
{-Cancu-}
rangoEdad :: Int -> String
rangoEdad x | x<35 && x>=0 = "Joven"
| x>=35 && x<65 = "Adulto"
| x>=65 = "Mayor"
| x<0 = "Todavia no nasiste che"
(El programa de aLaN no esta definido para las edades 0, 35 y 65)
{-JDiaz-}
rangoEdad :: Int -> String
rangoEdad x | x >= 65 = "Mayor"
| x >= 35 = "Adulto"
| x > 0 = "Joven"
| x <= 0 = error "Edad menor o igual a cero"
segundo3
{-aLaN-}
segundo3 :: (Int,Int,Int) -> Int
segundo3 (a,b,c) = b
mayor03
{-Cancu-}
mayor3 :: (Int,Int,Int) -> (Bool,Bool,Bool)
mayor3 (x,y,z) | x>3 && y>3 && z>3 = (True,True,True)
| x>3 && y>3 && z<=3 = (True,True,False)
| x>3 && y<=3 && z>3 = (True,False,True)
| x<=3 && y>3 && z>3 = (False,True,True)
| x>3 && y<=3 && z<=3 = (True,False,False)
| x<=3 && y<=3 && z>3 = (False,False,True)
| x<=3 && y>3 && z<=3 = (False,True,False)
| x<=3 && y<=3 && z<=3 = (False,False,False)
{-Cancu-}
(pero pensando un ratito llegue a hacer este otro que parece bastante mejor :-) )
mayor32 :: (Int,Int,Int) -> (Bool,Bool,Bool)
mayor32 (x,y,z) = (x>3,y>3,z>3)
(nicolasw) Aca se ve la diferencia entre una tabla de verdad y las expresiones booleanas, una línea contra 23 :)
ordena
{-Cancu-}
ordena :: (Int,Int) -> (Int,Int)
ordena (a,b) | a>b = (b,a)
| b>=a = (a,b)
ambospositivos
{-nicolasw-}
ambospositivos :: Int -> Int -> Int
ambospositivos x y | x>0 && y>0 = True
| otherwise = False
ambospositivos :: Int -> Int -> Int
ambospositivos x y | x>=0 && y>=0 = True
| not(x>=0 && y>=0) = False
{-JDiaz-}
ambospositivos :: Int -> Int -> Bool
ambospositivos x y = (( sgn(x) == 1 ) && ( sgn(y) == 1 ))
{-Cancu-}
(en el programa de nicolasw da false cuando x o y son iguales a 0 y tiene un error cuando define el tipo, da de Int->Int->Int y deberia ser Int->Int->Bool)
(el segundo programa tiene el mismo problema cuando define el tipo)
(y el de JDiaz lo probe en mi hugs y dice que hay que definir la variable sgn) (La función sgn es la función signo que fue definida en el taller y en clases. JDiaz)
{-Cancu-}
ambospositivos :: Int -> Int -> Bool
ambospositivos x y = x>=0 && y>=0
(-El Gustavo-) Espero no haberme hechado un moco el editar la pagina Morgan (?) ambospositivos :: Int -> Int -> Bool ambospositivos x y | x>0 && y>0 = True | not (x>0) || not (y>0) = False
averaver
{-Cancu-}
averaver :: (Int,Int,Int) -> (Int,Int,Int)
averaver (x,y,z) | x>=0 && y>=0 && z>=0 = (z,y,x)
| x<0 && y<0 && z<0 = (-1*x,-1*y,-1*z)
| otherwise = (x,y,z)
rangoPrecio
{-Cancu-}
rangoPrecio :: Int->String
rangoPrecio x | x<2000 && x>=0 = "muy barato"
| x>5000 = "demasiado caro"
| 2000<=x && x<=5000 = "hay que verlo bien"
| x<0 = "esto no puede ser!"
absoluto
{-Cancu-}
absoluto :: Int->Int
absoluto x | x>=0 = x
| x<0 = -1*x
{-JDiaz}
absoluto :: Int -> Int
absoluto x = x * sgn x
{-según definicón de valor absoluto-}
absoluto' :: Int -> Int
absoluto' x | x >= 0 = x
| x < 0 = -x
signo
{-Cancu-}
signo :: Int->Int
signo x | x>=0 = 1
| x<0 = -1
{- La Función signo/sgn deber retornar 0 si el valor de x == 0 -}
{-JDiaz-}
sgn :: Int -> Int
sgn x | x > 0 = 1
| x < 0 = -1
| x == 0 = 0
esMultiplo2
{-Tomás Ferreyra-}
esMultiplo2::Int->Bool
esMultiplo2 n = n `mod`2 ==0
rangoPrecioParametrizado
esMultiplo
{-Tomás Ferreyra-}
esMultiplo::Int->Int->Bool
esMultiplo x n = x `mod`n == 0
cabeza
{-Cancu-}
cabeza :: [a]-> a
cabeza (x:xs) = x
cola
{-Cancu-}
cola :: [a] -> [a]
cola (x:xs) = xs
cola [] = []
(nicolasw)cola []no está definido al igual que cabeza. La definición usual es asi de simple.
cola :: [a] -> [a] cola (x:xs) = xs
esVaciaOPrimer0
{-No hace falta definir false o true en
el segundo caso ya que (x == 0) es una expresion booleana-}
esVaciaOPrimer0 :: [Int] -> Bool
esVaciaOPrimer0 [] = True
esVaciaOPrimer0 (x:_) = (x == 0)
Drasky
(nicolasw) Drasky, te moví el código aca arriba para que esté ordenado.
Un poco más complicadas
bisiesto
edad
{-JDiaz-}
edad :: (Int,Int,Int) -> (Int,Int,Int) -> Int
edad (x_dia,x_mes,x_anio) (y_dia,y_mes,y_anio) =
( y_anio - x_anio ) - ( if x_mes > y_mes then 1 else 0 ) -
( if x_mes == y_mes then ( if x_dia > y_dia then 1 else 0 ) else 0 )
{-ngarcia-}
--Esta solucion se basa en que las fechas en el formato AAAAMMDD están ordenadas,
primero defino la función convertirfecha para llevar las fechas dadas en el formato
(DD,MM,AAAA) a AAAAMMDD y luego la uso en la definición de edad .
convertirfecha ::(Int,Int,Int)-> Int
convertirfecha (dd,mm,aaaa) =aaaa*10000+mm*100+dd
edad:: (Int,Int,Int)->(Int,Int,Int)->Int
edad (d,m,a)(d1,m1,a1) =(convertirfecha(d1,m1,a1) - convertirfecha(d,m,a))`div` 10000
{-El Gustavo-}
Esencialmente, defino cuando edad = b_año - a_año y despues cuando no lo es (edad = b_año - a_año - 1)
utlizando ley de Morgan ( Les juro que en mi casa el codigo se ve como la gente, aca no se como hacer para
ponerlo bien) Hay van dos formas, que en realidad es lo mismo
(1)edad :: (Int, Int, Int) -> (Int, Int, Int) -> Int
edad (a_dia,a_mes,a_año) (b_dia,b_mes,b_año) | (b_mes>a_mes) || ((b_dia>=a_dia) && (b_mes == a_mes)) = (b_año - a_año)
| not (b_mes>a_mes) && not((b_dia>=a_dia) && (b_mes == a_mes)) = (b_año - a_año -1)
(2) edad :: (Int, Int, Int) -> (Int, Int, Int) -> Int
edad (a_dia,a_mes,a_año) (b_dia,b_mes,b_año) | (b_mes>a_mes) || ((b_dia>=a_dia) && (b_mes == a_mes)) = (b_año - a_año)
| not ((b_mes>a_mes) || ((b_dia>=a_dia) && (b_mes == a_mes))) = (b_año - a_año -1)
Igual a los anteriores (Nueva versión mejorada(?)
edad1 :: (Int, Int, Int) -> (Int, Int, Int) -> Int
edad1 (a_dia,a_mes,a_año) (b_dia,b_mes,b_año) | (b_mes>a_mes) || ((b_dia>=a_dia) && (b_mes == a_mes)) = (b_año - a_año)
| otherwise = b_año - a_año - 1
{-n@no_maina-}
--me parecio una buena forma y muy general...sin usar muchas guardas
edad :: (RealFrac a, Integral b) => (a,a,a) -> (a,a,a) -> b
edad (d,m,a) (d',m',a') = floor (abs ((d/365 + m/12 + a) - (d'/365 + m'/12 + a')))
obtieneInterseccion
{-mdonati-}
--Obtiene la intersección entre la gráfica de una función cuadrática y una recta.
obtieneInterseccion :: (Float, Float) -> (Float, Float, Float) -> [(Float, Float)]
obtieneInterseccion (a1, b1) (a2, b2, c1)
| cuantasRaices (a, b, c) == 2 = [punto1, punto2]
| cuantasRaices (a, b, c) == 1 = [punto1]
| cuantasRaices (a, b, c) == 0 = error "Las gráficas no tienen punto de intersección."
where
a = a2
b = b2 + (-a1)
c = c1 + (-b1)
(x1, x2) = raicesCuadratica (a, b, c)
y1 = evaluaLineal x1 (a1, b1)
y2 = evaluaLineal x2 (a1, b1)
punto1 = (x1, y1)
punto2 = (x2, y2)
cuantasRaices :: (Float, Float, Float) -> Int
cuantasRaices (a, b, c)
| discriminante (a, b, c) > 0 = 2
| discriminante (a, b, c) == 0 = 1
| discriminante (a, b, c) < 0 = 0
discriminante :: (Float, Float, Float) -> Float discriminante (a, b, c) = b^2 - 4 * a * c
raicesCuadratica :: (Float, Float, Float) -> (Float, Float) raicesCuadratica (a, b, c) | a == 0 = error "La función no es cuadrática." | cuantasRaices (a, b, c) > 0 = ((((-b) + sqrt d) / 2 * a), (((-b) - sqrt d) / 2 * a)) | cuantasRaices (a, b, c) == 0 = error "La función no tiene raíces reales." where d = b^2 - 4 * a * c
evaluaLineal :: Float -> (Float, Float) -> Float evaluaLineal x (a, b) = ((a * x) + b)
Para usar Definiciones Locales
area
{Tomás Ferreyra}
area::Int->Int->Int->Int
area b h p = 2*frente+2*costado+2*tapa
where
frente = b*h
costado = p*h
tapa = b*p
raices
Divide y Conquista
pip
{-Mariano V-}
pip :: Int -> Bool
pip a | mod a 7 == 0 = True
| unidades a == 7 = True
| decenas a == 7 = True
| centenas a == 7 = True
| unidadesdemil a == 7 = True
| otherwise = False
– Se podria haber utilizado una sola linea pero de esta manera se entiende mejor
unidades :: Int -> Int
unidades a = mod a 10
decenas :: Int -> Int
decenas a = div (mod a 100) 10
centenas :: Int -> Int
centenas a = div (mod a 1000) 100
unidadesdemil :: Int -> Int
unidadesdemil a = div (mod a 10000) 1000
{-JDiaz-}
unidad :: Int -> Int
unidad n
| n >= 10000 || n < 0 = error "El valor debe ser mayor igual a 0 o menor a 10000"
| n < 10000 && n >= 0 = ( n - unidadDeMil n * 1000 ) - ( centena n * 100 ) - ( decena n * 10 )
decena :: Int -> Int
decena n
| n >= 10000 || n < 0 = error "El valor debe ser mayor igual a 0 o menor a 10000"
| n < 10000 && n >= 0 = div ( ( n - unidadDeMil n * 1000 ) - ( centena n * 100 ) ) 10
centena :: Int -> Int
centena n
| n >= 10000 || n < 0 = error "El valor debe ser mayor igual a 0 o menor a 10000"
| n < 10000 && n >= 0 = div ( n - unidadDeMil n * 1000 ) 100
unidadDeMil :: Int -> Int
unidadDeMil n
| n >= 10000 || n < 0 = error "El valor debe ser mayor igual a 0 o menor a 10000"
| n < 10000 && n >= 0 = div n 1000
pip :: Int -> Bool
pip n
| n >= 10000 || n < 0 = error "El valor debe ser mayor igual a 0 o menor a 10000"
| otherwise = mod n 7 == 0 || unidadDeMil n == 7 || centena n == 7 || decena n == 7 || unidad n == 7
{- Solución Menos Ortodoxa -}
pip' :: Int -> Bool
pip' n
| n >= 10000 || n < 0 = error "El valor debe ser mayor igual a 0 o menor a 10000"
| otherwise = mod n 7 == 0 || any (=='7') (show n)
recortaDia
{-LordHobborg-}
recortaDia :: [Char] -> [Char]
recortaDia xs | (semana xs)==True = [cabeza xs]
| (finde xs)==True = xs
semana :: [Char] -> Bool semana xs = xs==['l','u','n','e','s'] || xs==['m','a','r','t','e','s'] || xs==['m','i','e','r','c','o','l','e','s'] || xs==['j','u','e','v','e','s'] || xs==['v','i','e','r','n','e','s']
finde :: [Char] -> Bool finde xs = xs==['s','a','b','a','d','o'] || xs==['d','o','m','i','n','g','o']
{-mdonati-}
recortaDia :: [Char] -> [Char]
recortaDia xs
| esDeFinde xs = xs
| esDeSemana xs = [cabeza xs]
| otherwise = error "La lista de caracteres no contiene un dia de la semana."
esDeFinde :: [Char] -> Bool esDeFinde xs = xs == "domingo" || xs == "sabado"
esDeSemana :: [Char] -> Bool
esDeSemana xs = xs == "lunes" || xs == "martes" || xs == "miercoles" || xs == "jueves" || xs == "viernes"
{-Rebesgc-}
recortaDia :: [Char] -> [Char]
reortaDia [] = error "no hay día"
recortaDia (x:xs) |x=='l' && xs== "unes" = [x]
|x=='m' && (xs== "artes" || xs== "iercoles") = [x]
|x=='j' && xs== "ueves" = [x]
|x=='v' && xs== "iernes" = [x]
| otherwise = x:xs
otorgaBeca
{-Lord Hobborg-}
otorgaBeca :: (Int,Int,Int) -> String
otorgaBeca (x,y,z) | x<30 = menorDe30 (x,y,z)
| x>=30 = mayorDe30 (x,y,z)
menorDe30 :: (Int,Int,Int) -> String
menorDe30 (x,y,z) | z>15000 = ingresoMayor15000 (x,y,z)
| z<=15000 && y>=10000 = ingresoEntre15000y10000 (x,y,z)
| z<10000 = ingresoMenor10000 (x,y,z)
mayorDe30 :: (Int,Int,Int) -> String
mayorDe30 (x,y,z) | z>15000 = ingresoMayor15000' (x,y,z)
| z<=15000 && y>=10000 = ingresoEntre15000y10000' (x,y,z)
| z<10000 = ingresoMenor10000' (x,y,z)
ingresoMayor15000 :: (Int,Int,Int) -> String
ingresoMayor15000 (x,y,z) | y<=10 && y>8 = "Adecuado"
| y<=8 && y>6 = "Adecuado"
| y<=6 && y>4 = "Poco Adecuado"
| y<=4 && y>0 = "Poco Adecuado"
ingresoEntre15000y10000 :: (Int,Int,Int) -> String
ingresoEntre15000y10000 (x,y,z) | y<=10 && y>8 = "Muy Adecuado"
| y<=8 && y>6 = "Adecuado"
| y<=6 && y>4 = "Adecuado"
| y<=4 && y>0 = "Poco Adecuado"
ingresoMenor10000 :: (Int,Int,Int) -> String
ingresoMenor10000 (x,y,z) | y<=10 && y>8 = "Muy Adecuado"
| y<=8 && y>6 = "Muy Adecuado"
| y<=6 && y>4 = "Adecuado"
| y<=4 && y>0 = "Adecuado"
ingresoMayor15000' :: (Int,Int,Int) -> String
ingresoMayor15000' (x,y,z) | y<=10 && y>8 = "Adecuado"
| y<=8 && y>6 = "Poco Adecuado"
| y<=6 && y>4 = "Poco Adecuado"
| y<=4 && y>0 = "Poco Adecuado"
ingresoEntre15000y10000' :: (Int,Int,Int) -> String
ingresoEntre15000y10000' (x,y,z) | y<=10 && y>8 = "Adecuado"
| y<=8 && y>6 = "Adecuado"
| y<=6 && y>4 = "Poco Adecuado"
| y<=4 && y>0 = "Poco Adecuado"
ingresoMenor10000' :: (Int,Int,Int) -> String
ingresoMenor10000' (x,y,z) | y<=10 && y>8 = "Muy Adecuado"
| y<=8 && y>6 = "Adecuado"
| y<=6 && y>4 = "Adecuado"
| y<=4 && y>0 = "Poco Adecuado"
{-Drasky Vanderhoff -}
**Version Simplificada y Redefinible ( se le pueden agregar nuevos parametros sin realizar casi cambios a la funcion**
otorgaBeca :: (Int,Int,Int) -> String
otorgaBeca p@(x, y , z) | total p > 2 = "Muy Adecuado"
| total p == 2 = "Adecuado"
| total p < 2 = "Poco Adecuado"
where
total p = edad x + salario y + promedio z
edad :: Int -> Int
edad x | x < 30 = 1
| x >= 30 = 0
salario :: Int -> Int
salario x | x >= 15000 = (-1)
| x < 15000 && x > 10000 = 0
| x <= 10000 = 1
promedio :: Int -> Int
promedio x | x >= 8 = 2
| x < 8 && x >= 6 = 1
| x < 6 && x >= 4 = 0
| x < 4 = -1
Recursivos lineales
Aplicación
duplicar
{Tomás Frreyra}
duplicar :: [Int] -> [Int]
duplicar [] = []
duplicar (x:xs) = 2*x : duplicar xs
multiplicar
{-Lord Hobborg-}
multiplicar :: Int -> [Int] -> [Int]
multiplicar n [] = []
multiplicar n (x:xs) = (n*x): multiplicar n xs
esMultiploLista
{-mdonati-}
esMultiploLista :: Int -> [Int] -> [Bool]
esMultiploLista _ [] = []
esMultiploLista n (x:xs) = (x `mod` n == 0) : esMultiploLista n xs
Acumulación
longitud
{-Lord Hobborg-}
longitud :: [Int] -> Int
longitud [] = 0
longitud (x:xs) = 1 + longitud xs
sumatoria
{-SaNtY-}
sumatoria :: [Int] -> Int
sumatoria [] = 0
sumatoria (x:xs) = x + sumatoria xs
productoria
{-Lord Hobborg-}
productoria :: [Int] -> Int
productoria [] = 1
productoria (x:xs) = x * (productoria xs)
sumaPares
{-Lord Hobborg-}
sumaPares :: [(Int,Int)] -> Int
sumaPares [] = 0
sumaPares ((x,y):xs) = x+y+ sumaPares xs
concatenaInt
{-mdonati-}
concatenaInt :: [[Int]] -> [Int]
concatenaInt [[]] = []
concatenaInt [] = []
concatenaInt ([]:xss) = concatenaInt xss
concatenaInt ((x:xs):xss) = x : concatenaInt (xs:xss)
?? Gracias!! concatenaInt' :: [[Int]] -> [Int] concatenaInt' [] = [] concatenaInt' (xs:xss) = xs ++ concatenaInt' xss
(nicolasw) Y usando++, no sale más corto? Fijate que le falta un caso porqueconcatenaInt []tira error.
todos0y1
{-Lord Hobborg-}
todos0y1 :: [Int] -> Bool
todos0y1 [] = True
todos0y1 (x:xs) = (x==0 || x==1) && todos0y1 xs
todosA
todosMenores10
hay0
{-Lord Hobborg-}
hay0 :: [Int] -> Bool
hay0 [] = False
hay0 (x:xs) = x==0 || hay0 xs
Filtros
soloPares
{-EES-}
solopares :: [Int] -> [Int]
solopares [] = []
solopares (x:xs) | mod x 2 == 0 = x : solopares xs
| otherwise = solopares xs
quitar0s
{-Lord Hobborg-}
quitar0s :: [Int] -> [Int]
quitar0s [] = []
quitar0s (x:xs) |x==0 = quitar0s xs
|x/=0 = x : quitar0s xs
soloMultiplos
{-Lord Hobborg-}
soloMultiplos :: Int -> [Int] -> [Int]
soloMultiplos n [] = []
soloMultiplos n (x:xs) |x `mod` n == 0 = x : soloMultiplos n xs
|x `mod` n /= 0 = soloMultiplos n xs
ningunfalse
(-NeRoN-) ningunfalse :: [Bool] -> [Bool] ningunfalse [] = [] ningunfalse (x:xs) | cabeza (x:xs) == True = x : ningunfalse xs | otherwise = ningunfalse xs
Misceláneas
desdeHasta
{-mdonati-}
desdeHasta :: Int -> Int -> [Int]
desdeHasta n m | n < m = n : desdeHasta (n+1) m
| n > m = n : desdeHasta (n-1) m
| n == m = n : []
ultimo
{-mdonati-}
ultimo :: [a] -> a
ultimo [] = error "La lista no contiene elementos."
ultimo [x] = x
ultimo (x:xs) = ultimo xs
(nicolasw) Notar que el caso base es la lista con un solo elemento.
inicio
{-mdonati-}
inicio :: [a] -> [a]
inicio [] = error "La lista no contiene elementos."
inicio (x:xs) | longitud' xs == 0 = []
| otherwise = x : inicio xs
longitud' :: [a] -> Int longitud' [] = 0 longitud' (x:xs) = 1 + longitud' xs
(nicolasw) Mhhh,inicioes aultimo, comocolaes acabeza, es decir suelen ser códigos similares.
repetir
{- EES -}
rep :: Int -> Int -> [Int]
rep m n | m == 1 = [n]
|otherwise = n : rep (m-1) n
(nicolasw) Como harías para que funcionerep 0 5, o se que pido 0 repeticiones de algo?
{-Lord Hobborg-}
repetir :: Int -> a -> [a]
repetir 0 x = [] --(¿esta forma responde la pregunta de Nico?)
repetir n x = x:repetir (n-1) x
{-SaNtY-}
repetir :: Int -> a -> [a]
repetir 0 x = []
repetir n x | n<0 = [x] ++ repetir (-n-1) x
| n>0 = [x] ++ repetir (n-1) x --esta bien si repetir d n<0 es repetir para (-n)??
reversa
{-mdonati-}
reversa :: [Int] -> [Int]
reversa [] = []
reversa xs = ultimo xs : reversa (inicio xs)
(nicolasw) Y como seríareversausando pattern matching y sin usar ninguna función auxiliar?
{-Lord Hobborg-}
reversa :: [Int] -> [Int] --(¿esta forma responde la pregunta de Nico?)
reversa [] = []
reversa (x:xs) = reversa xs ++ [x]
ordenada
{-mdonati-}
ordenada :: [Int] -> Bool
ordenada [] = error "La lista no contiene elementos."
ordenada [x] = True -- Si nos queda un solo elemento por analizar, entonces la lista está ordenada
ordenada (x:y:xs) | x > y = False -- x es mayor que y, no hay mas nada que analizar, devuelve falso
| x <= y = ordenada (y:xs) -- caso recursivo
{-Lord Hobborg-}
ordenada :: [Int] -> Bool
ordenada [] = True
ordenada (x:y:xs) = x<=y && ordenada (y:xs)
ordenada (x:xs) = True --(es importante que este caso esté después de x:y:xs, sinó
-- la func. siempre tira True apenas vé que la lista tiene un elemento)
aBinario
{-mdonati-}
aBinario :: Int -> [Int]
aBinario 0 = [0]
aBinario n | n == 1 = n : []
| otherwise = resto : aBinario cociente
where
resto = n `mod` 2
cociente = n `div` 2
{-Lord Hobborg-}
aBinario :: Int -> [Int]
aBinario 0 = [0]
aBinario 1 = [1]
aBinario n |n `mod` 2==1 = 1: aBinario (n `div` 2)
|n `mod` 2==0 = 0: aBinario (n `div` 2)
LH: A ver si entendí, ¿lo que hace esta función es pasar un nº a binario, patas para arriba? De paso, ¿hay forma de hacer aBinario sin que devuelva la lista al revés?
(nicolasw) Eso, está “patas para arriba” porque asi la función sale mucho más fácil. Fijense que se puede mejorar y eliminar los casos en el paso inductivo, ya quen `mod` 2ya es 0 o 1! Idem a los “trucos” que hacíamos con los booleanos.
{-Lord Hobborg-}
aBinario :: Int -> [Int]
aBinario 0 = [0]
aBinario 1 = [1]
aBinario n = (n `mod` 2): aBinario (n `div` 2)
LH: Ahí estaría la función mejorada. Pero ahora que me fijo, es una copia textual de la forma de mdonati…
(nicolasw) Tanto esta versión como la de mdonatti, pueden ser reducidas a 1 sólo caso base si aceptamos queaBinario 0 = [].
deBinario
{-mdonati-}
deBinario :: [Int] -> Int
deBinario [0] = 0
deBinario [] = 0
deBinario (x:xs) = x * (2 ^ (longitud (x:xs) - 1)) + deBinario xs
(nicolasw) Esta es una implementación correcta pero poco eficiente, pues para cada elemento de la lista se calcula nuevamente toda lalongitud. ?Cómo se podría hacer para no necesitar longitud y que calcule lo mismo? Ayuda: pensar en una funciónacumulador'que tome 2 parámetros, donde el 1ro es la longitu hasta ahora recorrida.
(nicolasw) Perdón perdón! Esta implementación está al revés, es decir quedeBinario [1,0,0] = 4y nosotros pedimos quedeBinario [1,0,0] = 1, o sea el bit menos significativo es la cabeza de la lista, contrario a como usualmente se escriben los números binarios. Con esto la función sale chiquitita.
Generalizando los recursivos
Aplicaciones (map)
mapNumeros
{-Lord Hobborg-}
mapNumeros :: (Int -> Int) -> [Int] -> [Int]
mapNumeros f [] = []
mapNumeros f (x:xs) = (f x): mapNumeros f xs
mapNumeroString
map
{-Lord Hobborg-}
mapa :: (a -> b) -> [a] -> [b]
mapa f [] = []
mapa f (x:xs) = f x : mapa f xs
Filtros (filter)
filtraNumeros
{-Lord Hobborg-}
filtraNumeros :: (Int -> Bool) -> [Int] -> [Int]
filtraNumeros f [] = []
filtraNumeros f (x:xs) | f x = x : filtraNumeros f xs
| otherwise = filtraNumeros f xs
filtro
{-Lord Hobborg-}
filtro :: (a -> Bool) -> [a] -> [a]
filtro p [] = []
filtro p (x:xs) | p x = x : filtro p xs
| otherwise = filtro p xs
Acumuladores (fold)
concatena
{-Lord Hobborg-}
concatena :: [[a]] -> [a]
concatena = acumula (++) []
LH: acumula está definido más abajo
paraTodoInt
{-Lord Hobborg-}
paraTodoInt :: (Int -> Bool) -> [Int] -> Bool
paraTodoInt f [] = True
paraTodoInt f (x:xs) = f x && paraTodoInt f xs
LH: Una versión más grossa sería:
paraTodoInt :: (Int -> Bool) -> [Int] -> Bool paraTodoInt f xs = acumula (&&) True (mapa f xs)
mapa :: (a -> b) -> [a] -> [b] mapa f [] = [] mapa f (x:xs) = f x : mapa f xs
acumulaInt
acumulaBool
acumula
{-Lord Hobborg-}
acumula :: (a -> b -> b) -> b -> [a] -> b
acumula f z [] = z
acumula f z (x:xs) = f x (acumula f z xs)
Recursivos en dos argumentos
iguales
{-EES-}
igual :: [Int] -> [Int] -> Bool
igual [][] = True
igual (x:xs)[] = False
igual [] (x:xs) = False
igual (x:xs) (y:ys) | x==y && igual xs ys = True
| otherwise = False
{-Lord Hobborg-}
iguales :: [Int] -> [Int] -> Bool
iguales [] [] = True
iguales [] _ = False
iguales _ [] = False
iguales (x:xs) (y:ys) = x==y && iguales xs ys
encuentraEstafador
LH: Acá pongo tres versiones distintas y el rendimiento de cada una (¡fíjense qué abuso como cambia!)
{-Lord Hobborg-}
encuentraEstafador :: [Int] -> [Int] -> [Int] -- ### Ésta es la versión gratuita que nos dieron en la clase
encuentraEstafador [] _ = [] -- ### y como suele pasar con todo lo que es gratis, es la peor
encuentraEstafador (x:xs) ys | existe (==x) ys = x : encuentraEstafador xs ys
| otherwise = encuentraEstafador xs ys
encuentraEstafador' :: [Int] -> [Int] -> [Int] -- ### Ésta es la versión que aprovecha que las listas están ordenadas
encuentraEstafador' (x:xs) (y:ys) | x==y = x : encuentraEstafador' xs ys
| x>y = encuentraEstafador' (x:xs) ys
| x<y = encuentraEstafador' xs (y:ys)
encuentraEstafador' _ _ = []
encuentraEstafador'' :: [Int] -> [Int] -> [Int] -- #### Y esta versión tiene la única ventaja de no repasar lo que ya vió
encuentraEstafador'' (x:xs) (y:ys) | existe (==x) (y:ys) = x : encuentraEstafador'' xs ys
| otherwise = encuentraEstafador'' xs (y:ys)
encuentraEstafador'' _ _ = []
Los rendimientos para calcular los estafadores en [1..100] [90..190] son: 3º Puesto: encuentraEstafador con (51440 reductions, 62549 cells) 2º Puesto: encuentraEstafador'' con (51165 reductions, 62597 cells)... Apenas mejor a la anterior 1º Puesto: encuentraEstafador' con (4498 reductions, 6029 cells) ¡¡¡Usa tan sólo el 8,79 % de las "reductions" (sean lo que sean) que usó encuentraEstafador''!!!
Drasky Vanderhoff : Si intercambias la posicion de x > y por x < y obtenes una pequeña mejora adicional , la posicion del caso base no afecta en nada a mi me parece
{-Drasky Vanderhoff-}
--encuentraEstafador
encuentraEstafador :: [Int] -> [Int] -> [Int]
encuentraEstafador [] _ = []
encuentraEstafador (x:xs) (y:ys) | x == y = x : encuentraEstafador xs ys
| x < y = encuentraEstafador xs (y:ys)
| x > y = encuentraEstafador (x:xs) ys
cerrar2
{-mdonati-}
cerrar2 :: [Int] -> [Int] -> [(Int, Int)]
cerrar2 _ [] = []
cerrar2 [] _ = []
cerrar2 (x:xs) (y:ys) = (x, y) : cerrar2 xs ys
tomar
{-EES-}
tomar :: Int -> [Int] -> [Int]
tomar n [] = []
tomar n (x:xs) | n == 0 = []
| n <= longitud (x:xs) = x : tomar (n-1)(xs)
| otherwise = x:xs
{-mdonati-}
tomar :: Int -> [Int] -> [Int]
tomar 0 _ = []
tomar _ [] = []
tomar n (x:xs) | n < 0 = []
| n > 0 = x : tomar (n-1) xs
tirar
{-mdonati-}
tirar :: Int -> [Int] -> [Int]
tirar _ [] = []
tirar 0 xs = xs
tirar n (x:xs) | n < 0 = (x:xs)
| n > 0 = tirar (n-1) xs
{-EES-}
tirar :: Int -> [Int] -> [Int]
tirar 0 [] = []
tirar 0 (x:xs) = x:xs
tirar n (x:xs) | longitud (x:xs) > n = tirar (n-1) xs
| otherwise = []
(nicolasw) Notar las diferencias entre ambos algoritmos. ?Funcionan igual?
Si suponemos que 0⇐n, como quedaría?
nEsimo
{-mdonati-}
nEsimo :: Int -> [Int] -> Int
nEsimo _ [] = error "La función no está definida para estos parámetros."
nEsimo n (x:xs) | n < 0 = error "La función no está definida para estos parámetros."
| n == 0 = x
| n > 0 = nEsimo (n-1) xs
{-Lord Hobborg-}
nEsimo :: Int -> [Int] -> Int
nEsimo n [] = error "Mirá bien, ahí no hay nada"
nEsimo n xs = sacarLista (take 1 (drop n xs))
where sacarLista :: [Int] -> Int
sacarLista [x] = x
LH: esta forma de arriba es vueltera al vicio, pero me resultó graciosa
{-Lord Hobborg-}
nEsimo' :: Int -> [Int] -> Int
nEsimo' _ [] = error "Ahí no hay nada, gil"
nEsimo' 0 (x:xs) = x
nEsimo' (n+1) (x:xs) = nEsimo' n xs -- Para el caso n<0 dejo que salte error solo
-- (sigo la regla de la entropía: gastar la menor energía posible)
mezclaOrdenada
{-EES-}
mezcla :: [Int] -> [Int] -> [Int]
mezcla [] [] = []
mezcla (x:xs)[] = x:xs
mezcla [](y:ys) = y:ys
mezcla (x:xs)(y:ys) | ordenada (x:xs) == True && ordenada (y:ys) == True && x <= y = x : mezcla xs (y:ys)
| ordenada (x:xs) == True && ordenada (y:ys) == True && y <= x = y : mezcla (x:xs) ys
| otherwise = error "una de las 2 listas no esta ordenada"
(nicolasw) No es necesario en absoluto testear de que ambas listas estenordenadas, esto es una precondición del algoritmo, algo asi como un contrato.
{-Lord Hobborg-}
mezclaOrdenada :: [Int] -> [Int] -> [Int]
mezclaOrdenada [] [] = []
mezclaOrdenada [] xs = xs
mezclaOrdenada xs [] = xs
mezclaOrdenada (x:xs) (y:ys) | x<=y = x:mezclaOrdenada xs (y:ys)
| x>y = y:mezclaOrdenada (x:xs) ys
Para componer
capicua
{-Lord Hobborg-}
capicua :: [Int] -> Bool
capicua xs = iguales xs (reverse xs) -- iguales lo defino abajo
iguales :: Eq a => [a] -> [a] -> Bool iguales (x:xs) (y:ys) = x==y && (iguales xs ys) iguales [] [] = True iguales _ _ = False
hay0'
{-Lord Hobborg-}
hay0' :: [Int] -> Bool
hay0' xs = 0<length (filter (==0) xs)
duplicar', multiplicar'
{-Lord Hobborg-}
multiplicar' :: Int -> [Int] -> [Int]
multiplicar' n = map (*n)
sumatoria, soloPares, hay0
{-Lord Hobborg-}
sumatoria :: [Int] -> Int
sumatoria = foldr (+) 0
{-Lord Hobborg-}
soloPares :: [Int] -> Bool
soloPares xs = foldr (&&) True (map esPar xs)
where
esPar :: Int -> Bool
esPar x = x `mod` 2==0
{-Lord Hobborg-}
hay0'' :: [Int] -> Bool
hay0'' [] = False
hay0'' xs = foldr (||) False (map (==0) xs)
insertaOrd, ordenaIns
{-Lord Hobborg-}
insertaOrd :: Int -> [Int] -> [Int]
insertaOrd y (x:xs) | y>=x = x:insertaOrd y xs
| y<x = y:(x:xs)
insertaOrd y _ = [y]
{-Lord Hobborg-}
ordenaIns :: [Int] -> [Int]
ordenaIns (x:xs) = insertaOrd x (ordenaIns xs)
ordenaIns _ = []
partir, odenaMez
ordenada'
permutacion
{-Lord Hobborg-}
permutacion :: [Int] -> [Int] -> Bool -- Tiene más vueltas que un espiral. Lo que falta lo defino abajo, excepto iguales, que por ahí (^ ó v) andaba
permutacion xs ys = iguales (ordenaIns xs) (ordenaIns ys)
{-Lord Hobborg-}
ordenaIns :: [Int] -> [Int]
ordenaIns (x:xs) = insertaOrd x (ordenaIns xs)
ordenaIns _ = []
{-Lord Hobborg-}
insertaOrd :: Int -> [Int] -> [Int]
insertaOrd y (x:xs) | y>=x = x:insertaOrd y xs
| y<x = y:(x:xs)
insertaOrd y _ = [y]
primo
primosHasta
Para lucirse
potencia2
{-Cancu-}
potencia2 :: Int -> Int
potencia2 0 = 1
potencia2 n | n == 1 = 2 + potencia2 (n-1) - 1
| n >= 2 = potencia2 (n-1) + potencia2 (n-1)
(nicolasw) Se puede hacer en 2 líneas, caso base y caso recursivo …
{-Cancu-}
correcto potencia2 :: Int -> Int potencia2 0 = 1 potencia2 n = potencia2 (n-1) + potencia2 (n-1)
trianguloPascal
(nicolasw) ?Algun/a valiente?
{-Lord Hobborg-}
trianguloPascal :: Int -> [[Int]] -- Sólo porque Nico lo pidió. Detalles (casi) insignificantes: es menos eficiente que la
trianguloPascal 0 = [[1]] -- (sí, eso) ¡Pero andar anda!
trianguloPascal n = (map (combi n) (m n)):trianguloPascal (n-1)
where
m :: Int -> [Int]
m 0 = [0]
m n = n:m (n-1)
{-Lord Hobborg-}
fac :: Int -> Int
fac 0 = 1
fac n = n*(fac (n-1)) -- Por cierto, no funcionaba con Int sino Float hasta que alguien me dijo que la línea de combi:
-- "(fac n)/((fac (n-m))*(fac m))" se podía escribir como "(fac n) `div` ((fac (n-m))*(fac m))"
{-Lord Hobborg-} -- Y todo el mundo feliz
combi :: Int -> Int -> Int
combi n m | n>=m = (fac n) `div` ((fac (n-m))*(fac m))
| n<m = error "El primer parámetro siempre debe ser > ó = al segundo en una combinatoria"
ordenaQuick
{-Cancu-}
menor :: Int -> [Int] -> [Int]
menor n [] = []
menor n (x:xs) | n >= x = x : menor n xs
| n < x = menor n xs
mayor :: Int -> [Int] -> [Int]
mayor n [] = []
mayor n (x:xs) | n < x = x : mayor n xs
| n >= x = mayor n xs
ordenaQuick :: [Int] -> [Int]
ordenaQuick [] = []
ordenaQuick (x:xs) = ordenaQuick (menor x xs) ++ [x] ++ ordenaQuick (mayor x xs)
criba
longitud
{-Lord Hobborg-} -- \
longitud :: [a] -> Int -- |
longitud xs = acumula (+) 0 (mapa transformaEn1 xs) -- | Forma
-- |
transformaEn1 :: a -> Int -- | mía
transformaEn1 x = 1 -- |
-- /
-- \
longitud' :: [a] -> Int -- | Forma
longitud' = acumula f 0 -- | de
where f :: a -> Int -> Int -- | Nico (sí el profe)
f x n = 1 + n -- /
iguales, reverse
{-Lord Hobborg-}
reverse :: [a] -> [a]
reverse = acumula g []
where g :: a -> [a] -> [a]
g x xs = xs ++ [x]
map, filtro
{-Drasky Vanderhoff-]
{-En esta version no hay necesidad de colocar un where para definir una segunda funcion , utilizando lamda (\) se puede definir una mini funcion
interna por asi decirlo ( \x -> (f x :)), gracias a esto casi todos los ejercicios de generalizacion son practicamente iguales! -}
--mapa
mapa :: (a -> b) -> [a] -> [b]
mapa f = acumulador ( \x -> (f x :)) []
--filtro
filtro :: (a -> Bool) -> [a] -> [a]
filtro f (x:xs) | f x = acumulador (\x -> (x:)) [] xs
{-Trate de currificarla pero no pude -.- si alguien sabe como se agradeceria mucho que lo suba! :-D -}
{-Tomás Ferreyra-}
{-A continuaciónb definiré map y filtro en función de acumula-}
acumula::(a->b->b)->b->[a]->b
acumula f z []=z
acumula f z (x:xs)=f x (acumula f z xs)
--MAP (Como en el preludio de Hugs está definido map, definiré "mapa")
mapa::(a->b)->[a]->[b]
mapa f = acumula q []
where q m xs = f m:xs
--FILTRO
filtro::(a->Bool)->[a]->[a]
filtro p = acumula l []
where l m xs | p m = m : xs
(nicolasw) FIjate que sip mno vale, da un pattern matching failure, bueno no exactamente pero ese es el problema.
(Tomás Ferreyra) Eso es verdad, pido mil disculpas, la función correcta seríafiltro::(a->Bool)->[a]->[a] filtro p = acumula l [] where l m xs | p m = m : xs | otherwise = xs
LH: cuando definimos map en función de acumula de la siguinte forma, que al ojo humano parece correcta, Hugs tira un error que es el siguiente:
{-Lord Hobborg-}
map' :: (a->b) -> [a] -> [b]
map' f xs = foldr g [] xs
where
g :: a -> [b] -> [b]
g x xs = f x : xs
Hugs.Base> :l 1.hs ERROR "1.hs":5 - Inferred type is not general enough *** Expression : g *** Expected type : a -> [b] -> [b] *** Inferred type : _15 -> [_10] -> [_10]
LH: resulta que Haskell encuentra un error en el tipo de g, como si no fuera “lo suficientemente general”. Pero si omito el tipo de g y dejo que Hugs lo infiera por sí mismo todo anda de las mil maravillas:
{-Lord Hobborg-}
map' :: (a->b) -> [a] -> [b] -- Es igual a la forma de T. Ferreyra, que funciona perfectamente
map' f xs = foldr g [] xs
where
g x xs = f x : xs
LH: parece rara la cosa, porque “_15 → [_10] → [_10]” es en teoría lo mismo que “a → [b] → [b]”. ¿Qué pasa entonces, por qué Hugs se queja? Le pregunté al Nico, quien conversó el tema con Javier, y la respuesta en bruto que saltó fue la siguiente: JavierB.- Creo que lo que ocurre es que las variables de tipo a y b del tipo de 'g' no son las mismas que las del tipo de map'. Para el type checker es como si hubieras declarado “map´ :: (c → d) → [c] → [d]” Fijate que declarando asi (pero dejando 'g' intacto) da el mismo mensaje de error. El error existe ya que 'g' no puede ser de tipo “a → [b] →[b]” pues “f :: c → d” se usa en la definicion de 'g' y por lo tanto infiere un tipo menos general que el declarado. (En realidad, internamente el type checker no le asocia el tipo “c → d” sino “_15 → _10”, según el mensaje de error que tuviste). Pero para “arreglar” el problema planteado, lo que podes hacer es “ligar” a y b con las originales, por ejemplo decorando f con su tipo:
map' :: (a->b) -> [a] -> [b]
map' (f::a->b) xs = foldr g [] xs
where
g :: a -> [b] -> [b]
g x xs = f x : xs
LH: fíjense como llamó a f, “decorandola” con su tipo. Y resulta que sí, esto resuelve el problema.
