(define sg (load-graph "scratch/sup_layout.g"))
(define h  (load-graph "scratch/hyp.g"))
;(define sh (supermarket-hypergraph sg))

(define sg2 (copy-graph sg 1))
(for-each (lambda(x) 
		(if (equal? (vertex-degree x) 0) (remove-vertex! x sg2)))
	  (set-vertex->list (vertices sg2)))

(define sh2 (copy-graph sh 1))
(for-each (lambda(x) 
		(if (equal? (vertex-degree x) 0) (remove-vertex! x sh2)))
	  (set-vertex->list (vertices sh2)))

(define verts (set-vertex))
(define bev-test (string->regexp "Beverage"))
(define snack-test (string->regexp "Snack"))
(define (has-snack vlist)
        (cond ((null? vlist) #f)
              (#t (or (snack-test (vertex-label (car vlist)))
                      (has-snack (cdr vlist))))))
(define (has-bev vlist)
        (cond ((null? vlist) #f)
               (#t (or (bev-test (vertex-label (car vlist)))
                       (has-bev (cdr vlist))))))
(map (lambda (e)              
               (if (and (has-bev   (set-vertex->list (vertices e)))
                        (has-snack (set-vertex->list (vertices e))))
                     (set! verts (+ verts (vertices e)))))
     (set-edge->list (edges h)))

(define sh (induced-subgraph h (set-vertex verts) 1))

(define sg2verts (set-vertex))        
(map (lambda (x) 
	(insert! (find-vertex-by-name (vertex-label x) sg2) sg2verts))
     (set-vertex->list verts))
	

(define sh (induced-subgraph h verts 1))
(define ssg2 (induced-subgraph sg2 sg2verts 1))

(define hv   (make <graph-view> :graph h :layout 'random))

(define shv   (make <graph-view> :graph sh :layout 'spring))
(define ssg2v (make <graph-view> :graph ssg2 :layout 'spring))

(define max-degree 0)
(map (lambda (x) (if (> (vertex-degree x) max-degree)
			(set! max-degree (vertex-degree x)))) 
     (set-vertex->list (vertices h)))

(define max-size 0)
(map (lambda (x) (if (> (size x) max-size)
			(set! max-size (size x)))) (set-edge->list (edges h)))


(define bd1 (make <rectangle> :width 3 :parent (slot-ref ssg2v 'graph-canvas) 
			:coords '(3 3 380 297)))

(define bd2 (make <rectangle> :width 3 :parent (slot-ref shv 'graph-canvas) 
			:coords '(3 3 380 297)))

(with-output-to-file "| cat>snacks_bevs_simple.ps" 
	(lambda () (display (postscript (slot-ref ssg2v 'graph-canvas)))))

(with-output-to-file "| cat>snacks_bevs_hyper.ps" 
	(lambda () (display (postscript (slot-ref shv 'graph-canvas)))))