In the last post of the series, we’ve introduced modules, functors and maps. We had ended with realization of the value assignment function that maps a given table assignment to a (ranking) value.
In this post, we will conclude the series and solve the optimal table assignment problem using OCaml. We will implement a function that searches through the space of potential table assignments to find (the) one with best possible value. We will use a very simple exhaustive search algorithm here.
First, we introduce a new module similar to the Map module we’ve already used previously. It models a set of objects and allows to add, remove, and find elements and to iterate over them efficiently. For our purposes, a set will be the right data structure for walking through the search space.
module IntSet = Set.Make( struct type t = int let compare = compare end ) let int_list_to_set int_list = List.fold_left (fun set_acc list_el -> IntSet.add list_el set_acc) IntSet.empty int_list
As before, we have to specify a compare function, and we use the default one once again. We also add a function int_list_to_set that converts a list of integers to a set of integers by folding the list and adding one element at a time using IntSet.add while starting with the empty set IntSet.empty.
If we want to get the sets of people and seats, we could use the mapping function as follows:
let people_set = int_list_to_set (List.map (fun (x,_) -> x) people) let seats_set = int_list_to_set (List.map (fun (x,_,_) -> x) table)
Before we can turn to the exhaustive search algorithm, we consider one last type that is particularly useful in functional programs: the option type. It is a box that can contain at most one instance of some other type – in other words, it’s either an empty box or a singleton. It is already defined by OCaml, but it can easily be redefined:
type 'a option = None | Some of 'a
You can use the type as follows:
let x = None let y = Some 5 match option_variable with None -> do_something | Some i -> do_something_else
Back to our initial problem: finding an optimal table assignment. Just for fun, we will also try to find a worst table assignment, so the search algorithm should be given a comparison routine that allows the algorithm to select the more “appropriate” table assignment when comparing two.
We will therefore consider the following two comparison functions:
let better_selector assignment assignment' = if assignment_value assignment > assignment_value assignment' then assignment else assignment' let worse_selector assignment assignment' = if assignment_value assignment > assignment_value assignment' then assignment' else assignment
Our exhaustive search algorithm will be called find_assignment, and it will be given one of the comparison routines as only parameter. We will then be able to create the following two convenience function searching for either a best or a worst assignment:
let best_assignment = find_assignment better_selector let worst_assignment = find_assignment worse_selector
The basic idea of our exhaustive search algorithm is as follows. At any point in the algorithm we have four objects:
- the currently “best” assignment (initially will be None),
- a partial assignment (initially will be the empty map),
- the set of empty seats (initially will be the set of all seats), and
- the set of persons without a seat (initially will be the set of all persons)
The algorithm will then proceed as follows. If there are no more people without a seat, the partial assignment (which is a full assignment at that point) will be compared with the currently best assignment, and the better one will be returned. If otherwise there are no more seats left, the algorithm will fail, because there are not enough seats for all persons. If there are still seats and persons left, the algorithm will pick the first person unseated and the first unoccupied seat, seat the person there, and recursively find the best assignment. Then, the algorithm will free the seat again, and seat the second person on the same seat and recursively find the best assignment again. This will be done for all persons unseated, so in the end, we’ll find a best assignment.
Here is the code:
let find_assignment selector = let people_left = int_list_to_set (List.map (fun (x,_) -> x) people) in let seats_left = int_list_to_set (List.map (fun (x,_,_) -> x) table) in let rec find reference assignment people_left' seats_left' = if IntSet.is_empty people_left' then match reference with None -> Some assignment | Some other_assignment -> Some (selector other_assignment assignment) else if IntSet.is_empty seats_left' then failwith "There are not enough seats!" else IntSet.fold (fun person reference' -> let people_left'' = IntSet.remove person people_left' in let seat = IntSet.choose seats_left' in let seats_left'' = IntSet.remove seat seats_left' in let assignment' = IntMap.add person seat assignment in find reference' assignment' people_left'' seats_left'' ) people_left' reference in match find None IntMap.empty people_left seats_left with None -> failwith "There must be one assignment." | Some assignment -> assignment
So what do we get in the end? A best seating assignment gets a score of 7.5 and the assignment is:
Hank sits on seat #5 Karen sits on seat #4 Becka sits on seat #1 Mia sits on seat #2 Julian sits on seat #0 Trixi sits on seat #3
A worst seating assignment gets a score of -0.625 and the assignment is:
Hank sits on seat #0 Karen sits on seat #3 Becka sits on seat #1 Mia sits on seat #5 Julian sits on seat #4 Trixi sits on seat #2
This completes our visit to the functional language OCaml. If you would like to download the full source code for the example, please click here.