Lisp 如何将平面列表转换为嵌套的树状结构？

如何将平面列表转换为任意复杂的树状结构？首先，一个简单的例子，将

'（1234）

转换为

'（1（2（3（4））

。我知道如何使用经典递归：

(defun nestify (xs)
  (if (null xs)
      (list)
    (list (car xs) (nestify (cdr xs)))))

现在，如果嵌套结构任意复杂怎么办？例如，我想将

'（12345678）

转换为

'（1（23）（4（56）7）8）

。如何编写能够在任何此类嵌套结构中转换平面列表的通用函数？我可以考虑给出一个带有伪值的模板。例如：

* (nestify '(1 2 3 4 5 6 7 8) '(t (t t) (t (t t) t) t))
'(1 (2 3) (4 (5 6) 7) 8)

我第一次尝试使用递归和自定义树大小查找函数：

(defun length* (tr)
  "Count number of elements in a tree."
  (cond ((null tr) 0)
        ((atom tr) 1)
        (t (+ (length* (car tr))
              (length* (cdr tr))))))

(defun tree-substitute (xs tpl)
  "(tree-substitute '(1 2 3) '(t (t) t)) -> '(1 (2) 3)"
  (cond ((null tpl) nil)
        ((atom (car tpl))
         (cons (car xs) (tree (cdr xs) (cdr tpl))))
        (t (cons (tree xs (car tpl))
              (tree (nthcdr (length* (car tpl)) xs) (cdr tpl))))))

有没有更好的方法，以更优雅和简洁的方式？例如，将列表转换为树的函数可能不使用模板，尽管我想不出该方法。我可以抽象出递归和其他细节，并拥有一个整洁的

reduce

或其他高级函数吗？

如果使用reduce，将（1234）转换为（1（2（3（4）））实际上并不像您希望的那么简单。如果要先处理4，则需要指定：从t端开始，如果未指定，则使用3和4调用缩减函数：指定初始值，如果未指定，则使用4和初始值调用缩减函数。这意味着您可以使用类似的方法，其中函数检查特殊的初始情况：

(reduce (lambda (x y)
          (if y
            (list x y)
            (list x)))
        '(1 2 3 4)
        :from-end t
        :initial-value nil)
;=> (1 (2 (3 (4))))

在我看来，包含模板的解决方案更有趣。定义一个maptree函数非常简单，该函数将函数映射到树上，并返回一个包含函数结果的新树：

(defun maptree (function tree)
  "Return a tree with the same structure as TREE, but
whose elements are the result of calling FUNCTION with
the element from TREE.  Because TREE is treated as an 
arbitrarily nested structure, any occurrence of NIL is 
treated as an empty tree."
  (cond 
    ((null tree) tree)
    ((atom tree) (funcall function tree))
    ((cons (maptree function (car tree))
           (maptree function (cdr tree))))))

给定maptree函数，在元素列表用尽之前，使用从元素列表中提供元素的函数调用它并不困难。这提供了替换为的定义：

(defun substitute-into (items tree)
  "Return a tree like TREE, but in which the elements
of TREE are replaced with elements drawn from ITEMS.  
If there are more elements in TREE than there are in 
ITEMS, the original elements of TREE remain in the result,
but a new tree structure is still constructed."
  (maptree #'(lambda (x)
               (if (endp items) x
                   (pop items)))
           tree))

另见 上面的映射树实际上只是更一般的树的reduce或fold函数的特例。查看更多有关如何折叠树木的信息。在这种情况下，您可以使用mytree reduce函数从到该问题：

(defun tree-reduce (node-fn leaf-fn tree)
  (if (consp tree)
      (funcall node-fn 
               (tree-reduce node-fn leaf-fn (car tree))
               (tree-reduce node-fn leaf-fn (cdr tree)))
      (funcall leaf-fn 
               tree)))

并根据它定义maptree：

(defun maptree (function tree)
  (tree-reduce 'cons function tree))

我的尝试：

(defun mimicry (source pattern)
  (labels ((rec (pattern)
             (mapcar (lambda (x)
                       (if (atom x)
                           (pop source)
                           (rec x)))
               pattern)))
    (rec pattern)))

测试：

---

+1好的，简单的。警告：因为您使用的是mapcar，所以这只适用于嵌套的正确列表，并且顶级树必须是列表。例如，您不能使用atom

x

作为顶层模式，即使它是一个平凡的树，也不能使用类似

（12.3）

，即使它是一个cons树。

(defun maptree (function tree)
  (tree-reduce 'cons function tree))

(defun mimicry (source pattern)
  (labels ((rec (pattern)
             (mapcar (lambda (x)
                       (if (atom x)
                           (pop source)
                           (rec x)))
               pattern)))
    (rec pattern)))

CL-USER> (mimicry '(1 2 3 4 5) '(t (u (v)) (w x)))
(1 (2 (3)) (4 5))