Every once in while, I go back and refactor the code I wrote in my earlier posts if I see significant improvements. Today’s post is one of these. I am going to look at the set covering problem I wrote about in one of my earlier posts. I am going to re-implement the same algorithm.
Assume we have a finite set \(X=\{x_1, \ldots, x_n\}\) and a finite collection of subsets of \(X\), \(\mathcal{S}=\{S_1, \ldots , S_m\}\). Our task today is to find smallest subset \(\mathcal{T}\) of \(\mathcal{S}\) such that \(X=\bigcup \mathcal{T}\).
Here is our algorithm:
Algorithm Cover
Input: A set X, a collection S of subsets of X
Output: A smallest subset of S covering X
Begin
Let R <- X, V <- {}
While R is non-empty do
Find a subset Z in S that has a largest intersection with R
Remove the elements of Z from R
If R\Z is equal to R then
Raise an error
Else
Add Z to V
End
End
Return V
End(defun set-cover (rest subsets &optional (current nil))
(if (or (null rest) (null subsets))
current
(let* ((points (if current (reduce #'union current)))
(cover-now (remove-if-not (lambda (x) (set-difference x points)) subsets))
(xs (car (sort cover-now #'> :key (lambda (x) (length (set-difference x points))))))
(ys (set-difference rest xs)))
(if (not (equal ys rest))
(set-cover ys
cover-now
(cons xs current))))))
SET-COVERThere is still room for improvement: I am taking set differences
twice over the current cover passed to the function. One can create a
temporary local variable for these differences, and modify the code use
these calculated differences but the code wan’t any more readable. If I
were to use this in a production system with large sets and covers, I
would have to resort to that, but this is good enough for now. Also,
note that the function returns nil if the set of subsets
you passed doesn’t actually cover the underlying set. One should
probably raise an exception for that case. For that, one must modify the
inner-most if clause.
Let us test:
(let* ((n 18)
(xs (loop for i from 0 below n collect i))
(ys (remove-duplicates
(loop repeat (* n n) collect
(remove-duplicates
(sort (loop repeat (1+ (random (truncate (/ n 3)))) collect (random n)) #'<)))
:test #'equal)))
(list (cons :set xs)
(cons :subsets ys)
(cons :covering (set-cover xs (sort ys #'> :key #'length)))))
((SET 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17)
(SUBSETS (1 5 11 12 14) (7 8 10 16 17) (1 3 7 9 15) (1 2 8 13 16)
(2 6 7 8 9) (0 8 10 12 13) (1 9 11 13 17) (2 11 13 14 16) (9 12 13 16 17)
(2 3 9 12 16) (0 1 7 10 17) (2 3 12 15 17) (0 1 2 10 12) (2 7 14 15 17)
(3 4 5 8 9) (2 9 10 11 12) (6 9 10 14 15) (0 3 7 9 10) (4 7 10 14 16)
(1 2 3 6 16) (1 3 7 12 15) (1 2 12 15 16) (1 4 8 11 13) (2 3 5 9 16)
(1 3 5 7 11) (0 3 7 13 14) (0 2 5 11 14) (5 7 9 11 15) (2 3 6 12 15)
(2 8 9 11 15) (2 4 13 15 16) (1 3 7 9 12) (1 5 6 12 15) (1 2 4 5 14)
(0 6 11 12 13) (1 4 13 14 15) (7 11 15 16 17) (0 7 8 12 15) (0 4 10 13 17)
(1 2 7 12 17) (0 6 7 9 12) (0 1 8 9 12) (0 1 6 7 9) (2 4 6 9 11)
(2 3 13 15 17) (0 8 13 15 16) (9 12 13 14 15) (0 5 9 10 11) (0 1 11 12 14)
(1 3 7 16 17) (5 6 10 11 16) (0 1 4 12 14) (1 5 6 9 15) (0 5 10 11 12)
(2 3 4 15 17) (4 5 6 16 17) (3 5 9 10 11) (4 5 7 16) (1 10 13 17)
(2 7 11 14) (9 11 12 14) (1 3 8 16) (2 4 10 13) (2 8 10 15) (1 2 3 16)
(2 8 13 15) (4 8 16 17) (0 1 7 11) (8 13 14 16) (4 9 14 16) (0 2 3 4)
(4 9 16 17) (0 1 7 12) (0 1 2 11) (0 4 5 13) (2 7 8 15) (2 4 6 14)
(0 8 11 15) (0 2 4 8) (0 1 4 14) (3 8 9 14) (3 11 14 15) (8 9 14 17)
(0 4 12 17) (2 5 6 13) (1 8 9 15) (7 9 15 16) (1 3 4 8) (6 10 11 16)
(0 3 12 14) (4 7 13 14) (6 10 11 15) (1 3 4 11) (2 6 7 16) (0 6 9 13)
(1 2 5 6) (0 13 14 15) (1 8 10 16) (3 10 13 15) (3 7 12 13) (6 11 13 17)
(0 3 12 16) (9 10 11 12) (0 10 12 16) (1 7 12 15) (0 1 12 17) (4 5 6 11)
(7 12 15 17) (3 12 16 17) (0 2 10 17) (5 13 14 16) (2 7 9 15) (1 14 16 17)
(1 4 6 7) (4 6 8 9) (0 1 4 15) (1 6 9 16) (4 5 6 17) (2 6 9 10)
(7 10 14 16) (0 5 9 11) (6 7 11 17) (1 5 6 7) (0 1 12 14) (1 9 12 16)
(0 3 14 15) (4 5 6 10) (2 6 8 14) (2 11 13 14) (6 12 16 17) (1 7 9 15)
(7 9 14) (2 6 13) (1 8 14) (7 12 16) (4 10 15) (1 3 7) (5 7 10) (1 6 11)
(1 13 17) (3 7 11) (6 16 17) (3 4 12) (5 15 16) (12 13 17) (5 7 15)
(0 13 16) (7 10 13) (8 11 17) (3 8 17) (5 7 16) (8 11 14) (10 14 15)
(5 10 14) (4 11 14) (0 16 17) (2 8 10) (6 9 16) (1 4 5) (6 8 17) (5 16 17)
(1 10 15) (1 2 11) (3 6 16) (1 6 9) (5 10 15) (3 5 12) (0 13 14) (4 12 15)
(0 4 16) (1 3 14) (3 8 13) (0 2 12) (6 8 14) (1 2 6) (7 14 17) (3 5 13)
(5 11 14) (4 5 13) (2 10 11) (7 8 14) (2 9 10) (1 2 12) (0 13 17) (0 11 14)
(3 11 16) (1 3 12) (0 1 8) (4 7 17) (4 6 17) (7 12 15) (0 2 8) (3 7 16)
(9 13 15) (4 9) (1 9) (10 14) (3 7) (2 4) (4 8) (14 15) (0 9) (1 17) (1 6)
(5 10) (3 6) (15 16) (2 12) (7 14) (6 11) (0 6) (1 13) (8 17) (0 8) (2 8)
(9 14) (0 11) (13 15) (3 12) (8 15) (2 9) (4 11) (2 14) (0 12) (10 12)
(1 12) (4 5) (0 16) (4 15) (8 12) (5 15) (9 12) (2 17) (0 14) (0 13) (2 13)
(3 9) (4 17) (5 7) (2 5) (1 5) (3) (5) (1) (11) (4) (6) (13) (8) (15) (14)
(10) (17) (2) (7) (16) (12) (9) (0))
(COVERING (1 2 3 6 16) (1 3 4 5 7 10) (4 6 9 13 14 17) (0 5 8 11 12 15)))