Question

I have function ‘my_a’ in OCaml, which could have a very complicated return type:

exception Backtrack
exception Continue of (* How do I put the type of function 'my_a' here? *)

let my_a arg = try do_stuff (List.hd arg) 
               with 
               | Backtrack -> my_a (List.tl arg)
               | Continue (found_answer) ->  (try my_a (List.tl arg)
                                              with 
                                     | Backtrack -> raise Continue(found_answer)
                                     | Continue (other_answer) -> 
                       raise Continue (compare_answer(found_answer,other_answer));;
(* the caller of my_a will handle the Continue exception to catch the found value
if something was found*)

This is my problem: I’m using backtrack to find a solution. When a backtrack exception is raised by do_stuff, there was no solution going that path. However, when it raises an exception of type Continue, it means it found a solution, but, it may not be the best solution there is, that’s when I try again with a different path. If there is another exception, I want to return the answer it already had found.

The thing is, to be able to use that feature of OCaml I need to to tell it what data type Continue will be carrying. What the OCaml top level returns when i define my_a:

   'a * ('a -> ('a, 'b) symbol list list) ->
  'b list -> ('a * ('a, 'b) symbol list) list * 'b list = <fun>

Does anyone have any idea of how to do that, or a different solution to that?

Answer 1

You are gaining nothing by using exceptions. Here is a possible solution.

(** There are many ways to implement backtracking in Ocaml. We show here one
    possibility. We search for an optimal solution in a search space. The
    search space is given by an [initial] state and a function [search] which
    takes a state and returns either

    - a solution [x] together with a number [a] describing how good [x] is
      (larger [a] means better solution), or

    - a list of states that need still to be searched.

    An example of such a problem: given a number [n], express it as a sum
    [n1 + n2 + ... + nk = n] such that the product [n1 * n2 * ... * nk] is
    as large as possible. Additionally require that [n1 <= n2 <= ... <= nk].
    The state of the search can be expressed as pair [(lst, s, m)] where
    [lst] is the list of numbers in the sum, [s] is the sum of numbers in [lst],
    and [m] is the next number we will try to add to the list. If [s = n] then
    [lst] is a solution. Otherwise, if [s + m <= n] then we branch into two states:

    - either we add [m] to the list, so the next state is [(m :: lst, m+s, m)], or
    - we do not add [m] to the list, and the next state is [(lst, s, m+1)].

    The return type of [search] is described by the following datatype:
*)

type ('a, 'b, 'c) backtrack =
  | Solution of ('a * 'b)
  | Branches of 'c list

(** The main function accepts an initial state and the search function. *)
let backtrack initial search =
  (* Auxiliary function to compare two optional solutions, and return the better one. *)
  let cmp x y =
    match x, y with
      | None, None -> None (* no solution *)
      | None, Some _ -> y  (* any solution is better than none *)
      | Some _, None -> x  (* any solution is better than none *)
      | Some (_, a), Some (_, b) ->
        if a < b then y else x
  in
  (* Auxiliary function which actually performs the search, note that it is tail-recursive.
     The argument [best] is the best (optional) solution found so far, [branches] is the
     list of branch points that still needs to be processed. *)
  let rec backtrack best branches =
    match branches with
      | [] -> best (* no more branches, return the best solution found *)
      | b :: bs ->
        (match search b with
          | Solution x ->
            let best = cmp best (Some x) in
              backtrack best bs
          | Branches lst ->
            backtrack best (lst @ bs))
  in
    (* initiate the search with no solution in the initial state *)
    match backtrack None [initial] with
      | None -> None (* nothing was found *)
      | Some (x, _) -> Some x (* the best solution found *)

(** Here is the above example encoded. *)
let sum n =
  let search (lst, s, m) =
    if s = n then
      (* solution found, compute the product of [lst] *)
      let p = List.fold_left ( * ) 1 lst in
        Solution (lst, p)
    else
      if s + m <= n then
        (* split into two states, one that adds [m] to the list and another
           that increases [m] *)
        Branches [(m::lst, m+s, m); (lst, s, m+1)]
      else
        (* [m] is too big, no way to proceed, return empty list of branches *)           
        Branches []
  in
    backtrack ([], 0, 1) search
;;

(** How to write 10 as a sum of numbers so that their product is as large as possible? *)
sum 10 ;; (* returns Some [3; 3; 2; 2] *)

OCaml happily informs us that the type of backtrack is

'a -> ('a -> ('b, 'c, 'a) backtrack) -> 'b option

This makes sense:

• the first argument is the initial state, which has some type 'a
• the second argument is the search function, which takes a state of type 'a and
  returns either a Solution (x,a) where x has type 'b and a has type 'c,
  or Branches lst where lst has type 'a list.