INF 231 - Functional Algorithmic and Programming

Lecture 3: Advanced Types

Below are the commands demonstrated during the lecture session plus some additional commands.

Remember:

  • Try them yourself.
  • Tweak them: modify them and try variants of those commands.
  • Your curiosity is your best pedagogical tool.

Disclaimer: the functions in the code below are defined most of the times without SPECIFICATION. Remember that defining a function always consists in giving its specification and then implementation.

Synonym type

In [2]:
type price = float     (* >0 *)
type rate = int        (* 1,2,…, 99 *)

let reducedPrice (p:price) (r:rate):price =
        p -. (p *. (float_of_int r) /. 100.)
Out[2]:
type price = float
Out[2]:
type rate = int
Out[2]:
val reducedPrice : price -> rate -> price = <fun>

Enumerated type: the card game

In [5]:
type family = Spade | Heart | Diamond | Club;;  (* in French: pique, coeur, carreau, trefle *)
type color = White | Black;;

Spade;; 
Spade = Heart;;

Spade < Heart;;
Spade != Heart;;

let colorFamily (f:family):color = 
        if (f=Spade || f = Club) then Black
        else White ;;
                
colorFamily Spade ;;
Out[5]:
type family = Spade | Heart | Diamond | Club
Out[5]:
type color = White | Black
Out[5]:
- : family = Spade
Out[5]:
- : bool = false
Out[5]:
- : bool = true
Out[5]:
- : bool = true
Out[5]:
val colorFamily : family -> color = <fun>
Out[5]:
- : color = Black
Out[5]:
val colorFamily : family -> color = <fun>

Now using pattern matching

In [7]:
let colorFamily (f:family):color=
  match f with
    | Spade -> Black
    | Club -> Black
    | Diamond -> White
    | Heart -> White
Out[7]:
val colorFamily : family -> color = <fun>

Note that it follows the type definition in the sense that it also ${\bf enumerates}$ the symbolic constants of the type. Moreover it is also exhaustive in the sense that all values are mentioned. Note however, that the order of "cases" does not necessarily follows the one of the type definition.

In [8]:
let colorFamily (f:family):color=
  match f with
      Spade | Club -> Black
    | Heart | Diamond -> White ;;

let colorFamily (f:family):color =
  match f with 
      Spade | Club -> Black
    | _ -> White ;;

let colorFamily = function | Spade | Club -> Black
    | _ -> White ;;

type painting = 
  | Blue 
  | Yellow
  | Red ;;
Out[8]:
val colorFamily : family -> color = <fun>
Out[8]:
val colorFamily : family -> color = <fun>
Out[8]:
val colorFamily : family -> color = <fun>
Out[8]:
type painting = Blue | Yellow | Red

A predicate determining whether a paint is $\texttt{Blue}$.

In [11]:
let is_blue (p : painting) : bool =
  match p with 
    | Blue -> true
    | Yellow -> false
    | Red -> false
    
let is_blue2 (p : painting) : bool =
  match p with 
    | Blue -> true
    | _ -> false
    
let is_blue3 (p : painting) : bool = p=Blue ;;

is_blue Red ;;
Out[11]:
val is_blue : painting -> bool = <fun>
Out[11]:
val is_blue2 : painting -> bool = <fun>
Out[11]:
val is_blue3 : painting -> bool = <fun>
Out[11]:
- : bool = false

Pattern matching on integers

In [12]:
let is_even (n : int) : bool =
  match n with 
    | 0 -> true
    | 1 -> false
    | 2 -> true
    | n -> if n mod 2 = 0 then true else false

type natural = int

let has_predecessor (n:natural):bool =
  match n with 0 -> false | n -> true ;;
  
let  has_predecessor2 (n:natural):bool =
  match n with 0 -> false | _ -> true ;;

let  has_predecessor3 (n:natural):bool = n > 0 ;;
Out[12]:
val is_even : int -> bool = <fun>
Out[12]:
type natural = int
Out[12]:
val has_predecessor : natural -> bool = <fun>
Out[12]:
val has_predecessor2 : natural -> bool = <fun>
Out[12]:
val has_predecessor3 : natural -> bool = <fun>

Shortening Pattern Matching

In [14]:
let is_uppercase (c:char):bool =
  match c with
 'A'| 'B' | 'C' | 'D' | 'E' | 'F' | 'G' | 'H' | 'I' | 'J' | 'K' | 'L' | 'M'
| 'N' | 'O' | 'P' | 'R' | 'S' | 'T' | 'U' | 'V' | 'W' | 'X' | 'Y' | 'Z' -> true
| c -> false ;;

let is_uppercase (c:char):bool =
  match c with
    | 'A' .. 'Z' -> true
    | c -> false ;;

is_uppercase 'N' ;;
is_uppercase 'm' ;;

let is_uppercase (c:char):bool =
  match c with
    | 'Z' .. 'A' -> true
    | c -> false ;;
    
is_uppercase 'N' ;;

let is_less_than_100 (n:int):bool =
  match n with
    | 1 .. 100 -> true
    | _ -> false ;;
Out[14]:
val is_uppercase : char -> bool = <fun>
Out[14]:
val is_uppercase : char -> bool = <fun>
Out[14]:
- : bool = true
Out[14]:
- : bool = false
Out[14]:
val is_uppercase : char -> bool = <fun>
Out[14]:
- : bool = true

File "[14]", line 24, characters 6-14:
Error: Only character intervals are supported in patterns.
  23:   match n with
  24:     | 1 .. 100 -> true
  25:     | _ -> false ;;

Product types

A couple of pairs

In [15]:
((1.2),3);;
let _ = ((1.0, 2),(3,4));;
Out[15]:
- : float * int = (1.2, 3)
Out[15]:
- : (float * int) * (int * int) = ((1., 2), (3, 4))

Product type

In [21]:
1,2;;

(true, (3,4));;

(3.4 , 3.5, 3.6);;

((fst (1,2)),  (snd(3,4)));;

fst;;

fst (snd (1,(2,3)));;

snd (fst (1,(2,3)));;

fst (1,(2,3,4));;

let (x,y) = (3,2) in x + y ;;

let (a, _, c) = (10, 18, 91) in a + c ;;

let make_coord (x:float) (y:float) = x,y ;;
Out[21]:
- : int * int = (1, 2)
Out[21]:
- : bool * (int * int) = (true, (3, 4))
Out[21]:
- : float * float * float = (3.4, 3.5, 3.6)
Out[21]:
- : int * int = (1, 4)
Out[21]:
- : 'a * 'b -> 'a = <fun>
Out[21]:
- : int = 2

File "[21]", line 13, characters 4-19:
Error: This expression has type int but an expression was expected of type
         'a * 'b
  12: 
  13: snd (fst (1,(2,3)));;
  14:

Let's practice product types

In [24]:
type pair_of_int = int*int ;;

let my_fst (p:pair_of_int):int = let (first_element,_) = p in first_element ;;

let swap (p:pair_of_int):pair_of_int =
  let (the_first,the_second)=p in (the_second,the_first);;

let swap (p:pair_of_int):pair_of_int = (snd p,fst p) ;;
Out[24]:
type pair_of_int = int * int
Out[24]:
val my_fst : pair_of_int -> int = <fun>
Out[24]:
val swap : pair_of_int -> pair_of_int = <fun>
Out[24]:
val swap : pair_of_int -> pair_of_int = <fun>

The above functions can actually be more general, as we shall see later when we will introduce polymorphism

In [25]:
let swap (x : 'a * 'b) :  'b * 'a = 
  (snd (x), fst (x));; 

let swap (x : 'a * 'b) :  'b * 'a = 
  let (toto, tutu) = x in 
  (tutu, toto);;

let my_fst (x : 'a * 'b) :  'a = 
  let (toto, _ ) = x in (toto);;
Out[25]:
val swap : 'a * 'b -> 'b * 'a = <fun>
Out[25]:
val swap : 'a * 'b -> 'b * 'a = <fun>
Out[25]:
val my_fst : 'a * 'b -> 'a = <fun>
In [26]:
type complex = float * float ;;

let conjugation (x : complex) : complex = 
  let (a,b) = x in  (a, -. b );;

let conjugation (x : complex) : complex = 
  (fst (x), -. (snd (x)) );;

let _ = conjugation (1.0, 12.0);;
Out[26]:
type complex = float * float
Out[26]:
val conjugation : complex -> complex = <fun>
Out[26]:
val conjugation : complex -> complex = <fun>
Out[26]:
- : complex = (1., -12.)

Let's practice more

In [29]:
type vect = float * float ;;

let sum (u : vect)(v : vect) : vect =
  (fst (u) +. fst (v)), (snd (u) +. snd (v)) ;;
  
let sum (u : vect) (v : vect) : vect =
  let (ux,uy) = u in 
  let (vx,vy) = v in 
  ux+.vx , uy +. vy ;;
  
let scalar_product (u : vect)(v : vect) : float =
  let (ux,uy) = u in 
  let (vx,vy) = v in 
  ux *.vx +. uy *. vy ;;
Out[29]:
type vect = float * float
Out[29]:
val sum : vect -> vect -> vect = <fun>
Out[29]:
val sum : vect -> vect -> vect = <fun>
Out[29]:
val scalar_product : vect -> vect -> float = <fun>

Union types

In [30]:
type pt = float * float ;;

type figure = 
  | Circle of pt * float 
  | Triangle of pt * pt * pt
  | Rectangle of pt * pt 

let is_square (fig:figure):bool =
  match fig with
    | Circle (p,r) -> false
    | Triangle (p1,p2,p3) -> false
    | Rectangle (p1,p2) -> 
        let (p1x,p1y) = p1 and (p2x,p2y)=p2 in 
        let abs_float (x:float):float = if x < 0. then -. x else x in
        let diffx = abs_float (p1x -. p2x)  and diffy = abs_float (p1y -. p2y) in
          diffx = diffy ;;

let is_square (fig:figure):bool = 
  match fig with
    | Rectangle (p1,p2) ->  (* note that, contrarily to standard tuples, here in a pattern matching, outer parentheses are mandatory *)
        let (p1x,p1y) = p1 and (p2x,p2y)=p2 in 
        let abs_float (x:float):float = if x < 0. then -. x else x in
        let diffx = abs_float (p1x -. p2x) and diffy = abs_float (p1y -. p2y) in
          diffx = diffy
    | _ -> false ;;

let is_square (fig:figure):bool = 
  match fig with
    | Rectangle ((p1x,p1y),(p2x,p2y)) ->
        let abs_float (x:float):float = if x < 0. then -. x else x in
        let diffx = abs_float (p1x -. p2x) and diffy = abs_float (p1y -. p2y) in
          diffx = diffy
    | _ -> false ;;
Out[30]:
type pt = float * float
Out[30]:
type figure =
    Circle of pt * float
  | Triangle of pt * pt * pt
  | Rectangle of pt * pt
Out[30]:
val is_square : figure -> bool = <fun>
Out[30]:
val is_square : figure -> bool = <fun>
Out[30]:
val is_square : figure -> bool = <fun>

Distance between two points

In [34]:
let distance (p1:pt) (p2:pt):float =
  let (p1x,p1y)=p1 and (p2x,p2y) = p2 in
  let diffx = p1x -. p2x and diffy = p1y -. p2y in
    sqrt ((diffx**2.)+.(diffy**2.)) ;;

let distance ((p1x,p1y):pt) ((p2x,p2y):pt):float =
  let diffx = p1x -. p2x and diffy = p1y -. p2y in
    sqrt ((diffx**2.)+.(diffy**2.)) ;;

let area (fig:figure):float =
  match fig with
    | Rectangle (p1,p2) -> let (p1x,p1y)=p1 and (p2x,p2y)=p2 in (sqrt (p1x-.p2x)**2.) *. (sqrt (p1y-.p2y)**2.)
    | Triangle (p1, p2, p3) ->
        let (p1x,p1y) = p1 and (p2x,p2y) = p2 and (p3x,p3y)= p3 in
        let a = sqrt ( (p1x-.p2x)**2. +. (p1y -. p2y)**2.) and b = sqrt ((p2x-.p3x)**2. +. (p2y-.p3y)**2.) and c = sqrt ((p3x-.p1x)**2. +. (p3y -. p1y)**2.)**2. in
        let s = 0.5 *. (a+.b+.c) in
          sqrt (s*. (s-.a) *. (s-.b) *. (s-.c))
    | Circle (p,r) -> let pi = 3.14 in pi*.(r**2.) ;;

let area2 (fig:figure):float =
  match fig with
    | Rectangle ((p1x,p1y),(p2x,p2y)) -> (sqrt (p1x-.p2x)**2.) *. (sqrt (p1y-.p2y)**2.)
    | Triangle ((p1x,p1y),(p2x,p2y),(p3x,p3y)) -> 
        let a = sqrt ( (p1x-.p2x)**2. +. (p1y -. p2y)**2.) and b = sqrt ((p2x-.p3x)**2. +. (p2y-.p3y)**2.) and c = sqrt ((p3x-.p1x)**2. +. (p3y -. p1y)**2.)**2. in
        let s = 0.5 *. (a+.b+.c) in
          sqrt (s*. (s-.a) *. (s-.b) *. (s-.c))
    | Circle (p,r) -> let pi = 3.14 in pi*.(r**2.) ;;

let p1 = 1.3, 2.0 and p0 = 0.0,0.0;;
let fig1 = Circle (p1,2.9) ;;

area fig1;;
Out[34]:
val distance : pt -> pt -> float = <fun>
Out[34]:
val distance : pt -> pt -> float = <fun>
Out[34]:
val area : figure -> float = <fun>
Out[34]:
val area2 : figure -> float = <fun>
Out[34]:
val p1 : float * float = (1.3, 2.)
val p0 : float * float = (0., 0.)
Out[34]:
val fig1 : figure = Circle ((1.3, 2.), 2.9)
Out[34]:
- : float = 26.4074000000000026
In [ ]: