Exercises

Exercises

Binary Trees

We represent binary trees in the form of vectors. If a tree a has height h, then the length of the vector will be 2^(h+1)-1. If a node has position i, then the left subtree of this node lies in the interval of indices [i+1 , i+1+2^h], and its right subtree lies in the interval [i+1+2^h+1 , 2^(h+1)-1]. This representation is useful when the tree is almost completely filled. The type 'a of labels for nodes in the tree is assumed to contain a special value indicating that the node does not exist. Thus, we represent labeled trees by the by vectors of type 'a array.

Write a function , taking as input a binary tree of type 'a bin_tree
```
# let fill_array tree tab empty = 
   let rec aux i p = function
       Empty -> tab.(i) <- empty 
     | Node (l,e,r) -> 
         tab.(i) <- e ;
         aux (i+1) (p/2) l ;
         aux (i+p) (p/2) r 
    in aux 0 (((Array.length tab)+1)/2) tree ;;
val fill_array : 'a bin_tree -> 'a array -> 'a -> unit = <fun>
```
```
# type 'a bin_tree = 
     Empty
   | Node of 'a bin_tree * 'a * 'a bin_tree ;;
type 'a bin_tree = | Empty | Node of 'a bin_tree * 'a * 'a bin_tree
```
(defined on page ??) and an array (which one assumes to be large enough). The function stores the labels contained in the tree in the array, located according to the discipline described above.
Write a function to create a leaf (tree of height 0).
```
# let leaf empty = [| empty |]  ;;
val leaf : 'a -> 'a array = <fun>
```

Write a function to construct a new tree from a label and two other trees.


# let node elt left right = 
   let ll = Array.length left and lr = Array.length right in
   let l = max ll lr in
   let res = Array.create (2*l+1) elt in 
   Array.blit left 0 res 1 ll ;
   Array.blit right 0 res (ll+1) lr ;
   res  ;;
val node : 'a -> 'a array -> 'a array -> 'a array = <fun>

Write a conversion function from the type 'a bin_tree to an array.


# let rec make_array empty = function 
     Empty -> leaf empty
   | Node (l,e,r) -> node e (make_array empty l) (make_array empty r) ;;
val make_array : 'a -> 'a bin_tree -> 'a array = <fun>

Define an infix traversal function for these trees.


# let infix tab empty f = 
   let rec aux i p = 
     if tab.(i)<>empty then ( aux (i+1) (p/2) ; f tab.(i) ; aux (i+p) (p/2) )
   in aux 0 (((Array.length tab)+1)/2) ;;
val infix : 'a array -> 'a -> ('a -> 'b) -> unit = <fun>

Use it to display the tree.
```
# let print_tab_int tab empty = 
   infix tab empty (fun x -> print_int x ; print_string " - ") ;;
val print_tab_int : int array -> int -> unit = <fun>
```
What can you say about prefix traversal of these trees?
Prefix traversal of the tree corresponds to left-to-right traversal of the array.
```
# let prefix tab empty f = 
   for i=0 to (Array.length tab)-1 do if tab.(i)<>empty then f tab.(i) done ;;
val prefix : 'a array -> 'a -> ('a -> unit) -> unit = <fun>
```

Spelling Corrector

The exercise uses the lexical tree , from the exercise of chapter 2, page ??, to build a spelling corrector.

Construct a dictionary from a file in ASCII in which each line contains one word. For this, one will write a function which takes a file name as argument and returns the corresponding dictionary.


# type noeud_lex = Lettre of char * bool * arbre_lex 
 and arbre_lex = noeud_lex  list;;
type noeud_lex = | Lettre of char * bool * arbre_lex
type arbre_lex = noeud_lex list
# type mot = string;;
type mot = string
# let rec  existe m d = 
   let  aux sm i n = 
     match d with
       [] -> false
     | (Lettre (c,b,l))::q -> 
          if c = sm.[i] then 
            if n = 1 then b 
            else existe (String.sub sm (i+1) (n-1)) l       
          else existe sm q
   in aux m 0 (String.length m);;
val existe : string -> arbre_lex -> bool = <fun>

# let rec ajoute m d = 
   let aux sm i n = 
     if n = 0 then d else 
     match d with 
       [] -> [Lettre (sm.[i], n = 1, ajoute (String.sub sm (i+1) (n-1)) [])]
     | (Lettre(c,b,l))::q -> 
         if c = sm.[i] then
            if n = 1 then (Lettre(c,true,l))::q
            else Lettre(c,b,ajoute (String.sub sm (i+1) (n-1)) l)::q
         else (Lettre(c,b,l))::(ajoute sm q)
   in aux m 0 (String.length m);;
val ajoute : string -> arbre_lex -> arbre_lex = <fun>

# let rec verifie l d = match l with 
   [] -> []
 | t::q -> if existe t d then t::(verifie q d) 
           else verifie q d
 ;;
val verifie : string list -> arbre_lex -> string list = <fun>

# let string_of_char c = String.make 1 c;;
val string_of_char : char -> string = <fun>

# let rec filter p l = match l with 
   [] -> []
 | t::q -> if p t then t::(filter p q)
           else filter p q;;
val filter : ('a -> bool) -> 'a list -> 'a list = <fun>


# let rec selecte n d = 
   match d with 
     [] -> []
   | (Lettre(c,b,l))::q -> 
        if n = 1 then
          filter (function x -> x <> "!")  
           (List.map  (function (Lettre(c,b,_)) ->  if b then string_of_char c else "!") d)
        else 
          let r = selecte (n-1) l 
          and r2 = selecte n q  in
            let pr = List.map (function s -> (string_of_char c)^s) r 
            in pr@r2;;
val selecte : int -> arbre_lex -> string list = <fun>


# let lire_fichier nom_fichier = 
   let dico = ref [] 
   and canal = open_in nom_fichier in
   try 
     while true do dico := ajoute (input_line canal) !dico done ;
     failwith "cas impossible"
    with 
        End_of_file -> close_in canal ; !dico
      |  x -> close_in canal ; raise x  ;;
val lire_fichier : string -> arbre_lex = <fun>

Write a function words that takes a character string and constructs the list of words in this string. The word separators are space, tab, apostrophe, and quotation marks.


# let mots s = 
   let est_sep = function ' '|'\t'|'\''|'"' -> true  |  _ -> false in
   let res = ref [] and p = ref ((String.length s)-1) in 
   let n = ref !p in
   while !p>=0 && est_sep s.[!p] do decr p done ;
   n := !p ;
   while (!n>=0) do
     while !n>=0 && not (est_sep s.[!n]) do decr n  done ;
     res := String.sub s ( !n +1) (!p - !n) :: !res ;
     while !n>=0 && est_sep s.[!n] do decr n done ;
     p := !n 
   done ;
   !res ;;
val mots : string -> string list = <fun>

Write a function verify that takes a dictionary and a list of words, and returns the list of words that do not occur in the dictionary.
```
# let rec verifie dico = function 
     [] -> []
   | m::l -> if existe m dico then verifie dico l else m::(verifie dico l) ;;
val verifie : arbre_lex -> string list -> string list = <fun>
```

Write a function occurrences that takes a list of words and returns a list of pairs associating each word with the number of its occurrences.


# let rec ajoute x = function 
     [] -> [(x,1)]
   | ((y,n) as p)::l -> if x=y then (y,n+1)::l else p::(ajoute x l) ;;
val ajoute : 'a -> ('a * int) list -> ('a * int) list = <fun>

# let rec ajoute_liste ld = function 
     [] -> ld
   | n::l -> let res = ajoute_liste ld l in ajoute n res ;;
val ajoute_liste : ('a * int) list -> 'a list -> ('a * int) list = <fun>

# let occurences l = ajoute_liste [] l ;;
val occurences : 'a list -> ('a * int) list = <fun>

Write a function spellcheck that takes a dictionary and the name of a file containing the text to analyze. It should return the list of incorrect words, together with their number of occurrences.


# let orthographe dico nom = 
   let f = open_in nom  and res = ref [] in
   try  
     while true do 
       let s = input_line f in 
       let ls = mots s in 
       let lv = verifie dico ls in 
       res := ajoute_liste !res lv 
     done ;
     failwith "cas impossible"
   with 
       End_of_file -> close_in f ; !res
     | x -> close_in f ; raise x  ;;
val orthographe : arbre_lex -> string -> (string * int) list = <fun>

Set of Prime Numbers

We would like now to construct the infinite set of prime numbers (without calculating it completely) using lazy data structures.

Define the predicate divisible which takes an integer and an initial list of prime numbers, and determines whether the number is divisible by one of the integers on the list.
On sait que si un nombre x possède un diviseur supérieur à x alors il en possède inférieur à x. Nous nous contentons donc de ne tester que les éléments de la liste qui sont inférieurs à la racine carrée de l'argument.
```
# let rec est_divisible x = function 
     [] -> false
   | n::l ->  (x mod n)=0 || ( (n*n<=x) && (est_divisible x l)) ;;
val est_divisible : int -> int list -> bool = <fun>
```

Given an initial list of prime numbers, write the function next that returns the smallest number not on the list. On calcule le dernier élément de la liste.


# let rec dernier = function 
     [] -> failwith "liste vide"
   | [x] -> x 
   | _::l -> dernier l ;;
val dernier : 'a list -> 'a = <fun>

On cherche le premier nombre premier à partir d'un certain entier en les testant de deux en deux.


# let rec plus_petit_premier l n = 
   if est_divisible n l then plus_petit_premier l (n+2) else n ;;
val plus_petit_premier : int list -> int -> int = <fun>

Et on assemble.


# let suivant = function 
     []  -> 2
   | [2] -> 3
   |  l  -> let pg = dernier l in plus_petit_premier l (pg+2) ;;
val suivant : int list -> int = <fun>

Define the value setprime representing the set of prime numbers, in the style of the type 'a enum on page ??. It will be useful for this set to retain the integers already found to be prime.


# type 'a ens = {mutable i:'a ; f : 'a -> 'a } ;;
type 'a ens = { mutable i: 'a; f: 'a -> 'a }
# let next e = let x = e.i in e.i <- (e.f e.i) ; x ;;
val next : 'a ens -> 'a = <fun>


# let ensprem = 
   let prec = ref [2] in 
   let fonct _ = let n = suivant !prec in prec := !prec @ [n] ;  n 
   in { i = 2 ; f = fonct } ;;
val ensprem : int ens = {i=2; f=<fun>}