Reference. The Zipper [huet-1997]

Almost every programmer has faced the problem of representing a tree together with a subtree that is the focus of attention, where that focus may move left, right, up or down the tree. The Zipper is Huet's nifty name for a nifty data structure which fulfills this need. I wish I had known of it when I faced this task, because the solution I came up with was not quite so efficient or elegant as the Zipper.

@article{10.1017/S0956796897002864,
  author = {Huet, G\'{e}rard},
  title = {The Zipper},
  year = {1997},
  issue_date = {September 1997},
  publisher = {Cambridge University Press},
  address = {USA},
  volume = {7},
  number = {5},
  issn = {0956-7968},
  url = {https://doi.org/10.1017/S0956796897002864},
  doi = {10.1017/S0956796897002864},
  abstract = {Almost every programmer has faced the problem of representing a tree together with a subtree that is the focus of attention, where that focus may move left, right, up or down the tree. The Zipper is Huet's nifty name for a nifty data structure which fulfills this need. I wish I had known of it when I faced this task, because the solution I came up with was not quite so efficient or elegant as the Zipper.},
  journal = {J. Funct. Program.},
  month = sep,
  pages = {549–554},
  numpages = {6}
}

Backlinks

Translation. Using zippers to handle huge trees [jsr-000Q]

December 22, 2024
Diego Olivier Fernandez Pons with contributions from Jinser Kafka
Original

This article is translated from Diego Olivier Fernandez Pons's article titled "Using zippers to handle huge trees".

本文翻译自 Diego Olivier Fernandez Pons 题为《Using zippers to handle huge trees》的文章

tips: Click on the translation to expand and view the original text. 点击译文可展开查看原文。有修复原文 typo。

嗨，

Bonjour,

2003年4月9日星期三，Yang Shouxun 写道：

我不知道如何编写尾递归版本来构建树。如果连续属性不多且数据集也不是很大，那树会在堆栈溢出之前停止生长。

（译者按：连续属性是指其在数据集中可以取无限多值，通常是实数，例如身高、温度等。）

On Wednesday, 09 Apr 2003, Yang Shouxun wrote:

> I don't know how to write a tail recursive version to build trees.
> If there are not that many continuous attributes and the dataset is
> not so large, the tree stops growing before stack overflow.

2003 年 4 月 9 日星期三，Markus Mottl 写道：

这里的诀窍是使用延续传递风格（CPS）：传递一个包含后续计算所需的所有内容的函数闭包（延续）。子函数不返回结果，而是使用结果调用延续，这使得函数成为尾递归。

On Wednesday 09 April 2003, Markus Mottl wrote:

> The trick is to use continuation passing style (CPS): you pass a
> function closure (continuation) containing everything that's needed
> in subsequent computations.  Instead of returning a result, the
> sub-function calls the continuation with the result, which makes the
> functions tail-recursive.

zipper 是一种处理巨大（实际是无限）tree 的简单方法。

Zippers are a simple way to handle huge (in fact infinite) trees.

Zipper 的解释 _{Explanation of zippers} [#261]

December 22, 2024
Diego Olivier Fernandez Pons

zipper 可以被视为一种“函数式指针”，因为它能够提供：

纯 ( purely ) 的函数式和类型化的操作
O(1) 的访问指针元素
O(1) 的指针移动

Zippers may be seen as 'functional pointers' since they offer :
- purely functional and typed operations
- O(1) access to the pointed element
- O(1) pointer movements

限制是数据结构只允许有一个指针，且每次指针移动都会分配内存。

The restrictions are that only one pointer is allowed by data structure and every pointer movement allocates memory.

采用二叉搜索树的经典类型声明

Take a classical type declaration for binary search trees

type 'a tree = E | N of 'a tree * 'a * 'a tree * int

考虑一棵二叉搜索树和一个你想要指向的内部节点。要对指向的子树进行 O(1) 访问，它必须可以直接从数据结构的基础中获取。然后，树的其余部分必须保存在单独的地方。我们将沿着从根到指向的节点的路径来解构它

Consider a binary search tree and an inner node to which you want to
point. To have a 0(1) access to the pointed subtree, it has to be
directly available from the base of the data structure. Then, the
rest of the tree must be kept in a separate place. We will deconstruct
it along the path from the root to the pointed node

type 'a path =
  | Root
  | Left of 'a * 'a tree * 'a path
  | Right of 'a tree * 'a * 'a path

type 'a zipper = 'a tree * 'a path

zipper 约束 ( constraints ) 声明如下：

指向的子树
沿着通往根的路径断开的树的其余部分

The zipper constraint as announced :
- the pointed subtree
- the rest of the tree breaked along the path to the root

接着我们定义指针的移动（数据结构中的每个指针各一个）：

Then we define the pointer movements (one for each pointer in the data structure) :

exception Bottom

(* To be replaced by a balancing constructor *)
let makeDTree = fun l v r -> N (l, v, r, 0)

let move_left = fun (tree, path) ->
  match tree with
    | E -> raise Bottom
    | N (l, v, r, _) -> (l, Left (v, r, path))

let move_right = fun (tree, path) ->
  match tree with
    | E -> raise Bottom
    | N (l, v, r, _) -> (r, Right (l, v, path))

let move_up = fun (tree, path) ->
  match path with
    | Root -> raise Top
    | Left (v, r, tail) -> (makeDTree tree v r, tail)
    | Right (l, v, tail) -> (makeDTree l v tree, tail)

现在我们可以通过以下过程构建任意大的树：

构建一棵有界深度的树
选择下一个要发展的节点
移动当前指针到那个节点
继续构建这课树

Now we can build an arbitrary large tree by the following procedure :
- build a tree of bounded depth
- choose the node which will be developed next
- move the current pointer to that node
- continue building the tree

该过程使用有界的堆栈空间。

This procedure uses a bounded stack space

代码示例 _{Examples of code} [#263]

December 22, 2024
Diego Olivier Fernandez Pons

以下是从 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
;;

Translation. Zipper in scheme [jsr-000O]

December 18, 2024
Oleg Kiselyov with contributions from Jinser Kafka
Original

This article is translated from Oleg Kiselyov's article titled "zipper in scheme".

本文翻译自 Oleg Kiselyov 题为《zipper in scheme》的文章

Title added by translator. 标题由译者添加。

tips: Click on the translation to expand and view the original text. 点击译文可展开查看原文。

前言 [#271]

December 18, 2024
Oleg Kiselyov

zipper 是一种非常方便的数据结构，它允许我们替换复杂数据结构（例如树或 term）深处的项，而无需任何可变性。结果数据结构将尽可能多地与旧结构共享其组件 [见附录]。旧的数据结构仍然可用（这便于我们撤销该操作）。本质上，zipper 是一个“可更新”但纯函数式的数据结构游标。

Zipper is a very handy data structure that lets us replace an item deep in a complex data structure, e.g., a tree or a term, without any mutation. The resulting data structure will share as much of its components with the old structure as possible [see addendum]. The old data structure is still available (which can be handy if we wish to 'undo' the operation later on). Zipper is essentially an `updateable' and yet pure functional cursor into a data structure.

有用的参考:

http://www.nist.gov/dads/HTML/zipper.html
http://citeseer.ist.psu.edu/hinze01web.html

Useful references:
        http://www.nist.gov/dads/HTML/zipper.html
        http://citeseer.ist.psu.edu/hinze01web.html

zipper 是一种由定界延续具体化而来的数据结构。不知何故，这个想法在 zipper 领域并不常见。因为 scheme 有一等支持的定界延续，我们可以更容易地派生和使用 zipper。

Zipper is a _delimited continuation_ reified as a data structure. Somehow that idea is not commonly discussed in the zipper literature. Because Scheme has first-class and delimited continuations, we can derive and use zipper far more easily.

本文将给出 zipper 的派生及其使用示例：交换两棵树的两个分支。该使用示例是遗传编程中典型的交叉操作。

Given below is a derivation of zipper and an example of its use: swapping out of two branches of a two trees. The latter is a typical cross-over operation in genetic programming.

[email protected] (Noel Welsh) 在消息中写

news:<[email protected]>...

我想以纯函数式的方式进行交叉，我设想的算法是：

计算两棵树中每棵树的节点数

选择 0 ...（节点数 - 1）之间的随机整数，在这个（整数索引的）节点进行交叉。

[email protected] (Noel Welsh) wrote in message
news:<[email protected]>...
I would like to do the crossover in a purely functional manner.  The
algorithm I envisage is:
  - Count the number of nodes for each of the two trees
  - Choose an random integer between 0 ... (number of nodes - 1)
    This is the node where crossover will take place.

正如上文指出的，我们不需要通过计数来从树中选择随机节点。选择节点后，我们可以使用 eq? 测试来向下拉开树中的该节点。然而，在下文中，为了简单起见，我们跳过随机选择，按深度优先顺序和节点索引选择节点。

As pointed out earlier, we don't need counting to select a random node from a tree. After we selected the node, we can zip down to that node in the tree using the eq? test. In the following however, we skip the random selection for simplicity and thus we shall be selecting nodes by their index in the depth-first order.

派生 [#272]

December 18, 2024
Oleg Kiselyov

为了派生 zipper，我们首先编写更熟悉的深度优先遍历例程：

To derive zipper, we first write the familiar depth-first traversal routine:

Welcome to Scheme 48 1.1
> ,open srfi-9
> ,open escapes signals
> ,load /usr/local/lib/scheme48/misc/shift-reset.scm

; deterministic, left-to-right map
(define (map* f l)
  (if (null? l) l
    (cons (f (car l)) (map* f (cdr l)))))

(define (depth-first handle tree)
  (cond
    ((null? tree) tree)
    ((handle tree) => (lambda (new-tree) new-tree))
    ; the node was not handled -- descend
    ((not (pair? tree)) tree) ; an atom
    (else
      (cons (car tree) ; node name
        (map* (lambda (kid) (depth-first handle kid)) (cdr tree))))))

函数 handle，作为 depth-first 的第一个参数，接受一个 node 并应该返回一个 node 或 #f。在第一种情况下，返回的 node 替换结果树中的现有节点。如果 handle 返回 #f，则表明它已拒绝处理该节点，因此我们保留该节点，在可能的情况下继续处理该节点的子节点。

The function handle, the first-argument of depth-first, receives a node and should yield either a node or #f. In the first case, the return node replaces the existing node in the result tree. If the handle returned #f, it has declined to handle that node, so we keep that node and descend into it, if possible.

为了解其工作原理，我们定义两个示例树并打印出它们的节点：

To see how this works, we define two sample trees and print out their nodes:

(define tree1 '(a (b) (c (d 1 2)) e))
(define tree2 '(z (u) (v (w 10 12)) y))

(depth-first (lambda (node) (display node) (newline) #f) tree1)
==> prints
  (a (b) (c (d 1 2)) e)
  (b)
  (c (d 1 2))
  (d 1 2)
  1
  2
  e
==> yields
'(a (b) (c (d 1 2)) e)

我们现在可以定义数据类型 zipper：

We can now define the zipper data structure:

(define-record-type zzipper
  (zipper curr-node k)
  zipper?
  (curr-node z-curr-node)
  (k z-k))

它包含两个字段：树的当前节点和延续。延续应该接收一个 node 或 #f。在前一种情况，接收到的节点将替换现有节点。在后一种情况，我们保留现有节点并继续遍历。这个延续返回一个新的 zipper 或一课树（如果遍历完成）。可以看出，zipper 在某种意义上是函数 handle 的“逆”。

It contains two fields: the current node of a tree, and the continuation. The continuation should receive a node or #f. In the former case, the received node will replace the existing node. In the latter case, we keep the existing node and continue the traversal. The continuation returns either a new zipper, or a tree (if the traversal is finished). One can see that zipper is in a sense an 'inverse' of the function handle.

(define (zip-tree tree)
  (reset (depth-first (lambda (tree) (shift f (zipper tree f))) tree)))

正如所承诺的，zipper 确实是定界延续的一种表现形式。

As promised, zipper is indeed a manifestation of a delimited continuation.

我们应该指出，record zipper 和构造函数 zip-tree 都是 generic 的。它们本身既不依赖树的表示，也不依赖遍历策略。有关树数据结构及其遍历的所有信息都被封装在一个函数 depth-first 中。我们可以通过改变深度优先策略从深度优先策略切换到广度优先策略，或者从嵌套列表切换到树的嵌套向量实现。无论是 zipper、zip-tree 还是任何使用 zipper 的代码（见下文）都不需要任何修改。我们的 zipper 的这一特性与 Gerard Huet 的 zipper 派生形成了鲜明的对比。在 Gerard Huet 的形式中，zipper 确实取决于数据类型的具体实现：zipper 是从数据类型 derived（双关语）的（译者按：派生和求导）。不同的数据类型（以及抽象数据类型的不同实现）将具有不同的对应 zipper 结构。在我们的形式中，zipper 是遍历函数的 generic derivation（双关语）（译者按：派生和导数）。zipper 是遍历函数的导数——就只是机械的导数。因此，shift/reset 可以被视为遍历函数的导数运算符。

We should point out that both the zipper record and the constructor function zip-tree are _generic_. They by themselves depend neither on the representation of the tree nor on the traversal strategy. All the information about the tree data structure and its traversal is encapsulated in one single function depth-first. We can switch from depth-first to breadth-first strategy or from a nested list to a nested vector realization of trees just by changing depth-first. Neither zipper, nor zip-tree, nor any code that uses zipper (see below) will require any modifications. This property of our zipper is in a marked contrast with Gerard Huet's derivation of zipper. In Gerard Huet's formulation, zipper does depend on the concrete realization of the data type: zipper is derived (pun intended) from the data type. Different data types (and different realizations of an abstract data type) will have different corresponding zipper structures. In our formulation, zipper is a _generic_ derivation (pun intended) on the traversal function. Zipper is a derivative of the traversal function -- mechanical derivative at that. So, shift/reset can be considered traversal function derivative operators.

使用 [#273]

December 18, 2024
Oleg Kiselyov

我们现在可以用一种不同的方式打印树：

We can now print out the tree in a different way:

(define (print-tree tree)
  (do ((cursor (zip-tree tree) ((z-k cursor) #f)))
      ((not (zipper? cursor)))
    (display (z-curr-node cursor))
    (newline)))

我们使用 zipper（即 cursor）逐个节点地检查整个树。从某种意义上说，我们翻转了 depth-first 的操作。

we use zipper, which is a cursor, to examine all of the tree, node by node. In a sense, we have inverted the operation of depth-first.

(print-tree tree1)
; prints as before

(print-tree tree2)
  (z (u) (v (w 10 12)) y)
  (u)
  (v (w 10 12))
  (w 10 12)
  10
  12
  y

引入一些有用的函数

We introduce a few helpful functions

(define (zip-all-the-way-up zipper)
  (if (zipper? zipper) (zip-all-the-way-up ((z-k zipper) (z-curr-node zipper)))
    zipper))

(define (locate-nth-node n tree)
  (do ((i 0 (+ 1 i)) (cursor (zip-tree tree) ((z-k cursor) #f)))
    ((and (= i n)
       (if (zipper? cursor) #t
        (error "too few nodes"))) cursor)
    ))

我们已准备好做一些事：

And we are ready for some action:

; replace the 3-d node of tree1 with 'xxx
(let ((desired-node (locate-nth-node 3 tree1)))
  (display "Replacing the node: ")
  (display (z-curr-node desired-node))
  (newline)
  (zip-all-the-way-up ((z-k desired-node) 'xxx)))

==> prints
    Replacing the node: (d 1 2)
==> yieds
    '(a (b) (c xxx) e)

它确实替换了，不是吗？

It did replace it, didn't it?

; cross-over of the 3d node of tree1 and 1st node of tree2
(let* ((desired-node1 (locate-nth-node 3 tree1))
       (_ (begin
       (display "Cross-over the node1: ")
       (display (z-curr-node desired-node1))
       (newline)))
       (desired-node2 (locate-nth-node 1 tree2))
       (_ (begin
       (display "Cross-over the node2: ")
       (display (z-curr-node desired-node2))
       (newline)))
       (new-tree1
         (zip-all-the-way-up ((z-k desired-node1)
                              (z-curr-node desired-node2))))
       (new-tree2
          (zip-all-the-way-up ((z-k desired-node2)
                               (z-curr-node desired-node1))))
        )
  (display "new tree1: ") (display new-tree1) (newline)
  (display "new tree2: ") (display new-tree2) (newline)
)

==> prints
  Cross-over the node1: (d 1 2)
  Cross-over the node2: (u)
  new tree1: (a (b) (c (u)) e)
  new tree2: (z (d 1 2) (v (w 10 12)) y)

嗯，看来可行...

Well, it seems to work...

如果我们交换 tree1 的第3个节点和 tree2 的第5个节点，我们得到

If we swap the 3d node of tree1 and the 5th node of tree2, we get

Cross-over the node1: (d 1 2)
  Cross-over the node2: 12
  new tree1: (a (b) (c 12) e)
  new tree2: (z (u) (v (w 10 (d 1 2))) y)

总结 [#274]

December 18, 2024
Oleg Kiselyov

总而言之，定界延续非常有用。可以在任何 R5RS scheme 系统中进行模拟；但如果它本身受支持，性能会更好。Scheme48 本身就支持定界延续（Martin Gasbichler and Michael Sperber, ICFP 2002）。如果你最喜欢的 Scheme 系统默认没有提供它们，请向实现者投诉。支持哪个特定的定界延续运算符（shift、control、shift0、splitter、cupto 等）并不重要——所有这些的表达性都是相同的：

To conclude, delimited continuations are quite useful. They can be emulated in any R5RS Scheme system; yet it is better for performance if they are supported natively. Scheme48 does support delimited continuations natively (Martin Gasbichler and Michael Sperber, ICFP 2002). If your favorite Scheme system does not offer them by default, please complain to the implementors. It doesn't matter which particular delimited continuation operator (shift, control, shift0, splitter, cupto, etc) is supported -- all of them are equally expressible:

Chung-chieh Shan, Scheme2004 workshop
http://www.eecs.harvard.edu/~ccshan/recur/

附录 [#275]

December 18, 2024
Oleg Kiselyov

附录，2006 年 6 月 7 日 [受到 Andrew Wilcox 问题的启发] 更准确地说，zipper 与底层枚举器一样保留了共享。以下是最大共享保留枚举器。这两个函数应该取代本文中的函数。

Addendum, June 7, 2006 [inspired by a question from Andrew Wilcox] To be more precise, the zipper preserves sharing as much as the underlying enumerator does. The following is the maximal sharing preserving enumerator. Those two functions should replace the ones in the article.

; deterministic, left-to-right map
; It preserves sharing as much as possible: that is, if given the pair
; l == (cons h t), (and (eq? h (f h)) (eq? t (map* f t))) holds, then
; (eq? (map* f l) l) holds as well.
(define (map* f l)
  (if (null? l) l
    (let ((h (car l)) (t (cdr l)))
      (let ((h1 (f h)) (t1 (map* f t)))
        (if (and (eq? h1 h) (eq? t1 t)) l
            (cons h1 t1))))))

(define (depth-first handle tree)
  (cond
    ((null? tree) tree)
    ((handle tree) => (lambda (new-tree) new-tree))
    ; the node was not handled -- descend
    ((not (pair? tree)) tree) ; an atom
    (else
      (let ((kids1 
             (map* (lambda (kid) (depth-first handle kid)) (cdr tree))))
        (if (eq? kids1 (cdr tree)) tree
            (cons (car tree) ; node name
                kids1))))))

为了测试新的 depth-first 确实保留了共享，我们求值

To test that the new depth-first indeed preserves sharing, we evaluate

(eq? tree1
     (depth-first (lambda (node) (display node) (newline) #f) tree1))

以深度优先顺序打印所有节点后，给出结果 #t。在这种情况下，深度优先（depth-first）返回的树确实是原始树。

which, after printing all nodes in depth-first order, gives the result #t. The tree returned by depth-first in this case is indeed the original tree as it is.

zipper 代码无需更改，按原样工作，具有相同的结果。为了测试共享是否保留，我们首先通过替换 tree2 中的第 6 个节点（即 y）来生成一棵树：

The zipper code needs no changes, and it works as it was, with the same results. To test the sharing preservation, we first produce a tree by replacing the 6th node (which is y) in tree2:

(define tree2*
  (let ((desired-node (locate-nth-node 6 tree2)))
  (display "Replacing the node: ")
  (display (z-curr-node desired-node))
  (newline)
  (zip-all-the-way-up ((z-k desired-node) 'newy))))

这是结果：(z (u) (v (w 10 12)) newy)

here's the result: (z (u) (v (w 10 12)) newy)

现在，我们编写一个函数，它接受两棵树，同步遍历它们并打印出节点以及它们是否共享：

Now, we write a function that takes two trees, traverses them in lockstep and prints out the nodes and if they are shared:

(define (tree-compare-sharing t1 t2)
  (do ((cursor1 (zip-tree t1) ((z-k cursor1) #f))
       (cursor2 (zip-tree t2) ((z-k cursor2) #f)))
      ((cond
        ((and (zipper? cursor1) (zipper? cursor2)) #f)
      ((zipper? cursor1) (display "t2 finished early") #t)
      ((zipper? cursor2) (display "t1 finished early") #t)
      (else #t)))
      (let ((n1 (z-curr-node cursor1)) (n2 (z-curr-node cursor2)))
        (cond
          ((eq? n1 n2) (display "shared node: ") (display n1))
          (else (display "t1 node: ") (display n1) (newline)
                (display "t2 node: ") (display n2)))
        (newline))))

(tree-compare-sharing tree2 tree2*)
===>
t1 node: (z (u) (v (w 10 12)) y)
t2 node: (z (u) (v (w 10 12)) newy)
shared node: (u)
shared node: (v (w 10 12))
shared node: (w 10 12)
shared node: 10
shared node: 12
t1 node: y
t2 node: newy