List 如何使用Lisp编写集合封面代码？（包括算法）

我在使用CommonLisp编写集合封面问题代码时遇到了问题

（setcover ns）

，

N

是一个非负整数，

S

是一组数字U=（12…N）的子集。集合覆盖问题要求在S中找到（少量）子集，使其并集覆盖U。这意味着U中的每个数字都包含在解决方案中的至少一个子集中。最终的解决方案必须是贪婪

例：

输出：

((1 2 3) (4 5))

我试着写这段代码，我确实为它写了算法。 （round表示递归）

第一轮： 使用数字功能创建列表（1，2…U） 然后使用公共函数比较S和列表U的子列表，并检查有多少个数字是公共的。然后使用该子列表进行构造（在这个例子中，它是（1233）），最后从列表U中删除（1233）

第二轮： 再次检查，列表U中只剩下（45），因此将使用子列表（45）

第三轮： 没有留下任何东西，因此将形成一个新的列表（（1 2 3）（4 5））

我的问题是如何在每一轮中从公共函数中找到最大数？如何从列表U中删除这些匹配的数字（因为必须先创建它）？以及如何在末尾创建一个新列表

;create a list U
(defun numbers (N)  
  (if (<= N 0)
      nil
    (append (numbers (- N 1)) (list n))))

;check if this atom exist in the list
(defun check (Atom List)
  (cond
   ((null List) nil)
   ((equal Atom (car List)))
   (t (check Atom (cdr List)))))

;numbers of common numbers that both two lists have
(defun common (L1 L2)
  (cond 
   ((null L1) 0)
   ((check (car L1) L2) (+ 1 (common (cdr L1) L2)))
   (t (common (cdr L1) L2))))

;final setcover function but I have no idea what to do next...
(defun setcover (N S)
  (cond 
   ((if (null S) nil))
   ((listp (car S)) 
    (common (car S) (numbers N)) 
    (setcover N (cdr S)))))

解决方案：

((1 2 3) (4 5))

解释：N=5，所以U=（12345）。S由（1,2,3,4,5）的一些子集组成。我们正在寻找这些子集中的一小部分，它们共同涵盖所有五个数字

最佳解决方案仅使用两个子集（1、2、3）和（4、5）。另一个有三个子集的解决方案是（（1 2 3）（2 4）（2 5））。另一个解决方案是（（1 2 3）（2 4）（3 4）（2 5））。然而，在这个解决方案中，您可以删除（2 4）或（3 4），得到一个更小的解决方案，它仍然覆盖了所有的U

最优地解决集合覆盖问题意味着找到覆盖U的S的最小子集数（集合数，而不是集合大小）。不幸的是，这个问题是NP难问题，因此没有有效的算法

您的程序应该计算并返回贪婪的解决方案，而不是最优的解决方案，贪婪的解决方案是一个覆盖U的小子集集，由下面所谓的贪婪算法计算。wikipedia页面上也描述了该算法

基本思路是分几轮解决问题。在每一轮中，我们从S中再选择一个子集，直到得到完整的覆盖。我们选择一个子集，其中包含尽可能多的仍然缺失的数字

假设我们还有（12…N）中的一些数字要覆盖。我们考虑S中的每个子集SI，并计算这些数字中有多少将被SI覆盖。然后，我们贪婪地选择一个子集，它覆盖了大部分

详细示例

S = ((1 2 3) (2 4) (3 4) (2 5) (4 5))
Subsets in S: S1 = (1 2 3), S2 = (2 4), S3 = (3 4), S4 = (2 5), S5 = (4 5)
N = 5
U = (1 2 3 4 5)

Start of algorithm:
Solution so far = ()
Still to cover = (1 2 3 4 5)

Round 1:
Covered by S1: 3 numbers (1 2 3)
Covered by S2: 2 numbers (2 4)
Covered by S3: 2 numbers 
Covered by S4: 2
Covered by S5: 2
Best subset: S1, covers 3 numbers (1 2 3)
Solution so far = (S1)
Still to cover = (4 5)

Round 2:
Covered by S2: 1 number (4)
Covered by S3: 1 number (4)
Covered by S4: 1 number (5)
Covered by S5: 2 numbers (4 5)
Best: S5, covers (4 5)
Solution so far = (S1 S5)
Still to cover = ()

Round 3:
Nothing left to cover, so stop.
Return solution (S1 S5) = ((1 2 3) (4 5))

更多示例：

(setcover 2 '((1) (2) (1 2)))
((1 2))

(let
    ((S '((1 2 3 4 5))))
    (setcover 5 S)
)
((1 2 3 4 5))

---

这里是一个可能的贪婪解决方案，假设所有集合都已排序，并且不使用Common Lisp的原始函数，如

set difference

，并且只使用递归（而不是迭代或高阶函数）

下面是一个具有基本函数和迭代的替代解决方案：

(defun cover (n s)
  (let ((u (loop for i from 1 to n collect i)))
    (loop for x in s
      for w = (intersection u x)
      when w
        do (setf u (set-difference u x))
        and collect x
      end
      while u)))

添加

在使用算法规范更新post之后，这里有一个可能的解决方案（不使用递归）：

下面是一个递归解决方案：

(defun most-elements (s1 s2 m)
  "find the set with the higher number of elements in common 
 with s1 between m and all the elements of s2"
  (if (null s2)
      m
      (let ((l1 (length (my-difference s1 m)))
            (l2 (length (my-difference s1 (car s2)))))
        (if (< l1 l2)
            (most-elements s1 (cdr s2) m)
            (most-elements s1 (cdr s2) (car s2))))))     

(defun greedy-cover-set (s1 s2)
  "find the greedy cover set of s1 by using the sets elements of s2"
  (cond ((null s1) nil)
        ((null s2) (error "no cover possible"))
        (t (let ((candidate (most-elements s1 s2 nil)))
            (cons
              candidate
              (greedy-cover-set (my-difference s1 candidate)
                                (remove candidate s2)))))))

(defun setcover (n s)
  (greedy-cover-set (numbers n) s))

（排除大多数元件（s1 s2 m）
“查找具有更多公共元素的集合
s1在m和s2的所有元素之间”
（如果（空s2）
M
（让（（l1（长度（我的差值s1 m）））
（l2（长度（我的差异s1（汽车s2()))））
（如果（

---

请注意，

remove

是Common Lisp的预定义函数（请参阅）。给出它的递归定义并不困难。

我知道我的问题有点奇怪，但我对Lisp完全陌生。我对这段代码仍然不熟悉…您没有对

common

的返回值做任何操作。您也没有将每个递归的结果与上一级结合起来生成完整的结果。您所说的最终解决方案贪婪是什么意思？我希望贪婪算法能为您的示例提供解决方案（通过选择每个包含至少一个新数字的子列表）。Common Lisp具有内置函数

SET-DIFFERENCE

和

SET-INTERSECTION

。这些可能对你有用。例如，

（公共s1s2）

只是

（长度（集合交点s1s2））

。对不起，如果我把（let（（S'（（12345）））（setcover 5s））放进去，输出是（（1234）（25）），但我真正想要的是（（1234）（45）），我应该如何更改代码，以便它能为我找到最小的子集？非常感谢。你要求一个贪婪的解决方案。一般来说，贪婪意味着：“一旦找到任何解决方案，就停止搜索”。如果你需要一个非常简单的解决方案，那么这个程序必须更加复杂。你需要最小可能的解决方案吗？还是“中间”解决方案？你有问题的描述吗？稍后我将尝试发布不同的解决方案。我更新了此问题描述，但不确定此问题为什么使用“贪婪”来描述期望的结果。它应该告诉我们，我们需要找到最小子集…@codevansa，好的，我已经阅读了规范，并将实现该算法。你知道吗

(defun my-difference (s1 s2)
  "Compute the difference between set s1 and set s2"
  (cond ((null s1) nil)
        ((check (car s1) s2) (my-difference (cdr s1) s2))
        (t (cons (car s1) (my-difference (cdr s1) s2)))))

(defun cover-sets (s1 s2)
  "Compute the greedy cover of set s1 by elements of list of sets s2"
  (cond ((null s1) nil)
        ((null s2) (error "no cover possible"))
        (t (let ((diff (my-difference s1 (car s2))))
             (if (equal diff s1)
                 (cover-sets s1 (cdr s2))
                 (cons (car s2) (cover-sets diff (cdr s2))))))))

(defun setcover (n s)
  "Solve the problem"
  (cover-sets (numbers n) s))

(defun cover (n s)
  (let ((u (loop for i from 1 to n collect i)))
    (loop for x in s
      for w = (intersection u x)
      when w
        do (setf u (set-difference u x))
        and collect x
      end
      while u)))

(defun count-common-elements (s1 s2)
  "return the number of common elements with s1 of each set of s2"
  (mapcar (lambda (x) (length (intersection s1 x))) s2))

(defun index-of-maximum (l)
  "return the index of the maximum element in list l"
  (position (reduce #'max l) l))

(defun setcover (n s)
  (let ((working-set (numbers n))
        (solution nil))
    (loop while working-set
          for i = (index-of-maximum (count-common-elements working-set s))
          for set = (elt s i)
          do (setf working-set (set-difference working-set set)
                   s (remove set s))
          do (push set solution))
   (reverse solution)))

(defun most-elements (s1 s2 m)
  "find the set with the higher number of elements in common 
 with s1 between m and all the elements of s2"
  (if (null s2)
      m
      (let ((l1 (length (my-difference s1 m)))
            (l2 (length (my-difference s1 (car s2)))))
        (if (< l1 l2)
            (most-elements s1 (cdr s2) m)
            (most-elements s1 (cdr s2) (car s2))))))     

(defun greedy-cover-set (s1 s2)
  "find the greedy cover set of s1 by using the sets elements of s2"
  (cond ((null s1) nil)
        ((null s2) (error "no cover possible"))
        (t (let ((candidate (most-elements s1 s2 nil)))
            (cons
              candidate
              (greedy-cover-set (my-difference s1 candidate)
                                (remove candidate s2)))))))

(defun setcover (n s)
  (greedy-cover-set (numbers n) s))