Monday, September 10, 2007

I've been looking at a paper by Jean-Cristophe Filliatre, Backtracking Iterators. The goal of them is to be able to traverse a tree, going up or down, without having to use exceptions. In other words, instead of using the caml stack to do the backtracking you do the backtracking explicitly.

I'm not going to go into details about how the following works right now, but it's a backtracking iterator I wrote for n-ary trees.

type path = Down | Up | Entry of int

exception End_of_Traversal

(* Preorder traversal of an n-ary tree. checked *)

let preorder t =
  let rec aux = function
      E -> []
    | N (x, []) -> [Entry x]
    | N (x, children) ->
        let result =
          List.fold_left
            (fun accum c ->
              match (aux c) with
                  [] -> accum
                | x ->
                    Up::x @ Down::accum
            )
            []
            children
        in
        result @ [Entry x]
  in
  List.rev (aux t)

(* postorder ie depth-first, checked *)

let postorder t =
  let rec aux accum = function
      E -> []
    | N (x, []) -> [Entry x]
    | N (x, children) ->
        let result =
          List.fold_left
            (fun accum c ->
               match (aux [] c) with
                   [] -> accum
                 | x ->
                     Up::x @ Down::accum
            )
            []
            children
        in
        (Entry x)::result
  in
  List.rev (aux [] t)

(*Now the same functions can be used for going forward and backward in
the traversal, whatever traversal you chose.*)

let rec forward = function
    ([],_) -> raise End_of_Traversal
  | Up::(Entry x)::xx, history ->
      (Entry x)::xx, Down::history
  | Down::(Entry x)::xx, history ->
      (Entry x)::xx, Up::history
  | Up::x::xx, history ->
      forward (x::xx, Down::history)
  | Down::x::xx, history ->
      forward (x::xx, Up::history)
  | x, history -> forward (List. tl x, (List.hd x)::history)

let rec backward = function
    (_, []) -> raise End_of_Traversal
  | (current, Up::history) -> backward (Down::current, history)
  | (current, Down::history) -> backward (Up::current, history)
  | (current, x::xx) -> (x::current, xx)

let rewind (current, history) =
  List.rev_append (invert history) current

let extract (current, history) =
  try
    match List.hd current with
        Up | Down -> None
      | Entry x -> Some x
  with
    (Failure "hd") -> raise End_of_Traversal

1 comment:

Anonymous said...

Keep posting stuff like this i really like it