Assume we have a finite set \(X\) and a collection of subsets \(\{U_i\|\ i=1,...,n\}\). I’d like to find the smallest number of subsets covering \(X\), i.e. find the smallest number \(m\) and the subsets \(U_{i_1},\ldots,U_{i_m}\) such that \(X = \bigcup_{j=1}^m U_{i_j}\).
This problem is known as the Set Cover Problem
I am going to use the simplest algorithm possible:
Algorithm Covering
Input: A set X and a collection U of subsets of X
Output: A sub-collection V of subsets in U covering X
Begin
Y <- X
W <- U
V <- empty set
While Y and W are not non-empty do
Find the largest covering set A of Y in W
Y <- Y \ A
W <- W \ {A}
V <- V union {A}
End
Return(V)
EndI am going to need a function that sorts the sets in the covering
according to how much each set U covers the set
X at hand.
(defun sort-cover (X U)
(sort
U
(lambda (a b)
(apply
#'>
(mapcar
(lambda (i) (length (intersection i X)))
(list a b))))))
SORT-COVERImplementation is going to be recursive.
(defun set-cover (Y W &optional V)
(if (or (null Y) (null W))
V
(let* ((A (car W))
(Z (set-difference Y A)))
(set-cover
Z
(sort-cover Z (cdr W))
(append V (list A))))))
SET-COVERIn order to test the implementation, I am going to need a function that generates a random covering:
(defun random-set (n m)
(remove-duplicates
(sort (loop repeat m collect (random n)) #'<)))
RANDOM-SET
(defun random-covering (n m k)
(remove-duplicates
(loop repeat m collect (random-set n (1+ (random k))))
:test #'equal))
RANDOM-COVERINGFinally, a test:
(defvar X (loop for i from 0 to 11 collect i))
X
(defvar cover (sort-cover X (random-covering 12 20 6)))
COVER
cover
((0 5 6 8 10 11) (1 5 6 9 10) (1 7 9 10 11) (3 4 5 10) (1 3 9 10) (2 8 9 11)
(2 8 9) (2 4 6) (2 7 9) (6 7 8) (4 9) (9 10) (3 7) (4 8) (10 11) (3 10) (7)
(0) (6) (9))
(set-cover X cover)
((0 5 6 8 10 11) (1 7 9 10 11) (3 4 5 10) (2 4 6))