以下是从 Baire 中提取的一些常用二叉搜索树操作的示例(insert
,delete
,move_pointer_to
,...)(当前版本 11 avril 2003,大量错误和损坏的代码,您可以在 Baire 的下载页面中找到它) :
(译者按:Baire 相关资源基本已不可用。)
Here are some examples of usual binary search trees operations made
with zippers (insert, delete, move_pointer_to, ...) extracted from
Baire (current version 11 avril 2003, plenty of bugs and breaked
code, you will find it in Baire's download pages) :
(译者按:使用 ocamlformat
重新格式化,与原文的格式稍有不同。)
let rec move_to_top = function
| (tree, path) as pointer ->
(match path with
| Root -> pointer
| Left (v, r, tail) -> move_to_top (makeDTree tree v r, tail)
| Right (l, v, tail) -> move_to_top (makeDTree l v tree, tail))
;;
let rec move_to x = function
| (tree, path) as pointer ->
(match tree with
| E ->
(match path with
| Right (_, rv, _) when x <= rv -> move_to x (move_up pointer)
| Left (lv, _, _) when x >= lv -> move_to x (move_up pointer)
| _ -> pointer)
| N (_, v, _, _) ->
(match compare x v with
| n when n < 0 ->
(match path with
| Right (_, rv, _) when x < rv -> move_to x (move_up pointer)
| Right _ | Root | Left _ -> move_to x (move_left pointer))
| n when n > 0 ->
(match path with
| Left (lv, _, _) when x > lv -> move_to x (move_up pointer)
| Left _ | Root | Right _ -> move_to x (move_right pointer))
| _ -> pointer))
;;
let rec member_path x = function
| Right (l, v, tail) ->
(match compare x v with
| n when n < 0 -> member x l
| 0 -> true
| _ -> member_path x tail)
| Left (v, r, tail) ->
(match compare x v with
| n when n > 0 -> member x r
| 0 -> true
| _ -> member_path x tail)
| Root -> false
;;
let rec zipper_member x = function
| tree, path ->
(match tree with
| E -> member_path x path
| N (l, v, r, _) ->
(match compare x v with
| n when n < 0 ->
(match path with
| Right (_, rv, _) when x <= rv -> member_path x path
| Right _ | Root | Left _ -> member x l)
| n when n > 0 ->
(match path with
| Left (lv, _, _) when x >= lv -> member_path x path
| Left _ | Root | Right _ -> member x r)
| _ -> true))
;;
let current_tree = function
| tree, _ -> tree
;;
let current_value = function
| tree, _ ->
(match tree with
| E -> None
| N (_, v, _, _) -> Some v)
;;
let current_value' = function
| tree, _ ->
(match tree with
| E -> raise Empty
| N (_, v, _, _) -> v)
;;
let rec zipper_insert x = function
| (tree, path) as pointer ->
(match tree with
| E ->
(match path with
| Right (_, rv, _) when x <= rv -> zipper_insert x (move_up pointer)
| Left (lv, _, _) when x >= lv -> zipper_insert x (move_up pointer)
| _ -> makeTree E x E, path)
| N (_, v, _, _) ->
(match compare x v with
| n when n < 0 ->
(match path with
| Right (_, rv, _) when x < rv -> zipper_insert x (move_up pointer)
| Right _ | Root | Left _ -> zipper_insert x (move_left pointer))
| n when n > 0 ->
(match path with
| Left (lv, _, _) when x > lv -> zipper_insert x (move_up pointer)
| Left _ | Root | Right _ -> zipper_insert x (move_right pointer))
| _ -> pointer))
;;
let rec zipper_delete x = function
| (tree, path) as pointer ->
(match tree with
| E ->
(match path with
| Right (_, rv, _) when x <= rv -> zipper_delete x (move_up pointer)
| Left (lv, _, _) when x >= lv -> zipper_delete x (move_up pointer)
| _ -> pointer)
| N (l, v, r, _) ->
(match compare x v with
| n when n < 0 ->
(match path with
| Right (_, rv, _) when x < rv -> zipper_delete x (move_up pointer)
| Right _ | Root | Left _ -> zipper_delete x (move_left pointer))
| n when n > 0 ->
(match path with
| Left (lv, _, _) when x > lv -> zipper_delete x (move_up pointer)
| Left _ | Root | Right _ -> zipper_delete x (move_right pointer))
| _ -> move_to x (appendB l r, path)))
;;
let rec path_to_list result = function
| Root -> result
| Left (v, r, path) -> path_to_list (result @ (v :: to_ordered_list r)) path
| Right (l, v, path) -> path_to_list (to_ordered_list_rec (v :: result) l) path
;;
let zipper_to_list = function
| tree, path -> path_to_list (to_list tree) path
;;