; issue this command before loading: (set! load-noisily? #t)

; graph search (transitive closure) in Scheme.

; Directed graphs can be represented by a list of pairs (edges):
; '( (a b) (b c) (c a) ) represents a three-vertex graph with edges from
; a to b, b to c, and c back to a.

; note that to extract the first vertex of the first edge, we can use
; (caar graph), and the second vertex of the first edge is (cadar graph)

; Our ultimate goal is to generate the transitive closure of a graph G: 
; G is transitive iff when (x y) and (y z) are both in G, then so is (x z).

; first, some utility functions:

; deletes all occurrences of x from list l:     (USED BELOW)
(define (delete x l)
  (cond ((null? l) l)
	((equal? x (car l)) (delete x (cdr l)))
	(#t (cons (car l) (delete x (cdr l))))))

; remove duplicates from a list:  (constructive)
(define (remdups l)
  (if (null? l) l (cons (car l) (remdups (delete (car l) (cdr l))))))

; unique cons - a version of cons that avoids adding duplicates:
(define (cons1 x l)       ; (USED BELOW)
  (if (member x l) l (cons x l)))  ; member is built-in

; determines if every element of A is also in B:
(define (sublist A B)
  (or (null? A)
      (and (member (car A) B)
	   (sublist (cdr A) B))))

; adds elements of A to B, avoiding duplicates:
; better if tail recursive, but we'll use the easier version:
(define (union A B)     ; (USED BELOW)
   (if (null? A) B (cons1 (car A) (union (cdr A) B))))

; list difference: elminate all elements of B from A:
(define (diff A B)      ; (USED BELOW)
  (if (null? B) A
     (diff (delete (car B) A) (cdr B))))

; extract all unique vertices from a graph  ; (USED BELOW)
(define (vertices graph)
  (if (null? graph) '()
     (cons1 (caar graph) (cons1 (cadar graph) (vertices (cdr graph))))))

; central to finding the transitive closure is a procedure, that,
; given a starting vertex, generates a spanning tree from that
; vertex.  That is, it returns the list of vertices that are
; reachable from a starting vertex, including itself.

;  The central recursive procedure maintains two lists: one for
;  the vertices generated so far, and one for the "search frontier":
;  We repeatedly expand the search frontier, add new nodes to the
;  interior nodes while avoiding duplicates.  The procedure terminates
;  when the search frontier is null - that is, when nodes in the
;  frontier are not connected to any more new nodes.

(define (spantree init g)
; note the following functions are local to spantree, and uses g 
; as a free variable:

; returns immediate neighbors of a node:
(define (expand1 vertex graph)
  (cond ((null? graph) graph)
	((equal? vertex (caar graph))
	      (cons1 (cadar graph) (expand1 vertex (cdr graph))))
	(#t (expand1 vertex (cdr graph)))))
    
; returns immediate neighbors of a list of nodes
(define (expand-front front)
  (if (null? front) front
    (union (expand1 (car front) g) (expand-front (cdr front)))))

(define (span interior frontier)
  (if (null? frontier) interior
    (let ((newfrontier (expand-front frontier))
	  (newinterior (union interior frontier)))
      (span newinterior (diff newfrontier newinterior)))))

; body of outer function spantree:
(span (list init) (list init))
)


(define graph0 '((a b) (b d) (d c) (a d) (d a)))
(spantree 'a graph0)
(spantree 'c (cons '(c e) graph0))


; once we can compute the spanning tree, the transitive (and reflexive)
; closure is a straightforward application:

(define (trclosure graph)

;  make edges given a node and its spanning tree
(define (make-edges node)
  (map (lambda (x) (list node x)) (spantree node graph)))

; body of trclosure: loop-like construct is really tail-recursion:
(let iter ((nodes (vertices graph)))
     (if (null? nodes) '() 
        (union (make-edges (car nodes)) (iter (cdr nodes))))))

; try it out:
(trclosure graph0)


; -- for added problems:

; two lists contain the same elements:
(define (eqlist A B) (and (sublist A B) (sublist B A)))

; determine if there's an element that appears in both lists:
(define (intersect A B)
  (cond ((null? A) #f)
        ((null? (cdr A)) (member (car A) B))
	(#t (or (member (car A) B) (intersect (cdr A) B)))))