Why Not Tail-Recursive?

Why Not Tail-Recursive?

[Ruchira Datta]

I am interested in the following problem: given a set of elements with
weights, enumerate all subsets with a given total weight.  I wrote the
function find_subsets_of_total_weight to do this in OCaml.  It works
exactly as I expect on small inputs.  But on larger (not extremely large)
inputs, I get a stack overflow.  

The function deepen within find_subsets_of_total_weight originally had an
accumulating parameter subsets, but I took that out in favor of printing
out each subset as it was found, in case that was what was causing the
stack to overflow.  Unfortunately it wasn't.  I have inserted and deleted
print statements at numerous places, and in every case the function is
doing as I expect right up until the stack overflows, or at least so
it seems to me.  

The only thing I can think of is that the functions deepen and next_path
are not actually tail-recursive as I expected them to be.  But why not?  

I have appended here the file weights.ml, which includes test data
leading to a stack overflow on my OCaml system.  (Bonus points if you can
guess where the test data came from.)  Any help anyone can give me with
this problem would be greatly appreciated.  Thanks in advance.

Ruchira Datta
datta@math.berkeley.edu

------------------------------weights.ml------------------------------
let sort_elts_by_wgt all_elts wgt_fn =
  let compare_wgt x y = compare (wgt_fn x) (wgt_fn y) in
  List.sort ~cmp:compare_wgt all_elts

exception Done

(* invariant for next_path and deepen: 
  weight_so_far is the sum of the weights of the elements marked true in
  elts_so_far; also weight_so_far < desired_wgt *)
(* next_path *cannot* be called to find the initial path *)
(*
The procedure print_fn is supposed to decode a list such as, e.g.,
[ (elt0, true); (elt1, false); (elt2, false); (elt3, true) ] into
the subset [ elt0; elt3 ] and print it out; it is purely side-effecting.
*)

let find_subsets_of_total_weight all_elts wgt_fn print_fn desired_wgt =
  let elts_sorted_by_wgt = sort_elts_by_wgt all_elts wgt_fn in
  let rec next_path ( elts_so_far, wgt_so_far, undecided_elts ) =
    match elts_so_far with
    | [] -> raise Done (* no paths left *)
    | ( elt, true ) :: other_elts ->
        let new_wgt = wgt_so_far -. wgt_fn elt in
        ( ( elt, false ) :: other_elts, new_wgt, undecided_elts )
    | ( elt, false ) :: other_elts ->
        next_path ( other_elts, wgt_so_far, elt :: undecided_elts )
  in
  let rec deepen ( elts_so_far, wgt_so_far, undecided_elts ) =
    try (
      match undecided_elts with
      | [] -> 
        let new_path = next_path ( elts_so_far, wgt_so_far, undecided_elts ) 
        in deepen new_path
      | elt :: elts ->
        let new_wgt = wgt_so_far +. wgt_fn elt in
        if new_wgt < desired_wgt then
          deepen ( ( ( elt, true ) :: elts_so_far ), new_wgt, elts )
        else if new_wgt = desired_wgt then
          let _ = print_fn ( ( elt, true ) :: elts_so_far ) in
          deepen ( ( ( elt, false ) :: elts_so_far ), wgt_so_far, elts )
        else (* new_wgt > desired_wgt *)
          let new_path = next_path ( elts_so_far, wgt_so_far, undecided_elts ) 
          in deepen new_path
    ) with Done -> ()
  in deepen ( [], 0., elts_sorted_by_wgt )

let weights = [
  ( "w0", 3.0 );
  ( "w1", 4.0 );
  ( "w2", 5.0 );
  ( "w3", 5.0 );
  ( "w4", 6.0 );
  ( "w5", 10.0 );
  ( "w6", 11.0 );
  ( "w7", 11.0 );
  ( "w8", 11.0 );
  ( "w9", 18.0 );
  ( "w10", 22.0 );
  ( "w11", 23.0 );
  ( "w12", 25.0 );
  ( "w13", 54.0 );
  ( "w14", 92.0 );
  ( "w15", 238.0 )
]

let total =
  let accum total_so_far wgt = total_so_far +. snd wgt in
  List.fold_left ~f:accum ~init:0. weights

let tie_num = float_of_int ( int_of_float total / 2 )

let _ = 
  let cout = open_out "tied_weights.txt" in
  let print_elt ( name, weight ) =
    let _ = Printf.fprintf cout "\t%s\t\t\t%d\n" name (int_of_float weight) 
    in
    ()
  in
  let print_path elts =
    let _ = Printf.fprintf cout "Way:\n" in
    let rec print_elts = function
    | [] -> ()
    | ( elt, true ) :: elts -> ( print_elt elt; print_elts elts )
    | ( elt, false ) :: elts -> print_elts elts
    in print_elts elts
  in
  try
    find_subsets_of_total_weight weights snd print_path tie_num
  with Stack_overflow -> (Printf.printf "Stack overflowed\n"; close_out cout);;

Re: Why Not Tail-Recursive?

[bcpierce]

> The only thing I can think of is that the functions deepen and next_path
> are not actually tail-recursive as I expected them to be.  But why not?  

Because each call installs a new exception handler.  To make them
tail-recursive, you need to change the style a little (e.g., make them
return an option instead of raising an exception).

       B

Re: Why Not Tail-Recursive?

[hubert.fauque]

your function deepen is not tail recursive because
the recursive call to itself is enclosed in a try..with
and the function could return by its last line
        with Done -> ()
in fact it can't return by that line if there is a recursive
call to deepen because the Done would have been catched by the
recursive deepen and the function could be considered to be
tail recursive, but the compiler doesn't know that.

a possible solution is to catch the Done in
find_subsets_of_total_weight so deepen becomes tail recursive
and there is no more a stack overflow:


let find_subsets_of_total_weight all_elts wgt_fn print_fn desired_wgt =
  let elts_sorted_by_wgt = sort_elts_by_wgt all_elts wgt_fn in
  let rec next_path ( elts_so_far, wgt_so_far, undecided_elts ) =
    match elts_so_far with
    | [] -> raise Done (* no paths left *)
    | ( elt, true ) :: other_elts ->
        let new_wgt = wgt_so_far -. wgt_fn elt in
        ( ( elt, false ) :: other_elts, new_wgt, undecided_elts )
    | ( elt, false ) :: other_elts ->
        next_path ( other_elts, wgt_so_far, elt :: undecided_elts )
  in
  let rec deepen ( elts_so_far, wgt_so_far, undecided_elts ) =
      match undecided_elts with
      | [] -> 
        let new_path = next_path ( elts_so_far, wgt_so_far, undecided_elts ) 
        in deepen new_path
      | elt :: elts ->
        let new_wgt = wgt_so_far +. wgt_fn elt in
        if new_wgt < desired_wgt then
          deepen ( ( ( elt, true ) :: elts_so_far ), new_wgt, elts )
        else if new_wgt = desired_wgt then
          let _ = print_fn ( ( elt, true ) :: elts_so_far ) in
          deepen ( ( ( elt, false ) :: elts_so_far ), wgt_so_far, elts )
        else (* new_wgt > desired_wgt *)
          let new_path = next_path ( elts_so_far, wgt_so_far, undecided_elts ) 
          in deepen new_path
  in
  try (
    deepen ( [], 0., elts_sorted_by_wgt )
   ) with Done -> ()




additionnaly in the last function the 
        close_out cout
should be outside the
     with Stack_overflow



Hubert Fauque

Re: Why Not Tail-Recursive?

[Alain Frisch]

On Wed, 25 Oct 2000, Ruchira Datta wrote:

> The only thing I can think of is that the functions deepen and next_path
> are not actually tail-recursive as I expected them to be.  But why not?  

deepen is not tail recursive: the recursive call is followed by the
the exception handler (which must be desinstalled, even if it doesn't
catch any exception).

For instance:
let f x =
    try f x with Not_found -> ();;

will raise a Stack overflow when executed.

If you want the exception to stop the computation, install the handler
around the toplevel call of deepen.


>   let rec deepen ( elts_so_far, wgt_so_far, undecided_elts ) =
>     try (
>       match undecided_elts with
>       | [] -> 
>         let new_path = next_path ( elts_so_far, wgt_so_far, undecided_elts ) 
>         in deepen new_path
>       | elt :: elts ->
>         let new_wgt = wgt_so_far +. wgt_fn elt in
>         if new_wgt < desired_wgt then
>           deepen ( ( ( elt, true ) :: elts_so_far ), new_wgt, elts )
>         else if new_wgt = desired_wgt then
>           let _ = print_fn ( ( elt, true ) :: elts_so_far ) in
>           deepen ( ( ( elt, false ) :: elts_so_far ), wgt_so_far, elts )
>         else (* new_wgt > desired_wgt *)
>           let new_path = next_path ( elts_so_far, wgt_so_far, undecided_elts ) 
>           in deepen new_path
>     ) with Done -> ()
>   in deepen ( [], 0., elts_sorted_by_wgt )


-- 
  Alain Frisch

Re: Why Not Tail-Recursive?

[John Prevost]

>>>>> "rd" == Ruchira Datta <datta@math.berkeley.edu> writes:

    rd> I am interested in the following problem: given a set of
    rd> elements with weights, enumerate all subsets with a given
    rd> total weight.  I wrote the function
    rd> find_subsets_of_total_weight to do this in OCaml.  It works
    rd> exactly as I expect on small inputs.  But on larger (not
    rd> extremely large) inputs, I get a stack overflow.

    rd> The function deepen within find_subsets_of_total_weight
    rd> originally had an accumulating parameter subsets, but I took
    rd> that out in favor of printing out each subset as it was found,
    rd> in case that was what was causing the stack to overflow.
    rd> Unfortunately it wasn't.  I have inserted and deleted print
    rd> statements at numerous places, and in every case the function
    rd> is doing as I expect right up until the stack overflows, or at
    rd> least so it seems to me.

    rd> The only thing I can think of is that the functions deepen and
    rd> next_path are not actually tail-recursive as I expected them
    rd> to be.  But why not?

    rd> I have appended here the file weights.ml, which includes test
    rd> data leading to a stack overflow on my OCaml system.  (Bonus
    rd> points if you can guess where the test data came from.)  Any
    rd> help anyone can give me with this problem would be greatly
    rd> appreciated.  Thanks in advance.

------------------------------weights.ml------------------------------
  ...
  let rec deepen ( elts_so_far, wgt_so_far, undecided_elts ) =
>>> try (
      match undecided_elts with
      | [] -> 
        let new_path = next_path ( elts_so_far, wgt_so_far, undecided_elts ) 
        in deepen new_path
      | elt :: elts ->
        let new_wgt = wgt_so_far +. wgt_fn elt in
        if new_wgt < desired_wgt then
          deepen ( ( ( elt, true ) :: elts_so_far ), new_wgt, elts )
        else if new_wgt = desired_wgt then
          let _ = print_fn ( ( elt, true ) :: elts_so_far ) in
          deepen ( ( ( elt, false ) :: elts_so_far ), wgt_so_far, elts )
        else (* new_wgt > desired_wgt *)
          let new_path = next_path ( elts_so_far, wgt_so_far, undecided_elts ) 
          in deepen new_path
>>> ) with Done -> ()
  in deepen ( [], 0., elts_sorted_by_wgt )
------------------------------------------------------------------------

Your problem is marked with >>> above.  try ... match ... around the
tail recursive call makes your call not be tail recursive.  Try
wrapping the use of deepen instead:

  in try deepen ( [], 0., elts_sorted_by_wgt) with Done -> ()

John.

Re: Why Not Tail-Recursive?

[Ruchira Datta]

Thanks very much to everyone who replied.  The exception handler in deepen
prevented it from being tail-recursive.  Two different fixes were proposed:
putting the "try...with..." around the call to deepen in
find_subsets_of_total_weight instead of within deepen; and having next_path
return an option.  Both work.  The former was simpler, but I chose to go
with the latter so I could put the accumulating parameter subsets back in
deepen and return the list of subsets as the final result.  (With the
former method, deepen never returns normally.)  In case anyone is
interested, here is the revised sample code.  I really appreciate
everyone's help!

Ruchira Datta
datta@math.berkeley.edu

-----------------------------electors.ml-----------------------------

let sort_elts_by_wgt all_elts wgt_fn =
  let compare_wgt x y = compare (wgt_fn x) (wgt_fn y) in
  List.sort ~cmp:compare_wgt all_elts

(* invariant for next_path and deepen: 
  weight_so_far is the sum of the weights of the elements marked true in
  elts_so_far; also weight_so_far < desired_wgt *)
(* next_path *cannot* be called to find the initial path *)

let find_subsets_of_total_weight all_elts wgt_fn print_fn desired_wgt =
  let elts_sorted_by_wgt = sort_elts_by_wgt all_elts wgt_fn in
  let rec next_path ( elts_so_far, wgt_so_far, undecided_elts ) =
    match elts_so_far with
    | [] -> None (* no paths left *)
    | ( elt, true ) :: other_elts ->
        let new_wgt = wgt_so_far -. wgt_fn elt in
        Some ( ( elt, false ) :: other_elts, new_wgt, undecided_elts )
    | ( elt, false ) :: other_elts ->
        next_path ( other_elts, wgt_so_far, elt :: undecided_elts )
  in
  let rec deepen subsets ( elts_so_far, wgt_so_far, undecided_elts ) =
    match undecided_elts with
    | [] -> 
      let new_path = next_path ( elts_so_far, wgt_so_far, undecided_elts ) in 
      ( match new_path with
        | None -> subsets
        | Some path -> deepen subsets path )
    | elt :: elts ->
      let new_wgt = wgt_so_far +. wgt_fn elt in
      if new_wgt < desired_wgt then
        deepen subsets ( ( ( elt, true ) :: elts_so_far ), new_wgt, elts )
      else if new_wgt = desired_wgt then
        let new_subset = ( ( elt, true ) :: elts_so_far ) in
        let _ = print_fn new_subset in
        let new_subsets = new_subset :: subsets in
        let new_path = ( ( ( elt, false ) :: elts_so_far ), wgt_so_far, elts )
        in deepen new_subsets new_path
      else (* new_wgt > desired_wgt *)
        let new_path = next_path ( elts_so_far, wgt_so_far, undecided_elts ) in 
        ( match new_path with
          | None -> subsets
          | Some path -> deepen subsets path )
  in deepen [] ( [], 0., elts_sorted_by_wgt )

let states = [
	( "arkansas", 6. );
	( "california", 54. );
	( "delaware", 3. );
	( "florida", 25. );
	( "illinois", 22. );
	( "maine", 4. );
	( "michigan", 18. );
	( "minnesota", 10. );
	( "missouri", 11. );
	( "new_mexico", 5. );
	( "pennsylvania", 23. );
  ( "safe_bush_block", 238. );
  ( "safe_gore_block", 92. );
	( "tennessee", 11. );
	( "washington", 11. );
	( "west_virginia", 5. );
]

let states_by_wgt = sort_elts_by_wgt states snd

let total =
  let accum total_so_far state = total_so_far +. snd state in
  List.fold_left ~f:accum ~init:0. states_by_wgt

let tie_num = float_of_int ( int_of_float total / 2 )

let subsets = 
  let cout = open_out "ways_to_tie.txt" in
  let print_state ( name, num_votes ) =
    Printf.fprintf cout "\t%s\t\t\t%d\n" name (int_of_float num_votes) 
  in
  let print_path = function
  (* Each "way" of producing an electoral college tie corresponds to two
    disjoint subsets of equal weight; since we are only interested in the
    ways, we only print half the subsets (omitting their complements). *)
  | ( ( "safe_bush_block", _ ) as state, true ) :: elts ->
    let _ = Printf.fprintf cout "Way:\n" in
    let _ = print_state state in
    let rec print_states = function
    | [] -> ()
    | ( state, true ) :: states -> ( print_state state; print_states states )
    | ( state, false ) :: states -> print_states states
    in print_states elts
  | _ -> ()
  in
  let encoded_subsets =
    find_subsets_of_total_weight states_by_wgt snd print_path tie_num
  in
  let _ = close_out cout in
  List.map (fun ls -> fst (List.split (List.filter snd ls))) encoded_subsets