Lisp:两个列表的有序联合

Lisp: ordered union of two lists

我正在尝试创建一个 return 以有序方式合并两个列表的函数。 这是我的代码:

(defun setunion (lst1 lst2)
  (cond
    ((null lst1) lst2)
    ((null lst2) lst1)
    ((member (car lst2) lst1)
     (setunion lst1 (cdr lst2)))
    (t (append (setunion lst1 (cdr lst2))
               (list (car lst2))))))


(print (setunion '(a b c) '(a c d e f a)))

This returns (A B C F E D) 但我要查找的输出是 (A B C D E F)。如何将我的代码更改为 return 正确的输出?

谢谢!


编辑:我想我明白了。我制作了一个辅助函数,用于删除列表 2 的重复项并将其反转以及删除列表 1 的重复项。

(defun help (lst1 lst2)
(setunion (remove-duplicates lst1 :from-end t) (reverse(remove-duplicates lst2 :from-end t))))
(print (help  '(b c b d) '(a d e a)))

这给了我正在寻找的输出 (B C D A E)。

好的,所以基本上您要做的就是删除所有列表中的重复项,并且元素应按首次出现的顺序排列。您可以附加所有列表,然后从末尾删除重复项:

(defun set-union (&rest lists)
  (remove-duplicates (reduce #'append lists)
                     :from-end t))

如果您想要的是一堆列表的并集,以便列表中的元素按照它们在列表中出现的顺序出现,从左边开始,那么这是一种相当自然的方法。我不确定这是否是我在现实生活中会写的。它的优点是:

  • 很容易看出发生了什么;
  • 它不依赖复杂的标准 CL 函数。

它的缺点需要tail-call消除才能处理长列表(有些人认为像这样工作的代码不是惯用的 CL)。

(defun union-preserving-order (&rest ls)
  ;; Union of a bunch of lists.  The result will not contain
  ;; duplicates (under EQL) and elements will occur in the order they
  ;; occur in the lists, working from the left to the right.  So
  ;; (union-preserving-order '(a b) '(b a c)) will be (a b c), as will
  ;; (union-preserving-order '(a b) '(c b a)), while
  ;; (union-preserving-order '(b a) '(a b c) '(c d)) will be (b a c
  ;; d).
  (upo/loop (first ls) (rest ls) '()))

(defun upo/loop (lt more accum)
  ;; LT is the list we're working on, MORE is more lists for later,
  ;; ACCUM is the list we're building (backwards). In real life this
  ;; would be a local function in UNION-PRESERVING-ORDER.
  (if (null lt)
      ;; Finished this list
      (if (null more)
          ;; no more lists: we're done
          (nreverse accum)
        ;; more lists, so pick the first of them and loop on that
        (upo/loop (first more) (rest more) accum))
    ;; not finished this list, so loop on it
    (upo/loop (rest lt) more
              ;; Either the next element of this list is already in
              ;; the accumulator, or it's not and we need to add it.
              (if (member (first lt) accum)
                  accum           
                (cons (first lt) accum)))))

这是一个使用显式迭代但在其他方面执行相同技巧的版本。

(defun union-preserving-order (&rest ls)
  ;; Union of a bunch of lists.  The result will not contain
  ;; duplicates (under EQL) and elements will occur in the order they
  ;; occur in the lists, working from the left to the right.  So
  ;; (union-preserving-order '(a b) '(b a c)) will be (a b c), as will
  ;; (union-preserving-order '(a b) '(c b a)), while
  ;; (union-preserving-order '(b a) '(a b c) '(c d)) will be (b a c
  ;; d).
  (let ((accum '()))
    (dolist (l ls (nreverse accum))
      (dolist (e l)
        (pushnew e accum)))))

最后,这里有一个肮脏的技巧,可以向前构建结果。在没有证据的情况下,我认为就性能而言,这与您可以做的一样好,而无需诉诸 hash-table 等一些聪明的查找结构来检查您是否已经看到元素。

(defun union-preserving-order (&rest ls)
  ;; Union of a bunch of lists.  The result will not contain
  ;; duplicates (under EQL) and elements will occur in the order they
  ;; occur in the lists, working from the left to the right.  So
  ;; (union-preserving-order '(a b) '(b a c)) will be (a b c), as will
  ;; (union-preserving-order '(a b) '(c b a)), while
  ;; (union-preserving-order '(b a) '(a b c) '(c d)) will be (b a c
  ;; d).
  (let ((results '())                   ;results we'll return
        (rlc nil))                      ;last cons of results
    (dolist (l ls results)
      (dolist (e l)
        (unless (member e results)
          (if (not (null rlc))
              (setf (cdr rlc) (list e)
                    rlc (cdr rlc))
            (setf rlc (list e)
                  results rlc)))))))