examples/set--greedy-set-cover.scm
;;; greedy-set-cover.scm  --  Jens Axel Søgaard

(require (planet "set.scm" ("soegaard" "galore.plt")))

; An instance (X,F) of the "set-covering problem" consists
; of a finite set X and a family F of subsets of X covering X,
; that is, every element of X belongs to at least one subset in F.

; Example:

(define X (insert* '(a b c
d e f
g h i
j k l)
(empty)))

(define S1 (insert* '(a b c d e f)  (empty)))
(define S2 (insert* '(e f h i)      (empty)))
(define S3 (insert* '(a d g j)      (empty)))
(define S4 (insert* '(b e h k j)    (empty)))
(define S5 (insert* '(c f i l)      (empty)))
(define S6 (insert* '(j k)          (empty)))

(define F  (list S1 S2 S3 S4 S5 S6))

; A minimum set cover is C={S3,S4,S5}.

; Let's try a greedy approach:

; greedy-set-cover : (set alpha) (list (set alpha))  ->  (list (set alpha))
;   given a set X and a list F of subsets of X covering X,
;   returns an approximation of the minimal set covering.
;   The covering is returned as a list of subsets from F.
(define (greedy-set-cover X F)
(let loop ([U X]     ; elements not covered by the subsets in C
[C '()])  ; list of subset in the covering chosen so far
(if (empty? U)
C
(let ([S (select-S-in-F-such-that-S-intersect-U-maximal F U)])
(loop (difference U S)
(cons S C))))))

(define (select-S-in-F-such-that-S-intersect-U-maximal F U)
(foldl (lambda (S S-best)
(if (> (size (intersection S U))
(size (intersection S-best U)))
S
S-best))
(car F)
(cdr F)))

; Let's try it on the exmaple:

(map elements
(greedy-set-cover X F))

; => ((a d g j) (c f i l) (b e h j k) (a b c d e f))

; The greedy approach produces C={S1,S4,S5,S3} and
; thus doesn't find the minimal covering.