Wiki de Scripts Haskell

Esta página Wiki es editable por cualquiera. La idea es poner pedazos de código Haskell con los programas que vayamos haciendo o nos parezcan interesantes.

A manera de inicio contribuyo con un Haskell script que contiene algunas definiciones del Capítulo 8 de “Extracto del Cálculo de Programas”

Programa
-- 8.2 Definiciones

-- El numero pi esta definido en Hugs.Prelude.pi, o sea en el "preludio"
--pi = 3.141592657
cuadrado x = x * x
area r = pi * cuadrado r
 
-- Expresiones ... hay que evaluarlas


-- 8.3 Reglas para el calculo con definiciones

-- Composicion de funciones
hyperCubo x = x * x * x * x
hyperCubo' x = (cuadrado.cuadrado) x
-- Notacion infija
hyperCubo'' x = ((.) cuadrado cuadrado) x


-- 8.4 Definiciones locales
raiz1 a b c = (-b - sqrt disc) / (2*a)
        where
        disc = cuadrado b - 4*a*c


-- 8.5 Analisis por casos
max a b | a<=b = b
        | b<=a = a

fac n   | n==0 = 1
        | n/=0 = n*fac (n-1)

n b     | b     = 1
        | not b = 0


-- 8.6 Pattern Matching
fac' 0    = 1
fac' (n+1) = (n+1) * fac' n


-- 8.7 Tipos, 8.8 Tipos basicos

-- Booleano
verdad :: Bool
verdad = True || (False && not True)

-- Entero
respuesta :: Int
respuesta = 42

-- Caracter
inicial :: Char
inicial = 'I'

-- Cadena de caracteres
materia :: String
materia = "Introduccion a los Algoritmos"

-- Funcion
sumar :: Int -> Int -> Int
sumar x y = x+y
-- Funcion polimorfica
id :: a -> a
id x = x

-- 8.9 Tuplas
sumRat :: (Int,Int) -> (Int,Int) -> (Int,Int)
sumRat (a,b) (c,d) = (a*d+b*c , b*d)
 

-- 8.10 Listas
notas :: [Int]
notas = [4, 7, 8, 4, 2, 5, 7]

alumnos :: [String]
alumnos = ["Cabanillas", "Egea", "Berlin", "Tamburrini", "Rodriguez", "Biasi", "Ferme"]

rara :: [Int]
rara = length alumnos : notas!!0 : notas ++ [2,2,2]

'Pablo Zurita'

Mi solución es similar a las anteriores con la diferencia que chequea la validez de los datos y le da un mensaje de error útil al usuario en caso de dar algun dato incorrecto.

 edad :: (Int, Int, Int) -> (Int, Int, Int) -> Int
 edad (d, m, a) (d', m', a')	| 12 < m || 12 < m' || m < 1 || m' < 1 = error "El mes no es valido."
			| ([31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31] !!(m - 1)) < d = error "El dia del mes inicial no es valido."
			| ([31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31] !!(m' - 1)) < d' = error "El dia del mes final no es valido."
			| a < 0 || a' < a = error "El año inicial es menor que cero o menor que el año final."
			| a == a' && m' < m = error "Mismo año pero el mes inicial es mayor que el final."
			| a == a' && m' == m && d' < d = error "Mismo mes y año pero dia inicial mayor que el final."
			| (m' < m) || (m' == m && d' < d) = (a'-a)-1  -- No alcanza a completar un año.
			| otherwise = a'-a  -- Ningun caso especial, resta directa.

'Nico Visintin'

 edad :: (Int, Int, Int) -> (Int, Int, Int) -> Int
 edad (d,m,a) (d',m',a')      |m'<m	= a'-a-1
			|m'>m	= a'-a
			|m'==m && d'>=d	= a'-a
			|m'==m && d'<d	= a'-a-1

'Pedro A.'

Pues yo propongo dos soluciones, iguales pero a su vez distintas. La única diferencia es que en una solamente contemplo un caso, ya que si no ocurre ese caso, pues, ocurre el caso contrario. Y en la segunda, pues analizo dos casos, la diferencia es que no posee la estructura del if. Ambas poseen una combinación de operadores lógicos.

 edad' :: (Int,Int,Int) -> (Int,Int,Int) -> Int
 edad' (d,m,y) (d',m',y') = if m < m' || (m == m' && d <= d') then y' - y
                             else y' - y - 1

 edad :: (Int,Int,Int) -> (Int,Int,Int) -> Int
 edad (d,m,y) (d',m',y') | (m < m' || (m == m' && d <= d')) = y' - y
                         | (m > m' || (m == m' && d > d')) = y' - y - 1

(José Neder) Este es mas lindo a la vista:

edad :: (Int, Int, Int) → (Int, Int, Int) → Int edad (x,y,z) (o,p,q) | y<p||(y==p&&x<o) = q-z

		| otherwise = q-z-1

Usando definiciones locales y calculando bien el área de los laterales (N. Wolovick)

area :: Int -> Int -> Int -> Int
area h b d = 2*frente + 2*lado + 2*arriba
      where
             frente = h*b
             lado = h*d
             arriba = b*d

'Nico Visintin'

area :: (Int, Int, Int) -> Int
area (h,b,d)	|h >=0 && b >=0 && d>=0 = 2*h*b + 2*h*d + 2*b*d

area' :: (Int, Int, Int) -> Int
area' (h,b,d) = 2*h*b + 2*h*d + 2*b*d

Cierto… Habia calculado mal el area de cada lado…

cabeza :: [Int] -> Int
cabeza [a]  = a
cabeza (x:xs)  = x

Creeria que esta bien, saludos a todos

(nwolovick) Fijate que el primer caso es redundante con el segundo, pues [a]=a:[], luego se puede eliminar sin problemas.

Vinsanity

Hasta 10000

pip :: Int -> Bool
pip n = mod n 7==0 || mod n 10==7 || div (mod n 100) 10==7 || div (mod n 1000) 100==7 || div n 1000==7

(nwolovick) Fijate que podés ganar legibilidad usando definiciones locales y notación infija:

pip' :: Int -> Bool
pip' n = n `mod` 7==0 || unidades==7 || decenas==7 || centenas==7 || unidadesDeMil==7
        where
                unidades        = n `mod` 10
                decenas         = (n `div` 10) `mod` 10
                centenas        = (n `div` 100) `mod` 10
                unidadesDeMil   = (n `div` 1000) `mod` 10

(PabloZ) Hay que validar la información y en caso que sea un valor no valido hay que darle al usuario un mensaje de error que pueda entender.

pip :: Int -> Bool
pip n	| n < 0 = error "Valor no valido, usar cualquier natural."
        | n >= 10000 = error "Valor no valido, usar naturales menores que 10000."
        | mod n 7 == 0 || unidades == 7 || decenas == 7 || centenas == 7 || miles == 7 = True
        | otherwise = False
        where
                unidades        = n `mod` 10
                decenas         = (n `div` 10) `mod` 10
                centenas        = (n `div` 100) `mod` 10
                miles   		= (n `div` 1000) `mod` 10

Y las probé usando

Main> map pip [0..9999] == map pip' [0..9999]
True

Teoricamente para cualquier numero.

pip2 :: Int -> Bool
pip2 n = mod n 7==0 || digall 7 (digi n)
	where	digall :: Int -> [Int] -> Bool
	digall n [x] = x==n
	digall n (x:xs) = x==n || digall n xs
	digi :: Int -> [Int]
	digi x	| x<10 && x>=0 = [x]
		| x>10 = digi (div x 10) ++ [mod x 10]

José Neder

¿Asi estara mal? Primero defini unmil, centena, decena y unidad

unmil :: Int -> Int
unmil x  | 999<x && x<10000 = x`div`1000
         | otherwise = 0
        
centena :: Int -> Int
centena x | 999<x && x<10000 = (x`mod`1000)`div`100
          | 99<x && x<1000   = x`div`100
          | otherwise = 0           

decena :: Int → Int

decena x  | 999<x && x<10000 = ((x`mod`1000)`mod`100)`div`10
          | 99<x && x<1000   = (x`mod`100)`div`10
          | 9<x && x<100     = x`div`10
          | otherwise = 0

unidad :: Int -> Int
unidad x  | 999<x && x<10000 = ((x`mod`1000)`mod`100)`mod`10
          | 99<x && x<1000   = (x`mod`100)`mod`10
          | 9<x && x<100     = x`mod`10  
          | 0<=x && x<10     = x

pip :: Int → Bool

pip x   | x`mod`7 == 0 = True
        | (unmil x) == 7 || (centena x) == 7 || (decena x) == 7 || (unidad x) ==7  =  True
        | otherwise  = False

cabeza :: [Int] -> Int
cabeza [a]  = a
cabeza (x:xs)  = x

ahora si, disculpen :p

Vinsanity

(José Neder) No hace falta aclarar ¨cabeza [a] = a¨ ya que [a] = a:[]

cabeza :: [a] -> a
cabeza (x:xs) = x

cola :: [a] -> [a]
cola (x:xs) = xs

ó

cabeza :: [a] -> a
cabeza (x:_) = x

cola :: [a] -> [a]
cola (_:xs) = xs

(nwolovick) Esto es usando el “Comodín” o variable anónima _.

(PabloZ) Hay que validar la información y en caso que sea un valor no valido hay que darle al usuario un mensaje de error que pueda entender.

cabeza :: [a] -> a
cabeza [] = error "La lista no puede estar vacia."
cabeza (x:xs) = x

cola :: [a] -> [a]
cola a | length a == 0 = error "La lista no puede estar vacia."
cola (x:xs) = xs

-Creeria que es asi

2*cuadrado.(cabeza.[2,4,5,6,7,8])
2*cuadrado.(cabeza.(2:[4,5,6,7,8]))
2*cuadrado.2
2*(2*2)
2*4
8

José Neder

Todo excepto el ultimo elemento

inicio :: [a] -> [a]
inicio [x] = []
inicio (x:xs) = x : inicio xs

El ultimo elemento

ultimo :: [a] -> a
ultimo [x] = x
ultimo (x:xs) = ultimo xs

José Neder

====== Yo lo pense de esta forma no se si estara bien…. :S

inicio :: [a] -> [a]
inicio(x:xs) = reverse ( cola ( reverse (x:xs)))

lo que hice es dar vuelta la lista tomar la cola -que ya estaba definida-( osea todo menos el primer elemento, que es el ultimo de la lista original) y aplicarle reverse para que vuelva a su estado normal… jeje…

ultimo :: [a] -> a
ultimo (x:xs) = cabeza (reverse (x:xs))

como cabeza ya estaba definida y reverse esta en el prelude… Andrés… ahh me olvide poner un msj de error si la lista es vacia… seria asi en los dos casos

inicio/ultimo [] = error "lista vacia" ======

Duplica todos los enteros de una lista de enteros

duplicar :: [Int] -> [Int]
duplicar [] = []
duplicar (x:xs) = x*2 : duplicar xs

Si se quiere en racionales(no periodicos)

duplicar :: [Float] -> [Float]
duplicar [] = []
duplicar (x:xs) = x*2 : duplicar xs

tambien se puede hacer general a todos los tipos de numeros:

duplicar :: Num a => [a] -> [a]
duplicar [] = []
duplicar (x:xs) = x*2 : duplicar xs

José Neder

Esto va aca

Anaconda Express

multiplicar :: [Int] -> Int -> [Int]
multiplicar [] a = []
multiplicar (x:xs) a = x*a : multiplicar xs a

Igual pero para racionales

multiplicar :: [Float] -> Float -> [Float]
multiplicar [] a = []
multiplicar (x:xs) a = x*a : multiplicar xs a

y general

multiplicar :: Num a => [a] -> a -> [a]
multiplicar [] a = []
multiplicar (x:xs) a = x*a : multiplicar xs a

José Neder

'Walter Alini'

Acá se me ocurre usar una función de longitud de lista propia, pero que devuelva un Float en vez de un Int, para después poder usarla en la definición de promedio (esto es porque no existe una función de conversión -aka casteo- de Int a Float):

longitud :: [A] -> Float
longitud [] = 0
longitud (x: xs) = 1 + longitud xs

Ahora sí podemos hacer la función multiplicar, que tendrá la siguiente signatura (la definición queda como ejercicio para el lector);

promedio :: [Float] -> Float

Otra idea sería hacer nuestra propia función que pase de Int a Float:

int2Float :: Int -> Float
int2Float = fromIntegral

Entonces, podemos usar, cada vez que necesitemos la longitud de una lista (pero como un Float):

int2Float(length xs)

en vez de:

(length xs)

sumatoria :: Num a => [a] -> a
sumatoria [] = 0
sumatoria (x:xs) = x + sumatoria xs

cardinal :: Num a => [a] -> a
cardinal [] = 0
cardinal (x:xs) = 1 + cardinal xs

promedio :: [Float] -> Float
promedio [] = 0
promedio xs = (sumatoria xs)/(cardinal xs)

José Neder

reversa :: [a] -> [a]
reversa [] = []
reversa (x:xs) = reversa xs ++ [x]

Suponiendo que concatenar(++) no esta definido, lo defino como

conca :: [a] -> [a] -> [a]
conca [] ys = ys
conca (x:xs) ys = x : (conca xs ys)

reversa1 :: [a] -> [a]
reversa1 [] = []
reversa1 (x:xs) = conca (reversa1 xs) [x]

José Neder

listcap :: Eq a => [a] -> Bool
listcap xs = xs==(reversa xs)

o

listcap2 :: Eq a => [a] -> String
listcap2 xs	| xs==(reversa xs) = "Es capicua"
	| otherwise = "No es capicua"

Esto es porque “The problem here is that in order to compare lists for equality one can only do this when the elements themselves carry an equality function. This is necessary even when comparing with the empty list” que en castellano es algo como esto: “El problema aqui es que, uno puede comparar la equivalencia de las listas solo cuando los elementos en si mismos tienen una funcion de equivalencia. Esto es necesario aun cuando se compara con una lista vacia”

José Neder

(nwolovick) Perfecto, necesitamos que la variable de tipo a acepte la igualdad, por eso ponemos Eq a ⇒ … al principio.

(nwolovick) ¿Quién da una definición recursiva pura?

ya la dijiste asi que la pongo

listcap3 [a] -> Bool
listcap3 [] = True
listcap3 [x] = True
listcap3 (x:xs) = x==ultimo xs && listcap (inicio xs)

Algo asi:

reversa.[2,4,5,6,7,8]
reversa.[4,5,6,7,8] ++ [2]
(reversa.[5,6,7,8] ++ [4]) ++ [2]
((reversa.[6,7,8] ++ [5]) ++ [4]) ++ [2]
(((reversa.[7,8] ++ [6]) ++ [5]) ++ [4]) ++ [2]
((((reversa.[8] ++ [7]) ++ [6]) ++ [5]) ++ [4]) ++ [2]
(((((reversa.[] ++ [8]) ++ [7]) ++ [6]) ++ [5]) ++ [4]) ++ [2]
((((([] ++ [8]) ++ [7]) ++ [6]) ++ [5]) ++ [4]) ++ [2]
(((([8] ++ [7]) ++ [6]) ++ [5]) ++ [4]) ++ [2]
((([8,7] ++ [6]) ++ [5]) ++ [4]) ++ [2]
(([8,7,6] ++ [5]) ++ [4]) ++ [2]
([8,7,6,5] ++ [4]) ++ [2]
[8,7,6,5,4] ++ [2]
[8,7,6,5,4,2]

José Neder

Esto va aca

desdeHasta :: Int -> Int -> [Int]
desdeHasta n m  | n>m  = reverse (desdeHasta m n)
                | n==m = [n]
                | n<m  = n : desdeHasta (n+1) m

Hay una solución que no utiliza reverse y que para n>m usa el mismo patrón que para n<m (N.Wolovick)

desdeHasta :: Int -> Int -> [Int]
desdeHasta n m | n > m  = n : desdeHasta (n-1) m
               | n == m = [n]
               | n < m  = n : desdeHasta (n+1) m

Puede ser esa una solución?. (Pedro A.)

De peluche, mejorale la “indentación” asi quedan bien encolumnadas las guardas y las definiciones

desdehasta :: Int -> Int -> [Int]
desdehasta a b |a<b = [a..b]             
               |a==b = [a]
               |a>b = reversa [b..a]

Tambien lo hice yo desde esta forma. (PATRICK R.)

desde :: Int -> Int -> [Int]
desde x y
|x > y = x:desde (x-1) y
|x < y = x:desde (x+1) y
|otherwise = [y]

listbin :: [Int] -> Bool
listbin [] = False
listbin [y] = y==0||y==1
listbin (x:xs) = (x==0||x==1)&&listbin xs

José Neder

(nwolovick) fijate que como [y]=y:[] el primer caso esta de mas, mmmhhh, pero ahora que lo miro lo hicistes para parchar un poco el caso base que es incorrecto, el caso base es True porque sabemos el teorema del neutro de la conjunción. (José Neder) desde mi punto de vista una lista vacia no esta compuesta solo de ceros o de unos, sino que podemos creer que no esta compuesta de nada o que esta compuesta de todo.

Solucion mas elegante

listabinaria :: [Int] -> Bool
listabinaria [] = False  -- Una lista vacia no tiene ni ceros ni unos.
listabinaria (x:xs)     | (x == 0 || x == 1) && xs == [] = True -- x es el ultimo elemento, si es 0 o 1 ya devolvemos.
                        | (x == 0 || x == 1) = True && listabinaria (xs) -- El elemento actual es 0 o 1, vamos al siguiente.
                        | otherwise = False -- El elemento actual no es ni 0 ni 1. Ya es falso.

Pablo Zurita.

En esta solucion se ve si los num de la lista son numeros binarios de mas de una cifra….

listbin' :: [Int] -> Bool
listbin' [] = False
listbin' [y] = bin (dig y) 
listbin' (x:xs) = bin (dig x) && listbin' xs

bin :: [Int] -> Bool 
bin [x] = (x==0 || x==1)
bin (x:xs) = (x==0 || x==1) && bin xs 

dig :: Int -> [Int]
dig x | x>=0 && x<10 = [x]
      | x>= 10 = dig (div x 10) ++ [mod x 10]

Mati Tealdi…

Lo que yo pense es mas o menos asi corrijanme si esta mal…

lista_bin :: [Int] -> Bool
lista_bin [] = False
lista_bin (x:xs) = Para_todo (cero_o_uno) (x:xs)

use dos funciones que ya habia definido antes…

Andrés…

(nwolovick) esta bien, solo que podes poner directamente

lista_bin :: [Int] -> Bool
lista_bin xs = paraTodo ceroOUno xs
  where
    ceroOUno :: Int -> Bool
    ceroOUno x = x==0 || x==1

> no es necesario dividir en el caso base y el inductivo, esto ya lo hace paraTodo.

listabin :: [Int] -> Bool
listabin [] = False
listabin [x] |x==1 || x==0 = True
             |otherwise = False
listabin (x:xs) |(x==1 || x==0) && listabin xs = True
                |otherwise = False

Generalizo el ejercicio 17 para cualquier par de numeros (creo que a eso se referia):

listbin3 :: Int -> Int -> [Int] -> Bool
listbin3 x y [] = False 
listbin3 x y [q] = [q]==[x]||[q]==[y]
listbin3 x y (m:ms) = ([m]==[x]||[m]==[y])&&listbin3 x y ms

Yo queria hacerlo para que me devolviera una cadena de caracteres y lei que habia una función chr que transformaba un Int en un char de acuerdo al mapa de caracteres y eso me hubiera servido, pero en mi hugs no estaba por lo que tuve que hacer algo como esto:

digtochr :: Int -> String
digtochr 0 = "0"
digtochr 1 = "1"
digtochr 2 = "2"
digtochr 3 = "3"
digtochr 4 = "4"
digtochr 5 = "5"
digtochr 6 = "6"
digtochr 7 = "7"
digtochr 8 = "8"
digtochr 9 = "9"

listtochr :: [Int] -> String
listtochr [] = ""
listtochr [x] = digtochr x
listtochr (x:xs) = (digtochr x) ++ (listtochr xs)

numtochr :: Int -> String
numtochr x = listtochr (digi x)

listbin4 :: Int -> Int -> [Int] -> String
listbin4 x y ms	|ms==[] = "Es vacia"
		|listbinS x y ms = "Solo tiene "++(numtochr x)++"'s y "++(numtochr y)++"'s"
		|otherwise ="Tiene mas que "++(numtochr x)++"'s y "++(numtochr y)++"'s"
		 where	listbinS :: Int -> Int -> [Int] -> Bool
			listbinS x y [] = False
			listbinS x y [m] = [m]==[x]||[m]==[y]
			listbinS x y (m:ms) = ([m]==[x]||[m]==[y])&&listbinS x y ms

Me parecio una obscenidad de funciones solo para lograr eso por lo que hice esta alternativa:

listbin5 :: Int -> Int -> [Int] -> String
listbin5 x y ms	|ms==[] = "Es vacia"
	    	|listbinS x y ms = "Solo tiene esos numeros"
		|otherwise ="Tiene mas que esos numeros"
		 where	listbinS :: Int -> Int -> [Int] -> Bool
			listbinS x y [] = False
			listbinS x y [m] = [m]==[x]||[m]==[y]
			listbinS x y (m:ms) = ([m]==[x]||[m]==[y])&&listbinS x y ms

Definí paraTodo asi:

paraTodo :: (a -> Bool) -> [a] -> Bool
paraTodo pre [] = True
paraTodo pre (x:xs) = pre x && paraTodo pre xs

y redefiní la funcion asi:

listbin6 :: [Int] -> Bool
listbin6 [] = True
listbin6 (xs) = paraTodo (listbinopt) (xs)
	  	where	listbinopt :: Int -> Bool
			listbinopt x = x==1||x==0

para redefinir la funcion generalizada no se me ocurrio como hacerlo con paraTodo por lo que defini la funcion paraTodos:

paraTodos :: (a -> a -> a -> Bool) -> a -> a -> [a] -> Bool
paraTodos pre x y [] = True
paraTodos pre x y (m:ms) = pre x y m && paraTodos pre x y ms

y luego

listbin7 :: Int -> Int -> [Int] -> Bool
listbin7 x y [] = True
listbin7 x y xs = paraTodos listbinopt x y xs
		    	where	listbinopt :: Int -> Int -> Int -> Bool
				listbinopt x y z = z==x||z==y

José Neder

(nwolovick) El ejercicio se resuelve solo con paraTodo y listbin6 lo demás es mucho mucho ruido. Hay que simplificar, complicar siempre se puede.

Ya lo vi, Soy un tonto, si lo podria haber escrito casi igual asi:

listbin8 :: Int -> Int -> [Int] -> Bool
listbin8 x y [] = True
listbin8 x y xs = paraTodo (listbinopt x y) xs
		    	where	listbinopt :: Int -> Int -> Int -> Bool
				listbinopt x y z = z==x||z==y

Me parese q esta puede se otra solucion posible… No me fijo solo si los num de la lista son 0 o 1 sino si son binarios de mas de un digito…

listabin18 :: [Int] -> Bool
listabin18 [] = False      --Defino q si la lista esta vacia no hay num binarios XD
listabin18 [x] = binall x
listabin18 xs = paraTodo binall xs

paraTodo :: (a -> Bool) -> [a] -> Bool
paraTodo p [] = False
paraTodo p [x] = p x
paraTodo p (x:xs) = p x && paraTodo p xs 
binall :: Int -> Bool
binall n = bin (dig n)
bin :: [Int] -> Bool
bin [x] = (x==0 || x==1)
bin (x:xs) = (x==0 || x==1) && bin xs 
dig :: Int -> [Int]
dig x | x>=0 && x<10 = [x]
      | x>= 10 = dig (div x 10) ++ [mod x 10]

Mati Tealdi…

Con no multiplo lo hice asi:

noMultiplo :: Int -> Int -> Bool
noMultiplo p n = mod p n > 0

primo1 :: Int -> Bool
primo1 1 = False
primo1 2 = True
primo1 x = paraTodo (noMultiplo x) (desdeHasta 2 (x-1))

o lo que es lo mismo:

primo2 :: Int -> Bool
primo2 1 = False
primo2 2 = True
primo2 x = paraTodo (noMultiplo x) [2..(x-1)]

Tambien se me ocurrió hacerlo asi:

primo3 :: Int -> Bool
primo3 1 = False
primo3 2 = True
primo3 x = listno0 (map (mod x) (desdeHasta 2 (x-1)))
	where	listno0 :: [Int] -> Bool
		listno0 [] = True
		listno0 (x:xs) = x/=0 && listno0 xs

Pero estas funciones como las veo yo tienen un defecto que es que hay que definir los casos 1 y 2 por lo que hice esta otra, definiendo filtro:

multiplo :: Int -> Int -> Bool
multiplo p n = mod p n == 0

filtro :: (a -> Bool) -> [a] -> [a]
filtro p [] = []
filtro p (x:xs)	| p x = [x: filtro p xs]
		| otherwise = [filtro p xs]

o comprensivamente

filtro2 :: (a -> Bool) -> [a] -> [a]
filtro2 p xs = [ x | x <- xs, p x ]

primo4 :: Int -> Bool
primo4 x = filtro (multiplo x) (desdeHasta 1 x)==[1,x]

Ahora tambien sabemos que si no tiene divisores hasta la raiz, es primo por lo que defini esta otra, un poco mas complicada, gracias a la funcion definida por “” y utilizando dos funciones de Haskell (sqrt y round):

primo5 :: Int -> Bool
primo5 1 = False
primo5 x = (filtro (multiplo x) (desdeHasta 1 (round (sqrt (fromIntegral x)))))==[1]

yo éste lo hice así:

definí en los ejercicios anteriores paraTodo y noMultiplo:

paraTodo :: (a -> Bool) -> [a] -> Bool
paraTodo p [] = False
paraTodo p [x] = p x == True
paraTodo p (x:xs) = (paraTodo p xs) && (p x == True)

noMultiplo :: Int -> Int -> Bool
noMultiplo x y = x`mod`y >0

Y luego, primo:

primo :: Int -> Bool
primo n = paraTodo (noMultiplo n) (desdeHasta 2 (n-1))

EMMANUEL GUNTHER

Yo lo compliqué un poco, pero solamente para que sea un poco más rápido. El tema es que había problema de tipos, asique tuve que crear 2 funciones, una que ya está en este wiki (int2float) y su inversa, int2float.

int2float :: Int -> Float
int2float = fromIntegral

float2int :: Float -> Int
float2int = round

primo :: Int -> Bool
primo n | (abs n) > 2  = paraTodo (noMultiplo n) (desdeHasta 2 (float2int(sqrt(int2float(abs(n))))))
        | (abs n) == 2 = True
        | otherwise    = False

Lo que tiene esta funcion primo es que no busca desde 2 hasta n-1, sino hasta la raíz cuadrada de n porque se supone que si no es primo, entonces es divisible por algún numero menor a la raiz cuadrada del mismo. Si intentás poner en la función hasta n-1 el número que aparece al último del taller3, pues tarda muchísimo. Mientras que ésta función te devuelve el resultado en segundos. Obviamente que seguro se puede optimizar aún más.

(Pedro A.)

(nwolovick) Propongo la siguiente optimización probar que no es multiplo de 2,3,5,7 … sqrt(n-1), con lo que nos ahorramos todo los pares salvo el 2. Si ya no es multiplo de 2 pues no va ser de 4 ni de 6, etc. Ahi tenemos un 50% mas de velocidad.

(José Neder) Aca esta la optimizacion que faltaba utilizando solo los primos hasta el cuadrado.

primoshasta3 :: Int -> [Int]
primoshasta3 x = cabeza (primhasta x)

primhasta :: Int -> [[Int]]
primhasta x = plegarI primo7 [] [2..x]
	where	primo7 :: [[Int]] -> Int -> [[Int]]
		primo7 [] n = [[n],[n]]
		primo7 [xs,(y:ys)] n	| todocump (multiplo n) ys==[] && y*y>n = [xs++[n],(y:ys)]
					| y*y==n = [xs,tomar (length (y:ys)) xs:(y:ys)]
					| otherwise = [xs,(y:ys)]
		tomar :: Int -> [a] -> a
		tomar 0 (x:xs)=x
		tomar n (x:xs)=tomar (n-1) xs

Con filtro es algo asi asi:

primoshasta :: Int -> [Int]
primoshasta x = filtro primo1 (desdeHasta 1 x)

primoshast2 :: Int -> [Int]
primoshast2 x = filtro primo1 (desdeHasta 1 x)

mas rapido con la definicion de primo con raiz

primoshast3 :: Int -> [Int]
primoshast3 x = filtro primo5 (desdeHasta 1 x)

José Neder

Ahora que lo se aca esta la solucion:

eqlist :: Eq a => [a] -> [a] -> Bool
eqlist [] [] = True
eqlist xs [] = False
eqlist [] ys = False
eqlist (x:xs) (y:ys)	| x==y = eqlist xs ys
		| otherwise = False

Esto sirve para listas con los mismos tipos de elementos, pero todavia no se como hacer para que sirva para listas con distintos tipos de elementos, es decir, que me devuelva False cuando esto suceda…

(nwolovick) No creo que se pueda. Fijate que la definición no es muy prolija los casos 2 y 3 pueden ponerse de manera equivalente pero que sean mas legibles.

(nwolovick) Fijense que hay redundancia por no usar calculo de predicados!
El caso

eqlist (x:xs) (y:ys)	| x==y = eqlist xs ys
                      | otherwise = False

Es equivalente a

eqlist (x:xs) (y:ys) = x==y && eqlist xs ys

que resulta más corto y más entendible.

Recomiendo esta pagina: http://www.cs.kent.ac.uk/people/staff/sjt/craft2e/ es la pagina de libro “Haskell: The Craft of Functional Programming, Second Edition” y dice casi todo a cerca de Haskell.

(nwolovick) Es el libro que estoy usando! Muy recomendable salvo que esta en inglé.

José Neder

En este ejercicio amí se me ocurrió una variante. “Dadas dos listas desordenadas, devolver la mezcla ordenada. El que lo quiera resolver, deje de leer en este punto. La solución a continuación:

 mixorder :: [Int] -> [Int] -> [Int]
 mixorder [] []     = []
 mixorder xs []     = order xs
 mixorder [] ys     = order ys
 mixorder xs (y:ys) = mixorder (filter (<y) xs) (filter (<y) ys) ++ [y] ++ mixorder (filter (>=y) xs) (filter (>=y) ys)

Noten que llamo a otra función denominada order. Esta función está publicada en el ejercicio que sigue (ejercicio_23). (Pedro A.)

(José Neder) En el ejercicio dice “Defina una función tal que, dadas dos listas de naturales ordenadas xs y ys, retorne la “mezcla ordenada” de las listas, es decir la lista ordenada compuesta por los elementos de xs y ys. Ayuda: piense como procedería con 2 mazos de cartas.”

aca lo hice con plegarI

buscmin :: Ord a => [a] -> a -> [a]
buscmin [] x = [x]
buscmin (x:xs) y	| y<=x = y:(x:xs)
		| otherwise = x:(buscmin xs y)

mixlists1 :: Ord a => [a] -> [a] -> [a]
mixlists1 xs ys = plegarI (buscmin) [] (xs++ys)

si no se debe repetir

buscmin2 :: Ord a => [a] -> a -> [a]
buscmin2 [] x = [x]
buscmin2 (x:xs) y	| y<x = y:(x:xs)
		| y==x = (x:xs)
		| otherwise = x:(buscmin2 xs y)

mixlists2 :: Ord a => [a] -> [a] -> [a]
mixlists2 xs ys = plegarI (buscmin2) [] (xs++ys)

la unica forma que se me ocurrio fue esta, espero que se me ocurra una mejor:

mayorig :: Int -> Int -> Bool
mayorig x y = x>=y

sacMax :: [Int] -> [Int]
sacMax [] = []
sacMax (x:xs)	|paraTodo (mayorig x) xs = xs
	|otherwise = x:(sacMax xs)

tomarMax :: [Int] -> Int
tomarMax [x] = x
tomarMax (x:xs)	|paraTodo (mayorig x) xs = x
		|otherwise = tomarMax xs

ordenar :: [Int] -> [Int]
ordenar [] = []
ordenar xs = (ordenar (sacMax xs)) ++ [tomarMax xs]

o si saco el menor de la lista

(nwolovick) Esto se llama ordenar por inserción.

menorig :: Int -> Int -> Bool
menorig x y = x<=y

sacMin :: [Int] -> [Int]
sacMin [] = []
sacMin (x:xs)	|paraTodo (menorig x) xs = xs
	|otherwise = x:(sacMin xs)

tomarMin :: [Int] -> Int
tomarMin [x] = x
tomarMin (x:xs)	|paraTodo (menorig x) xs = x
		|otherwise = tomarMin xs

ordenar1 :: [Int] -> [Int]
ordenar1 [] = []
ordenar1 xs = (tomarMin xs):(ordenar (sacMin xs))

José Neder

(nwolovick) totalmente equivalente a la anterior, no?

José, aquí presento otra solución, basada en lo que hablé con Nicolás acerca de quicksort. (Pedro A.)

 order :: [Int] -> [Int]
 order [] = []
 order (x:xs) = order (filter (<=x) xs) ++ [x] ++ order (filter (>x) xs)

- Acá hay otra solucióm para ordenar:

 ordenar :: [Int] -> [Int]
 ordenar [x] = [x]
 ordenar xs = mezcla (ordenar derecha) (ordenar izquierda)
    where derecha = take mitad xs
          izquierda = drop mitad xs
          mitad = length xs `div` 2

Emmanuel Gunther (con ayuda de Nicolás W.)

(José Neder) Acabo de revizar esa funcion de arriba Emmanuel, no se bien a que te referis con mezcla porque esa funcion no existe. si es la de la “mezcla ordenada” esa la definimos con ordenar asi que no tiene sentido. Ademas, en todo caso, es una funcion mas general… Aca hice una con plegarI

buscmin :: Ord a => [a] -> a -> [a]
buscmin [] x = [x]
buscmin (x:xs) y	| y<=x = y:(x:xs)
		| otherwise = x:(buscmin xs y)

ordenar2 :: Ord a => [a] -> [a]
ordenar2 xs = plegarI (buscmin) [] (xs)

(nwolovick) Está todo bien con la solución de Emmanuel, simplemente mezcla es la mezcla ordenada de dos listas que ya están ordenadas.

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

duplicar3 :: [Int] -> [Int]
duplicar3 xs = mapear (* 2) (xs)

multiplicar3 :: [Int] -> Int -> [Int]
multiplicar3 xs r = mapear (* r) (xs)

José Neder

filtro :: (a -> Bool) -> [a] -> [a]
filtro p [] = []
filtro p (x:xs)	| p x = (x:filtro p xs)
			| otherwise = filtro p xs

filtro2 :: (a -> Bool) -> [a] -> [a]
filtro2 p xs = [x|x <- xs, p x]

listbin8 :: Int -> Int -> [Int] -> Bool
listbin8 x y [] = False
listbin8 x y xs = cardinal (filtro (y==) xs++filtro (x==) xs)==cardinal xs

José Neder

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

–Rep12

sumatoria3 :: [Float] -> Float
sumatoria3 xs = (plegarI (+) (0) (xs))

sumatoria4 :: Num a => [a] -> a
sumatoria4 xs = (plegarI (+) (0) (xs))

cardinal :: [a] -> Int
cardinal xs = (plegarI (sum1) (0) (xs))
		where	sum1 :: Int -> a -> Int
			sum1 a b = a+1

–Rep17

listbin9 :: [Int] -> Bool
listbin9 xs = (plegarI (equiv) (True) xs)
		where	equiv :: Bool -> Int -> Bool
			equiv b n = b&&(1==n||0==n)

–Rep18

listbin10 :: Int -> Int -> [Int] -> Bool
listbin10 x z xs = (plegarI (equiv x z) (True) xs)
		where	equiv :: Int -> Int -> Bool -> Int -> Bool
			equiv x z b n = b&&(x==n||z==n)

–Res13

peginv :: [a] -> a -> [a]
peginv [] n = [n]
peginv (x:xs) n = n:(x:xs)

reversa3 :: [a] -> [a]
reversa3 xs = (plegarI (peginv) [] xs)

–tambien se puede usar la funcion flip

flip1 :: (a -> b -> c) -> b -> a -> c
flip1 f x y = f y x

reversa4 :: [a] -> [a]
reversa4 xs = (plegarI (flip1 (:)) [] xs)

–Res21

eqlist2 :: Eq a => [a] -> [a] -> Bool
eqlist2 xs ys	| length xs == length ys = plegarI (eq) True (zip xs ys)
	| otherwise = False
			where	eq :: Eq a => Bool -> (a,a) -> Bool
				eq a (b,c) = a&&b==c

–Res24

mapear2 :: (a -> b) -> [a] -> [b]
mapear2 f xs = (plegarI (concaf f) [] xs)
	where	concaf :: (a -> b) -> [b] -> a -> [b]
		concaf f ys e = (ys++[f e])

–Res25

filtro3 :: (a → Bool) → [a] → [a]

filtro3 p xs = plegarI (fil1 p) [] xs
		where	fil1 :: (a -> Bool) -> [a] -> a -> [a]
			fil1 p xs x	| p x = xs++[x]
					| otherwise = xs

José Neder

perm :: [Int] → [Int] → Bool

perm [] [] = True

perm xs ys = lsiguales (ordenar xs) (ordenar ys)

Juanchi…

(José Neder) No hace falta aclarar que es True para dos listas vacia ya que “ordenar [] = []” y eqlist2 [] [] = True

uperm :: Ord a => [a] -> [a] -> Bool
uperm xs ys = (eqlist2 (ordenar xs) (ordenar ys))

(José Neder)Ya lo hice no era tan dificil, aunque no se si hay una forma mejor

Defini esto primero:

inter :: a -> [a] -> Int -> [a]
inter a xs 0 = a:xs
inter a (x:xs) (n+1)= x:(inter a xs n) 

interc :: a -> [a] -> [[a]]
interc a xs = map (inter a xs) [0..(length xs)]

concatodo :: [[a]] -> [a]
concatodo [] = []
concatodo (x:xs) = x++concatodo xs

interca :: [[a]] -> a -> [[a]]
interca xs y = concatodo  (map (interc y) xs)

Y luego

permdexs :: [a] -> [[a]]
permdexs [] = [[]]
permdexs (x:xs) = interca (permdexs xs) x

o con plegarI

permdexs2 :: [a] -> [[a]]
permdexs2 xs = plegarI interca [[]] xs

expo :: Int → Int

expo 0 = 1

expo x = (x*0+2 ) * expo (x-1)

Juanchi…

(José Neder)??? porque asi? si es 2 a la n. Yo lo hice asi:

dosalan :: Int -> Int
dosalan 0 = 1
dosalan n = 2*(dosalan (n-1))

con plegarI:

dosalan2 :: Int -> Int
dosalan2 n = plegarI (pordos) 1 [1..n]
		where	pordos :: Int -> Int -> Int
			pordos z n = z*2

utilizando las funciones de Haskell, ya esta definido mas general asi que se puede hacer asi, para cualquier n:

dosalan3 :: Float → Float dosalan3 n = 2 aca van 2 estellitas n

Este lo hizo Pedro durante el practico 23/05

Primero definimos una funcion sumar

sumar:: [Int] -> [Int] -> [Int]
sumar [] ys = ys
sumar xs [] = xs
sumar (x:xs) (y:ys) = (x+y) : sumar xs ys

que nos servira para hacer la relacion de suma entre las distintas filas de del triangulo de pascal (notar que si agregagamos un 0 a una fila y le aplicamos sumar con la misma fila nos da la siguiente fila….)

ej:

       1           = [1]     
      1 1          = sumar (0:[1]) [1] = [1,1] 
     1 2 1         = sumar (0:[1,1]) [1,1] = [1,2,1]
    1 3 3 1        = sumar (0:[1,2,1]) [1,2,1] = [1,3,3,1]

una vez que nos damos cuenta de esto definimos la funcion pascal:

pascal:: Int -> [[Int]]
pascal 0 = [[]]
pascal 1= [[1]]
pascal (x+1) = sumar (0: (cabeza(pascal x))) (cabeza (pascal x)) : pascal x

aca obtenemos las filas desde n hasta 1 para ordenarlas deberiamos aplicarle un reverse a la funcion (si se desea)

Grande Pedro!!!!!!!!!!!!!!!!!!!!!!!!!!! Esta muy bueno gracias…… Andres Pozo…

aclaro que seria mas correcto poner lo siguiente

pascal:: Int -> [[Int]]
pascal 0 = [[]]
pascal 1= [[1]]
pascal (x+2) = sumar (0: (cabeza(pascal (x+1)))) (cabeza (pascal (x+1))) : pascal (x+1)

ya que si x=0 cae en dos casos distintos…

(José Neder) Acabo de probar su version y es increiblemente ineficaz la mia es un poco mas larga de escribir, pero sale al toque y va de en orden no hace falta hacer un reverse. El problema con la suya es que va al reves por lo que la maquina debe acumular demasiada informacion. Yo lo hice de otras dos formas, esta es la mas ineficaz pensando en el coeficiente binominal:

fact :: Int -> Int
fact 0 = 1
fact (n+1) = (n+1)*(fact n)

coefbin :: Int -> Int -> Int
coefbin n m = div (div (fact n) (fact (n-m))) (fact m)

listnpas :: Int -> [Int]
listnpas n = map (coefbin n) [0..n]

tripascal :: Int -> [[Int]]
tripascal n = map listnpas [0..n]

(José Neder) Admito que la anterior es peor, solo da hasta el 14 en Hugs pero con las las propiedades del triangulo de Pascal defini esta:

p' :: [Int] -> [Int]
p' [x] = [x]
p' (x:xs) = (x+cabeza xs):(p' xs)

p :: [Int] -> [Int]
p (x:xs) = x:(p' (x:xs))

listnpas2 :: Int -> [Int]
listnpas2 0 = [1]
listnpas2 (n+1) = p (listnpas2 n)

ahora con map:

tripascal2 :: Int -> [[Int]]
tripascal2 n = map listnpas2 [0..n]

y con plegarI: gs

tripascal3 :: Int -> [[Int]]
tripascal3 n = plegarI (listpasn3) [] [0..n]
		where	listpasn3 :: [[Int]] -> Int -> [[Int]]
			listpasn3 xs n = xs++[listnpas2 n]

(nwolovick) Hay una forma de tener lo mejor de ambos mundos, por un lado la claridad de la definición de Andrés y la velocidad de José.

Hice un experimento activando el “medidor de pasos de reducción” que trae Hugs

Main> :set +s
Main> pascal 10
[[1,9,36,84,126,126,84,36,9,1],[1,8,28,56,70,56,28,8,1],[1,7,21,35,35,21,7,1],[1,6,15,20,15,6,1],[1,5,10,10,5,1],[1,4,6,4,1],[1,3,3,1],[1,2,1],[1,1],[1]]
(68468 reductions, 103162 cells)
Main> tripascal3 9
[[1],[1,1],[1,2,1],[1,3,3,1],[1,4,6,4,1],[1,5,10,10,5,1],[1,6,15,20,15,6,1],[1,7,21,35,35,21,7,1],[1,8,28,56,70,56,28,8,1],[1,9,36,84,126,126,84,36,9,1]]
(2790 reductions, 4082 cells)

Tenemos 68000 reducciones de la versión fácil de leer, contra 2790 de la versión rápida pero inentendible.
Parecería que la claridad tiene un precio alto.
Si embargo hacemos, podemos modificar la versión de Andrés para que use definiciones locales y calcule solo 1 vez cada una de las filas.

pascal':: Int -> [[Int]]
pascal' 0 = [[]]
pascal' 1= [[1]]
pascal' (x+2) = sumar (0: filaAnterior) filaAnterior : trianguloAnterior
  where
    filaAnterior = cabeza trianguloAnterior
    trianguloAnterior = pascal' (x+1)

Aca tenemos un versión aun más legible que la de Andrés y veamos cuantas reducciones necesita para hacer 9 filas del Triángulo de Tartaglia.

Main> pascal' 10
[[1,9,36,84,126,126,84,36,9,1],[1,8,28,56,70,56,28,8,1],[1,7,21,35,35,21,7,1],[1,6,15,20,15,6,1],[1,5,10,10,5,1],[1,4,6,4,1],[1,3,3,1],[1,2,1],[1,1],[1]]
(1065 reductions, 1695 cells)

De nuevo, tenemos lo mejor de dos mundos, claridad y velocidad, el ingrediente clave fue la utilización de definiciones locales que hacen que el cómputo del triángulo anterior y de la fila anterior solo se hagan 1 vez y se comparta en la fila superior.

(José Neder)Utilizando la idea de definirlo con definiciones locales redefino la funcion asi:

p3' :: [Int] -> [Int]
p3' [x] = [x]
p3' (x:y:ys) = x+y:p3' (y:ys)

p3 :: [Int] -> [Int]
p3 (x:xs) = x:p3'(x:xs)

tripascal7 :: Int -> [[Int]]
tripascal7 0 = [[1]]
tripascal7 n = p3 x:(x:xs)
		where	(x:xs) = tripascal7 (n-1)

Practico8> tripascal7 9
[[1,9,36,84,126,126,84,36,9,1],[1,8,28,56,70,56,28,8,1],[1,7,21,35,35,21,7,1],[1,6,15,20,15,6,1],[1,5,10,10,5,1],[1,4,6,4,1],[1,3,3,1],[1,2,1],[1,1],[1]]
(807 reductions, 1444 cells)

(José Neder) aca la volvi a hacer de la manera que yo lo habia hecho y es un poquito mas rapida

foldnr :: (a -> a) -> a -> Int -> a
foldnr a x 0 = a x
foldnr a x n = a (foldnr a x (n-1))

p2' :: [Int] -> [Int]
p2' [x] = [x]
p2' (x:y:ys) = x+y:p2' (y:ys)

p2 :: [[Int]] -> [[Int]]
p2 [] = [[1]]
p2 ((x:xs):ys) = (x:p2' (x:xs)):(x:xs):ys

tripascal6 :: Int -> [[Int]]
tripascal6 n = foldnr p2 [] n

Practico8> tripascal6 9
[[1,9,36,84,126,126,84,36,9,1],[1,8,28,56,70,56,28,8,1],[1,7,21,35,35,21,7,1],[1,6,15,20,15,6,1],[1,5,10,10,5,1],[1,4,6,4,1],[1,3,3,1],[1,2,1],[1,1],[1]]
(788 reductions, 1434 cells)

(José Neder) a frecuencia lo defini directamente con plegarI.

esta :: Eq a => a -> [a] -> Bool
esta a [] = False
esta a (x:xs) = x==a||esta a xs

frecuencia :: [Palabra] -> [(Palabra,Int)]
frecuencia xs = foldl contarpalabras [] xs
		where	contarpalabras :: [(Palabra,Int)] -> Palabra -> [(Palabra,Int)]
			contarpalabras [] x = [(x,1)]
			contarpalabras ((a,b):xs) x	| x==a = (a,b+1):xs
							| otherwise = (a,b):contarpalabras xs x

(José Neder) Para que identifique todos los caracteres que no son letras y no distinga entre mayusculas y minisculas, lo defino a partir de las letras:

letrasM :: String
letrasM = ['A'..'Z']++['À'..'Ö']++['Ù'..'Ý']

letrasm :: String
letrasm = ['a'..'z']++['à'..'ö']++['ù'..'ý']

numdea :: Eq a => a -> [a] -> Int
numdea a (x:xs)	| a==x = 0
		| otherwise = 1+numdea a xs

tomarun :: Int -> [a] -> a
tomarun 0 (x:xs)=x
tomarun n (x:xs)=tomarun (n-1) xs

palabramin :: String -> String
palabramin []=[]
palabramin (x:xs)	|esta x letrasM = tomarun (numdea x letrasM) letrasm:palabramin xs
		|otherwise = x:palabramin xs

tiraTodo :: String -> String
tiraTodo [] = []
tiraTodo (x:xs)	| esta x letrasm ||esta x letrasM = x:xs
		| otherwise	= tiraTodo xs

tomaPalabra2 :: String -> String
tomaPalabra2 [] = []
tomaPalabra2 (x:xs)	| esta x letrasm ||esta x letrasM = x : tomaPalabra2 xs
		| otherwise      = []

tiraPalabra2 :: String -> String
tiraPalabra2 [] = []
tiraPalabra2 (x:xs)	| esta x letrasm ||esta x letrasM = tiraPalabra2 xs
		| otherwise      = x:xs

partirPalabras2 :: String -> [Palabra]
partirPalabras2 st = partirPalabras2' (tiraTodo st)

partirPalabras2' :: String -> [Palabra]
partirPalabras2' [] = []
partirPalabras2' st = (tomaPalabra2 st) : partirPalabras2' (tiraTodo (tiraPalabra2 st))

frecuencia' :: [Palabra] -> [(Palabra,Int)]
frecuencia' xs = foldl contarpalabras [] xs
		where	contarpalabras :: [(Palabra,Int)] -> Palabra -> [(Palabra,Int)]
			contarpalabras [] x = [(palabramin x,1)]
			contarpalabras ((a,b):xs) x	| a==palabramin x = (a,b+1):xs
							| otherwise = (a,b):contarpalabras xs x

ordenarpar :: Ord b => [(a,b)] -> [(a,b)]
ordenarpar xs = foldl (buscparmin) [] (xs)
		where	buscparmin :: Ord b => [(a,b)] -> (a,b) -> [(a,b)]
			buscparmin [] x = [x]
			buscparmin ((a,b):xs) (c,d)	| d>=b = (c,d):((a,b):xs)
							| otherwise = (a,b):buscparmin xs (c,d)

he aqui una implementacion de lo aprendido pero sobre otro lenguaje en este caso c:

FUNCIÓN FACTORIAL # include <stdio.h> long factorial(long);

main() {

int i; 

printf(“Digite un entero: “); scanf(“%ld”, &n); for(i = 1;i ⇐ n; i ++) printf(“%2d! = %ld\n”,i ,factorial(i));

return 0; 

}

long factorial(long number) {

if (number <= 1) 
     return 1; 
 else 
      return (number * factorial (number-1)); 

}

y disculpen por meterme hablando de otro tema, pero aquellos que creen saber programar en c seguramente ahora lo veran de otra forma