;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;                              Graphs
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define graph
  (make-record-type "graph" '(n type C V E p x-vect y-vect mst tour cost
				best-tour best-cost)))

(define create-graph
  (record-constructor graph '(n type C V E p x-vect y-vect mst tour cost
				best-tour best-cost)))

(define (make-graph n)
  (let ((type 'unknown)
	(C 'unknown)
	(V '())
	(E '())
	(p 'unknown)
	(x-vect (make-vector (+ n 1)))
	(y-vect (make-vector (+ n 1)))
	(mst '()) (tour '()))
    (do ((i n (- i 1)))
	((= i 0))
      (set! V (cons i V))
      (vector-set! x-vect i (+ 10 (random 390)))
      (vector-set! y-vect i (+ 10 (random 390))))
    (create-graph n type C V E p x-vect y-vect mst tour *max* '() *max*)))

(define graph? (record-predicate graph))

(define n         (record-accessor graph 'n))
(define type      (record-accessor graph 'type))
(define C         (record-accessor graph 'C))
(define V         (record-accessor graph 'V))
(define E         (record-accessor graph 'E))
(define p         (record-accessor graph 'p))
(define x-vect    (record-accessor graph 'x-vect))
(define y-vect    (record-accessor graph 'y-vect))
(define mst       (record-accessor graph 'mst))
(define tour      (record-accessor graph 'tour))
(define cost      (record-accessor graph 'cost))
(define best-tour (record-accessor graph 'best-tour))
(define best-cost (record-accessor graph 'best-cost))

(define n!         (record-modifier graph 'n))
(define type!      (record-modifier graph 'type))
(define C!         (record-modifier graph 'C))
(define V!         (record-modifier graph 'V))
(define E!         (record-modifier graph 'E))
(define p!         (record-modifier graph 'p))
(define x-vect!    (record-modifier graph 'x-vect))
(define y-vect!    (record-modifier graph 'y-vect))
(define mst!       (record-modifier graph 'mst))
(define tour!      (record-modifier graph 'tour))
(define cost!      (record-modifier graph 'cost))
(define best-tour! (record-modifier graph 'best-tour))
(define best-cost! (record-modifier graph 'best-cost))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (sqr x) (* x x))

(define (euclidean-distance x1 y1 x2 y2)
  (2d (sqrt (+ (sqr (- x1 x2)) (sqr (- y1 y2))))))

(define (manhattan-distance x1 y1 x2 y2)
  (+ (abs (- x1 x2)) (abs (- y1 y2))))

(define (make-random-graph n p)
  (let ((G (make-graph n))
	(A (make-array (list (+ n 1) (+ n 1)) *max*))
	(d 0)
	(nc (round (* p n (- n 1) 0.5)))
	(edges 0) 
	(denom (round (* n (- n 1) 0.5))))
    (C! G A)
    (do ((i 1 (+ i 1)))
	((or (= nc edges) (= i n)))
      (do ((j (+ i 1) (+ j 1)))
	  ((or (= nc edges) (> j n)))
	(cond ((and (< (random 1.0) (/ (- nc edges) denom))
		    (not (adjacent? i j G))
		    (not (= i j)))
	       (set! edges (+ 1 edges))
	       (set! d (manhattan-distance (vector-ref (x-vect G) i)
					   (vector-ref (y-vect G) i)
					   (vector-ref (x-vect G) j)
					   (vector-ref (y-vect G) j)))
	       (array-set! A (list i j) d)
	       (array-set! A (list j i) d)
	       (E! G (cons (list i j) (E G)))
	       (E! G (cons (list j i) (E G)))))
	(set! denom (- denom 1))))
    (n! G n) (type! G 'graph) (C! G A) (p! G p)
    G))
;;;
;;; Produces an adjacency matrix for an undirected graph with n nodes, with 
;;; p1 the probability of an edge existing between any pair of vertices
;;; where (array-ref G (list i j)) is 1 if there is an edge (i j)
;;; 
;;; NOTE:
;;; 1. (make-random-graph n 1) is the n-clique and
;;; 2. (make-random-graph n 0) is the null graph
;;; 3. for all i (= *max* (array-ref G (list i i)))
;;;


(define (make-random-digraph n p)
  (let ((G (make-graph n))
	(A (make-array (list (+ n 1) (+ n 1)) *max*))
	(d 0)
	(nc (round (* p n (- n 1))))
	(edges 0) 
	(denom (* n (- n 1))))
    (C! G A)
    (do () ((= nc edges))
    (do ((i 1 (+ i 1)))
	((or (= nc edges) (= i n)))
      (do ((j 1 (+ j 1)))
	  ((or (= nc edges) (> j n)))
	(cond ((and (< (random 1.0) (/ (- nc edges) denom))
		    (not (adjacent? i j G))
		    (not (= i j)))
	       (set! edges (+ 1 edges))
	       (set! d (manhattan-distance (vector-ref (x-vect G) i)
					   (vector-ref (y-vect G) i)
					   (vector-ref (x-vect G) j)
					   (vector-ref (y-vect G) j)))
	       (array-set! A (list i j) d)
	       (E! G (cons (list i j) (E G)))))
	(set! denom (- denom 1)))))
    (n! G n) (type! G 'digraph) (C! G A) (p! G p)
    G))


(define (adjacent? i j G)
  (< (array-ref (C G) (list i j)) *max*))
;;; 
;;; Is vertex i adjacent to vertex j in G?
;;; Yes, if the cost of the edge from i to j is less than *max*
;;;


(define (adjacent-to i G)
  (let ((vertices '()))
    (do ((j 1 (+ j 1)))
	((> j (n G)) vertices)
      (cond ((adjacent? i j G)
	     (set! vertices (cons j vertices)))))))

(define (degree i G)
  (length (adjacent-to i G)))
  

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define draw-vertex
  (lambda (G)
    (lambda (v)
      (draw-box 2
		(vector-ref (x-vect G) v)
		(vector-ref (y-vect G) v)
		2))))

(define undraw-special-vertex
  (lambda (G)
    (lambda (v)
      (draw-circle (vector-ref (x-vect G) v)
		   (vector-ref (y-vect G) v)
		   6 0)
      ((draw-vertex G) v))))

(define draw-special-vertex
  (lambda (G)
    (lambda (v)
      (draw-circle (vector-ref (x-vect G) v)
		   (vector-ref (y-vect G) v)
		   6 3))))

(define draw-edge
  (lambda (G)
    (lambda (edge)
      (let* ((u (first edge))
	     (v (second edge))
	     (xu (vector-ref (x-vect G) u))
	     (yu (vector-ref (y-vect G) u))
	     (xv (vector-ref (x-vect G) v))
	     (yv (vector-ref (y-vect G) v)))
	(draw-line xu yu xv yv 6)))))

(define draw-special-edge
  (lambda (G)
    (lambda (edge)
      (let* ((u (first edge))
	     (v (second edge))
	     (xu (vector-ref (x-vect G) u))
	     (yu (vector-ref (y-vect G) u))
	     (xv (vector-ref (x-vect G) v))
	     (yv (vector-ref (y-vect G) v)))
	(do ((i 0 (+ i 1)))
	    ((= i 3))
	  (draw-line (+ i xu) yu (+ i xv) yv 8)
	  (draw-line xu (+ i yu) xv (+ i yv) 8))))))

(define undraw-special-edge
  (lambda (G)
    (lambda (edge)
      (let* ((u (first edge))
	     (v (second edge))
	     (xu (vector-ref (x-vect G) u))
	     (yu (vector-ref (y-vect G) u))
	     (xv (vector-ref (x-vect G) v))
	     (yv (vector-ref (y-vect G) v)))
	(do ((i 0 (+ i 1)))
	    ((= i 3))
	  (draw-line (+ i xu) yu (+ i xv) yv 0)
	  (draw-line xu (+ i yu) xv (+ i yv) 0)))
      ((draw-edge g) edge))))
	

(define undraw-edge
  (lambda (G)
    (lambda (edge)
      (let* ((u (first edge))
	     (v (second edge))
	     (xu (vector-ref (x-vect G) u))
	     (yu (vector-ref (y-vect G) u))
	     (xv (vector-ref (x-vect G) v))
	     (yv (vector-ref (y-vect G) v)))
	(draw-line xu yu xv yv 0)))))

(define draw-edge-manhattan
  (lambda (G)
    (lambda (edge)
      (let* ((u (first edge))
	     (v (second edge))
	     (xu (vector-ref (x-vect G) u))
	     (yu (vector-ref (y-vect G) u))
	     (xv (vector-ref (x-vect G) v))
	     (yv (vector-ref (y-vect G) v)))
	(draw-line xu yu xu yv 6)
	(draw-line xu yv xv yv 6)))))

(define undraw-edge-manhattan
  (lambda (G)
    (lambda (edge)
      (let* ((u (first edge))
	     (v (second edge))
	     (xu (vector-ref (x-vect G) u))
	     (yu (vector-ref (y-vect G) u))
	     (xv (vector-ref (x-vect G) v))
	     (yv (vector-ref (y-vect G) v)))
	(draw-line xu yu xu yv 0)
	(draw-line xu yv xv yv 0)))))


(define (draw-graph G)
  (graphics-mode!)
  (clear-graphics!)
  (for-each (draw-vertex G) (V G))
  (for-each (draw-edge G) (E G)))

(define (draw-mst G)
  (graphics-mode!)
  (clear-graphics!)
  (for-each (draw-vertex G) (V G))
  (for-each (draw-edge G) (mst G)))

(define (draw-tour G)
  (graphics-mode!)
  (clear-graphics!)
  (for-each (draw-vertex G) (V G))
  (let ((edges '()))
    (do ((cities (tour G) (cdr cities)))
	((or (null? cities) (null? (cdr cities))))
      (set! edges (cons (list (first cities) (second cities)) edges)))
    (for-each (draw-edge G) edges)))

(define (draw-tour-manhattan G)
  (graphics-mode!)
  (clear-graphics!)
  (for-each (draw-vertex G) (V G))
  (let ((edges '()))
    (do ((cities (tour G) (cdr cities)))
	((or (null? cities) (null? (cdr cities))))
      (set! edges (cons (list (first cities) (second cities)) edges)))
    (for-each (draw-edge-manhattan G) edges)))

(define (draw-best-tour G)
  (graphics-mode!)
  (clear-graphics!)
  (for-each (draw-vertex G) (V G))
  (let ((edges '()))
    (do ((cities (best-tour G) (cdr cities)))
	((or (null? cities) (null? (cdr cities))))
      (set! edges (cons (list (first cities) (second cities)) edges)))
    (for-each (draw-edge G) edges)))
  

(define (show-graph G)
  (newline)
  (display (format nil "~S ~S ~S" (n G) (type G) (p G))) (newline)
  (do ((i 1 (+ i 1)))
      ((> i (n G)))
    (let ((v (array-ref (C G) (list i))))
      (do ((j 1 (+ j 1)))
	  ((> j (n G)))
	(cond ((< (vector-ref v j) *max*)
	       (display (format nil "~S " (vector-ref v j))))
	      (t (display (format nil "~S " '-))))))
    (newline)))
;;;
;;; Display an adjacency/cost matrix G of n vertices
;;;

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
;                 Saving and Loading graphs
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(define (save-graph G fname)
  (let ((fout (open-output-file fname)))
    (display (format nil "~S ~S ~S"
		     (n G) (type G) (p G)) fout) (newline fout)
    (do ((i 1 (+ i 1)))
	((> i (n G)))
      (let ((v (array-ref (C G) (list i))))
	(do ((j 1 (+ j 1)))
	    ((> j (n G)))
	  (display (format nil "~S " (vector-ref v j)) fout)))
      (newline fout))
    (do ((i 1 (+ i 1)))
	((> i (n G)))
	(display (format nil "~S ~S"
			 (vector-ref (x-vect G) i)
			 (vector-ref (y-vect G) i)) fout) (newline fout))
    (display (length (mst G)) fout) (newline fout)
    (do ((edges (mst G) (cdr edges)))
	((null? edges))
      (let ((edge (first edges)))
	(display (format nil "~S ~S" (first edge) (second edge)) fout)
	(newline fout)))
    (do ((vertices (tour G) (cdr vertices)))
	((null? vertices))
      (display (first vertices) fout) (newline fout))
    (close-output-port fout)))
;;;
;;; Save an adjacency/cost matrix G of n vertices to file fname
;;;


(define (load-graph fname)
  (let* ((fin (open-input-file fname))
	 (x (read fin))
	 (G (make-graph x)))
    (n! G x) (type! G (read fin)) (p! G (read fin))
    (C! G (make-array (list (+ 1 (n G)) (+ 1 (n G))) nil))
    (do ((i 1 (+ i 1)))
	((> i (n G)))
      (do ((j 1 (+ j 1)))
	  ((> j (n G)))
	(array-set! (C G) (list i j) (read fin))))
    (do ((i 1 (+ i 1)))
	((> i (n G)))
      (vector-set! (x-vect G) i (read fin))
      (vector-set! (y-vect G) i (read fin)))
    (do ((i (n G) (- i 1)))
	((= i 0))
      (do ((j (n G) (- j 1)))
	  ((= j 0))
	(let ((edge (list i j)))
	    (cond ((< (array-ref (C G) edge) *max*)
		   (E! G (cons edge (E G))))))))
    (let ((length.mst (read fin))) ; no.of.edges in mst
      (do ((i 0 (+ i 1)))
	  ((= i length.mst))
	(mst! G (cons (list (read fin) (read fin)) (mst G)))))
    (do ((i (read fin) (read fin)))
	((eof-object? i))
      (tour! G (cons i (tour G))))
    (close-input-port fin)
    G))
;;;
;;; Load an adjacency/cost matrix of n vertices from file fname
;;;