list - 如何使用 Lisp 编写套套代码？ (包括算法)

Question

我在使用 Common Lisp 编写一组封面问题代码时遇到了问题。

(setcover N S)，N是一个非负整数，S是数字U = (1 2 ...N)。集合覆盖问题要求在 S 中找到(少量)子集，使得它们的并集覆盖 U。这意味着 U 中的每个数字都包含在解决方案的至少一个子集中。并且最终的解决方案必须是贪心的

例如:

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

输出:

((1 2 3) (4 5))

我试着写了这段代码，我确实为它写了算法。(轮表示递归)

第一轮: 使用数字函数创建列表 (1 ,2 ....U) 然后使用 common 函数比较 S 的子列表和列表 U 并检查有多少数字是共同的。然后对该子列表进行构造(在这个例子中，它是 (1 2 3))，最后从列表 U 中删除 (1 2 3)。

第二轮: 再次检查，列表U中只剩下(4 5)，所以将使用子列表(4 5)。

第三轮: 什么都没有，所以将形成一个新列表((1 2 3)(4 5))

我的问题是如何从每一轮的公共(public)函数中找到最大的数字？如何从列表 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)))))

希望有人能帮助我。谢谢!

2019/01/24(更多问题描述)

写一个 Lisp 函数:

(设置 N S)这个函数应该实现集合覆盖问题的贪心算法。这个问题和算法描述如下。维基百科关于片场封面的文章也解释了这个问题(比我们需要的更详细)。

在(setcover N S)中，N是一个非负整数，S是数U = (1 2 ... N)的一组子集。集合覆盖问题要求在 S 中找到(少量)子集，使得它们的并集覆盖 U。这意味着 U 中的每个数字都包含在解决方案的至少一个子集中。

例子:

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

解决方案:

((1 2 3) (4 5))

解释:N = 5，所以 U = (1 2 3 4 5)。 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-hard，因此没有有效的算法是已知的.

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

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

假设我们还有 (1 2 ... 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))

Answer 1

这是一个可能的贪婪解决方案，假设所有集合都已排序并且不使用 Common Lisp 的原始函数，如 set-difference，并且仅使用递归(而不是迭代或高-订单功能)。

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

请注意，remove 是 Common Lisp 的预定义函数(参见 manual)。不难给出它的递归定义。