Questões de Haskell Resolvidas

Esta é uma pré-visualização de arquivo. Entre para ver o arquivo original

Haskell/where.hs
quad :: Int -> Int
quad n = quad_n
			where 
				quad_n = n*n
Haskell/whatfiles.sh
#!/bin/bash
if [ "$#" -eq 3 ]; then
	files=`ls -R $1`
else
	files=`ls $1`
fi
for f in $files
do
	cat $f | grep "$2" >& /dev/null
	if [ "$?" -eq 0 ]; then
		echo $f
	fi
done
Haskell/vasos.hs
{-0 0
encher2 x -> y
x 4
0 4
completar1 x -> y
(x + min(y, 3-x)) (y - min(y,3-x))
3 1
esvaziar1 x -> y
0 y
0 1
completar1 x -> y
(x + min(y, 3-x)) (y - min(y, 3-x))
1 0
------------------------------------------------------
0 0
encher1
3 0
completar2
0 3
encher 1
3 3
completar 2
2 4-}
--x possui capacidade 3
--y possui capacidade 4
--inicialmente x e y devem estar vazios ou seja, deve-ser chamar resolver (0,0)
my_min :: (Int, Int) -> Int
my_min (x,y) | (x < y) = x
			 | otherwise = y
encher1 :: (Int, Int) -> (Int, Int)
encher1 (x,y) = (3,y)
completar2 :: (Int, Int) -> (Int, Int)
completar2 (x,y) = ( (x - my_min(x,(4-y))),(y + my_min(x,(4-y))) )
resolver :: (Int, Int) ->[(String, (Int,Int))]
resolver (x,y) = [("Encher 1", (encher1(x,y))), ("Completar 2 com 1", completar2(encher1(x,y))), ("Encher 1",encher1(completar2(encher1(x,y)))), ("Completar 2 com 1",completar2(encher1(completar2(encher1(x,y)))))]
Haskell/resultadoAprovacoes.hs
type Nota = Float
type Falta = Integer
type Status = String
type Nome = String
data Registro = Aluno Nome Nota Nota Nota Nota Falta 
				deriving(Show)
carga_horaria :: Float
-- Por padrao foi considerada uma carga horaria de 40 horas
carga_horaria = 40.0
-- Status possíveis:
rf :: Status
rf = "Reprovado por faltas"
rn :: Status
rn = "Reprovado por notas"
am :: Status
am = "Aprovado por media"
ef :: Status
ef = "Exame final"
-- Retorna media das tres notas
md :: Nota -> Nota -> Nota -> Nota
md x y z = ((x+y+z)/3.0)
menorAluno :: Registro -> Registro -> Bool
menorAluno (Aluno x _ _ _ _ _) (Aluno y _ _ _ _ _) | x < y = True
												 | otherwise = False
-- Ordena uma lista de alunos pelo nome
-- Exemplo: [(Aluno "Milton" 10.0 10.0 10.0 0.0 33), (Aluno "Astrobaldo" 3.0 5.0 1.0 5.0 33)]
-- --> [Aluno "Astrobaldo" 3.0 5.0 1.0 5.0 33,Aluno "Milton" 10.0 10.0 10.0 0.0 33]
menores :: Registro -> [Registro] -> [Registro]
menores n [] = []
menores n x = [b | b <- x, menorAluno b n]
maiores :: Registro -> [Registro] -> [Registro]
maiores n [] = []
maiores n x = [b | b <- x, menorAluno n b]
ordenarAluno :: [Registro] -> [Registro]
ordenarAluno [] = []
ordenarAluno (x:[]) = [x]
ordenarAluno (x:xs) = (ordenarAluno (menores x xs)) ++ [x] ++ (ordenarAluno (maiores x xs))
-- Mostra qual foi a nota final e o resultado para um determinado aluno
-- Exemplo: resultado (Aluno "Milton" 10.0 10.0 10.0 0.0 33) --> ("Aprovado por media",10.0)
-- 			resultado (Aluno "Astrobaldo" 3.0 5.0 1.0 5.0 33) --> ("Reprovado por notas",4.0)
-- resultado (Aluno "Irresponsável" 3.0 2.0 1.0 0.0 5) --> ("Reprovado por faltas",0.0)
resultado :: Registro -> (Status, Nota)
resultado (Aluno _ x y z w f) | (fromIntegral(f)/carga_horaria) < 0.75 = (rf, 0.0)
						 | ((md x y z) >= 7.0) = (am, (md x y z))
						 |	(((md x y z) + w)/2.0 < 6.0) = (rn, (((md x y z) + w)/2.0))
						 | otherwise = (ef, (((md x y z) + w)/2.0))
Haskell/pile.hs
push :: [Int] -> Int -> [Int]
push pilha x = x:pilha
pop :: [Int] -> [Int]
pop [] = error "Pilha vazia"
pop (x:xs) = xs
top :: [Int] -> Int
top [] = error "Pilha vazia"
top (x:xs) = x
is_empty :: [Int] -> Bool
is_empty [] = True
is_empty _ = False
Haskell/pie.cpp
/*Problema 3635 - UVA: https://icpcarchive.ecs.baylor.edu/index.php?option=com_onlinejudge&Itemid=8&category=19&page=show_problem&problem=1636*/
#include <iostream>
#include <cstdio>
#include <stack>
#include <queue>
#include <list>
#include <vector>
#include <map>
#include <utility>
#include <functional>
#include <algorithm>
#include <cmath>
#include <limits>
#define PI 3.141592653589793238463
#define sz(a) int((a).size()) 
#define pb push_back 
#define all(c) (c).begin(),(c).end() 
#define tr(c,i) for(typeof((c).begin()) (i) = (c).begin(); (i) != (c).end(); (i)++) 
#define present(c,x) ((c).find(x) != (c).end()) 
#define cpresent(c,x) (find(all(c),x) != (c).end()) 
#define I(x) ((int)(x))
using namespace std;
typedef vector<int> vi; 
typedef vector<vi > vvi; 
typedef pair<int,int> ii;
typedef pair<double,int> di;
typedef vector<string> vs; 
typedef vector<ii> vii;
typedef vector<di> vdi;
typedef vector< pair<double, ii> > vdii;
template <class T>
int N, F;
double r[10000];
class mycmp: less<T>{
	public:
		bool operator() (const T& e1, const T& e2)
		{
			if(e1.first > e2.first)
			{
				return true;
			}
			if(e1.first == e2.first)
			{
				if(e1.second < e2.second)
				{
					return true;
				}
			}
			return false;
		}
};
bool satisfaz(int a)
{
	int l, c;
	int somatorio = 0;
	for(i = 0; i < N; i++)
	{
		somatorio += I(r[i]/a);
	}
	return somatorio >= F;
}
bool fsatisfaz(int a)
{
	int l, c;
	int somatorio = 0;
	for(i = 0; i < N; i++)
	{
		somatorio += I(r[i]/a);
	}
	return somatorio >= F;
}
inline float satisfaz2(int a, int b)
{
	int i;
	float aux = 0.00000;
	cout << "Aux: " << aux;
	a = a*10000;
	b = b*10000;
	for(i = b; i >= a; i--)
	{
		aux = i;
		if(fsatisfaz(aux/10000.0000F))
		{
			return i;
		}
	}
	return -1;
}
inline float satisfaz3(float a, float b)
{
	int i;
	float aux = 0.0000;
	int c = a*10000;
	int d = b*10000;
	for(i = d; i >= c; i--)
	{
		aux = i;
		if(fsatisfaz(aux/10000.0000F))
		{
			return i;
		}
	}
	return -1;
}
int main()
{
	int T;
	int i, j;
	double m;
	int ini, fim, mid;
	cin >> T;
	while(T)
	{
		cin >> N >> F;
		F++;
		m = 1000000000;
		fini = ffim = 0.0000;
		for(i = 0; i < N; i++)
		{
			cin >> r[i];
			r[i] =* r[i]*PI;
			m = min(r[i], m);
		}
		m *= m*PI;
		if(!satisfaz(1))
		{
			cout << satisfaz2(0, 1);
		}
		else if(satisfaz(I(m)))
		{
			cout << satisfaz3(I(m), m);
		}
		else{
			ini = 1;
			fim = (int)m;
			while(ini < fim-1)
			{
				mid = (ini + fim)/2;
				if(satisfaz(mid))
				{
					ini = mid;
				}
				else
				{
					fim = mid;
				}
				cout << satisfaz2(ini, fim);
			}
			//o volume procurado esta entre ini e fim
		}
		T--;
	}
	return 0;
}
Haskell/operadores.hs
True && False --> e logico
True || False --> ou lógico
not True --> negação lógica
div 3 2 --> divisao inteira
mod 3 2 --> modulo
abs(-20) --> valor absoluto
-- relacionais
2 > 2
2 < 2
2 >= 2
2 <= 2
2 == 2
2 /= 2
-- operadores de caracteres
import Data.char
ord 'g' --> valor numerico do caractere g na tabela ASCII
chr 120 --> quem é 120 na tabelas ASCII?
isLower 'a' -->verifica se um caracter é minúsculo
isUpper 'A' --> verifica se um caracter é maiúsculo
toLower 'a' --> converte caractere a minúsculo
toUpper 'a' --> converte caractere a maiúsculo
isDigit '1' --> verifica se caracterer é digito
digitToInt '2' --> converte caracter digito a inteiro
intToDigit 2 --> converte digito inteiro a caracter
exp 2 --> e^2
fromIntegral 10 --> converte inteiro a real
log 10 --> log 10 na base e
sqrt 100 --> raiz quadrada
floor 3.8 --> arrendondamento para baixo
ceiling 3.8 --> arrendondamento para cima
round 4.5 --> arrendondamento
Haskell/new_types.hs
type Nome = String
type Linguagem = String
type Universidade = String
data Pessoa = Programador Nome Linguagem | Aluno Nome Universidade
				deriving(Show)
programador = Programador "Marcos" "Haskell"
aluno = Aluno "Marcos" "UFPI"
is_programador :: Pessoa -> Bool
is_programador (Programador _ _) = True
is_programador _ = False
is_aluno :: Pessoa -> Bool
is_aluno (Aluno _ _) = True
is_aluno _ = False
Haskell/my_comp.hs
comp_listas :: [Int] -> [Int] -> Bool
comp_listas [] [] = True
comp_listas (a:b) (c:d)
		| (a==c) = comp_listas b d
		|
otherwise = False
comp_listas _ _ = False
Haskell/ifthen_case.hs
if_par :: Int -> Bool
if_par n = if (mod n 2 == 0) then True else False
case_par :: Int -> Bool
case_par n = case (mod n 2 == 0) of
					True -> True
					False -> False
					
Haskell/hanoi.hs
--hanoiAux N origem auxiliar destino
--move os N-1 discos superiores para o auxiliar utilizando a torre destino como auxiliar
--move o disco inferior, o maior de todos para a origem
--move os N-1 discos restantes da torre intermediaria para a torre de destino
hanoiAux :: Int -> Char -> Char -> Char-> [[Char]]
hanoiAux 1 o a d = ["Move de " ++ [o] ++ " para " ++ [d]]
hanoiAux n o a d | n > 1 = (hanoiAux (n-1) o d a) ++ ["Move de " ++ [o] ++ " para " ++ [d]] ++ (hanoiAux (n-1) a o d)
				 | otherwise = []
hanoi :: Int -> [[Char]]
hanoi n = (hanoiAux n 'A' 'B' 'C')
Haskell/filter.hs
is_prime :: Int -> Bool
is_prime 1 = False
is_prime 2 = True
is_prime n | (length [x | x <- [2 .. n-1], mod n x == 0]) > 0 = False
		 | otherwise = True
-- uso: filter is_prime [1 .. n]
Haskell/f_lambda.hs
f_lambda = \x -> (x*x)
f x = x * x
Haskell/exercicios1_10.hs
{-myEq :: [t] -> [t] -> Bool
myEq [] [] = True
myEq [] _ = False
myEq _ [] = False
myEq (x:xs) (y:ys) | (x /= y) = False
				 | otherwise = myEq xs ys-}
--problem4
myLen :: [t] -> Int
myLen [] = 0
myLen (x:xs) = 1 + myLen xs
--problem1
myLast :: [t] -> t
myLast (x:xs) | (myLen (x:xs) == 1) = x
			 | otherwise = myLast xs
--problem2
myButLast :: [t] -> t
myButLast (x:xs) | (myLen(x:xs) == 2) = x
				 | otherwise = myButLast xs
--problem3
elementAt :: [t] -> Int -> t
elementAt (x:xs) n | (n == 1) = x
				 | (n > 1) = elementAt xs (n-1)
--problem5
myReverse :: [t] -> [t]
myReverse [] = []
myReverse (x:xs) = (myReverse xs)++[x]
--problem6
isPalindrome :: [Char] -> Bool
isPalindrome x | (x == (myReverse x)) = True
			 | otherwise = False
--problem7
data NestedList = Elem Int | List [NestedList]
is_elem :: NestedList -> Bool
is_elem (Elem _) = True
is_elem _ = False
get_elem :: NestedList -> Int
get_elem (Elem x) = x
myFlatten :: NestedList -> [Int]
myFlatten (Elem x) = [x]
myFlatten (List []) = []
myFlatten (List (x:xs)) | is_elem(x) = get_elem(x):myFlatten(List xs)
					 | otherwise = myFlatten(x) ++ myFlatten(List xs)
--problem8
myCompress :: [Char] -> [Char]
myCompress [] = []
myCompress (x:[]) = [x]
myCompress (x:(y:ys)) | x == y = myCompress(y:ys)
					 | otherwise = x:(myCompress(y:ys))
--problem9
packAux :: [Char] -> [Char] -> [[Char]]
packAux [] [] = []
packAux (x:[]) [] = [[x]]
packAux [] (x:[]) = [[x]]
packAux (x:xs) [] = [(x:xs)]
packAux [] (x:xs) = packAux [x] xs
packAux (x:xs) (y:ys) | x == y = packAux (y:(x:xs)) ys
					 | otherwise = (x:xs):(packAux [] (y:ys))
pack :: [Char] -> [[Char]]
pack x = packAux [] x
{-- 
Exemplo:
pack ['a', 'a', 'a', 'a', 'b', 'c', 'c', 'a', 'a', 'd', 'e', 'e', 'e']
 = packAux [] ['a', 'a', 'a', 'a', 'b', 'c', 'c', 'a', 'a', 'd', 'e', 'e', 'e']
 = packAux ['a'] ['a', 'a', 'a', 'b', 'c', 'c', 'a', 'a', 'd', 'e', 'e', 'e']
 = packAux ['a', 'a'] ['a', 'a', 'b', 'c', 'c', 'a', 'a', 'd', 'e', 'e', 'e']
 = packAux ["aaa"] ['a', 'b', 'c', 'c', 'a', 'a', 'd', 'e', 'e', 'e']
 = packAux ["aaaa"] ['b', 'c', 'c', 'a', 'a', 'd', 'e', 'e', 'e']
 = ["aaaa"]:(packAux [] ['b', 'c', 'c', 'a', 'a', 'd', 'e', 'e', 'e'])
 = ["aaaa"]:(packAux ['b'] ['c', 'c', 'a', 'a', 'd', 'e', 'e', 'e'])
 = ["aaaa"]:(['b']:(packAux [] ['c', 'c', 'a', 'a', 'd', 'e', 'e', 'e']))
 = ["aaaa"]:(['b']:(packAux ['c'] ['c', 'a', 'a', 'd', 'e', 'e', 'e']))
 = ["aaaa"]:(['b']:(packAux ["cc"] ['a', 'a', 'd', 'e', 'e', 'e']))
 = ["aaaa"]:(['b']:(("cc"):(packAux [] ['a', 'a', 'd', 'e', 'e', 'e']))
 = ("aaaa"):(['b']:(("cc"):(packAux ['a'] ['a', 'd', 'e', 'e', 'e']))
 = ["aaaa"]:(['b']:(("cc"):(packAux ("aa") ['d', 'e', 'e', 'e']))
 = ["aaaa"]:(['b']:(("cc"):(("aa"):(packAux [] ['d', 'e', 'e', 'e'])) )
 --}
--problem10
encodeAux :: [[Char]] -> [(Int,Char)]
encodeAux [] = []
encodeAux ((x:xs):ys) = ((myLen (x:xs)), x):(encodeAux ys)
encode :: [Char] -> [(Int,Char)]
encode x = encodeAux (pack x)
--problem11
data Compression = Single Char | Multiple Int Char
					deriving(Show)
encodeModifiedAux :: [[Char]] -> [Compression]
encodeModifiedAux [] = []
encodeModifiedAux((x:xs):ys) | (myLen (x:xs)) == 1 = (Single x):(encodeModifiedAux ys)
							 | otherwise = (Multiple (myLen(x:xs)) x):(encodeModifiedAux ys)
encodeModified :: [Char] -> [Compression]
encodeModified x = encodeModifiedAux (pack x)
Haskell/exemplo_carros.hs
type Pessoa = String
type Carro = String
type Idade = Int
type Registro = (Pessoa, Carro, Idade)
type BD = [Registro]
f_bd :: BD
f_bd = [("Joao", "Camaro", 20), ("Maria", "Fusca", 30)]
getNome :: Registro -> Pessoa
getNome (n, _, _) = n
getCarros :: BD -> [String]
getCarros ((_, carro, _):xs) = carro : getCarros xs --> retorna lista de todos os carros
Haskell/exemploDo.hs
putStrLn:: String -> IO()
putStrLn str = do putStr str
				 putStr "\n"
faz4vezes::String -> IO()
faz4vezes str = do putStrLn str
				 putStrLn str
				 putStrLn str
				 putStrLn str
fazNvezes :: Int -> String -> IO()
fazNvezes n str = if n <= 1 then putStrLn str
							else do putStrLn str
									fazNvezes (n-1) str
leia2Linhas :: IO()
leia2Linhas = do getLine
				 getLine
				 putStrLn "duas linhas lidas"
getNput :: IO()
getNput = do linha1 <- getLine
			 linha2 <- getLine
			 putStrLn linha1
			 putStrLn linha2
Haskell/arvbusbin.hs
data ArvBusBin t = Nil | No (ArvBusBin t) t (ArvBusBin t)
						deriving (Show, Ord, Eq)
arvbusbin1 = No (No Nil 9 Nil) 14 (No Nil 19 (No Nil 51 Nil))
arvbusbin2 = No (No Nil 3 Nil) 7 (No Nil 18 (No Nil 27 Nil))
arvBBtolista :: ArvBusBin t -> [t]
arvBBtolista Nil = []
arvBBtolista (No ae n ad) = arvBBtolista ae ++ [n] ++ arvBBtolista ad
membroABB :: (Ord t) => t -> ArvBusBin t -> Bool
membroABB :: x Nil = False
membroABB :: x (No ae y ad)
			| x == y = True
			| x != y = (membroABB x ae) || (membroABB x ad)
altABB :: (Ord t) => ArvBusBin t -> Int
altABB Nil = 0
altABB (No ae n ad)
	|ae == Nil) && (ad == Nil) = 0
	| otherwise 1 + max (altABB ae) (altABB ad)
fazABB :: (Ord t) => [t] -> ArvBusBin t
fazABB :: [] = Nil
fazABB (x:xs) = No (fazABB ys) x (fazABB zs)
						| where (ys,zs) = particao (<=x) xs
particao :: (Ord t) => (t->Bool) -> [t] -> ([t],[t])
partica p xs = (filter p xs, filter (not.p) xs)
sort :: (Ord t) => [t] -> [t]
sort = arvBBtolista.fazABB
remove :: (Ord t) => t -> ArvBusBin t -> ArvBusBin t
remove x Nil = Nil
remove x (No ae n ad)
	| (x<n) = No (remove x ae) n ad
	| (x>n) = No ae n (remove x ad)
	| (x==n) = junta ae ad
junta :: (Ord t) => ArvBusBin t -> ArvBusBin t -> ArvBusBin t
junta Nil yt = yt
junta (No ut x vt) yt = No ut x (junta yt vt)
Haskell/arvbin.hs
--Nos externos = nos internos + 1
data ArvBin = Nulo | No Int ArvBin ArvBin
arv :: ArvBin
arv = (No 1 
		(No 2(No 4 Nulo Nulo) (No 5 Nulo Nulo))
		(No 3(No 6 Nulo Nulo) Nulo))
em_ordem :: ArvBin -> [Int]
em_ordem Nulo = []
em_ordem (No num esq dir) = (em_ordem esq) ++ [num] ++ (em_ordem dir)
Haskell/array.hs
import Data.Array
get_array = array (1, 4) [(1,'A'), (2, 'B'), (3, 'C'), (4, 'D')]
-- elems get_array --> retorna os elementos do array
-- get_array ! 2 --> elemento da posicao 2
-- bounds get_array --> retorna limites do array
get_matriz = array ((1,1),(2,2)) [((1,1), 'A'), ((1,2), 'B'), ((2,1), 'C'), ((2,2), 'D')]
Haskell/3nmaisum.hs
par :: Int -> Bool
par x | ((mod x 2) == 0) = True
	 | otherwise = False
tamciclo :: Int -> Int
tamciclo 1 = 1
tamciclo x | (par(x) == True) = (1+tamciclo((x `div` 2)))
		 | otherwise = (1+tamciclo(((3*x) + 1)))
Haskell/haskell problems.odt
http://www.haskell.org/haskellwiki/99_questions/1_to_10
1 Problem 1 
(*) Find the last element of a list. 
(Note that the Lisp transcription of this problem is incorrect.) 
Example in Haskell: 
Prelude> myLast [1,2,3,4]
4
Prelude> myLast ['x','y','z']
'z'
Solutions 
2 Problem 2 
(*) Find the last but one element of a list. 
(Note that the Lisp transcription of this problem is incorrect.) 
Example in Haskell: 
Prelude> myButLast [1,2,3,4]
3
Prelude> myButLast ['a'..'z']
'y'
Solutions 
3 Problem 3 
(*) Find the K'th element of a list. The first element in the list is number 1. 
Example: 
* (element-at '(a b c d e) 3)
c
Example in Haskell: 
Prelude> elementAt [1,2,3] 2
2
Prelude> elementAt "haskell" 5
'e'
Solutions 
4 Problem 4 
(*) Find the number of elements of a list. 
Example in Haskell: 
Prelude> myLength [123, 456, 789]
3
Prelude> myLength "Hello, world!"
13
Solutions 
5 Problem 5 
(*) Reverse a list. 
Example in Haskell: 
Prelude> myReverse "A man, a plan, a canal, panama!"
"!amanap ,lanac a ,nalp a ,nam A"
Prelude> myReverse [1,2,3,4]
[4,3,2,1]
Solutions 
6 Problem 6 
(*) Find out whether a list is a palindrome. A palindrome can be read forward or backward; e.g. (x a m a x). 
Example in Haskell: 
*Main> isPalindrome [1,2,3]
False
*Main> isPalindrome "madamimadam"
True
*Main> isPalindrome [1,2,4,8,16,8,4,2,1]
True
Solutions 
7 Problem 7 
(**) Flatten a nested list structure. 
Transform a list, possibly holding lists as elements into a `flat' list by replacing each list with its elements (recursively). 
Example: 
* (my-flatten '(a (b (c d) e)))
(A B C D E)
Example in Haskell: 
We have to define a new data type, because lists in Haskell are homogeneous. 
data NestedList a = Elem a | List [NestedList a]
*Main> flatten (Elem 5)
[5]
*Main> flatten (List [Elem 1, List [Elem 2, List [Elem 3, Elem 4], Elem 5]])
[1,2,3,4,5]
*Main> flatten (List [])
[]
Solutions 
8 Problem 8 
(**) Eliminate consecutive duplicates of list elements. 
If a list contains repeated elements they should be replaced with a single copy of the element. The order of the elements should not be changed. 
Example: 
* (compress '(a a a a b c c a a d e e e e))
(A B C A D E)
Example in Haskell: 
> compress "aaaabccaadeeee"
"abcade"
Solutions 
9 Problem 9 
(**) Pack consecutive duplicates of list elements into sublists. If a list contains repeated elements they should be placed in separate sublists. 
Example: 
* (pack '(a a a a b c c a a d e e e e))
((A A A A) (B) (C C) (A A) (D) (E E E E))
Example in Haskell: 
*Main> pack ['a', 'a', 'a', 'a', 'b', 'c', 'c', 'a', 
'a', 'd', 'e', 'e', 'e', 'e']
["aaaa","b","cc","aa","d","eeee"]
Solutions 
10 Problem 10 
(*) Run-length encoding of a list. Use the result of problem P09 to implement the so-called run-length encoding data compression method. Consecutive duplicates of elements are encoded as lists (N E) where N is the number of duplicates of the element E. 
Example: 
* (encode '(a a a a b c c a a d e e e e))
((4 A) (1 B) (2 C) (2 A) (1 D)(4 E))
Example in Haskell: 
encode "aaaabccaadeeee"
[(4,'a'),(1,'b'),(2,'c'),(2,'a'),(1,'d'),(4,'e')]
http://www.haskell.org/haskellwiki/99_questions/11_to_20
1 Problem 11 
(*) Modified run-length encoding. 
Modify the result of problem 10 in such a way that if an element has no duplicates it is simply copied into the result list. Only elements with duplicates are transferred as (N E) lists. 
Example: 
* (encode-modified '(a a a a b c c a a d e e e e))
((4 A) B (2 C) (2 A) D (4 E))
Example in Haskell: 
P11> encodeModified "aaaabccaadeeee"
[Multiple 4 'a',Single 'b',Multiple 2 'c',
Multiple 2 'a',Single 'd',Multiple 4 'e']
Solutions 
2 Problem 12 
(**) Decode a run-length encoded list. 
Given a run-length code list generated as specified in problem 11. Construct its uncompressed version. 
Example in Haskell: 
P12> decodeModified 
[Multiple 4 'a',Single 'b',Multiple 2 'c',
Multiple 2 'a',Single 'd',Multiple 4 'e']
"aaaabccaadeeee"
Solutions 
3 Problem 13 
(**) Run-length encoding of a list (direct solution). 
Implement the so-called run-length encoding data compression method directly. I.e. don't explicitly create the sublists containing the duplicates, as in problem 9, but only count them. As in problem P11, simplify the result list by replacing the singleton lists (1 X) by X. 
Example: 
* (encode-direct '(a a a a b c c a a d e e e e))
((4 A) B (2 C) (2 A) D (4 E))
Example in Haskell: 
P13> encodeDirect "aaaabccaadeeee"
[Multiple 4 'a',Single 'b',Multiple 2 'c',
Multiple 2 'a',Single 'd',Multiple 4 'e']
Solutions 
4 Problem 14 
(*) Duplicate the elements of a list. 
Example: 
* (dupli '(a b c c d))
(A A B B C C C C D D)
Example in Haskell: 
> dupli [1, 2, 3]
[1,1,2,2,3,3]
Solutions 
5 Problem 15 
(**) Replicate the elements of a list a given number of times. 
Example: 
* (repli '(a b c) 3)
(A A A B B B C C C)
Example in Haskell: 
> repli "abc" 3
"aaabbbccc"
Solutions 
6 Problem 16 
(**) Drop every N'th element from a list. 
Example: 
* (drop '(a b c d e f g h i k) 3)
(A B D E G H K)
Example in Haskell: 
*Main> dropEvery "abcdefghik" 3
"abdeghk"
Solutions 
7 Problem 17 
(*) Split a list into two parts; the length of the first part is given. 
Do not use any predefined predicates. 
Example: 
* (split '(a b c d e f g h i k) 3)
( (A B C) (D E F G H I K))
Example in Haskell: 
*Main> split "abcdefghik" 3
("abc", "defghik")
Solutions 
8 Problem 18 
(**) Extract a slice from a list. 
Given two indices, i and k, the slice is the list containing the elements between the i'th and k'th element of the original list (both limits included). Start counting the elements with 1. 
Example: 
* (slice '(a b c d e f g h i k) 3 7)
(C D E F G)
Example in Haskell: 
*Main> slice ['a','b','c','d','e','f','g','h','i','k'] 3 7
"cdefg"
Solutions 
9 Problem 19 
(**) Rotate a list N places to the left. 
Hint: Use the predefined functions length and (++). 
Examples: 
* (rotate '(a b c d e f g h) 3)
(D E F G H A B C)
* (rotate '(a b c d e f g h) -2)
(G H A B C D E F)
Examples in Haskell: 
*Main> rotate ['a','b','c','d','e','f','g','h'] 3
"defghabc"
 
*Main> rotate ['a','b','c','d','e','f','g','h'] (-2)
"ghabcdef"
Solutions 
10 Problem 20 
(*) Remove the K'th element from a list. 
Example in Prolog: 
?- remove_at(X,[a,b,c,d],2,R).
X = b
R = [a,c,d]
Example in Lisp: 
* (remove-at '(a b c d) 2)
(A C D)
(Note that this only returns the residue list, while the Prolog version also returns the deleted element.) 
Example in Haskell: 
*Main> removeAt 2 "abcd"
('b',"acd")
Haskell/quant_perfeitos.hs
eDivisor :: Int -> Int -> Bool
eDivisor x y | (x `mod` y == 0) = True
			 | otherwise = False
aux :: Int -> Int -> Int
aux x 1 = 1
aux x y | y <= 0 = 0
		| (eDivisor x y) = (y + (aux x (y-1)))
		| otherwise = (aux x (y-1))
somaDivisores :: Int -> Int
somaDivisores n = (aux n (n `div` 2))
ePerfeito :: Int -> Bool
ePerfeito n = (n == somaDivisores(n))
perfeitosAux :: Int -> Int -> [Int]
perfeitosAux x 0 = []
perfeitosAux x 1 | ePerfeito(x) = [x]
				 | otherwise = perfeitosAux (x+1) 1
perfeitosAux x y | ePerfeito(x) = x:(perfeitosAux (x+1) (y-1))
				 | otherwise = perfeitosAux (x+1) y
quantPerfeitos :: Int -> [Int]
quantPerfeitos 1 = [6]
quantPerfeitos n | n > 1 = 6:(perfeitosAux 7 (n-1))
Haskell/zip.hs
-- zip :: [a] -> [b] -> [(a,b)]
zip [1,2,3] [a,b,c]
-- gera [(1,a), (2,b), (3,c)]
Haskell/tuple.hs
tuple :: (Int, Int) -> (Int, Int) -> (Int,
Int)
tuple (a, b) (c, d) = (a + c, b + d)
Haskell/exercicios_list.hs
Haskell/ordenacao.hs
get_menor :: [Int] -> Int
get_menor [x] = x
get_menor (x:xs) | (x < get_menor xs) = x
				 | otherwise = get_menor xs
remove_menor :: [Int] -> [Int]
remove_menor [] = []
remove_menor (x:xs) | (x == get_menor (x:xs)) = xs
					| otherwise (x:remove_menor xs)
aux_ordena :: [Int] -> [Int]
aux_ordena lista_ordenada [] = lista_ordenada
aux_ordena lista_ordenada x = aux_ordena (lista_ordenada++[get_menor x]) (remove_menor x)
ordena :: [Int] -> [Int]
ordena [] = []
ordena x = aux_ordena [] x
Haskell/rev_list.hs
inv_aux :: [t] -> [t] -> [t]
inv_aux [] l_inv = l_inv
inv_aux (x:xs) l_inv = inv_aux xs l_inv++[x] --operador ++ concatena listas necessario transformar x em lista usando []
inv_lista :: [t] -> [t]
inv_lista [] = []
inv_lista l = inv_aux l []
rev_list :: [t] -> [t]
rev_list [] = []
rev_list (x:xs) = rev_list xs ++ [x] -- recursao a esquerda
Haskell/comp_listas.hs
comp_listas :: [Int] -> [Int] -> Bool
comp_listas [] [] = True
comp_listas [] _ = False
comp_listas _ [] = False
comp_listas (x:xs) (y:ys) | (x == y) = comp_listas xs ys
						 | otherwise = False
Haskell/anom_and.hs
e :: Bool -> Bool -> Bool
e False _ = False
e _ False = False
e True True = True
Haskell/guarda.hs
guarda x | (x == 0) = 0
		 | (x == 1) = 1
		 | otherwise = 10
Haskell/fatorial.hs
fatorial 0 = 1
fatorial n = n*fatorial(n-1)
Haskell/tuple_ops.hs
-- fst ("marcos", 73) --extrai primeiro elemento de uma tupla
-- snd ("marcos", 73) --extrai segundo elemento de uma tupla de dois elementos
nomes :: (String, String, String)
nomes = ("Marcos", "Geeksbr", "Haskell")
selec_prim(x, _, _) = x
selec_sec(_, y, _) = y
selec_ter(_, _, z) = z
Haskell/list_len.hs
size_list [] = 0
size_list (x:xs) = 1 + size_list(xs)
Haskell/list_ops.hs
pertence :: [Int] -> Int -> Bool
pertence [] _ = False
pertence (x:xs) n | (x == n) = True
				 | otherwise = pertence xs n
maior :: [Int] -> Int
maior [x] = x
maior (x:xs) | (x > maior xs) = x
			 | otherwise = maior xs
todos_pares :: [Int] -> Bool
todos_pares [] = True
todos_pares (x:xs) | (mod x 2 /= 0) = False
				 | otherwise = todos_pares xs
Haskell/soma_numeros.hs
soma 1 = 1
soma n = soma(n-1) + 1
Haskell/list_comprehension.hs
[x | x <- [1 .. 10], (mod x 2) == 0]
[(x,y) | x <- [2 .. 5], y <- [4 .. 9]]
Haskell/type.hs
type Nome = String
type Idade = Int
type Linguagem = String
type Pessoa = (Nome, Idade, Linguagem)
pessoa:: Pessoa
pessoa = ("joao", 20, "haskell")
my_fst :: Pessoa -> Nome
my_fst (n, i, l) = n
Haskell/fibonacci.hs
fibonacci 0 = 1
fibonacci 1 = 1
fibonacci n = fibonacci (n - 1) + fibonacci (n - 2)
Haskell/lista 2/um.hs
{--
A implementação deste item foi realizada utilizando uma função f2 auxiliar, 
que retorna a lista de elementos a ser concatenada baseada no vetor de posições, 
e a função utilitária map. A função map juntamente com a função implementada dec 
foi usada por conveniencia, para realizar a indexação dos elementos a partir de 
um, embora por default o operador !! use indexação baseada em zero. Adicionalmente
utilizamos a funcao reverse para imprimir os elementos extras na ordem especifica-
da.
--}
dec :: Int -> Int
dec x = x-1
f2 :: [Int] -> [t] -> [t]
f2 [] (y:ys) = []
f2 (x:xs) (y:ys) = ((y:ys)!!x):(f2 xs (y:ys))
f :: [Int] -> [t] -> [t]
f [] [] = []
f (x:xs) [] = []
f [] (y:ys) = (y:ys)
f (x:xs) (y:ys) = (y:ys)++(reverse(f2 (map (dec) (x:xs)) (y:ys)))
Haskell/lista 2/tres.hs
import Data.Matrix
my_sum :: (Num t) => [t] -> Int -> t
my_sum [] _ = 0
my_sum (x:xs) 1 = x + (my_sum xs (-1))
my_sum (x:xs) (-1) = (-1)*x + (my_sum xs 1)
my_minor :: (Num t) => Matrix t -> Int -> Matrix t
my_minor x a = minorMatrix 1 a x 
my_det :: (Num t) => Matrix t -> t
my_det x | (nrows x) == 2 = ((getElem 1 1 x)*(getElem 2 2 x) - (getElem 1 2 x)*(getElem 2 1 x))
		 | otherwise = (my_sum (map (my_det) (map (my_minor x) [1 .. (ncols x)])) 1)
mat :: Matrix Int
mat = fromList 3 3 [1..]
{--
Na implementação deste exercício foi utilizada a biblioteca Data.Matrix,
que pode ser instalada no linux com o utilitário cabal(apt-get install cabal-install) 
com o comando cabal install matrix.
Instrucoes de instalacao do cabal no windows podem ser encontradas em:
http://www.haskell.org/haskellwiki/Cabal-Install#Windows
Com a declaração de mat é possível realizar o teste da função my_det que recebe como 
argumento uma matriz de números e retorna o determinante dessa matriz, que no caso é zero. 
Foi utilizada a ideia recursiva de que o determinante de uma matriz é igual ao somatório 
do determinante multiplicado por um fator, que se alterna entre -1 e 1(função my_sum) das
submatrizes obtidas escolhendo-se uma linha e removendo, isoladamente, a coluna e o 
elemento de cada elemento desta linha até a coluna ncols x , onde x é uma matriz 
passada como parâmetro.
--}
Haskell/lista 2/sete.hs
pred_length :: Int -> [t] -> Bool
pred_length n x = (length x) >= n
list_sub :: [t] -> Int -> [[t]]
list_sub [] _ = [[]]
list_sub (x:xs) n | (length (x:xs)) >= n = filter (pred_length n) ([x:y | y <- (list_sub xs (n-1))] ++ (list_sub xs n) ) 
					| otherwise = [[]]
{--
Para retornar todas as sublistas de uma lista de elementos, tal que essas sublistas tenham um tamanho
maior ou igual que um número n eh necessário percorrer todo o espaço de busca. Recursivamente, podemos definir 
todas essas combinacoes em uma lista haskell do tipo (x:xs) como o conjunto de todas as sublistas de 
tamanho maiores ou iguais que n que nao contem a cabeça x unido ao conjunto das sublistas da concatenacao
da cabeça x a todas as sublistas possiveis de tamanho maior ou igual a n-1 na lista xs. A funcao filter garante a 
propriedade “>=n”, enquanto a condicao (length (x:xs)) >= n foi utilizada para fins de desempenho, podando 
onde as cadeias nao podem alcançar a longitude minima desejada.
--}
Haskell/lista 2/seis.hs
nove :: [Int]
nove = [4,1,4,2,1,2,1]
cinco :: [Int]
cinco = [4,2,3,2,4]
um :: [Int]
um = [0,2,1,2,1,2,1,2,1,2,1]
dois :: [Int]
dois = [3,2,5,2,3]
tres :: [Int]
tres = [3,2,4,2,4] 
quatro :: [Int]
quatro = [1,1,2,1,4,2,1,2,1]
seis :: [Int]
seis = [4,2,4,1,4]
sete :: [Int]
sete = [3,2,1,2,1,2,1,2,1]
oito :: [Int]
oito = [4,1,5,1,4]
zero :: [Int]
zero = [4,1,2,1,2,1,4]
-- Letra a
toAst :: Int -> String
toAst 0 = ""
toAst n = "*"++(toAst (n-1))
toSpace :: Int -> String
toSpace 0 = ""
toSpace n = " "++(toSpace (n-1))
toString :: [Int] -> String
toString [] = ""
toString (x:[]) = toAst x
toString (x:y:ys) = (toAst x) ++ (toSpace y) ++ (toString ys)
--Letra b
type Linha = String
toLinhas :: String -> [Linha]
toLinhas [] = []
toLinhas (x:[]) = [[x]]
toLinhas (x:y:z:zs) = [x,y,z]:(toLinhas zs)
--Letra c
showLinhas :: [Linha] -> String
showLinhas [] = ""
showLinhas (x:xs) = x++"\n"++(showLinhas xs)
--Letra d
juntaLinhas :: [Linha] -> [Linha] -> [Linha]
juntaLinhas [] [] = []
juntaLinhas (x:xs) (y:ys) = (x++" "++y):(juntaLinhas xs ys)
--Letra e
ndig :: Int -> Int
ndig n | n < 10 = 1
 | n < 100 = 2
 | otherwise = 3
numeros :: [[Int]]
numeros = [zero,um,dois,tres,quatro,cinco,seis,sete,oito,nove]
tolcd :: Int -> String
tolcd n | (ndig n) == 1 = showLinhas (toLinhas (toString (numeros!!n)))
 | (ndig n) == 2 
 = showLinhas
 (juntaLinhas 
 (toLinhas (toString (numeros!!((mod n 100) `div` 10)))) 
 (toLinhas (toString (numeros!!(mod n 10))))
 )
 | (ndig n) == 3 
 = showLinhas
 (juntaLinhas 
 (juntaLinhas
 (toLinhas 
 (toString (numeros!!((mod n 1000) `div` 100))))
(toLinhas 
 (toString (numeros!!((mod n 100) `div` 10)))) ) 
 (toLinhas (toString (numeros!!((mod n 10)))))
 )
--Letra f
type Estado = Bool
tcomp :: String -> Estado -> Int -> [Int]
tcomp [] False n | (n > 0) = [n]
 | otherwise = []
tcomp [] True n | (n > 0) = [n]
 | otherwise = []
tcomp (x:xs) True n | x == '*' = tcomp (xs) True (n+1)
 | otherwise = n:(tcomp (x:xs) False 0)
tcomp (x:xs) False n | x == ' ' = tcomp (xs) False (n+1)
 | otherwise = n:(tcomp (x:xs) True 0)
toCompact :: String -> [Int]
toCompact s = tcomp s True 0
Haskell/lista 2/quatro.hs
validAux :: Int -> Int -> [Int] -> Bool
validAux _ _ [] = True
validAux p c (x:xs) | p == x = False --rainhas na mesma linha
					| ((x-p) == c) || ((x-p) == (-c)) = False -- rainhas na mesma diagonal
					| otherwise = validAux p (c+1) xs
valid :: [Int] -> Bool
valid [] = True
valid (x:xs) = (validAux x 1 xs) && (valid xs)
--chess8Aux n
--resolve problema das 8 rainhas. O parametro n eh o numero de colunas restantes
chess8Aux :: Int -> [[Int]]
chess8Aux 0 = [[]]
chess8Aux 1 = [[1]]
chess8Aux n = filter valid [x:y | y <- (chess8Aux (n-1)), x <- [1 .. 8]]
chess8 :: [Int]
chess8 = (chess8Aux 8)!!1
{--
As funções valid e validAux são usadas com propósito de filtrar o espaço de configurações do tabuleiro 
de modo que as rainhas não conflitem em linha ou diagonal. A verificação por coluna não é necessária 
visto que é considerado que as rainhas são colocadas por padrão em colunas distintas, sendo o retorno 
de chess8 uma lista com as posições das linhas das rainhas em ordem de colunas. A função chess8Aux 
retorna um conjunto de soluções possíveis quando passada com o parâmetro 8, e a função chess retorna 
a solução de posição 1 na lista de listas retornada por chess8Aux.
--}
Haskell/lista 2/oito.hs
occur :: String -> String -> String -> Bool
occur [] _ _ = True
occur x _ [] = True
occur _ [] _ = False
occur x (y:ys) (a:as) | y == a = occur x ys as
				 | otherwise = occur x (ys) x
getT :: Int -> (String, String) -> String
getT 0 (a,b) = a
getT 1 (a,b) = b
-- sep x y z b c
-- retorna uma tupla contendo as string anteriores e posteriores a string x na cadeia y
-- x: A string a ser encontrada
-- y: String onde deveremos buscar a String x
-- z: Restante dos caracteres de x a serem reconhecidos
-- b: Parte da String que coincidiu com o inicio de x, porem ainda esta em reconhecimento
-- c: Parte da String que foi lida mas que nao foi reconhecida
sep :: String -> String -> String -> String -> String -> (String, String)
sep [] y _ _ _= (y, [])
sep x y [] b c = (c, y)
sep _ [] _ b c = ((c++b), [])
sep x (y:ys) (a:as) b c | y == a = sep x ys as (b++[a]) c
				 		| otherwise = sep x ys x [] (c++b++[y])
substr :: String -> String -> String -> String
substr x y z | (occur x z x) = (getT 0 (sep x z x [] [])) ++ y ++ (getT 1 (sep x z x [] []))
		 | otherwise = z
{--
Para implementar o reconhecimento de strings, podemos simular um autômato que reconheça a substring1
na substring3 fazendo com que os estados do automato correspondam aos caracteres da substring1,
realizando a transicao dos caracteres um a um. Mantemos a string a ser reconhecida em memoria como 
o primeiro parâmetro da função occur e a cada passo fazemos uma chamada recursiva para a mesma, que 
equivale a uma transicao. O estado atual eh mantido na cabeca da lista correspondente ao terceiro 
parametro, juntamente com o restante a ser reconhecido. Quando não nos restam mais caracteres a 
serem reconhecidos(O terceiro parâmetro é a lista vazia), temos a certeza de que reconhecemos todos os 
caracteres e a substring1 pertence a substring3. Apos o reconhecimento, podemos realizar a 
substituicao com segurança. Em primeiro lugar separamos a string nas duas partes para a esquerda 
e para a direita da substring1, utilizando a função sep. Por ultimo, a funcao substr realiza o resto 
do trabalho concatenando a substring2 no meio das duas substrings resultantes de sep.
--}
Haskell/lista 2/nove.hs
type Pessoa = String
type Key = String
type Keys = [Key]
type Nome = String
type Database = [(Pessoa, Livro)]
--Tipos para letra c:
type Dia = Integer
type Mes = Integer
type Ano = Integer
type Data = (Dia, Mes, Ano)
type Livro = (String, Keys, Data) -- Letra b: Acrescentar chaves
numEmprestados :: Database -> Pessoa -> Int
numEmprestados db fulano = length [liv | (pes,liv) <- db, pes == fulano]
livrosEmprestados :: Database -> Pessoa -> [Livro]
livrosEmprestados db fulano = [liv | (pes, liv) <- db, pes == fulano]
--Letra a: Quantidade de livros emprestados deve ser menor ou igual que maxL, o numero maximo que alguem deve tomar emprestado
tomaEmprestado :: Database -> Pessoa -> Livro -> Database
tomaEmprestado db fulano titulo | ((numEmprestados db fulano) < maxL) = (fulano, titulo) : db
								| otherwise = db
--Funcao modificada para facilitar a devolucao do livro apenas pelo nome do livro
devolveLivro :: Database -> Pessoa -> Nome -> Database
devolveLivro ((p, (t,k,d)): r) f l
			|(p == f) && (t == l) = r
			| otherwise = (p,(t,k,d)) : devolveLivro r f l 
devolveLivro [ ] ful tit = error "Nao ha livro emprestado"
--Se livro ocorre no vetor de chaves retorna True. False Caso contrario.
occur :: Key -> Keys -> Bool
occur x (y:ys) | (x == y) = True
			 | otherwise = occur x ys
occur x [] = False
estaEmprestado :: Database -> Nome -> Bool
estaEmprestado db nome = (length [n | (_, (n, k, d)) <- db, n == nome]) > 0
--Letra b: Os livros podem ser encontrados atraves de palavras-chaves associadas a eles
buscarLivro :: Database -> Key -> [Livro]
buscarLivro db k = [(t,l,d) | (_, (t,l,d)) <- db, (occur k l)]
toDias :: Data -> Integer
toDias (d,m,a) = (d + (m*30) + (a*365))
devedores :: Database -> Data -> Nome -> [Pessoa]
devedores db atual l_name = [p | (p, (l,k,d)) <- db, (l == l_name), ((toDias atual) - (toDias d)) > maxD]
--Letra c: Livros atrasados podem ser encontrados
livrosAtrasados :: Database -> Data -> [Livro]
livrosAtrasados db atual = [(l,k,d) | (_, (l,k,d)) <- db, ((toDias atual) - (toDias d)) > maxD]
--Letra c: A lista de livros emprestados a uma determinada pessoa pode ser ordenada por data 
ordLivros :: [Livro] -> [Livro]
ordLivros ((pes, keys, dat):xs) = ((ordLivros [(p,k,d) | (p,k,d) <- xs, (toDias d) < (toDias dat)]) ++ [(pes, keys, dat)]) ++ (ordLivros [(p,k,d) | (p,k,d) <- xs, (toDias d) >= (toDias dat)])
ordLivros [] = []
livrosEmprestadosOrd :: Database -> Pessoa -> [Livro]
livrosEmprestadosOrd db p = ordLivros (livrosEmprestados db p)
-- maxL: Numero maximo de livros a serem emprestados
maxL :: Int
maxL = 3
-- maxD: Numero maximo de dias de um emprestimo
maxD :: Integer
maxD = 7
teste = [("Paulo", ("A Mente Nova do Rei", ["IA", "Roger Penrose", "Computador"], (12,6,2014))),
		("Ana", ("O Segredo de Luiza",["Empreendedorismo", "Fernando Dolabela"], (15, 5, 2014))),
		("Paulo", ("O Pequeno Principe", ["Antoine de Saint-Exupery", "Le Petit Prince", "historia"], (28, 6, 2014))), 
		("Mauro", ("O Capital", ["Karl Marx", "Das Kapital", "Socialismo"], (25, 6, 2014))),
		("Francisco", ("O Auto da Compadecida", ["Ariano Suassuna","Peça Teatral"], (22, 6, 2014))),
		("Paulo", ("O Cacador de Pipas", ["historia", "Khaled Hosseini", "Afeganistao"], (12,6,2014)))]
datual :: Data
datual = (30, 6, 2014)
Haskell/lista 2/lista_2_Milton.zip
cinco.hs
f2 :: [t] -> Bool -> [[t]] -> [[t]]
f2 [] _ x = x
f2 (x:xs) True [a, b] = f2 xs False [a++[x], b]
f2 (x:xs) False [a, b] = f2 xs True [a, b++[x]]
f :: [t] -> [[t]]
f x = f2 x True [[], []]
{--
As funções valid e validAux são usadas com propósito de filtrar o espaço de configurações 
do tabuleiro de modo que as rainhas não conflitem em linha ou diagonal. A verificação por 
coluna não é necessária visto
que é considerado que as rainhas são colocadas por padrão 
em colunas distintas, sendo o retorno de chess8 uma lista com as posições das linhas das 
rainhas em ordem consecutiva de colunas. A função chess8Aux retorna um conjunto de soluções possíveis
quando passada com o parâmetro 8, e a função chess retorna a solução de posição 1 na lista
de listas retornada por chess8Aux.
--}
dez.hs
sub_lists :: [t] -> [[t]]
sub_lists [] = [[]]
sub_lists (x:xs) = [x:y | y <- (sub_lists xs)] ++ (sub_lists xs)
{--
O conjunto de todas as sublistas e subsequencias possiveis da lista (x:xs)
eh a uniao entre o conjunto de todas as sublistas de (xs) e o conjunto de 
todas as concatenacoes [x]++y, tal que y pertence ao conjunto de todas as
sublistas e subsequencias de xs.
--}
nove.hs
type Pessoa = String
type Key = String
type Keys = [Key]
type Nome = String
type Database = [(Pessoa, Livro)]
--Tipos para letra c:
type Dia = Integer
type Mes = Integer
type Ano = Integer
type Data = (Dia, Mes, Ano)
type Livro = (String, Keys, Data) -- Letra b: Acrescentar chaves
numEmprestados :: Database -> Pessoa -> Int
numEmprestados db fulano = length [liv | (pes,liv) <- db, pes == fulano]
livrosEmprestados :: Database -> Pessoa -> [Livro]
livrosEmprestados db fulano = [liv | (pes, liv) <- db, pes == fulano]
--Letra a: Quantidade de livros emprestados deve ser menor ou igual que maxL, o numero maximo que alguem deve tomar emprestado
tomaEmprestado :: Database -> Pessoa -> Livro -> Database
tomaEmprestado db fulano titulo | ((numEmprestados db fulano) < maxL) = (fulano, titulo) : db
								| otherwise = db
--Funcao modificada para facilitar a devolucao do livro apenas pelo nome do livro
devolveLivro :: Database -> Pessoa -> Nome -> Database
devolveLivro ((p, (t,k,d)): r) f l
			|(p == f) && (t == l) = r
			| otherwise = (p,(t,k,d)) : devolveLivro r f l 
devolveLivro [ ] ful tit = error "Nao ha livro emprestado"
--Se livro ocorre no vetor de chaves retorna True. False Caso contrario.
occur :: Key -> Keys -> Bool
occur x (y:ys) | (x == y) = True
			 | otherwise = occur x ys
occur x [] = False
estaEmprestado :: Database -> Nome -> Bool
estaEmprestado db nome = (length [n | (_, (n, k, d)) <- db, n == nome]) > 0
--Letra b: Os livros podem ser encontrados atraves de palavras-chaves associadas a eles
buscarLivro :: Database -> Key -> [Livro]
buscarLivro db k = [(t,l,d) | (_, (t,l,d)) <- db, (occur k l)]
toDias :: Data -> Integer
toDias (d,m,a) = (d + (m*30) + (a*365))
devedores :: Database -> Data -> Nome -> [Pessoa]
devedores db atual l_name = [p | (p, (l,k,d)) <- db, (l == l_name), ((toDias atual) - (toDias d)) > maxD]
--Letra c: Livros atrasados podem ser encontrados
livrosAtrasados :: Database -> Data -> [Livro]
livrosAtrasados db atual = [(l,k,d) | (_, (l,k,d)) <- db, ((toDias atual) - (toDias d)) > maxD]
--Letra c: A lista de livros emprestados a uma determinada pessoa pode ser ordenada por data 
ordLivros :: [Livro] -> [Livro]
ordLivros ((pes, keys, dat):xs) = ((ordLivros [(p,k,d) | (p,k,d) <- xs, (toDias d) < (toDias dat)]) ++ [(pes, keys, dat)]) ++ (ordLivros [(p,k,d) | (p,k,d) <- xs, (toDias d) >= (toDias dat)])
ordLivros [] = []
livrosEmprestadosOrd :: Database -> Pessoa -> [Livro]
livrosEmprestadosOrd db p = ordLivros (livrosEmprestados db p)
-- maxL: Numero maximo de livros a serem emprestados
maxL :: Int
maxL = 3
-- maxD: Numero maximo de dias de um emprestimo
maxD :: Integer
maxD = 7
teste = [("Paulo", ("A Mente Nova do Rei", ["IA", "Roger Penrose", "Computador"], (12,6,2014))),
		("Ana", ("O Segredo de Luiza",["Empreendedorismo", "Fernando Dolabela"], (15, 5, 2014))),
		("Paulo", ("O Pequeno Principe", ["Antoine de Saint-Exupery", "Le Petit Prince", "historia"], (28, 6, 2014))), 
		("Mauro", ("O Capital", ["Karl Marx", "Das Kapital", "Socialismo"], (25, 6, 2014))),
		("Francisco", ("O Auto da Compadecida", ["Ariano Suassuna","Peça Teatral"], (22, 6, 2014))),
		("Paulo", ("O Cacador de Pipas", ["historia", "Khaled Hosseini", "Afeganistao"], (12,6,2014)))]
datual :: Data
datual = (30, 6, 2014)
oito.hs
occur :: String -> String -> String -> Bool
occur [] _ _ = True
occur x _ [] = True
occur _ [] _ = False
occur x (y:ys) (a:as) | y == a = occur x ys as
				 | otherwise = occur x (ys) x
getT :: Int -> (String, String) -> String
getT 0 (a,b) = a
getT 1 (a,b) = b
-- sep x y z b c
-- retorna uma tupla contendo as string anteriores e posteriores a string x na cadeia y
-- x: A string a ser encontrada
-- y: String onde deveremos buscar a String x
-- z: Restante dos caracteres de x a serem reconhecidos
-- b: Parte da String que coincidiu com o inicio de x, porem ainda esta em reconhecimento
-- c: Parte da String que foi lida mas que nao foi reconhecida
sep :: String -> String -> String -> String -> String -> (String, String)
sep [] y _ _ _= (y, [])
sep x y [] b c = (c, y)
sep _ [] _ b c = ((c++b), [])
sep x (y:ys) (a:as) b c | y == a = sep x ys as (b++[a]) c
				 		| otherwise = sep x ys x [] (c++b++[y])
substr :: String -> String -> String -> String
substr x y z | (occur x z x) = (getT 0 (sep x z x [] [])) ++ y ++ (getT 1 (sep x z x [] []))
		 | otherwise = z
{--
Para implementar o reconhecimento de strings, podemos simular um autômato que reconheça a substring1
na substring3 fazendo com que os estados do automato correspondam aos caracteres da substring1,
realizando a transicao dos caracteres um a um. Mantemos a string a ser reconhecida em memoria como 
o primeiro parâmetro da função occur e a cada passo fazemos uma chamada recursiva para a mesma, que 
equivale a uma transicao. O estado atual eh mantido na cabeca da lista correspondente ao terceiro 
parametro, juntamente com o restante a ser reconhecido. Quando não nos restam mais caracteres a 
serem reconhecidos(O terceiro parâmetro é a lista vazia), temos a certeza de que reconhecemos todos os 
caracteres e a substring1 pertence a substring3. Apos o reconhecimento, podemos realizar a 
substituicao com segurança. Em primeiro lugar separamos a string nas duas partes para a esquerda 
e para a direita da substring1, utilizando a função sep. Por ultimo, a funcao substr realiza o resto 
do trabalho concatenando a substring2 no meio das duas substrings resultantes de sep.
--}
quatro.hs
validAux :: Int -> Int -> [Int] -> Bool
validAux _ _ [] = True
validAux p c (x:xs) | p == x = False --rainhas na mesma linha
					| ((x-p) == c) || ((x-p) == (-c)) = False -- rainhas na mesma diagonal
					| otherwise = validAux p (c+1) xs
valid :: [Int] -> Bool
valid [] = True
valid (x:xs) = (validAux x 1 xs) && (valid xs)
--chess8Aux n
--resolve problema das 8 rainhas. O parametro n eh o numero de colunas restantes
chess8Aux :: Int -> [[Int]]
chess8Aux 0 = [[]]
chess8Aux 1 = [[1]]
chess8Aux n = filter valid [x:y | y <- (chess8Aux (n-1)), x <- [1 .. 8]]
chess8 :: [Int]
chess8 = (chess8Aux 8)!!1
{--
As funções valid e validAux são usadas com propósito de filtrar o espaço de configurações do tabuleiro 
de modo que as rainhas não conflitem em linha ou diagonal. A verificação por coluna não é necessária 
visto que é considerado que as rainhas são colocadas por padrão em colunas distintas, sendo o retorno 
de chess8 uma lista com as posições das linhas das rainhas em ordem de colunas. A função chess8Aux 
retorna um conjunto de soluções possíveis quando passada com o parâmetro 8, e a função chess retorna 
a solução de posição 1 na lista de listas retornada por chess8Aux.
--}
seis.hs
nove :: [Int]
nove = [4,1,4,2,1,2,1]
cinco :: [Int]
cinco = [4,2,3,2,4]
um :: [Int]
um = [0,2,1,2,1,2,1,2,1,2,1]
dois :: [Int]
dois = [3,2,5,2,3]
tres :: [Int]
tres = [3,2,4,2,4] 
quatro :: [Int]
quatro = [1,1,2,1,4,2,1,2,1]
seis :: [Int]
seis = [4,2,4,1,4]
sete :: [Int]
sete = [3,2,1,2,1,2,1,2,1]
oito
:: [Int]
oito = [4,1,5,1,4]
zero :: [Int]
zero = [4,1,2,1,2,1,4]
-- Letra a
toAst :: Int -> String
toAst 0 = ""
toAst n = "*"++(toAst (n-1))
toSpace :: Int -> String
toSpace 0 = ""
toSpace n = " "++(toSpace (n-1))
toString :: [Int] -> String
toString [] = ""
toString (x:[]) = toAst x
toString (x:y:ys) = (toAst x) ++ (toSpace y) ++ (toString ys)
--Letra b
type Linha = String
toLinhas :: String -> [Linha]
toLinhas [] = []
toLinhas (x:[]) = [[x]]
toLinhas (x:y:z:zs) = [x,y,z]:(toLinhas zs)
--Letra c
showLinhas :: [Linha] -> String
showLinhas [] = ""
showLinhas (x:xs) = x++"\n"++(showLinhas xs)
--Letra d
juntaLinhas :: [Linha] -> [Linha] -> [Linha]
juntaLinhas [] [] = []
juntaLinhas (x:xs) (y:ys) = (x++" "++y):(juntaLinhas xs ys)
--Letra e
ndig :: Int -> Int
ndig n | n < 10 = 1
 | n < 100 = 2
 | otherwise = 3
numeros :: [[Int]]
numeros = [zero,um,dois,tres,quatro,cinco,seis,sete,oito,nove]
tolcd :: Int -> String
tolcd n | (ndig n) == 1 = showLinhas (toLinhas (toString (numeros!!n)))
 | (ndig n) == 2 
 = showLinhas
 (juntaLinhas 
 (toLinhas (toString (numeros!!((mod n 100) `div` 10)))) 
 (toLinhas (toString (numeros!!(mod n 10))))
 )
 | (ndig n) == 3 
 = showLinhas
 (juntaLinhas 
 (juntaLinhas
 (toLinhas 
 (toString (numeros!!((mod n 1000) `div` 100)))) 
 (toLinhas 
 (toString (numeros!!((mod n 100) `div` 10)))) ) 
 (toLinhas (toString (numeros!!((mod n 10)))))
 )
--Letra f
type Estado = Bool
tcomp :: String -> Estado -> Int -> [Int]
tcomp [] False n | (n > 0) = [n]
 | otherwise = []
tcomp [] True n | (n > 0) = [n]
 | otherwise = []
tcomp (x:xs) True n | x == '*' = tcomp (xs) True (n+1)
 | otherwise = n:(tcomp (x:xs) False 0)
tcomp (x:xs) False n | x == ' ' = tcomp (xs) False (n+1)
 | otherwise = n:(tcomp (x:xs) True 0)
toCompact :: String -> [Int]
toCompact s = tcomp s True 0
sete.hs
pred_length :: Int -> [t] -> Bool
pred_length n x = (length x) >= n
list_sub :: [t] -> Int -> [[t]]
list_sub [] _ = [[]]
list_sub (x:xs) n | (length (x:xs)) >= n = filter (pred_length n) ([x:y | y <- (list_sub xs (n-1))] ++ (list_sub xs n) ) 
					| otherwise = [[]]
{--
Para retornar todas as sublistas de uma lista de elementos, tal que essas sublistas tenham um tamanho
maior ou igual que um número n eh necessário percorrer todo o espaço de busca. Recursivamente, podemos definir 
todas essas combinacoes em uma lista haskell do tipo (x:xs) como o conjunto de todas as sublistas de 
tamanho maiores ou iguais que n que nao contem a cabeça x unido ao conjunto das sublistas da concatenacao
da cabeça x a todas as sublistas possiveis de tamanho maior ou igual a n-1 na lista xs. A funcao filter garante a 
propriedade “>=n”, enquanto a condicao (length (x:xs)) >= n foi utilizada para fins de desempenho, podando 
onde as cadeias nao podem alcançar a longitude minima desejada.
--}
tres.hs
import Data.Matrix
my_sum :: (Num t) => [t] -> Int -> t
my_sum [] _ = 0
my_sum (x:xs) 1 = x + (my_sum xs (-1))
my_sum (x:xs) (-1) = (-1)*x + (my_sum xs 1)
my_minor :: (Num t) => Matrix t -> Int -> Matrix t
my_minor x a = minorMatrix 1 a x 
my_det :: (Num t) => Matrix t -> t
my_det x | (nrows x) == 2 = ((getElem 1 1 x)*(getElem 2 2 x) - (getElem 1 2 x)*(getElem 2 1 x))
		 | otherwise = (my_sum (map (my_det) (map (my_minor x) [1 .. (ncols x)])) 1)
mat :: Matrix Int
mat = fromList 3 3 [1..]
{--
Na implementação deste exercício foi utilizada a biblioteca Data.Matrix,
que pode ser instalada no linux com o utilitário cabal(apt-get install cabal-install) 
com o comando cabal install matrix.
Instrucoes de instalacao do cabal no windows podem ser encontradas em:
http://www.haskell.org/haskellwiki/Cabal-Install#Windows
Com a declaração de mat é possível realizar o teste da função my_det que recebe como 
argumento uma matriz de números e retorna o determinante dessa matriz, que no caso é zero. 
Foi utilizada a ideia recursiva de que o determinante de uma matriz é igual ao somatório 
do determinante multiplicado por um fator, que se alterna entre -1 e 1(função my_sum) das
submatrizes obtidas escolhendo-se uma linha e removendo, isoladamente, a coluna e o 
elemento de cada elemento desta linha até a coluna ncols x , onde x é uma matriz 
passada como parâmetro.
--}
um.hs
{--
A implementação deste item foi realizada utilizando uma função f2 auxiliar, 
que retorna a lista de elementos a ser concatenada baseada no vetor de posições, 
e a função utilitária map. A função map juntamente com a função implementada dec 
foi usada por conveniencia, para realizar a indexação dos elementos a partir de 
um, embora por default o operador !! use indexação baseada em zero. Adicionalmente
utilizamos a funcao reverse para imprimir os elementos extras na ordem especifica-
da.
--}
dec :: Int -> Int
dec x = x-1
f2 :: [Int] -> [t] -> [t]
f2 [] (y:ys) = []
f2 (x:xs) (y:ys) = ((y:ys)!!x):(f2 xs (y:ys))
f :: [Int] -> [t] -> [t]
f [] [] = []
f (x:xs) [] = []
f [] (y:ys) = (y:ys)
f (x:xs) (y:ys) = (y:ys)++(reverse(f2 (map (dec) (x:xs)) (y:ys)))
Haskell/lista 2/lista 2 respostas_Milton.pdf
Haskell – Lista 2
Aluno: Mílton Cézar Correia Segundo
Matrícula: 1075128
Disciplina: Programação Funcional
Professor: Francisco Vieira
Nota: Embora, as questões da lista de exercícios estejam descontínuadas(i. e. Da questão um se vá 
direto à questão 3), a ordem aqui colocada corresponde a ordem sequencial.
1. A implementação deste item foi realizada utilizando uma função f2 auxiliar, que retorna a lista de 
elementos a ser concatenada baseada no vetor de posições, e a função utilitária map. A função map 
juntamente com a função implementada dec foi usada por conveniencia, para realizar a indexação 
dos elementos a partir de um, embora por default o operador !! use indexação baseada em zero.
dec :: Int -> Int
dec x = x-1
f2 :: [Int] -> [t] -> [t]
f2 [] (y:ys) = []
f2 (x:xs) (y:ys) = ((y:ys)!!x):(f2 xs (y:ys))
f :: [Int] -> [t] -> [t]
f [] [] = []
f (x:xs) [] = []
f [] (y:ys) = (y:ys)
f (x:xs) (y:ys) = (y:ys)++(f2 (map (dec) (x:xs)) (y:ys))
Obs: O exemplo do enunciado está errado. Considerando-se que a função indexa os elementos da lista a partir do 
elemento 1 temos:
 f [2,1,4] ["a", "b", "c", "d"] = ["a", "b", "c", "d", "b", "a", "d"]
Pois os elementos [2, 1, 4] correspondem a “b”, “a”, e “d” da lista da esquerda, respectivamente. Ao contrário do que se 
apresenta no enunciado:
 f [2,1,4] ["a", "b", "c", "d"] = ["a", "b", "c", "d", "d", "a", "b"]
2. Na implementação deste exercício foi utilizada a biblioteca Data.Matrix que pode ser instalada 
no linux com o utilitário cabal(apt-get install cabal-install) com o comando cabal install matrix.
Segue o código:
import Data.Matrix
my_sum :: (Num t) => [t] -> Int -> t
my_sum [] _ = 0
my_sum (x:xs) 1 = x + (my_sum xs (-1))
my_sum (x:xs) (-1) = (-1)*x + (my_sum xs 1)
my_minor :: (Num t) => Matrix t -> Int -> Matrix t
my_minor x a = minorMatrix 1 a x 
my_det :: (Num t) => Matrix t -> t
my_det x | (nrows x) == 2 = ((getElem 1 1 x)*(getElem 2 2 x) - (getElem 1 2 x)*(getElem 2 1 
x))
 | otherwise = (my_sum (map (my_det) (map (my_minor x) [1 .. (ncols x)])) 1)
mat :: Matrix Int
mat = fromList 3 3 [1..]
Com a declaração de mat é possível realizar o teste da função my_det que recebe como argumento 
uma matriz de números e retorna o determinante dessa matriz, que no caso é zero. Foi utilizada a 
ideia recursiva de que o determinante de uma matriz é igual ao somatório do determinante 
multiplicado por um fator, que se alterna entre -1 e 1(função my_sum)
das submatrizes obtidas 
escolhendo-se uma linha e removendo, isoladamente, a coluna e o elemento de cada elemento desta 
linha até a coluna ncols x , onde x é uma matrix passada como parâmetro.
3. As funções valid e validAux são usadas com propósito de filtrar o espaço de configurações do 
tabuleiro de modo que as rainhas não conflitem em linha ou diagonal. A verificação por coluna não 
é necessária visto que é considerado que as rainhas são colocadas por padrão em colunas distintas, 
sendo o retorno de chess8 uma lista com as posições das linhas das rainhas em ordem de colunas. A 
função chess8Aux retorna um conjunto de soluções possíveis quando passada com o parâmetro 8, e 
a função chess retorna a solução de posição 1 na lista de listas retornada por chess8Aux.
validAux :: Int -> Int -> [Int] -> Bool
validAux _ _ [] = True
validAux p c (x:xs) | p == x = False --rainhas na mesma linha
| ((x-p) == c) || ((x-p) == (-c)) = False -- rainhas na mesma diagonal
| otherwise = validAux p (c+1) xs
valid :: [Int] -> Bool
valid [] = True
valid (x:xs) = (validAux x 1 xs) && (valid xs)
--chess8Aux n
--resolve problema das 8 rainhas. O parametro n eh o numero de colunas restantes
chess8Aux :: Int -> [[Int]]
chess8Aux 0 = [[]]
chess8Aux 1 = [[1]]
chess8Aux n = filter valid [x:y | y <- (chess8Aux (n-1)), x <- [1 .. 8]]
chess8 :: [Int]
chess8 = (chess8Aux 8)!!1
4. Neste apartado, utiliza-se uma função auxiliar com dois parâmetros auxiliares do tipo Bool e [[t]]. 
O primeiro serve para saber a qual lista o elemento pertence. Se o parâmetro Bool é verdadeiro 
então o elemento pertence à primeira lista e se é falso, assume-se que é da segunda lista.
f2 :: [t] -> Bool -> [[t]] -> [[t]]
f2 [] _ x = x
f2 (x:xs) True [a, b] = f2 xs False [a++[x], b]
f2 (x:xs) False [a, b] = f2 xs True [a, b++[x]]
f :: [t] -> [[t]]
f x = f2 x True [[], []]
5. 
a) Para converter a lista de inteiros em string utilizamos as funções auxiliares toAst e toSpace, que 
repetem astericos e espaços uma quantidade n de vezes.
toAst :: Int -> String
toAst 0 = ""
toAst n = "*"++(toAst (n-1))
toSpace :: Int -> String
toSpace 0 = ""
toSpace n = " "++(toSpace (n-1))
toString :: [Int] -> String
toString [] = ""
toString (x:[]) = toAst x
toString (x:y:ys) = (toAst x) ++ (toSpace y) ++ (toString ys)
b) Agrupa-se cada três digitos em uma lista
type Linha = String
toLinhas :: String -> [Linha]
toLinhas [] = []
toLinhas (x:[]) = [[x]]
toLinhas (x:y:z:zs) = [x,y,z]:(toLinhas zs)
c) Para cada elemento da lista se insere um '\n'.
showLinhas :: [Linha] -> String
showLinhas [] = ""
showLinhas (x:xs) = x++"\n"++(showLinhas xs)
d) 
juntaLinhas :: [Linha] -> [Linha] -> [Linha]
juntaLinhas [] [] = []
juntaLinhas (x:xs) (y:ys) = (x++" "++y):(juntaLinhas xs ys)
e) Para esta implementação foi utilizada uma função ndig como função de apoio para definir as 
ações específicas para números de 1, 2 e 3 digítos. Para números de 1 dígito basta utilizar a recursão 
showLinhas → toLinhas → toString. Para números de mais de um dígito devemos concatenar o 
resultado de toLinhas de cada dígito, de tal forma que a possamos posicionar o \n ao final de cada 
linha i corretamente. Para tal utilizamos a função que contruímos juntaLinhas.
ndig :: Int -> Int
ndig n | n < 10 = 1
 | n < 100 = 2
 | otherwise = 3
numeros :: [[Int]]
numeros = [zero,um,dois,tres,quatro,cinco,seis,sete,oito,nove]
tolcd :: Int -> String
tolcd n | (ndig n) == 1 = showLinhas (toLinhas (toString (numeros!!n)))
 | (ndig n) == 2 
 = showLinhas
 (juntaLinhas 
 (toLinhas (toString (numeros!!((mod n 100) `div` 10)))) 
 (toLinhas (toString (numeros!!(mod n 10))))
 )
 | (ndig n) == 3 
 = showLinhas
 (juntaLinhas 
 (juntaLinhas
 (toLinhas 
 (toString (numeros!!((mod n 1000) `div` 100)))) 
 (toLinhas 
 (toString (numeros!!((mod n 100) `div` 10)))) ) 
 (toLinhas (toString (numeros!!((mod n 10)))))
 )
f)
type Estado = Bool
tcomp :: String -> Estado -> Int -> [Int]
tcomp [] False n | (n > 0) = [n]
 | otherwise = []
tcomp [] True n | (n > 0) = [n]
 | otherwise = []
tcomp (x:xs) True n | x == '*' = tcomp (xs) True (n+1)
 | otherwise = n:(tcomp (x:xs) False 0)
tcomp (x:xs) False n | x == ' ' = tcomp (xs) False (n+1)
 | otherwise = n:(tcomp (x:xs) True 0)
toCompact :: String -> [Int]
toCompact s = tcomp s True 0
A implementação da função toCompact é passada à função auxiliar tcomp que acrescenta dois 
parâmetros. Um deles é uma flag Boolean. O valor True indica que a função está contabilizando 
asteriscos e o valor falso indica que a função está contabilizando espaços em brancos. O outro 
parâmetro é um inteiro n, que indica a quantidade do caractér atual sendo lida
6. Para retornar todas as permutações de uma lista de elementos, tal que essas permutações tenham 
um tamanho maior ou igual que um número n é necessário percorrer todo o espaço de busca. 
Recursivamente, podemos definir todas essas permutações em uma lista haskell do tipo (x:xs), 
como o conjunto de todas as permutações de tamanho maiores ou iguais que n que não contém a 
cabeça x unido ao conjunto da concatenação da cabeça x a todas as permutações possíveis de 
tamanho n-1 na lista xs. A função filter garante a propriedade “>=n”, enquanto a condição (length 
(x:xs)) >= n foi utilizada para fins de desempenho, podando onde as cadeias não podem alcançar a 
longitude mínima desejada.
pred_length :: Int -> [t] -> Bool
pred_length n x = (length x) >= n
list_perms :: [t] -> Int -> [[t]]
list_perms [] _ = [[]]
list_perms (x:xs) n | (length (x:xs)) >= n 
 = filter (pred_length n) ([x:y | y <- (list_perms xs (n-1))] ++ (list_perms xs n) ) 
 | otherwise = [[]]
7. Para implementar o reconhecimento de strings, podemos simular um autômato que reconheça a 
substring1 na substring3 fazendo com que os estados do autômato correspondam aos caracteres da 
substring1, realizando a transição dos caracteres um a um. Mantemos a string a ser reconhecida em 
memória como o primeiro parâmetro da função occur e a cada passo fazemos uma chamada 
recursiva à mesma, que equivale a um movimento na fita. A primeira posição do cabeçote é mantida 
no terceiro parâmetro, juntamente com o restante a ser reconhecido. Quando não nos restam mais 
caracteres a serem reconhecidos(O terceiro parâmetro é a lista vazia), temos a certeza de que 
reconhecemos todos os caracteres e a substring1 pertence a substring3. Após o reconhecimento, 
podemos realizar a substituição com segurança. Em primeiro lugar separamos a string nas duas 
partes à esquerda e à direita da substring1, utilizando a função sep. Por último, a função substr 
realiza o resto do trabalho concatenando a substring2 no meio das duas substrings resultantes de 
sep.
 
occur :: String -> String -> String -> Bool
occur [] _ _ = True
occur x _ [] = True
occur _ [] _ = False
occur x (y:ys) (a:as) | y == a = occur x ys as
 | otherwise = occur x (ys) x
getT :: Int -> (String, String) -> String
getT 0 (a,b) = a
getT 1 (a,b) = b
-- sep x y z b c
-- retorna uma tupla contendo as string anteriores e posteriores a string x na cadeia y
-- x: A string a ser encontrada
-- y: String onde deveremos buscar a String x
-- z: Restante dos caracteres de x a serem reconhecidos
-- b: Parte da String que coincidiu com o inicio de x, porem ainda esta em reconhecimento
-- c: Parte da String que foi lida mas que nao foi reconhecida
sep :: String -> String -> String -> String -> String -> (String, String)
sep [] y _ _ _= (y, [])
sep x y [] b c = (c, y)
sep _ [] _ b c = ((c++b),
[])
sep x (y:ys) (a:as) b c | y == a = sep x ys as (b++[a]) c
 | otherwise = sep x ys x [] (c++b++[y])
substr :: String -> String -> String -> String
substr x y z | (occur x z x) = (getT 0 (sep x z x [] [])) ++ y ++ (getT 1 (sep x z x [] 
[]))
 | otherwise = z
8. Onde está o banco de dados ao qual a questão se refere?
9. Todas as permutações possíveis da lista (x:xs) são todas as permutações de (xs) e todas as 
concatenações de x com cada uma das cadeias do conjunto de permutações de xs.
perms :: [t] -> [[t]]
perms [] = [[]]
perms (x:xs) = [x:y | y <- (perms xs)] ++ (perms xs)
Haskell/lista 2/lista 2 respostas_Milton.odt
Haskell – Lista 2
Aluno: Mílton Cézar Correia Segundo
Matrícula: 1075128
Disciplina: Programação Funcional
Professor: Francisco Vieira
Nota: Embora, as questões da lista de exercícios estejam descontínuadas(i. e. Da questão um se vá direto à questão 3), a ordem aqui colocada corresponde a ordem sequencial.
1. A implementação deste item foi realizada utilizando uma função f2 auxiliar, que retorna a lista de elementos a ser concatenada baseada no vetor de posições, e a função utilitária map. A função map juntamente com a função implementada dec foi usada por conveniencia, para realizar a indexação dos elementos a partir de um, embora por default o operador !! use indexação baseada em zero.
dec :: Int -> Int
dec x = x-1
f2 :: [Int] -> [t] -> [t]
f2 [] (y:ys) = []
f2 (x:xs) (y:ys) = ((y:ys)!!x):(f2 xs (y:ys))
f :: [Int] -> [t] -> [t]
f [] [] = []
f (x:xs) [] = []
f [] (y:ys) = (y:ys)
f (x:xs) (y:ys) = (y:ys)++(reverse (f2 (map (dec) (x:xs)) (y:ys)))
2. Na implementação deste exercício foi utilizada a biblioteca Data.Matrix que pode ser instalada no linux com o utilitário cabal(apt-get install cabal-install) com o comando cabal install matrix.
Segue o código:
import Data.Matrix
my_sum :: (Num t) => [t] -> Int -> t
my_sum [] _ = 0
my_sum (x:xs) 1 = x + (my_sum xs (-1))
my_sum (x:xs) (-1) = (-1)*x + (my_sum xs 1)
my_minor :: (Num t) => Matrix t -> Int -> Matrix t
my_minor x a = minorMatrix 1 a x 
my_det :: (Num t) => Matrix t -> t
my_det x | (nrows x) == 2 = ((getElem 1 1 x)*(getElem 2 2 x) - (getElem 1 2 x)*(getElem 2 1 x))
		 | otherwise = (my_sum (map (my_det) (map (my_minor x) [1 .. (ncols x)])) 1)
mat :: Matrix Int
mat = fromList 3 3 [1..]
Com a declaração de mat é possível realizar o teste da função my_det que recebe como argumento uma matriz de números e retorna o determinante dessa matriz, que no caso é zero. Foi utilizada a ideia recursiva de que o determinante de uma matriz é igual ao somatório do determinante multiplicado por um fator, que se alterna entre -1 e 1(função my_sum) das submatrizes obtidas escolhendo-se uma linha e removendo, isoladamente, a coluna e o elemento de cada elemento desta linha até a coluna ncols x , onde x é uma matrix passada como parâmetro.
3. As funções valid e validAux são usadas com propósito de filtrar o espaço de configurações do tabuleiro de modo que as rainhas não conflitem em linha ou diagonal. A verificação por coluna não é necessária visto que é considerado que as rainhas são colocadas por padrão em colunas distintas, sendo o retorno de chess8 uma lista com as posições das linhas das rainhas em ordem de colunas. A função chess8Aux retorna um conjunto de soluções possíveis quando passada com o parâmetro 8, e a função chess retorna a solução de posição 1 na lista de listas retornada por chess8Aux.
validAux :: Int -> Int -> [Int] -> Bool
validAux _ _ [] = True
validAux p c (x:xs) | p == x = False --rainhas na mesma linha
			| ((x-p) == c) || ((x-p) == (-c)) = False -- rainhas na mesma diagonal
			| otherwise = validAux p (c+1) xs
valid :: [Int] -> Bool
valid [] = True
valid (x:xs) = (validAux x 1 xs) && (valid xs)
--chess8Aux n
--resolve problema das 8 rainhas. O parametro n eh o numero de colunas restantes
chess8Aux :: Int -> [[Int]]
chess8Aux 0 = [[]]
chess8Aux 1 = [[1]]
chess8Aux n = filter valid [x:y | y <- (chess8Aux (n-1)), x <- [1 .. 8]]
chess8 :: [Int]
chess8 = (chess8Aux 8)!!1
4. Neste apartado, utiliza-se uma função auxiliar com dois parâmetros auxiliares do tipo Bool e [[t]]. O primeiro serve para saber a qual lista o elemento pertence. Se o parâmetro Bool é verdadeiro então o elemento pertence à primeira lista e se é falso, assume-se que é da segunda lista.
f2 :: [t] -> Bool -> [[t]] -> [[t]]
f2 [] _ x = x
f2 (x:xs) True [a, b] = f2 xs False [a++[x], b]
f2 (x:xs) False [a, b] = f2 xs True [a, b++[x]]
f :: [t] -> [[t]]
f x = f2 x True [[], []]
5. 
a) Para converter a lista de inteiros em string utilizamos as funções auxiliares toAst e toSpace, que repetem astericos e espaços uma quantidade n de vezes.
toAst :: Int -> String
toAst 0 = ""
toAst n = "*"++(toAst (n-1))
toSpace :: Int -> String
toSpace 0 = ""
toSpace n = " "++(toSpace (n-1))
toString :: [Int] -> String
toString [] = ""
toString (x:[]) = toAst x
toString (x:y:ys) = (toAst x) ++ (toSpace y) ++ (toString ys)
b) Agrupa-se cada três digitos em uma lista
type Linha = String
toLinhas :: String -> [Linha]
toLinhas [] = []
toLinhas (x:[]) = [[x]]
toLinhas (x:y:z:zs) = [x,y,z]:(toLinhas zs)
c) Para cada elemento da lista se insere um '\n'.
showLinhas :: [Linha] -> String
showLinhas [] = ""
showLinhas (x:xs) = x++"\n"++(showLinhas xs)
d) 
juntaLinhas :: [Linha] -> [Linha] -> [Linha]
juntaLinhas [] [] = []
juntaLinhas (x:xs) (y:ys) = (x++" "++y):(juntaLinhas xs ys)
e) Para esta implementação foi utilizada uma função ndig como função de apoio para definir as ações específicas para números de 1, 2 e 3 digítos. Para números de 1 dígito basta utilizar a recursão showLinhas → toLinhas → toString. Para números de mais de um dígito devemos concatenar o resultado de toLinhas de cada dígito, de tal forma que a possamos posicionar o \n ao final de cada linha i corretamente. Para tal utilizamos a função que contruímos juntaLinhas.
ndig :: Int -> Int
ndig n | n < 10 = 1
| n < 100 = 2
| otherwise = 3
numeros :: [[Int]]
numeros = [zero,um,dois,tres,quatro,cinco,seis,sete,oito,nove]
tolcd :: Int -> String
tolcd n | (ndig n) == 1 = showLinhas (toLinhas (toString (numeros!!n)))
| (ndig n) == 2 
= showLinhas
(juntaLinhas 
(toLinhas (toString (numeros!!((mod n 100) `div` 10)))) 
(toLinhas (toString (numeros!!(mod n 10))))
)
| (ndig n) == 3 
= showLinhas
(juntaLinhas 
(juntaLinhas
(toLinhas 
(toString (numeros!!((mod n 1000) `div` 100)))) 
(toLinhas 
(toString (numeros!!((mod n 100) `div` 10)))) ) 
(toLinhas (toString (numeros!!((mod n 10)))))
)
f)
type Estado = Bool
tcomp :: String -> Estado -> Int -> [Int]
tcomp [] False n | (n > 0) = [n]
| otherwise = []
tcomp [] True n | (n > 0) = [n]
| otherwise = []
tcomp (x:xs) True n | x == '*' = tcomp (xs) True (n+1)
| otherwise = n:(tcomp (x:xs) False 0)
tcomp (x:xs) False n | x == ' ' = tcomp (xs) False (n+1)
| otherwise = n:(tcomp (x:xs) True 0)
toCompact :: String -> [Int]
toCompact s = tcomp s True 0
A implementação da função toCompact é passada à função auxiliar tcomp que acrescenta dois parâmetros. Um deles é uma flag Boolean. O valor True indica que a função está contabilizando asteriscos e o valor falso indica que a função está contabilizando espaços em brancos. O outro parâmetro é um inteiro n, que indica a quantidade do caractér atual sendo lida
6. Para retornar todas as permutações de uma lista de elementos, tal que essas permutações tenham um tamanho maior ou igual que um número n é necessário percorrer todo o espaço de busca. Recursivamente,
podemos definir todas essas permutações em uma lista haskell do tipo (x:xs), como o conjunto de todas as permutações de tamanho maiores ou iguais que n que não contém a cabeça x unido ao conjunto da concatenação da cabeça x a todas as permutações possíveis de tamanho n-1 na lista xs. A função filter garante a propriedade “>=n”, enquanto a condição (length (x:xs)) >= n foi utilizada para fins de desempenho, podando onde as cadeias não podem alcançar a longitude mínima desejada.
pred_length :: Int -> [t] -> Bool
pred_length n x = (length x) >= n
list_perms :: [t] -> Int -> [[t]]
list_perms [] _ = [[]]
list_perms (x:xs) n | (length (x:xs)) >= n 
	 = filter (pred_length n) ([x:y | y <- (list_perms xs (n-1))] ++ (list_perms xs n) ) 
	 | otherwise = [[]]
7. Para implementar o reconhecimento de strings, podemos simular um autômato que reconheça a substring1 na substring3 fazendo com que os estados do autômato correspondam aos caracteres da substring1, realizando a transição dos caracteres um a um. Mantemos a string a ser reconhecida em memória como o primeiro parâmetro da função occur e a cada passo fazemos uma chamada recursiva à mesma, que equivale a um movimento na fita. A primeira posição do cabeçote é mantida no terceiro parâmetro, juntamente com o restante a ser reconhecido. Quando não nos restam mais caracteres a serem reconhecidos(O terceiro parâmetro é a lista vazia), temos a certeza de que reconhecemos todos os caracteres e a substring1 pertence a substring3. Após o reconhecimento, podemos realizar a substituição com segurança. Em primeiro lugar separamos a string nas duas partes à esquerda e à direita da substring1, utilizando a função sep. Por último, a função substr realiza o resto do trabalho concatenando a substring2 no meio das duas substrings resultantes de sep.
occur :: String -> String -> String -> Bool
occur [] _ _ = True
occur x _ [] = True
occur _ [] _ = False
occur x (y:ys) (a:as) | y == a = occur x ys as
				 | otherwise = occur x (ys) x
getT :: Int -> (String, String) -> String
getT 0 (a,b) = a
getT 1 (a,b) = b
-- sep x y z b c
-- retorna uma tupla contendo as string anteriores e posteriores a string x na cadeia y
-- x: A string a ser encontrada
-- y: String onde deveremos buscar a String x
-- z: Restante dos caracteres de x a serem reconhecidos
-- b: Parte da String que coincidiu com o inicio de x, porem ainda esta em reconhecimento
-- c: Parte da String que foi lida mas que nao foi reconhecida
sep :: String -> String -> String -> String -> String -> (String, String)
sep [] y _ _ _= (y, [])
sep x y [] b c = (c, y)
sep _ [] _ b c = ((c++b), [])
sep x (y:ys) (a:as) b c | y == a = sep x ys as (b++[a]) c
				 		| otherwise = sep x ys x [] (c++b++[y])
substr :: String -> String -> String -> String
substr x y z | (occur x z x) = (getT 0 (sep x z x [] [])) ++ y ++ (getT 1 (sep x z x [] []))
		 | otherwise = z
8. Onde está o banco de dados ao qual a questão se refere?
9. O conjunto de todas as sublistas e subsequencias possíveis da lista (x:xs) é a união entre o conjunto de todas as sublistas de (xs) e o conjunto de todas as concatenações [x]++y, tal que y pertence ao conjunto de todas as sublistas e subsequencias de xs.
perms :: [t] -> [[t]]
perms [] = [[]]
perms (x:xs) = [x:y | y <- (perms xs)] ++ (perms xs)
Haskell/lista 2/dez.hs
sub_lists :: [t] -> [[t]]
sub_lists [] = [[]]
sub_lists (x:xs) = [x:y | y <- (sub_lists xs)] ++ (sub_lists xs)
{--
O conjunto de todas as sublistas e subsequencias possiveis da lista (x:xs)
eh a uniao entre o conjunto de todas as sublistas de (xs) e o conjunto de 
todas as concatenacoes [x]++y, tal que y pertence ao conjunto de todas as
sublistas e subsequencias de xs.
--}
Haskell/lista 2/cinco.hs
f2 :: [t] -> Bool -> [[t]] -> [[t]]
f2 [] _ x = x
f2 (x:xs) True [a, b] = f2 xs False [a++[x], b]
f2 (x:xs) False [a, b] = f2 xs True [a, b++[x]]
f :: [t] -> [[t]]
f x = f2 x True [[], []]
{--
As funções valid e validAux são usadas com propósito de filtrar o espaço de configurações 
do tabuleiro de modo que as rainhas não conflitem em linha ou diagonal. A verificação por 
coluna não é necessária visto que é considerado que as rainhas são colocadas por padrão 
em colunas distintas, sendo o retorno de chess8 uma lista com as posições das linhas das 
rainhas em ordem consecutiva de colunas. A função chess8Aux retorna um conjunto de soluções possíveis
quando passada com o parâmetro 8, e a função chess retorna a solução de posição 1 na lista
de listas retornada por chess8Aux.
--}
Haskell/lista 2/Lista_2_12014.docx
Universidade Federal do Piauí
Centro de Ciências da Natureza
Departamento de Computação
Disciplina: Linguagens Funcionais
Professor: Francisco Vieira de Souza
2ª. Lista de exercícios (para o dia 1º de julho de 2014)
Defina, em Haskell uma função "f" que, dadas uma lista "i" de inteiros e uma outra lista "l" qualquer, retorne uma nova lista constituída por "l" seguida de seus elementos que têm posição indicada em "i",conforme o exemplo a seguir: 
 f [2,1,4] ["a", "b", "c", "d"] = ["a", "b", "c", "d", "d", "a", "b"]
2. Defina, em Haskell, uma função que calcula o Determinante de uma matriz quadrada de ordem “n".
3. Resolva o problema das oito rainhas, usando Haskell.
4. Defina, em Haskell, uma função “f" que, dada uma lista “l", construa duas outras listas “l1" e “l2" de 
 forma que “l1" contenha os elementos de “l" de posição ímpar e “l2" contenha os elementos de “l" de 
 posição par, preservando a posição relativa dos elementos, conforme os exemplos a seguir: 
 f [a, b, c, d] = [[a, c], [b, d]] 
 f [a, b, c, d, e] = [[a, c, e],[b, d]]
5. Um pequeno visor de cristal liquido (LCD) contém uma matriz 5x3 que pode mostrar um número, como 9 ou 5. Por exemplo:
 *** ***
 * * *
 *** ***
 * *
 * ***
 O formato de cada número é definido por uma lista de inteiros que indica quantos '*' se repetem, 
 seguidos de quantos brancos se repetem, até o final da matriz 5x3, começando da primeira linha até a 
 última:
 nove,cinco,um,dois,tres,quatro,seis,sete,oito,zer :: [Int]
 nove = [4,1,4,2,1,2,1]
 cinco = [4,2,3,2,4]
 um = [0,2,1,2,1,2,1,2,1,2,1]
 dois = [3,2,5,2,3]
 tres = [3,2,4,2,4] 
 quatro = [1,1,2,1,4,2,1,2,1]
 seis = [4,2,4,1,4]
 sete = [3,2,1,2,1,2,1,2,1]
 oito = [4,1,5,1,4]
 zero = [4,1,2,1,2,1,4]
 indicando que o número nove é composto por 4 '*'s (três na primeira linha e um na segunda), seguido de 1 espaço, mais 4 '*'s, 2 espaços, 1 '*', 2 espaços e 1 '*'). Faça funções para:
 
Dado o formato do número (lista de inteiros) gerar a String correspondente de '*' e espaços.
 toString :: [Int] -> String
 toString nove ==> "**** **** * *"
Faça uma função que transforme a String de '*'s e espaços em uma lista de Strings, cada uma representando uma linha do LCD: 
 type Linha = String
 toLinhas :: String -> [Linha]
 toLinhas "**** **** * *" ==> ["***","* *","***"," *"," *"]
Faça uma função que pegue uma lista de Strings e a transforme em uma única String com '\n' entre cada uma delas:
 showLinhas :: [Linha] -> String
 showLinhas ["***","* *","***"," *"," *"] = "***\n* *\n***\n *\n *"
Faça uma função que pegue duas listas de linhas e transforme-as em uma única lista de linhas, onde as linhas originais se tornam uma única, com um espaço entre elas:
 juntaLinhas :: [Linha] -> [Linha] -> [Linha]
 juntaLinhas ["***","* *","***"," *"," *"] ["***","* *","***","