Tree 映射到嵌套序列树

我编写了一个函数，旨在映射到嵌套的正确列表的任意树中，这有点类似于常见的lisp函数

映射到
：

(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))))

然而，我不知道如何将其推广到任意嵌套序列（如序列的
映射到
）。感谢您的帮助。
这里有一个可能的解决方案：

(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))

该函数类似于
映射到树中
：主要区别在于，对于
cdr
是原子的情况，条件中有一个新的对称分支，以及对“原子”的测试仅当原子不同于
NIL
时，才应用函数
fn
的情况。您可以调用
映射到
；-）

。。。或相当于：

(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与包含cons单元格的序列一起工作，但对应的map-into树不工作，即使它使用map-into

（1（2.3））
是一个包含两个元素的适当列表，即
1
和
（2.3）
。由于
映射到
不会递归到元素中，因此它所做的只是在这两个元素上调用函数。在您的评论中，这是
print
，它可以毫无问题地打印不正确的列表

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

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

一种函数，旨在映射到嵌套正确列表的任意树中

包含不正确列表的树不是有效的输入

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

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

引用列表是一个常量，在运行时修改它是未定义的行为。这就是为什么我第一次在我的示例中使用
copytree

这项工作是否能处理所有特殊情况[……]

既然已经有了一个打字机，处理
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)))

酷，原力与你同在。我还注意到map-into与包含cons单元格的序列一起工作，但对应的map-into树不工作，即使它使用map-into。例如：（setqx’（1（2.3））；（映射到x#'打印x）->1，（2.3）；但是（映射到树#'print x）->错误。你能简要解释一下虚线列表出现错误的原因吗？@davypough我编辑了答案，因为它不适合注释。这可以处理所有特殊情况：
（defun虚线列表（item）（and（consp item）（cdr（last item）））（defun映射到树（函数树）（typecase树（（或字符串）（满足虚线列表））（funcall函数树）（序列（映射到树（lambda（u）（映射到树函数u））树）（t（funcall函数树）））
@davypough不幸的是，
last
也不能处理不正确的列表。对于正确的
虚线列表p
，在决定如何处理它之前，我仍然会犹豫使用它来测试整个列表。但是如果这是您想要实现的语义，您没有太多选择。在上面，我在中添加了一个变体哪些不正确的列表像正确的列表一样处理，即作为序列。精致，除了（映射到树#'1+（列表1 2 3））->（1 2 3）
(map-into #'print '(1 2))

(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)))