(define (reversed-edge? ed)
	(find-attribute 'reversed ed))

(define (get-flow ed)
	 (find-double-attribute 'flow ed))

(define (get-cap ed) 
	 (find-double-attribute 'capacity ed))

(define (get-res-cap ed)
	 (- (get-cap ed) (get-flow ed)))

(define (label-network-edge ed)
	 (let* ( (flow-str (number->string (get-flow ed)))
	         (cap-str (number->string (get-cap ed)))
		 (lbl (string-append flow-str "/" cap-str)))
	       (set! (edge-label (edge-item ed)) lbl))
)

(define (label-resid-edge ed lbl)
         (set! (edge-label (edge-item ed)) (number->string lbl))
)

(define (flow-to-push? v1 v2)
	 (let* ((e (is-edge v1 v2)))
		(cond (e (list (get-flow e) (reversed-edge? e)))
		      (#t (list 0 0))))
)





(define (initialize-network g)
	 (new-double-attribute! 'capacity 0 g)
	 (new-double-attribute! 'flow 0 g)
	 (new-attribute! 'reversed 0 g)
	 (map (lambda (x) 
		 (update-edge-capacity x (random-double))
	      )
	      (mset-edge->list (edges g)))
	 (set-source-and-sink g)
) 

(define (set-source-and-sink g) 
	 (define source (car (set-vertex->list (vertices g))))
	 (set! (vertex-label (vertex-item source)) "source")
	 (define sink (car (reverse (set-vertex->list (vertices g)))))
	 (set! (vertex-label (vertex-item sink)) "sink"))

(define (update-edge-capacity ed cap-amt)
	(cond ( (>= cap-amt (get-flow ed))
		(set-double-attribute! 'capacity cap-amt ed)
		(label-network-edge ed))
	      (#t "Capacity would be smaller than flow!"))
)

(define (update-edge-flow ed flow-amt)
         (cond ( (<= flow-amt (get-cap ed))
                 (set-double-attribute! 'flow flow-amt ed)
		 (label-network-edge ed))
	       (#t "Flow cannot exceed capacity!"))
)

(define (change-res-ed-flow re flow-amt)
	(cond ( (<= flow-amt (get-cap re))
		(set-double-attribute! 'flow flow-amt ed)
		(label-resid-edge ed))
	      (#t "Flow cannot exceed capacity!"))
)


(define (make-residual-edges rnv)
	 (map (lambda (x) 
	      (let* ( (lvs (sequence-vertex->list (vertices (edge x)))) )
		    (cond ( (> (get-flow (edge x)) 0.0)
		            (let* ((n-ed (add-edge-item! 
				(vertex-item (cadr lvs)) 
				(vertex-item (car lvs)) rnv)))
			    (label-resid-edge (edge n-ed) 
					(get-flow (edge x)))
			    (label-resid-edge (edge x) 
					(get-res-cap (edge x)))
			    (set-attribute! 'reversed 1 (edge n-ed))
			    (set! (color x) "green")
			    (set! (color n-ed) "cyan") )
			  )
		          (#t  #f))
    	      	    (cond ( (equal? (get-flow (edge x)) (get-cap (edge x)))
                            (remove-edge-item! x rnv)) 
			  (#t #f))
		    (cond ( (equal? (get-flow (edge x)) 0.0)
	                    (label-resid-edge (edge x) (get-res-cap (edge x)))
		   	    (set! (color x) "green"))
			  (#t #f)) ))
      		(edges rnv)))

(define (residual-network gv)
	(display "residual-network") (newline)
 	 (let* ( (g (graph gv))
		 (res-net (copy-graph g 1))
		 (res-net-view (show-labeled-graph res-net 'custom)))
		(set! (title res-net-view) "Residual Network")
	        (make-residual-edges res-net-view)
	 )
)

(define (network-setup)
	 (define gv (current-graph-view))
	 (define g (graph gv))
         (initialize-network g)
	 (update-edge-flow (edge-ref g 0) .0001)
)


(define (distance x1 y1 x2 y2)
	(let* ( (x-group (- x1 x2))
		(y-group (- y1 y2)))
	  (sqrt (+ (* x-group x-group) (* y-group y-group))))	
)







