;;;; -*- mode:Scheme -*- ;;;;
(load-option 'format)


(define (rest l) (cdr l))	; Enable a more mnemonic function

 

;;; A network host is represented as (hostname lat long neighbor1 neighbor2 ... 
;;;                                                     neighborN)
;;; Latitude and longitude are simple integers
;;; The neighbor1 ... neighborN are hostnames of hosts to which hostname is connected
;;; and hence can forward the packet.

;;;; TEST DATA
;  This will be reset when you read in the real network data.
;  Also, whenever this file is re-loaded, the data will be set back to this.

(define *data* 
  '((dartmouth 50 50 amherst)
    (smith 50 160 mt-holyoke amherst)
    (mt-holyoke 99 189 smith amherst mit bu)
    (amherst 110 110 dartmouth smith mt-holyoke mit bu hahvud)
    (mit 159 189 mt-holyoke amherst bu hahvud wellesley)
    (bu 180 150 mt-holyoke amherst mit hahvud wellesley)
    (hahvud 190 130 amherst mit bu wellesley)
    (wellesley 250 170 mit bu hahvud)))


;;;; ACCESSORS
(define hostname first)
(define lat second)
(define long third)
(define neighbors cdddr)
(define samehost? eq?)

(define (find-hoststruct hostname)
  ;;; given a host name, find the list that contains its info
  (or (assoc hostname *data*)
      (error (cons hostname '(not a valid host)))))

; Paths are implemented as lists of host names
;
(define empty-path? null?)
(define first-host first)
(define second-host second)
(define remaining-hosts rest)
(define reverse-path reverse)
(define construct-path list)

; Queues of paths are implemented as lists of paths
;
(define empty-queue? null?)
(define first-path first)
(define remaining-paths rest)
(define construct-queue list)


;;;; GENERALIZED SEARCH PROCEDURE

(define left-overs '()) ;; allows examining the queue after search ends.

(define (generalized-search start finish finish? merge-paths-into-queue how-many successors)
  "
  Purpose:	Given start and finish hosts, find a path
  Remark:	Search type is determined by the way paths are merged
                into the queue, that is, the function given as 4th arg.
  Remark:	GENERALIZED-SEARCH hands problem to GENERALIZED-SEARCH-AUX
		with a one-path queue as the added argument
  Remark:       The finish? predicate allows a generalized check 
                for having reached any goal state, not just equality.
  Remark:       how-many indicates how many successful paths should be 
                found; its value is either 'all or an integer
  Remark:       successors defines how the path is extended, see extend-path
  "

  (define (generalized-search-aux start finish finish? merge-paths-into-queue queue wins)
    "
    Purpose:	Given start and finish hosts, find a path
    Remark:	Search type is determined by the third argument;
		fourth argument is a queue of partial paths
    "
    (cond
     ((empty-queue? queue) 
     ;; If no paths left, return accumulated wins, if any
      (if wins
	  wins
	  (format #t "~%Cain't get thar from heah.")))
     ;; If the queue satisfies the end test, e.g. first path reaches the finish.
     ((finish? queue)
      (goal-action queue)
      (let ((current (first-path queue)))
	 (cond 
	  ;; checks to see if we've found enough possible solutions
	  ((and (not (eq? 'all how-many))
		(<= how-many (+ 1 (length wins))))
	   (set! left-overs (rest queue))
	   (cons current wins))
	  (else   
           ;; found a goal state but still need to find more
	   (generalized-search-aux start finish finish? merge-paths-into-queue
				   (merge-paths-into-queue
				    (successors (first-path queue))
				    (remaining-paths queue)
				    finish)
				   (cons current wins))))))
     ;; Otherwise extend the first path and merge results into path queue:
     (else 
      (generalized-search-aux
	    start finish finish? merge-paths-into-queue
	    (merge-paths-into-queue (successors (first-path queue))
				    (remaining-paths queue)
				    finish)
	    wins))))
  (generalized-search-aux start finish
			  finish?
			  merge-paths-into-queue
			  (construct-queue (construct-path start))
			  '()))

;; Given the end-point in a path, creates a function to test a queue
;; to see if the first path has reached the finish.
(define (make-finish-test end-point)
  (lambda (queue) 
    (samehost? end-point (first-host (first-path queue)))))

;; The action which should be taken when the goal host is reached.
;; Here we simply print length of path and describe the path.
(define (goal-action queue)
  (format #t "~%Final path length is ~s" (path-length (first-path queue)))
  (describe-path (reverse-path (first-path queue))))

;;;; SKELETON FOR DEPTH-FIRST SEARCH

(define (depth-first originhost destnhost)
  "
  Purpose:	Perform depth-first search
  Remark: 	Uses generalized search function
  "
  (define (combine-paths new-paths old-paths finish)
    "
    Purpose:	Define a queue constructor specific to depth-first search;
		add the new paths in front
                Note that the finish argument doe not need to be  used.
    "
    (append new-paths old-paths)
    )

  ;; Fire up generalized search using queue constructor defined above:
  (generalized-search originhost destnhost (make-finish-test destnhost) 
		      combine-paths 1 extend-path))


(define (breadth-first originhost destnhost)
  "
  Purpose:	Perform breadth-first search
  Remark: 	Uses generalized search function
  "
  (define (combine-paths new-paths old-paths finish)
    "
    Purpose:	Define a queue constructor specific to breadth-first search;
		add the new paths in back
                Note that the finish argument doe not need to be  used.
    "
    (append old-paths new-paths)
    )

  ;; Fire up generalized search using queue constructor defined above:
  (generalized-search originhost destnhost (make-finish-test destnhost) 
		      combine-paths 1 extend-path))


(define (best-first originhost destnhost)
  "
  Purpose:	Perform best-first search
  Remark: 	Uses generalized search function
  "
  (define (combine-paths new-paths old-paths finish)
    "
    Purpose:	Define a queue constructor specific to best-first search;
		add the best looking paths to the front
    "
    (sort (append new-paths old-paths)
	  (lambda (path1 path2)
	    (< (straight-line-distance (first-host path1) finish)
	       (straight-line-distance (first-host path2) finish))))
    )

  ;; Fire up generalized search using queue constructor defined above:
  (generalized-search originhost destnhost (make-finish-test destnhost) 
		      combine-paths 1 extend-path))


(define (best-first-hopcount originhost destnhost)
  "
  Purpose:	Perform best-first-hopcount search
  Remark: 	Uses generalized search function
  "
  (define (combine-paths new-paths old-paths finish)
    "
    Purpose:	Define a queue constructor specific to
                best-first-hopcount search;
		add the shortest paths to the front
    "
    ; sort paths based on length
    (sort (append new-paths old-paths)
	  (lambda (path1 path2)
	    (< (length path1)
	       (length path2))))
    )

  ;; Fire up generalized search using queue constructor defined above:
  (generalized-search originhost destnhost (make-finish-test destnhost) 
		      combine-paths 1 extend-path))


(define (extend-path path)
  ;;; note that this initial version has a bug you will need to fix
  "
  Purpose:  Extend a path to the neighbors of the terminal host
  Returns:  A list of extended paths
  "
  ;; Following for debugging; delete when debugging is complete:
   (format #t "~%Extending the path ~a." (reverse-path path))

  (let ((path-exts
	 (map (lambda (nexthost)
		(if (not (memq nexthost path))
		    (cons nexthost path)
		    '()))
	      (get-neighboring-hosts (first-host path)))))
    (list-transform-negative path-exts null?)))

(define (get-neighboring-hosts host)
  (neighbors (find-hoststruct host)))


;;;; DESCRIPTION APPARATUS

(define (describe-path path)
  (define (describe-rest-of-path path)
    (if (not (empty-path? (remaining-hosts path)))
	(begin
	  (newline)
	  (display "then from " )
	  (display (first path))
	  (display " to ")
	  (display (second path))
	  (describe-rest-of-path (remaining-hosts path)))
	(display ".")))
  (if (not (empty-path? (remaining-hosts path)))
      (begin
        (newline)
        (display "Proceed from ")
        (display (first path))
        (display " to ")
        (display (second path))
	(describe-rest-of-path (remaining-hosts path))
      (newline))))


;;;; VARIOUS AUXILIARIES

(define (straight-line-distance host-1 host-2)
  "Purpose:	Determine the straight line distance between two hosts"
  (let ((hoststruct1 (find-hoststruct host-1)) 
	(hoststruct2 (find-hoststruct host-2)))
    (round (sqrt (+ (expt (- (lat hoststruct1) (lat hoststruct2)) 2)
		    (expt (- (long hoststruct1) (long hoststruct2)) 2))))))


;;; path length is just the number of hops
(define path-length length)



;;; this function simply loads a file which resets *data* to the whole
;;; network to use for the problem set

;;; ********* YOU MAY NEED TO CHANGE THE PATHNAME OF hosts.scm *******

(define (loadrealdata)
  (load "/mit/daveg/Courses/6.034/ps4/hosts.scm"))


;;; this is a simple stepper to allow you to test the extend-path code

(define (step-by-step path)
  ;;; generate a simple path by taking the first successor of the first node on the path
  (format #t "~%The path ~a" path)
  (let ((extensions (extend-path path)))
    (if (null? extensions)
	(format #t "cannot be extended any further.")
    	(begin
	  (format #t " can be extended to get ~a" (first-path extensions))
	  (format #t "~%Continue? [y or n]: ")
	  (if (eq? 'y (read))
	      (step-by-step (first-path (extend-path path)))
	      '())))))