Exercises
Merging two lists

Write a function merge_i
which takes as input two integer lists sorted in increasing order and
returns a new sorted list containing the elements of the first two.
# let
rec
merge_i
l1
l2
=
match
(l1,
l2)
with
[],_
>
l2

_,[]
>
l1

h1::t1,
h2::t2
>
if
h1
<
h2
then
h1::(merge_i
t1
l2)
else
h2::(merge_i
l1
t2);;
val merge_i : 'a list > 'a list > 'a list = <fun>
 Write a general function merge
which takes as argument a comparison function and two lists sorted
in this order and returns the list merged in the same
order. The comparison function will be of type
'a > 'a > bool.
# let
rec
merge
ord_fn
l1
l2
=
match
(l1,
l2)
with
[],_
>
l2

_,[]
>
l1

h1::t1,
h2::t2
>
if
ord_fn
h1
h2
then
h1::(merge
ord_fn
t1
l2)
else
h2::(merge
ord_fn
l1
t2);;
val merge : ('a > 'a > bool) > 'a list > 'a list > 'a list = <fun>
 Apply
this function to two integer lists sorted in decreasing order, then to two
string lists sorted in decreasing order.
# merge
(>
)
[
4
4
;3
3
;2
2
;1
1
]
[
5
5
;3
0
;1
0
]
;;
 : int list = [55; 44; 33; 30; 22; 11; 10]
# merge
(>
)
[
"my"
;
"first"
;
"effort"
]
[
"wonderful"
;"try"
;"number"
;"1"
]
;;
 : string list =
["wonderful"; "try"; "number"; "my"; "first"; "effort"; "1"]
 What happens
if one of the lists is not in the required decreasing order?
If at least one of the lists is not in the given order, then the result
probably won't be.
 Write a new list
type in the form of a record containing three fields: the conventional
list, an order function and a boolean indicating whether the list is in
that order.
# type
'a
slist
=
{l:
'a
list;
ord_fn
:
'a
>
'a
>
bool;
is_in_order
:
bool};;
type 'a slist = { l: 'a list; ord_fn: 'a > 'a > bool; is_in_order: bool }
 Write the function insert
which adds an element to a list of this type.
 Write a function
sort which insertion sorts the elements of a list.
# let
insert
e
ls
=
let
rec
insert_rec
e
l
=
match
l
with
[]
>
[
e]

h::t
>
if
ls.
ord_fn
e
h
then
e::l
else
h::(insert_rec
e
t)
in
if
ls.
is_in_order
then
{ls
with
l=
insert_rec
e
ls.
l}
else
{ls
with
l
=
e::ls.
l};;
val insert : 'a > 'a slist > 'a slist = <fun>
# let
sort
ls
=
if
ls.
is_in_order
then
ls
else
List.fold_right
insert
ls.
l
{l=[]
;
ord_fn=
ls.
ord_fn;
is_in_order=
true};;
val sort : 'a slist > 'a slist = <fun>
 Write a new function merge
for these lists.
# let
rec
merge_ls
l1
l2
=
if
l1.
is_in_order
then
if
l2.
is_in_order
then
{l
=
merge
l1.
ord_fn
l1.
l
l2.
l;
ord_fn
=
l1.
ord_fn;
is_in_order
=
true}
else
List.fold_right
insert
l2.
l
l1
else
if
l2.
is_in_order
then
merge_ls
l2
l1
else
merge_ls
(sort
l1)
l2;;
val merge_ls : 'a slist > 'a slist > 'a slist = <fun>
Lexical trees
Lexical trees (or tries) are used for the representation of
dictionaries.
# type
lex_node
=
Letter
of
char
*
bool
*
lex_tree
and
lex_tree
=
lex_node
list;;
# type
word
=
string;;
The boolean value in lex_node marks the end of a word when it
equals true.
In such a structure, the sequence of words ``fa, false, far, fare, fried,
frieze'' is stored in the following way:
An asterisk (*) marks the end of a word.

Write the function exists
which tests whether a word belongs to a dictionary of type
lex_tree.
# let
rec
exists
w
d
=
let
aux
sw
i
n
=
match
d
with
[]
>
false

(Letter
(c,
b,
l))::t
when
c=
sw.[
i]
>
if
n
=
1
then
b
else
exists
(String.sub
sw
(i+
1
)
(n
1
))
l

(Letter
(c,
b,
l))::t
>
exists
sw
t
in
aux
w
0
(String.length
w)
;;
val exists : string > lex_tree > bool = <fun>
 Write a function insert
which takes a word and a dictionary and returns a new dictionary which
additionally contains this word. If the word is already in the dictionary,
it is not necessary to insert it.
# let
rec
insert
w
d
=
let
aux
sw
i
n
=
if
n
=
0
then
d
else
match
d
with
[]
>
[
Letter
(sw.[
i],
n
=
1
,
insert
(String.sub
sw
(i+
1
)
(n
1
))
[])]

(Letter(c,
b,
l))::t
when
c=
sw.[
i]>
if
n
=
1
then
(Letter(c,
true,
l))::t
else
Letter(c,
b,
insert
(String.sub
sw
(i+
1
)
(n
1
))
l)::t

(Letter(c,
b,
l))::t
>
(Letter(c,
b,
l))::(insert
sw
t)
in
aux
w
0
(String.length
w)
;;
val insert : string > lex_tree > lex_tree = <fun>
 Write a function construct
which takes a list of words and constructs the corresponding dictionary.
# let
construct
l
=
let
rec
aux
l
d
=
match
l
with
[]
>
d

h::t
>
aux
t
(insert
h
d)
in
aux
l
[]
;;
val construct : string list > lex_tree = <fun>
 Write a function verify
which takes a list of words and a dictionary and returns the list of words
not belonging to this dictionary.
# let
rec
filter
p
=
function
[]
>
[]

h::t
>
if
p
h
then
h::(filter
p
t)
else
filter
p
t
;;
val filter : ('a > bool) > 'a list > 'a list = <fun>
# let
verify
l
d
=
filter
(function
x
>
not
(exists
x
d))
l
;;
val verify : string list > lex_tree > string list = <fun>
 Write a function select
which takes a dictionary and a length and returns the set of words of this
length.
# let
string_of_char
c
=
String.make
1
c
;;
val string_of_char : char > string = <fun>
# let
rec
select
n
d
=
match
d
with
[]
>
[]

(Letter(c,
b,
l))::t
when
n=
1
>
let
f
(Letter
(c,
b,_
))
=
if
b
then
string_of_char
c
else
"!"
in
filter
(function
x
>
x
<>
"!"
)
(List.map
f
d)

(Letter(c,
b,
l))::t
>
let
r1
=
select
(n
1
)
l
and
r2
=
select
n
t
in
let
pr
=
List.map
(function
s
>
(string_of_char
c)^
s)
r1
in
pr@
r2
;;
val select : int > lex_tree > string list = <fun>
Graph traversal
We define a type 'a graph representing directed graphs by
adjacency lists containing for each vertex the list of its successors:
# type
'a
graph
=
(
'a
*
'a
list)
list
;;

Write a function insert_vtx
which inserts a vertex into a graph and returns the new graph.
# let
rec
insert_vtx
v
g
=
match
g
with
[]
>
[
(v,[]
)]

(h,_
)::_
when
h=
v
>
failwith
"existing vertex"

vl::t
>
vl::(insert_vtx
v
t)
;;
val insert_vtx : 'a > ('a * 'b list) list > ('a * 'b list) list = <fun>
# let
insert_vtx
=
(insert_vtx
:
'a
>
'a
graph
>
'a
graph)
;;
val insert_vtx : 'a > 'a graph > 'a graph = <fun>
 Write a function insert_edge
which adds an edge to a graph already possessing these two vertices.
# let
rec
insert_edge
v1
v2
g
=
match
g
with
[]
>
failwith
"unknown vertex"

(h,
el)::t
when
h=
v1
>
if
List.mem
v2
el
then
failwith
"existing edge"
else
(v1,
v2::el)::t

vl::t
>
vl::(insert_edge
v1
v2
t)
;;
val insert_edge : 'a > 'b > ('a * 'b list) list > ('a * 'b list) list =
<fun>
# let
insert_edge
=
(insert_edge
:
'a
>
'a
>
'a
graph
>
'a
graph
)
;;
val insert_edge : 'a > 'a > 'a graph > 'a graph = <fun>
 Write a function has_edges_to
which returns all the vertices following directly from a given vertex.
# let
rec
has_edges_to
v
g
=
match
g
with
[]
>
[]

(v'
,
el)::_
when
v=
v'
>
el

_::
t
>
has_edges_to
v
t
;;
val has_edges_to : 'a > ('a * 'b list) list > 'b list = <fun>
# let
has_edges_to
=
(has_edges_to
:
'a
>
'a
graph
>
'a
list)
;;
val has_edges_to : 'a > 'a graph > 'a list = <fun>
 Write a function has_edges_from
which returns the list of all the vertices leading directly to a given
vertex.
# let
rec
has_edges_from
v
g
=
match
g
with
[]
>
[]

(h,
el)::t
>
if
List.mem
v
el
then
h::(has_edges_to
v
t)
else
(has_edges_to
v
t)
;;
val has_edges_from : 'a > ('a * 'a list) list > 'a list = <fun>
# let
has_edges_from
=
(has_edges_from
:
'a
>
'a
graph
>
'a
list)
;;
val has_edges_from : 'a > 'a graph > 'a list = <fun>