(******************************************************************************)
(******************************************************************************)
(****                             Guião 4                                   ***)
(****                                                                       ***)
(******************************************************************************)
(******************************************************************************)

open Scanf
open List
    
(**** Excepções ***)
exception Minha of string;;

let rec fact  ?(a=1) v =
  if v < 0 

  (**
     Se algo de anormal advém do parametro, fact não é a função mais
     adequada para processar o erro.  Vamos aqui declarar a situação
     anómala e deixar quem "sabe" tratar do erro **)
  then raise (Minha ("valor = "^string_of_int v))
  else 
    if v = 0 
    then a 
    else fact ~a:(a*v) (v-1)
;;

(**objectivo= ler inteiros dum ficheiro, coloca-los numa lista e
   calcular para todos eles o factorial.  Esta função é a função mais
   adequada para tratar dos erros de argumentos que podem surgir (porque
   é essa função que extraiu os valores fornecidos a função fact)**)
let leitura name =
  let fich = open_in name in
  let sb = Scanf.Scanning.from_channel fich in
  let l = ref [] in
    try 
      while (true) do
        let x = Scanf.bscanf sb " %d" (fun a -> a) in
          l:= x::!l
      done; [] 
    with End_of_file ->
      try
        List.map fact (List.rev !l)
      with Minha st ->( 
        prerr_string ("Problema com dados invalidos: "^st^"\n");[])
;;

(***
  
    exception Invalid_argument of string

    -- Exception raised by library functions to signal that the given
    arguments do not make sense.

    exception Failure of string

    -- Exception raised by library functions to signal that they are
    undefined on the given arguments.

    exception Not_found

    -- Exception raised by search functions when the desired object could
    not be found.

    exception Out_of_memory

    -- Exception raised by the garbage collector when there is
    insufficient memory to complete the computation.

    exception Stack_overflow

    -- Exception raised by the bytecode interpreter when the evaluation
    stack reaches its maximal size. This often indicates infinite or
    excessively deep recursion in the user's program. (Not fully
    implemented by the native-code compiler; see section 11.5.)

    exception Sys_error of string

    -- Exception raised by the input/output functions to report an
    operating system error.

    exception End_of_file

    -- Exception raised by input functions to signal that the end of file
    has been reached.

    exception Division_by_zero

    -- Exception raised by division and remainder operations when their
    second argument is null.

    val raise : exn -> 'a

    -- Raise the given exception value

    val invalid_arg : string -> 'a

    -- Raise exception Invalid_argument with the given string.

    val failwith : string -> 'a

    -- Raise exception Failure with the given string.

    val exit : int -> 'a

    -- Terminate the process, returning the given status code to the
    operating system: usually 0 to indicate no errors, and a small
    positive integer to indicate failure. All open output channels are
    flushed with flush_all. An implicit exit 0 is performed each time
    a program terminates normally. An implicit exit 2 is performed if
    the program terminates early because of an uncaught exception.

    val at_exit : (unit -> unit) -> unit

    -- Register the given function to be called at program termination
    time. The functions registered with at_exit will be called when
    the program executes exit, or terminates, either normally or
    because of an uncaught exception. The functions are called in
    ``last in, first out'' order: the function most recently added
    with at_exit is called first.


    http://caml.inria.fr/pub/docs/manual-ocaml/libref/Printexc.html

    Module Printexc

    module Printexc: sig .. end

    Facilities for printing exceptions.

    val to_string : exn -> string

    Printexc.to_string e returns a string representation of the exception e.

    val print : ('a -> 'b) -> 'a -> 'b

    Printexc.print fn x applies fn to x and returns the result. If the
    evaluation of fn x raises any exception, the name of the exception
    is printed on standard error output, and the exception is raised
    again. The typical use is to catch and report exceptions that
    escape a function application.
    

***)



(**** Ficheiro e canais  ****)

(*

  O tipo dos ficheiros em OCaml designa-se por "canais", ou seja
  channel.

  De modo a fornecer uma abstracção cómoda e facilitar o processamento
  dos dados neles contidos, vário subtipos de canais são
  disponibilizadas de raíz no OCaml Canais de entrada de texto,
  canais de saída de texto, etc...,

  Nesta aula só precisaremos de dois destes tipos de canais:

  type in_channel 

  -- The type of input channel.

  type out_channel 

  -- The type of output channel.

  val stdin : in_channel

  -- The standard input for the process.

  val stdout : out_channel

  -- The standard output for the process.

  val stderr : out_channel

  -- The standard error output for the process.
  

  val open_out : string -> out_channel

  -- Open the named file for writing, and return a new output channel on
  that file, positionned at the beginning of the file. The file is
  truncated to zero length if it already exists. It is created if it
  does not already exists. Raise Sys_error if the file could not be
  opened.

  val open_out_bin : string -> out_channel

  -- Same as open_out, but the file is opened in binary mode, so that no
  translation takes place during writes. On operating systems that do
  not distinguish between text mode and binary mode, this function
  behaves like open_out.


  val flush : out_channel -> unit

  -- Flush the buffer associated with the given output channel,
  performing all pending writes on that channel. Interactive programs
  must be careful about flushing standard output and standard error at
  the right time.

  val flush_all : unit -> unit

  -- Flush all open output channels; ignore errors.

  val output_char : out_channel -> char -> unit

  -- Write the character on the given output channel.

  val output_string : out_channel -> string -> unit

  -- Write the string on the given output channel.

  val close_out : out_channel -> unit

  -- Close the given channel, flushing all buffered write
  operations. Output functions raise a Sys_error exception when they
  are applied to a closed output channel, except close_out and flush,
  which do nothing when applied to an already closed channel. Note
  that close_out may raise Sys_error if the operating system signals
  an error when flushing or closing.


  val open_in : string -> in_channel

  -- Open the named file for reading, and return a new input channel on
  that file, positionned at the beginning of the file. Raise Sys_error
  if the file could not be opened.

  val open_in_bin : string -> in_channel

  -- Same as open_in, but the file is opened in binary mode, so that no
  translation takes place during reads. On operating systems that do
  not distinguish between text mode and binary mode, this function
  behaves like open_in.

  val input_char : in_channel -> char

  -- Read one character from the given input channel. Raise End_of_file
  if there are no more characters to read.

  val input_line : in_channel -> string

  -- Read characters from the given input channel, until a newline
  character is encountered. Return the string of all characters read,
  without the newline character at the end. Raise End_of_file if the
  end of the file is reached at the beginning of line.

  val input : in_channel -> string -> int -> int -> int

  -- input ic buf pos len reads up to len characters from the given
  channel ic, storing them in string buf, starting at character number
  pos. It returns the actual number of characters read, between 0 and
  len (inclusive). A return value of 0 means that the end of file was
  reached. A return value between 0 and len exclusive means that not
  all requested len characters were read, either because no more
  characters were available at that time, or because the
  implementation found it convenient to do a partial read; input must
  be called again to read the remaining characters, if desired. (See
  also really_input for reading exactly len characters.) Exception
  Invalid_argument "input" is raised if pos and len do not designate a
  valid substring of buf.

  val close_in : in_channel -> unit

  -- Close the given channel. Input functions raise a Sys_error exception
  when they are applied to a closed input channel, except close_in,
  which does nothing when applied to an already closed channel. Note
  that close_in may raise Sys_error if the operating system signals an
  error.

  exception End_of_file

  -- Exception raised by input functions to signal that the end of file
   has been reached.

*)

let process () = 
  let iname = print_endline "Nome de ficheiro de input"; read_line() in
  let oname = print_endline "Nome de ficheiro de output"; read_line() in
  let rec leitura fich acc = 
    begin
      let n  = int_of_string (input_line fich) in 
        try leitura fich (n+acc) 
        with End_of_file -> acc
    end in
    if Sys.file_exists iname && Sys.file_exists oname 
    then 
      let ic = open_in iname in
      let oc = open_out oname in
      let v = leitura ic 0
      in 
        begin 
          output_string oc (string_of_int v); 
          close_in ic;
          close_out oc
        end 
    else failwith "File error";;  


process ();;


(***O tipo "Produto Cartesiano" ***)
(* pratico quando queremos devolver mais do que um valor:*)
let rec menor_maior l =
  match l with 
      [] -> invalid_arg "Com listas vazias é que não!!!!!"
    | [el] -> (el,el)
    | el::li ->
        let (a,b) = menor_maior li in
        (if a>el then el else a ),(if b<el then el else b) 
 

(** alternativa (válida só para pares) --->  
    let x = menor_maior li in         
    (if fst x>el then el else fst x ),(if snd x<el then el else snd x) 
**)
      
(** e pode-se com 3? claro!**)
let rec menor_maior_soma l = 
  match l with 
      [] -> invalid_arg "Com listas vazias é que não!!!!!"
    | [el] -> (el,el,el)
    | el::li ->
        let (a,b,s) = menor_maior_soma li in
        ((if a>el then el else a ),(if b<el then el else b), s+el) 
;;
 

(* 
exercício: definir a função menor_maior_soma_numerodepares_numerodeimpares
*)

type 'a tipo_fun = ('a * ('a -> 'a));;

let f x = x + 1;;
(0,f);;


type tipo_das_funcoes_inteiras_com_um_elemento = int tipo_fun;;

(** sintaxe generica para definição de tipos
type ('a1, ... ,'an) name = typedef ;;
**)


type ('a,'b) fun_type =  ('a * ('b -> 'a));;

(*** Tipos indutivos, ou tipos soma ***)

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

  Um dos mecanismos disponíveis no OCaml para definir tipos estruturados
  é o mecanismo dos tipos "soma" ou igualmente designados de "tipos
  indutivos"

  De uma forma informal um elemento dum tipo indutivos define-se pela
  forma que pode ter.

  Por exemplo: um dia pode ter 7 formas.
  ou é segunda feira, ou é terça feira etc....

  Uma propriedade deste tipo de elemento (e de definição de conjunto)
  é que um elemento tem uma forma *única*.

  No exemplo, é simples.... um dia não pode ser segunda feira e
  simultaneamente terça feira.


  Um dos exemplo clássicos é o tipo das listas: uma lista é, de forma
  exclusiva, ou a lista vazia ou uma lista que tem um elemento a cabeça
  e uma outra lista em cauda.

  Esta descrição é suficiente para descrever todas as listas possíveis.

  Obviamente, estes mecanismo suporta o polimorfismo e a ordem superior.

  Em termos de sintaxe, como é?

  Cada caso na definição das formas que um elemento do tipo pode ter,
  tem um nome, designado de *constructor*. Este nome é um caso
  particular duma função e começa sempre por uma maiúscula, e pode
  opcionalmente conter parâmetros. Um constructor quando devidamente
  parametrizado constrói um elemento do tipo.
  
  Por exemplo, quando devidamente instanciado por 0 e [1;2;3], o
  constructor :: constrói uma lista com 0 a cabeça e [1;2;3] a cauda:
  [0;1;2;3]

  Vejamos exemplos (e a sintaxe....)

*)


type dia = Seg | Ter | Qua | Qui | Sex | Sab | Dom;;

type 'a minha_lista = LVazia | Junta of 'a * ('a minha_lista)



(*

  O tipo minha_lista tem dois tipos de elementos: a lista vazia
  (constructor LVazia, sem parâmetros) ou a lista com pelo menos um
  elemento (constructor Junta, com dois parâmetros, o elemento e a lista
  a qual se junta este elemento)

*)

(*
  um elemento: 
*)


let umalista = Junta (0, Junta (1,(Junta (2,LVazia))))


let umaoutralista = Junta ('a', Junta ('b',(Junta ('c',(Junta ('d',LVazia))))))

let mais_uma = Junta (-4 , umalista)

(** Repare na utilização de match **)
let rec comprimento ml =
  match ml with 
      LVazia -> 0
    | Junta (a,b) -> 1 + (comprimento b);;

comprimento umalista;;

comprimento umaoutralista;;

let rec concatena ml1 ml2 = 
  match ml1 with
      LVazia  -> ml2
    | Junta (a,b) -> Junta (a,(concatena b ml2))




type figurageometrica =
    Triangulo of float*float
  | Rectangulo of float*float
  | Quadrado of float

let definir () =
  let resp = print_string "Que figura? (0 -> T, 1 -> R, ... -> Q)\n" ; read_int () in
    if resp = 0 then 
      (print_string "altura base: \n"; scanf " %f %f" (fun a b -> Triangulo (a,b)))
    else if resp = 1 then
      (print_string "largura comprimento: \n"; scanf " %f %f" (fun a b -> Rectangulo (a,b)))
    else 
      (print_string "lado: \n"; scanf " %f" (fun a -> Quadrado a))  


let area fg =
match fg with
    Triangulo (a,b) -> (a *. b )/. 2. 
  | Rectangulo (a,b) -> a *. b 
  | Quadrado a -> a *. a



type 'a ab = Vazia | Nodo of ('a ab)*'a*('a ab)


let exemplo =
Nodo ((Nodo ((Nodo (Vazia,1,(Nodo (Vazia,2,Vazia)))),3,(Nodo (Vazia,4,Vazia)))),5,(Nodo (Vazia,7,Vazia)));; 

let max a b = if a > b then a else b;;

let rec altura ar =
match ar with
    Vazia -> 0
  | Nodo (Vazia,a,Vazia) -> 0
  | Nodo (e,a,d) -> 1 + max (altura e) (altura d)
;;

let rec dfs ar =
  match ar with
    | Vazia -> []
    | Nodo (e,a,d) -> (dfs e)@ [a]@(dfs d)
;;


let rec map_ab f ar =
match ar with Vazia -> Vazia| Nodo (e,a,d) -> Nodo (map_ab f e, f a, map_ab f d)
;;


 



(* 

   Vamos definir o tipo das cartas onde os valores não são inteiros

*)

type valor = 
     Dois | Tres | Quatro | Cinco | Seis | Sete
  | Oito | Nove | Dez | Valete | Rainha | Rei | As
type carta =
    Ouros of valor
  | Paus of valor
  | Espadas of valor
  | Copas of valor

(* vamos assumir Ouros < Paus < Espadas < Copas *)
      
let ganha_valor v1 v2  = 
  match (v1,v2) with
    | As,As -> true
    | As, _ -> false
    | Dois,As | Dois,Dois -> true
    | Dois, _ -> false
    | Tres, As | Tres, Dois | Tres, Tres -> true
    | Tres, _ -> false
    | Quatro, As | Quatro, Dois | Quatro, Tres | Quatro, Quatro -> true
    | Quatro, _ -> false
    | Cinco, As | Cinco, Dois | Cinco, Tres | Cinco, Quatro | Cinco, Cinco -> true
    | Cinco, _ -> false
    | Seis, As | Seis ,Dois | Seis, Tres | Seis, Quatro | Seis, Cinco | Seis,Seis -> true
    | Seis, _ -> false
    | Sete, As | Sete ,Dois | Sete, Tres | Sete, Quatro | Sete, Cinco | Sete,Seis 
    | Sete, Sete -> true
    | Sete, _ -> false     
    | Oito, As | Oito ,Dois | Oito, Tres | Oito, Quatro | Oito, Cinco | Oito,Seis 
    | Oito, Sete | Oito, Oito -> true
    | Oito , _ -> false
    | Nove, As | Nove ,Dois | Nove, Tres | Nove, Quatro | Nove, Cinco | Nove,Seis 
    | Nove, Sete | Nove, Oito | Nove, Nove -> true
    | Nove , _ -> false
    | Dez, As | Dez ,Dois | Dez, Tres | Dez, Quatro | Dez, Cinco | Dez,Seis 
    | Dez, Sete | Dez, Oito | Dez, Nove | Dez, Dez -> true
    | Dez , _ -> false
    | Valete, As | Valete ,Dois | Valete, Tres | Valete, Quatro | Valete, Cinco | Valete,Seis 
    | Valete, Sete | Valete, Oito | Valete, Nove | Valete, Dez | Valete, Valete -> true
    | Valete , _ -> false
    | Rainha, As | Rainha ,Dois | Rainha, Tres | Rainha, Quatro | Rainha, Cinco | Rainha,Seis 
    | Rainha, Sete | Rainha, Oito | Rainha, Nove | Rainha, Dez | Rainha, Valete | Rainha, Rainha -> true
    | Rainha , _ -> false
   | Rei, As | Rei ,Dois | Rei, Tres | Rei, Quatro | Rei, Cinco | Rei,Seis 
    | Rei, _ -> true 

(* mais simplesmente podemos usar o atalho seguinte  se assumirmos que 
 Dois < Tres < Quatro < Cinco < Seis < Sete < Oito < Nove < Dez < Valete < Rainha < Rei < As *)

let ganha_valor v1 v2  = v1 >= v2


let ganha c1 c2 =
match (c1,c2) with
    Ouros v1,Ouros v2 ->  ganha_valor v1 v2 
  | Ouros _, _ -> false
  | Paus _,Ouros _ -> true
  | Paus v1,Paus v2 -> ganha_valor v1 v2
  | Paus _, _ -> false
  | Espadas _ , Ouros _ | Espadas _ , Paus _ -> true
  | Espadas v1,Espadas v2 -> ganha_valor v1 v2
  | Espadas _, _ -> false
  | Copas v1,Copas v2 -> ganha_valor v1 v2
  | Copas _, _ -> true


(** 

    Vamos agora explorar de forma informal tipos de dados estruturados
    clássicos em informática: árvores e grafos

    Comecemos com arvores binárias.  Uma árvore binária ou é uma folha
    ou é um nodo com um filho esquerdo e um filho direito.

**)

(* árvore binária de Inteiros *)
type intbintree = Vazia | Nodo of intbintree * int * intbintree 


(* agora com polimorfismo... árvores binárias de elementos de "qualquer tipo" *)
type 'a bintree =
    Leaf
  | Node of 'a bintree * 'a * 'a bintree


(* assim as árvores binarias de inteiros são vistas como uma instância
   do tipo anterior *)
type int_bintree = int bintree


(* Para generalizar, as árvores *)
type 'a tree = 
    TLeaf
  | TNode of 'a * ('a tree) list



let a1 = Node (Node (Leaf,0,Leaf),6, (Node (Leaf,9,Leaf)))

(* inserção ordenada *)
let rec insere x ar = 
 match ar with
  Leaf -> Node (Leaf,x,Leaf)
  | Node (e,a,d) -> 
    if x>a then Node (e,a,(insere x d))
    else Node(insere x e, a, d)

let rec soma ar =
match ar with
    Leaf -> 0
  | Node (e,a,d) -> a + (soma e)  + (soma d)
      
let rec percurso ar =
match ar with
    Leaf -> []
  | Node (e,a,d) ->  (percurso e) @ (a::(percurso d))
    
let rec altura ar =
  match ar with 
    Leaf -> 0
  | Node (e,a,d) ->  
      let v,w = (altura e), (altura d) in
        (if v > w then v+1 else w+1)
;;

soma a1;;


altura a1;;

percurso a1;;

(** e para as árvores gerais **)
let rec somag ar =
match ar with
    TLeaf -> 0
  | TNode (a,f) -> a + List.fold_left (fun acc el -> somag el + acc) 0 f
      
let rec percursog ar =
match ar with
    TLeaf -> []
  | TNode (a,f) ->  a::(List.fold_left (fun acc el -> (percursog el)@acc) [] f)
    
let rec alturag ar =
  match ar with 
    TLeaf -> 0
  | TNode (a,f) ->   1 + (List.fold_left (fun acc el -> let v = (alturag el) in if v > acc then v else acc ) 0 f)



(*

  Vamos agora explorar uma outra estrutura de dados clássica em
  informática: os grafos.  Há várias formas simples de os representar
  (vamos nos limitar aqui ao "obvio"):

  matriz de adjacências, listas de adjacências directas

  Um grafo tem nodos e vertices, pode ser dirigido e ter conteúdos nos
  nodos ou nos vertices.
*)

(* 
   cada nodo é indexado por un inteiro (o seu número)
   'a --> tipo da informação nos nodos 
   'b --> tipo da informação nos vertices
   (int*'b) --> o numero do nodo destino e a informação que o vertice contém
   (int * 'a) --> o nodo de numero int tem por informação 'a
   (int*'b) array array--> a matriz de adjacência em si.
   (int * 'a) list ---> a listagem dos nodos com os seus conteúdos
*)
type ('a,'b) grafogm = (int*'b) array array * (int * 'a) list


(* 

bom, ficando-nos no caso mais simple...

*)

type  grafo =  bool array array

(* ou ainda, via lista de adjacência *)

type grafol = (int * (int list)) list


(** Algumas funções sobre grafos, vistos como listas de adjacências **)

(* qual é a lista dos nodos vizinhos dum nodo i? *)
let nextl (g:grafol) (i:int) =  List.assoc i g;;

(*  fundir duas listas de valores sem causar repetições *)
let merge l1 l2 = List.fold_left (fun acc e -> if List.mem e acc then  acc else e::acc) l1 l2

(* Dado um grafo g, que nodos é possível atingir a partir de uma lista
   de nodos l (prerequisitos l está ordenada e sem repetição de
   elementos) ? *)
let rec atingiveis (g: grafol) (l: int list) =
  (*** vizinhos = lista ordenada (sem repetição, graças a função
       merge) dos vizinhos dos nodos presentes em l***)
  let vizinhos = List.sort compare (fold_left (fun acc a -> merge (nextl g a) acc) [] l) in
    (*** se vizinhos = l então nada de novo aconteceu... então de
         certeza que nada de novo acontecerá -> caso de paragem***)
    if vizinhos = l then l else atingiveis g (sort compare (merge l vizinhos) )



(*** um exemplo simples ***)
let umgrafo = [(1,[1;2;3;4;5]);(2,[1;3]);(3,[1;2]);(4,[1;5;6;7]);(5,[1;4;6]);(6,[4;5]);(7,[4]);(8,[9]);(9,[8])];;  

nextl umgrafo 1;;
nextl umgrafo 8;;

atingiveis umgrafo [8];;
atingiveis umgrafo [1];;
atingiveis umgrafo [1;8];;

(*** e com grafos de tipo grafo (matriz de adjacência) ? ***)



(**** algumas funções que vamos usar....

     val iter : ('a -> unit) -> 'a array -> unit

     -- Array.iter f a applies function f in turn to all the elements
     of a. It is equivalent to f a.(0); f a.(1); ...; f
     a.(Array.length a - 1); ().

     val iteri : (int -> 'a -> unit) -> 'a array -> unit

     -- Same as Array.iter, but the function is applied to the index
     of the element as first argument, and the element itself as
     second argument.  

****)

let next (g:grafo) i =   
  let l = ref [] in
  let _=   Array.iteri (fun j v -> if v then l:=j::!l) g.(i) in 
    !l;;

(* Dado um grafo g que nodos é possível atingir a partir de uma lista de nodos l ? *)
let rec atingiveisg (g: grafo) (l: int list) = 
  let vizinhos = sort compare (fold_left (fun acc a -> merge (next g a) acc) [] l) in
    if vizinhos = l then l else atingiveisg g (sort compare (merge l vizinhos) )


let maisumgrafo = 
[|
[| true  ; true  ; true  ; true  ; true  ; false ; false ; false ; false |];
[| true  ; false ; true  ; false ; false ; false ; false ; false ; false |];
[| true  ; true  ; false ; false ; false ; false ; false ; false ; false |];
[| true  ; false ; false ; false ; true  ; true  ; true  ; false ; false |];
[| true  ; false ; false ; true  ; false ; true  ; false ; false ; false |];
[| false ; false ; false ; true  ; true  ; false ; false ; false ; false |];
[| false ; false ; false ; true  ; false ; false ; false ; false ; false |];
[| false ; false ; false ; false ; false ; false ; false ; false ; true  |];
[| false ; false ; false ; false ; false ; false ; false ; true  ; false |];
|] ;;
  

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


next maisumgrafo 7;;
next maisumgrafo 0;;
atingiveisg maisumgrafo [7];;
atingiveisg maisumgrafo [0];;
atingiveisg maisumgrafo [0;7];;

(****
um exemplo completo com o tipo das expressões aritméticas de base.

Vamos implementar uma derivadora básica.
****)


open Scanf
open List
open Stream
open Genlex
open Printf
open Str

(*
Universo U  = (Var União N União {+,-,*,\,(,)})*

  expression é o menor X subconjunto de U verificando (B) e (I)

  (B) 2 casos
     a) qualquer que seja o inteiro i, i  pertence ao conjunto X
     b) qualquer que seja a variável v, v pertence ao conjunto X
  (I) 4 passos indutivos
     1) qualquer que sejam f e g elementos de X, então (f + g) pertence a X
     2) qualquer que sejam f e g elementos de X, então (f - g) pertence a X
     3) qualquer que sejam f e g elementos de X, então (f * g) pertence a X
     4) qualquer que sejam f e g elementos de X, então (f / g) pertence a X

*)
type variavel = string

type expression =
    Const of int                      (*    i    *)
  | Var of variavel                   (*    x    *)
  | Sum of expression * expression    (* e1 + e2 *)
  | Diff of expression * expression   (* e1 - e2 *)
  | Prod of expression * expression   (* e1 * e2 *)
  | Divi of expression * expression   (* e1 / e2 *)

(*

  Funções de leitura que permitam ler do teclado expressões do genero

  "(a + 5) * 2 / ( b - 4)"

  devolver um elemento de tipo expression que  representa a expressão lida  

  Divi ((Prod (Sum (Var "a", Const 5),( Const 2))),(Diff ((Var "b"),(Const 4))))

  Para tal é necessario fazer o que chamamos um "parser" capaz de ler
  uma string e reconhecer a expressão que nela está contida. 

  Veremos no segundo semestre estas técnicas de forma pormenorizada,
  aqui vamos nos contentar em usar uma receita "já feita" disponível no
  OCaml.  Numa primeira leitura, podem omitir a compreensão da
  construção do parser.

  Aqui vai uma gramática LL(1) que serve de base ao parser "caseiro" 

  E  ::= T E'
  E' ::= + T E'
  E' ::= - T E'
  E' ::= \epsilon
  T  ::= F T'
  T' ::=  * F T'
  T' ::=  / F T'
  T' ::= \epsilon
  F  ::= N
  F  ::= V
  F  ::= ( E )

*)



let lexer = make_lexer ["("; ")"; "+"; "*"; "-"; "/"];;


let rec parse_expr = parser (* corresponde a entrada E da gramatica *)
    [< e1 = parse_mult; e = parse_more_adds e1 >] -> e
and parse_more_adds e1 = parser (* corresponde a entrada E' da gramatica *)
    [< 'Kwd "+"; e2 = parse_mult; e = parse_more_adds (Sum(e1, e2)) >] -> e
  | [< 'Kwd "-"; e2 = parse_mult; e = parse_more_adds (Diff(e1, e2)) >] -> e
  | [< >] -> e1
and parse_mult = parser (* corresponde a entrada T da gramatica *)
    [< e1 = parse_simple; e = parse_more_mults e1 >] -> e
and parse_more_mults e1 = parser (* corresponde a entrada T' da gramatica *)
    [< 'Kwd "*"; e2 = parse_simple; e = parse_more_mults (Prod(e1, e2)) >] -> e
  | [< 'Kwd "/"; e2 = parse_simple; e = parse_more_mults (Divi(e1, e2)) >] -> e
  | [< >] -> e1
and parse_simple = parser (* corresponde a entrada F da gramatica *)
    [< 'Ident s >] -> Var s
  | [< 'Int i >] -> Const  i
  | [< 'Float f >] -> Const (int_of_float f)
  | [< 'Kwd "("; e = parse_expr; 'Kwd ")" >] -> e;;

let parse_expression = parser [< e = parse_expr; _ = Stream.empty >] -> e;;

(* função principal de leitura usando streams*)
let expr_of_string s = parse_expression(lexer(Stream.of_string s));;

let read_expression () = expr_of_string (read_line ());;



let rec do_n_times f n acc =   
  if n<=0 
  then rev acc
  else 
    let v= f () in
      (do_n_times f (n-1) (v::acc))

(****Funções de escrita ****)

(* Função (recursiva estrutural) de conversão de expressões para strings  *)     
let rec string_of_expr ex =
    match ex with
        Const c -> string_of_int c
      | Var v ->  v
      | Sum(f, g) ->
          ("( "^ string_of_expr f ^ " + " ^ string_of_expr g ^" )")
      | Prod(f, g) ->
          ("( "^ string_of_expr f ^ " * " ^ string_of_expr g ^" )")
      | Diff(f, g) ->
          ("( "^ string_of_expr f ^ " - " ^ string_of_expr g ^" )")
      | Divi(f, g) ->
          ("( "^ string_of_expr f ^ " / " ^ string_of_expr g ^" )")

exception Unbound_variable of string;;

let rec eval (env: (variavel * int) list) exp =
  match exp with
      Const c ->  float_of_int c
    | Var v ->        (
        try float_of_int (List.assoc v env) 
        with Not_found -> raise(Unbound_variable v))
    | Sum(f, g) -> eval env f +. eval env g
    | Diff(f, g) -> eval env f -. eval env g
    | Prod(f, g) -> eval env f *. eval env g
    | Divi(f, g) -> let valor = eval env g in
        if valor = 0.0 then failwith ("Divisão por ZERO!!! "^ string_of_expr g)
        else  eval env f /. valor;;


let rec deriv ex dv =
   match ex with
     Const c -> Const 0
   | Var v -> if v = dv then Const 1 else Const 0
   | Sum(f, g) -> Sum(deriv f dv, deriv g dv)
   | Diff(f, g) -> Diff(deriv f dv, deriv g dv)
   | Prod(f, g) -> Sum(Prod(f, deriv g dv), Prod(deriv f dv, g))
   | Divi(f, g) -> Divi (Diff(Prod(deriv f dv, g), Prod(f, deriv g dv)), Prod(g, g))
 ;;


let main () =
  let formula = read_expression () in
  let v = read_line() in 
  let nvar = read_int () in
  let env =  do_n_times (fun () -> 
                           let s = (scanf " %s" (fun a -> a)) in
                           let i = read_int () in (s,i)) 
                             nvar [] in
  let derivada = deriv formula v in
  let valorf = eval env formula in
  let valord = eval env derivada in
    printf "lido:%s\nderivada:%s\nvalor:%f\nvalor derivada:%f\n" 
      (string_of_expr formula) (string_of_expr derivada) valorf valord
;;

main ();;

(**** Fim do exemplo completo (mas no entanto simplista)****)

This document was generated using caml2html