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

Question

如何将平面列表转换为任意复杂的树状结构？首先，一个简单的例子，将'(1 2 3 4)转换成'(1 (2 (3 (4))))。我知道如何使用经典递归：

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

现在，如果嵌套结构任意复杂怎么办？例如，我想将'(1 2 3 4 5 6 7 8) 转换为'(1 (2 3) (4 (5 6) 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 或其他一些高级函数吗？

Answer 1

如果您使用 reduce，将 (1 2 3 4) 转换为 (1 (2 (3 (4)))) 实际上并不像您希望的那么简单。如果要先处理 4，则需要指定 :from-end t，如果没有 :initial-value，则使用 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))))

在我看来，涉及 模板 的解决方案更有趣。定义一个 ma​​ptree 函数将函数映射到树上并返回带有函数结果的新树很容易：

(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 '1+ '(1 2 (3 (4 5)) (6 7)))
;=> (2 3 (4 (5 6)) (7 8))

鉴于 ma​​ptree 函数，使用提供元素列表中的元素的函数调用它并不难，直到该元素列表用尽。这提供了substitute-into的定义：

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

(substitute-into '(1 2 3 4 5) '(t (u (v)) (w x)))
;=> (1 (2 (3)) (4 5))

(substitute-into '(1 2 3 4 5) '(t u (v w x) y z))
;=> (1 2 (3 4 5) Y Z)

另见

上面的ma​​ptree实际上只是一个更通用的减少或折叠树函数的特例。查看Using reduce over a tree in Lisp 了解更多关于如何折叠树木的信息。在这种情况下，您可以使用我的 tree-reduce 函数从my answer 解决该问题：

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

Answer 2

我的尝试：

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