映射到嵌套序列树

Question

我编写了一个函数，旨在映射到嵌套适当列表的任意树，有点类似于常见的 lisp 函数 map-into：

(defun map-into-tree (fn tree)
  "Destructive mapping into a proper tree."
  (cond ((null tree) nil)
        ((atom (car tree)) 
         (setf (car tree) (funcall fn (car tree))) 
         (map-into-tree fn (cdr tree)))
        (t (map-into-tree fn (car tree)) 
           (map-into-tree fn (cdr tree)))))

(defparameter *tree* '(1 (2) ((3)) (4 5) (6 ((7)))))
*TREE*

(map-into-tree #'1+ *tree*)
NIL

*tree*
(2 (3) ((4)) (5 6) (7 ((8))))

但是，我不确定如何将其推广到任意嵌套序列（例如 map-into 用于序列）。感谢您提供任何帮助。

Answer 1

您可以致电map-into ;-)

(defun map-into-tree (function tree)
  (labels
      ((recurse (tree)
         (typecase tree
           (sequence (map-into tree #'recurse tree))
           (t (funcall function tree)))))
    (recurse tree)))

...或等效：

(defun map-into-tree (function tree)
  (typecase tree
    (sequence (map-into tree (lambda (u) (map-into-tree function u)) tree))
    (t (funcall function tree))))

测试：

(map-into-tree #'1+ (copy-tree '((9 10) (8 9 10 11 (12 13) () (11) () 13))))
=> ((10 11) (9 10 11 12 (13 14) NIL (12) NIL 14))

我不确定包含字符串的树会发生什么：我们真的要遍历每个字符吗？事实上，这就是上面所做的。

我还注意到 map-into 可以处理包含 cons 单元的序列，但相应的 map-into-tree 不能，即使它使用了 map-into。

(1 (2 . 3)) 是一个包含两个元素的正确列表，即1 和(2 . 3)。由于map-into 不会递归到元素中，它所做的只是在这两个元素上调用函数。在您的评论中，这是print，它可以毫无问题地打印不正确的列表。

第二个元素是一个序列：当你调用map-into-tree时，函数用这个序列递归调用map-into，这恰好是一个不正确的列表。 map-into 需要 正确的序列，因此会因列表不正确而失败。

请注意，在您的问题中，您说：

一个旨在映射到嵌套适当列表的任意树的函数

具有不正确列表的树不是有效输入。

最后，我注意到您对文字数据调用破坏性函数，如下所示：

(map-into #'print '(1 2))

引用的列表是一个常量，在运行时修改它是未定义的行为。这就是我在示例中首先使用copy-tree 的原因。

这样可以处理所有特殊情况[...]

由于已经有一个 typecase，处理 cons 的特殊情况就足够了；无论cdr 槽中保存的值类型如何，它都有效：

(defun map-into-tree (function tree)
  (labels
      ((walk (tree)
         (typecase tree
           (cons
            (prog1 tree
              (setf (car tree) (walk (car tree)))
              (setf (cdr tree) (walk (cdr tree)))))
           (sequence (map-into tree #'walk tree))
           (t (funcall function tree)))))
    (walk tree)))

Answer 2

这是一个可能的解决方案：

(defun map-into-nested-list (fn nested-list)
  "Destructive mapping into a nested-list."
  (cond ((null nested-list) nil)
        ((atom (car nested-list)) 
         (when (car nested-list) (setf (car nested-list) (funcall fn (car nested-list))))
         (map-into-nested-list fn (cdr nested-list)))
        ((atom (cdr nested-list)) 
         (when (cdr nested-list) (setf (cdr nested-list) (funcall fn (cdr nested-list))))
         (map-into-nested-list fn (car nested-list)))
        (t (map-into-nested-list fn (car nested-list)) 
           (map-into-nested-list fn (cdr nested-list)))))

(defvar *a* (copy-tree '((9 10) (8 9 10 11 (12 13) () (11) () 13))))
;; => *A*
(map-into-nested-list #'1+ *a*)
;; => NIL
*a*
;; => ((10 11) (9 10 11 12 (13 14) NIL (12) NIL 14))

该功能类似于map-into-tree：主要区别在于cdr 是原子的情况下的条件中有一个新的对称分支，以及“原子”情况下的测试仅当原子与 NIL 不同时才应用函数 fn。