(******************************************************************************)
(******************************************************************************)
(****                             Guião 2                                   ***)
(****                                                                       ***)
(******************************************************************************)
(******************************************************************************)

open Arg
open Sys
open List



(** uma digressão rápida sobre a noção de função: **)
(* funções locais *)
let pitagores x y z = 
   let quadrado n = n*n in 
        quadrado x + quadrado y = quadrado z 



(*funções mutuamente recursivas *)

(**Definimos aqui uma versão "simplista" das funções "par" e "impar"
**)
let rec even x = 
  if x = 0      then true
  else if x > 0 then odd (x-1)
                else odd (x+1)
and odd x =
  if x = 0      then false
  else if x > 0 then even (x-1)
                else even (x+1)

(* oura versão com uma sintaxe diferente*)
let rec even = function 
| 0          -> true
| n when n>0 -> odd (n-1)
| n          -> odd (n+1)
and odd = function 
| 0          -> false
| n when n>0 -> even (n-1)
| n          -> even (n+1)
;;




(* Funções são valores de primeira classe como os valores numéricos*)

5;;

5+2;;




(*funções anónimas: são valores funcionais*)
function x -> if x>10 then true else false;;

function a -> a * 2;; 


(**  x,y |--> x + 2 * y  **)

(function x -> function y -> x + 2 * y);;

fun x y -> x + 2 * y;;

(* aplicação do parâmetro efectivo "3" à função anónima sucessor *)
(fun x -> x+1) 3;;





let succ = (fun x -> x+1);;

(* qual a diferença? function é o mecanismo atómico de construção de
   função, por definição só permite a definição de funções unárias. 

   fun extende function no sentido que permite varios parâmetros.

   Será function um mecanismo limitativo. Não, graças a ordem
   superior, qualquer função pode ser escrita com base em
   function... 

   mas não é pratico, daí a existência de fun
*)

fun x y z -> x + y + z ;;

(*  <---> *)

function x -> function y -> function z ->  x + y + z ;;

 (* uma vantagem de function é que explicita que para uma função de
    "n" argumento é possível dar só parte dos argumentos o resultado
    sendo uma função que espera pelo resto dos argumentos para dar o
    resultado final*)

(* uma nota "histórica" : function = "lambda" do lambda calculo de Church*)

let f x = x + 1

(*açúcar sintáctico para*)
let f = fun x -> x + 1

(* ou *)

let f = function x -> x + 1;;

(*de reparar: vê-se nesta ultima sintaxe que f é um valor como qualquer outro

  entre

  let x = 4 + 5 
  e 
  let f = fun x -> x + 4

  não há diferenças de natureza... x e f são identificadores
  atribuidos a valores.  um a um valor numérico outro a um valor
  *funcional*
*)


(*aplicação parcial*)
fun x y -> x * x + y * y
;;

(*  <---> *)
function x -> function y -> x * x + y * y
;;
(** ou seja 
(function x -> function y -> x * x + y * y) 6 ----> fun y -> 6 * 6 + y * y
**)


let f x y = x*x + y*y;;

(*let f = function x -> function y -> x*x + y*y*)


let g = f 3;;
g 4;;
(*g comparável a*)
 fun y -> 3 * 3 + y * y ;;


(** exercício : explique o código seguinte e dê o seu output **)

let f g a b c d = a*a + b/c + g d;;

let f2 = f (fun x -> x + 3);;

let f3 = f2 5;;

print_int (f3  3 4 5);;

print_int ((fun a b c -> f3 b a c) 3 2 1);;


(**********************************)
(*

Vamos agora ver como brincar com a ordem superior e o polimorfismo
graças a um exemplo simples. Veremos mais tarde que as listas fornecem
 um tereno ainda mais interessante para estas experiências

*)

(*******variantes do somatório *****)


let rec somatorio_1_10_aux i =
  if i < 1 || i > 10 then (invalid_arg "i<1 or i>10") else
    if i = 10 then 10
    else i +  somatorio_1_10_aux (i+1)
;;


let somatorio_1_10 () = somatorio_1_10_aux 1;;

somatorio_1_10 ();;

let rec somatorio_fast_1_10 i acc =
  if i < 1 then (invalid_arg "i<1") else
    if i > 10 then acc
    else  somatorio_fast_1_10 (i+1) (i+acc)
;;

let soma_fast () = somatorio_fast_1_10  1 0;;
soma_fast ();;

(* Vamos agora tentar generalizar a função somatório ao "máximo" *)
(* somatório de a até b ? *)
let rec somatorio_a_b a b = 
  if a > b then 0 else 
    a + somatorio_a_b (a+1) b
;;

somatorio_a_b 1 10;;

somatorio_a_b 3  15;;


(*exercício ---> recursivo terminal*)

let rec  somatorio_a_b_fast a b  acc = 
  if a > b then acc else 
    somatorio_a_b_fast (a+1) b (acc+a)
;;

let somatorio2_a_b a b = somatorio_a_b_fast a b 0;;


somatorio2_a_b 1 10 ;;
somatorio2_a_b 3  15;;


let rec  f_orio_a_b_fast f a b acc = 
  if a > b then acc else 
    f_orio_a_b_fast f (a+1) b (f acc a)
;;


let produtorio_1_10 () = f_orio_a_b_fast ( * ) 1 10 1;;  


(* somatório de i de a até b de f(i)? *)

let rec somatorio_f_a_b f a b = 
  if a > b then 0 else 
    (f a)+ (somatorio_f_a_b f (a+1) b);;


somatorio_f_a_b (fun x -> x+ x*x - 1) 3 18;;

somatorio_f_a_b (fun x -> x) 1 10;;

(** e para f real? como fazer ---> exercício **)


(** exercício. O que é (somatorio_f_a_b (fun x -> x + 1) 0) ? ****)



let rec fibt i a b = 
  if i<= 1 then b else (fibt (i-1) b (a+b))
;;

(*
solução: 
let rec somatorio_real_f_a_b f a b =
 if a > b then 0.0 else 
 (f a) +. somatorio_real_f_a_b f (a+1) b
;;

somatorio_real_f_a_b (fun a -> 1. /. float_of_int a) 2 8;;
*)


(*e agora como fazer o seguinte:

"para i  de a até b fazer f(i) e juntar eses elementos todos com g" 

ou seja

g0 = valor inicial
g(f(b),....g(f(a+1),g (f(a),g0)))
*)


let rec for_rec g f g0 a b =
  if a>b then g0
  else g (f a) (for_rec g f g0 (a+1) b);;  


(*que função /expressão é essa? *)
for_rec (fun a b -> a - b) (fun a -> a*a) 0 3 6 ;;



(** ---> recursivo terminal em exercício **)

(** ---> exercício: e se quiser definir um "step" generico (não só
    incrementar de um) **)

(**  definir uma função recursiva para

     for ( i=init1,v=init2 ; test(i) ; incr(i)) {v=f(v,i);} return v;
**)

(** exercício: Utilizar estas funções para definir a função

    \Sum_{i\in \{1..80\} \sqrt(\frac{i}{i+1})}
    \Pi_{i\in \{1..80\} \sqrt(\frac{i}{i+1})}
**)


(**
exercício:

   implementar a custa das funções anteriores o programa seguinte:


   for ( i=2,v=5 ; i<100 ; i*i) {v=1/(v+i);} return v; 

**)





let rec for_loop v i test step action =
  if not (test i) then v
  else for_loop (action v i) (step i) test step action;;
 
 

for_loop 0 1 (fun i -> i <= 10) (fun i -> i + 1) (fun  v i -> v + i);;


for_loop 0. 1. (fun i -> i <= 10.) (fun i -> i +. 1.) (fun  v i -> v +. i);;


(****EXERCICIO****)
(** definir a função "o" (combinação de funções bem conhecida em
    matemática) ou seja

    (f o g) x = f (g x)

    solução:

    chamar <<- a função.... (nem todos os caracteres podem ser identificadores de funções binárias infixas)

**)


let ( <<- ) f g x = f (g x);;

(* Explicar as seguintes funções:*)


let f1 = (fun x -> x * 2) <<- ( fun x -> x + 2);;

let f2 = (fun x -> print_int (x+4)) <<- (fun x -> x * x );;

let f3 = f2 <<- f1;;

f1 5;;

f2 7;;

f3 8;;


(*** listas ***)
(**********************************************)
(**    Exemplos de processamento de listas   **)
(**           (ver biblioteca List)          **)
(**********************************************)



(**Introdução **)
(**

   as listas são definidas da seguinte forma:

   type 'a list = [] | :: of 'a * 'a list

   Uma lista tem duas formas, ou vazia [] ou com pelo menos um
   elemento a::li (um elemento a a cabeça duma lista li)

**)

(**  match ... with ...  tem de ser exaustivo (todos os valores
     possíveis tem de ser considerados).  

     Como no caso da condicional, cada ramo tem de devolver
     exactamente o mesmo tipo **)



let is_empty l =
  match l with
      [] -> true
    | el::li -> false
;;

let is_empty l =
  match l with
      [] -> true
    | _::li -> false
;;

let is_empty l =
  match l with
      [] -> true
    | _::_ -> false
;;


let is_empty l =
  match l with
      [] -> true
    | _ -> false

;;


(*podemos aninhar os match *)

let has_two_elements l =
   match l with
    [] -> false (*|l| = 0*)
   | el::li -> match li with 
                 [] -> false (*|l|=1*)
               | el2 :: lli -> match lli with 
                                [] -> true (* |l| = 2 *)
                               | el3 :: _ -> false (* |l| > 2*)
;;

(** mais simples ainda **)
let has_two_elements l =
   match l with
    [] -> false
   | el1::el2::[] -> true
   | _ -> false
;;

(** mais simples ainda **)
let has_two_elements l =
   match l with
    [] -> false
   | [el1;el2] -> true
   | _ -> false
;;

(** mais simples ainda **)
let has_two_elements l =
   match l with
   | [el1;el2] -> true
   | _ -> false
;;


(*quando existe um overlap nos casos considerados, o primeiro tem prioridade*) 


(* variantes da função comprimento*)
let rec length0 l = 
  match l with
      [] -> 0
    | _::li -> 1 + length0 li;;
  
let rec length1 l = length_aux l 0 
and length_aux l n = 
  match l with 
      [] -> n 
    | el::li -> length_aux li (n+1);;

(**ver explicação de fold_left mais abaixo **)

(* cabeça duma lista*)

let  hd  l = 
  match l with
      el::li -> el
  | _ -> raise (Failure "lista inválida")


(* cauda duma lista *)
let tl l = 
  match l with
      el::li -> li
    | _ -> raise (Failure "lista inválida")



(* variantes da função de pertence *)
let rec mem1 x l = 
  match l with 
      [] -> false
    |el::li -> if el = x then true else mem1 x li
  
  
let rec mem2 x l =
  match l with 
      [] -> false
    | el::li when el=x ->  true
    | el::li -> mem2 x li

let  mem3 x l = exists (fun el -> x=el) l

let rec somadois l =
match l with
  [] ->  []
| el::li -> (el+2)::(somadois li);;

let somadois l = List.map (fun a -> a +2) l;;





(* n-ésimo elemento duma lista *)
let  rec nth lista n = 
  match lista with
      [] -> raise (Failure "Argumento inteiro inválido")
    | el::li -> 
	if n<0 then  raise (Failure "Argumento inteiro inválido")
	else
	  if n=0 
	  then el 
	  else nth li (n-1)

 
(* a concatenação de 2 listas*)

let rec append  l1 l2 =
  match l1 with
      [] -> l2
    |el::li ->  el::(append li l2)


let ( @ ) = append

let rec appendi (l1: int list) l2 =  match l1 with
      [] -> l2
    |el::li ->  el::(appendi li l2);;

let rec rev_append l1 l2 =
  match l1 with
    [] -> l2
  | a :: l -> rev_append l (a :: l2)

let rev l = rev_append l []

let rec flatten = function
    [] -> []
  | l::r -> l @ flatten r

let concat = flatten


let rev_map f l =
  let rec rmap_f accu = function
    | [] -> accu
    | a::l -> rmap_f (f a :: accu) l
  in
  rmap_f [] l
;;

(*

max ([a;b;c:.....; z]) ---> maior elemento inteiro da lista


*)


let rec maior_aux cand l = 
  match l with
      [] -> cand 
    | el::li  -> maior_aux  (if cand > el then cand else el) li;;

let maior l =
  match l with 
      [] -> failwith "lista vazia"
    | el::li -> maior_aux el li;;



(* devolve o maior elemento de li segundo a função d comparação comp.
   Repare na definição da função auxiliar e local max_aux *)
let max comp li = 
  let rec max_aux comp lista acc = 
    match lista with 
  [] -> acc
      | elemento::l ->
    if comp elemento acc
    then max_aux comp l elemento 
    else  max_aux comp l acc 
  in
    
  (* alternativamente max_aux pode ser definido como 
  let maux_aux2 comp lista acc = 
    fold_left (fun a x -> if comp  x a then x else a ) acc lista
  *)
    match li with 
  [] -> Failure "não dá...."
      |el::lista -> max_aux comp lista el 
;;


(* Retorna uma lista de n números aleatórios *)

Random.init (int_of_float (Sys.time()));;

let rec lista_aleatoria_aux = function 
  |0 -> []
  |n -> (Random.int 10000)::(lista_aleatoria_aux (n-1))
;;


let lista_aleatoria n = if n<0 then failwith "Não dá!" else lista_aleatoria_aux n;;


(*

Igual à seguinte função:

*)

let rec lista_aleatoria2 m = 
  match m with  
    |0 -> []
    |n -> (Random.int 10000)::(lista_aleatoria2 (n-1))
;;




let rec lista_aleatoria3 m = 
  if m=0 then []
  else (Random.int 10000)::(lista_aleatoria3 (m-1))
;;


(* ler n valores reais e coloca-los numa lista*)

let rec ler_lista1 n =
  if n < 0 then raise (Failure "Argumento Inválido")
  else 
    if n=0 then []
    else 
      let valor = read_float () in
  valor::(ler_lista1 (n-1));;


let lista = ler_lista1 5;;

(*  EVITAR!!!! *)
let lista2 = ref [];;


let ler_imperativo n =
  if n < 0 then raise (Failure "Argumento Inválido") 
                    (** equivalente failwith "Argumento Inválido"**)
  else   
    for i=1 to n do
      let v = read_float () in
  lista2 := v::!lista2
    done;;


(*versão recursiva terminal de ler_lista1*)
let rec ler_lista2_aux n acc = 
    if n=0 then  List.rev acc
    else 
      let valor = read_float () in
  ler_lista2_aux (n-1) (valor::acc);;



let ler_lista2 n =  
if n < 0 then raise (Failure "Argumento Inválido")
  else ler_lista2_aux n [];;



let rec ler_lista2_aux n acc =  
  if n < 0 then raise (Failure "Argumento Inválido")
  else 
    if n=0 then List.rev acc
    else ler_lista2_aux (n-1) ((read_float())::acc);;


let rec ler_lista3_aux n acc = 
  if n < 0 then raise (Failure "Argumento Inválido")
  else 
    if n=0
    then List.rev acc
    else ler_lista3_aux (n-1) ((read_int())::acc);;


let ler_lista3 n = ler_lista3_aux n [];;


let rec ler_generico_aux  ler n acc =   
  if n < 0 then raise (Failure "Argumento Inválido")
  else 
    if n=0 then List.rev acc
    else ler_generico_aux ler (n-1) (( ler ())::acc);;

let ler_floats n = ler_generico_aux read_float n [];;

let ler_ints n =  ler_generico_aux read_int n [];;

let ler_strings n =  ler_generico_aux read_line n [];;


(* 

umas funções sobre listas essenciais

 *) 


(*
 fold_left f init [a1;a2;a3;...;an] = (... (f (f init a1) a2) .... an)

  Esta função é útil em situações em que se pretende efectuar um
  processamento (a função f) do primeiro ao último elemento. 
  Duma certa forma esta função é uma representação  funcional do programa
  
  valor = valor inicial (init)
  para i de 1 até n fazer
     valor <-- f valor a_i
  fim_fazer
  devolver valor

  Muitos algoritmos sobre colecções de objecto tem esta forma. Logo
  fold_left é uma função extremamente útil. A questão é saber ver que
  parâmetro f e que valor inicial são precisos passar

*)
let rec fold_left f accu l =
  match l with
      [] -> accu
    | a::li -> fold_left f (f accu a) li;;


List.fold_left (fun a x -> if x > a then x else a) 0  [1;3;4;6;8;9;21;4;2];;

List.fold_left (fun a x -> a+x) 0 [1;3;4;6;8;9;21;4;2] ;;


(* 

   A função iter vai executer a função f (que devolve necesariamente unit
   (val f : 'a -> unit), isto é, só realiza um efeito lateral).


   Esta função é útil quando pretendemos varrer a lista e produzir
   efeitos laterais como, por exemplo, mostrar os elementos no stdin:
   iter print_int [1;2;3;4;5;6;7;8] = print_int 1; print_int 2; ....;
   print_int 8
*)


let ll = [1;2;3;4;5;6;77;3;6;3;5];;


let rec print_lista p l = 
  match l with
      [] -> ()
    | el::li -> let _ = (p el) in
	print_lista p li;;


let rec iter (f:'a -> unit) = function
    [] -> ()
  | a::l -> f a; iter f l



let _ = iter (fun x -> Printf.printf "%d - " x) [1;2;3;4;5;6]

(*

  map f [a1;a2;a3; .. ; an] = [f a1 ; f a2 ; f a3 ; ... ; f an]

  Como o nome o indica, map permite mapear um função f sobre uma
  lista, obtendo assim uma nova lista, a lista resultante.

  map int_of_string ["1";"2";"3";"4";"5";"6"] = [1;2;3;4;5;6]

*)

let rec map f = function
    [] -> []
  | a::l -> let r = f a in r :: map f l



(*

  for_all p [a1; ...; an] = (p a1) && (p a2) && ... && (p an).

  isto é verifica se todos os elementos verificam p predicado p (uma
  função booleana)


  for_all (fun x -> x>10) [1;2;3;4;5;6;7;8;9;10;11] = false
*)
let rec for_all p = function
    [] -> true
  | a::l -> p a && for_all p l


(*

  exists p [a1; ...; an] = (p a1) || (p a2) || ... || (p an).

  isto é verifica se pelo menos um elemento verifica p predicado p
  (uma função booleana)

  exists (fun x -> x>10) [1;2;3;4;5;6;7;8;9;10;11] = true

*)
let rec exists p = function
    [] -> false
  | a::l -> p a || exists p l


(* exemplos de utilização de fold_left *)
let somatorio l = fold_left (+) 0 l;;

(* Somatório de i^3 para i pertencendo a uma lista l*)
let som3 l = fold_left (fun a x -> a + x*x*x) l  

(* ou melhor ainda *)
let som3 = fold_left (fun a x -> a + x*x*x)

let o_maior l = 
  match l with 
      [] -> raise (Failure "Lista Vazia")
    | el::li -> fold_left (fun m c -> if c > m then c else m) el li;;

let o_menor l = 
  match l with 
      [] -> raise (Failure "Lista Vazia")
    | el::li -> fold_left (fun m c -> if c < m then c else m) el li;;


(* vamos generalizar aqui a função de procura *)
let o_tal f l = 
  match l with 
      [] -> raise (Failure "Lista Vazia")
    | el::li -> fold_left (fun m c -> if (f c m) then c else m) el li;;

(* ou ainda... deixamos que o caso de erro seja detectado por hd ou tl *)

let o_tal f l = fold_left (fun m c -> if (f c m) then c else m) (hd l) (tl l);;

let o_maior l = o_tal (>) l

let o_menor l = o_tal (<) l



let rec iter f = function
    [] -> ()
  | a::l -> f a; iter f l



(* 

   Vamos explorar aqui uma versão lista das tabelas de correspondência :
   as listas associativas.


   Estas listas são simplesmente listas de pares ( 'a * 'b ) em que os
   elementos de tipo 'a são as chaves e os de tipo 'b o conteúdo.

   Neste contexto:
   1- o "add" ou "insert"  é o operador ::
   2- o "find x", sendo x uma chave, é a função assoc x
   3- o "remove x", sendo x uma chave, é função remove_assoc x

   Assim sendo, em caso simples, as tabelas associativas podem ter o
   papel de tabelas de dispersão (Hash-tables). Não se esqueçam que
   existe a biblioteca Hashtable que forneçe uma estruura de dados e
   todas as funções para tabelas de dispersão eficientes mas no
   entanto de utilização simples.


*)



let tabela = [(1,"um"); (2,"dois"); (3,"três")];;

let valor = assoc 2 tabela;; (* ---> "dois" *)


let nova_tabela = (1,"uno")::tabela;;
(* [(1,"uno");(1,"um"); (2,"dois"); (3,"três")]*)


let novo_valor = assoc 1 nova_tabela;; 
(* ---> "uno"  o primeiro par esconde o outro. assoc devolve o
 conteúdo do primeiro par de chave 1 *)


(*** quicksort ***)

let rec corta a lista =
 match lista with
| [] -> [],[]
| x::resto -> let (u,v) =corta a resto in
if x < a then (x::u,v) else (u,x::v)
;;

let rec quicksort lista = 
match lista with
| [] -> []
| a::resto -> let (u,v) =corta a resto in
(quicksort u) @ (a :: (quicksort v))
;;

(** 

    Exercício: generalizar ao máximo esta definição (generalizar o tipo de
    listas por ordenar, o criterio de ordenação etc...)

**)