;; --------------------------------------------------------------------
;;                    Tim Montague, John Stites
;;                        October 19, 2007
;;                            CS 436
;;                Program 2: Ant Colony Optimization
;; --------------------------------------------------------------------
;; This file contains the functions for the second programming 
;; assignment. The objective of the assignment is to solve the 
;; traveling salesman problem using the ACO algorithm.
;; --------------------------------------------------------------------


;; --------------------------------------------------------------------
;; aco
;; --------------------------------------------------------------------
;; Driver function for ant colony optimization
;; --------------------------------------------------------------------

(defun aco ()
  (initialize)
  (dotimes (iteration-number (info-iterations *info*))
    (run-iteration iteration-number)
  )
)  

;; --------------------------------------------------------------------
;; run-iteration
;; --------------------------------------------------------------------
;; iteration-number    : current iteration's number
;; --------------------------------------------------------------------
;; Runs an iteration of ants through the ant colony optimization
;; algorithm. This calculates a tour for each ant, computes local
;; updates based on each tour as well as a global update based on the
;; the shortest tour found. last, the results are printed
;; --------------------------------------------------------------------

(defun run-iteration (iteration-number)
  (let
    (
      min-tour                            ; keep track of the shortest tour
      max-tour                            ; keep track of the longest tour
      min-length                          ; length of shortest tour
      max-length                          ; length of longest tour
      current-tour                        ; current ant's tour
      current-length                      ; length of current tour
      (total-length 0)                    ; sum of all tours in iteration
    )

    ; for each ant, run-ant, compare to min/max, and update trail with local update
    (dotimes (ant (info-ants *info*))
      
      (setf current-tour (run-ant (new-tour)))
      (setf current-length (tour-length current-tour))
      (setf total-length (+ total-length current-length))
      
      (cond 
        
        ; initialize all if it's the first ant
        ((null min-tour)
          (setf min-tour current-tour)
          (setf max-tour current-tour)
          (setf min-length current-length)
          (setf max-length current-length)
        )
      
        ; update minimums if it's shorter
        ((< current-length min-length)
          (setf min-tour current-tour)
          (setf min-length current-length)
        )
      
        ; update maximums if it's longer
        ((> current-length max-length)
          (setf max-tour current-tour)
          (setf max-length current-length)
        )
      )
      
      (update-trail current-tour #'local-trail-update)
    )

    (when (> (info-ants *info*) 0)

      ; global update for the shortest tour
      (update-trail min-tour #'(lambda (source destination) (global-trail-update source destination min-length)))
    
      ; print out the results
      (print-results
        iteration-number                              ;iteration-number 
        min-length                                    ;best-length
        (visited-cities min-tour)                     ;best-path 
        max-length                                    ;worst-length 
        (visited-cities max-tour)                     ;worst-path 
        (/ total-length (info-ants *info*))           ;average-length
      )    
    
    )
  )
)

;; --------------------------------------------------------------------
;; run-ant
;; --------------------------------------------------------------------
;; atour    : an initialized tour with the city information preloaded
;; --------------------------------------------------------------------
;; Builds a tour by continually selecting a next city based on one of
;; two different algorithms until the entire list of cities has been
;; visited
;; --------------------------------------------------------------------

(defun run-ant (atour)
  (do 
     
    ; local variables
    (
      (q (random 1.0) (random 1.0))           ; current value of q random variable
    )

    ; end test
    (
      ; keep going while there's cities left to visit
      (tour-complete-p atour)
      
      ; return the tour once it's completed
      atour                     
    )

    ; statements
    (if (<= q (info-q0 *info*))
      
      ; select city by maximizing tau * nu
      (visit-city atour (select-next-city atour #'tau-times-nu))
      
      ; select city according to Pk(r,s) probability distribution
      (visit-city atour (select-city-using-probability-distribution atour))
  
    )
  )
)

;; --------------------------------------------------------------------
;; new-tour
;; --------------------------------------------------------------------
;; Initializes a new tour object with the city information, setting 
;; city 0 as the first city visited
;; --------------------------------------------------------------------

(defun new-tour ()
  (make-instance 'tour :city-list (info-points *info*) :starting-city 0)
)

;; --------------------------------------------------------------------
;; update-trail
;; --------------------------------------------------------------------
;; atour            : completed tour used to update legs of that tour
;; update-function  : function used to update for each leg of tour
;;                    two-parameter function that is passed the source
;;                    and destination cities' indices
;; --------------------------------------------------------------------
;; Iterates over each leg of the tour and calls the update-function for
;; the two cities contained in the current leg
;; --------------------------------------------------------------------

(defun update-trail (atour update-function)
  (if (> 1 (length (visited-cities atour)))
    (dotimes (i (length (visited-cities atour)))
      (update-tau
        (third (nth i (visited-cities atour)))
        (third (nth (mod (+ i 1) (length (visited-cities atour))) (visited-cities atour)))
        update-function
      )
    )
  )
)

;; --------------------------------------------------------------------
;; local-trail-update
;; --------------------------------------------------------------------
;; source       : index of source city
;; destination  : index of destination city
;; --------------------------------------------------------------------
;; Calculates the value to set the new pheremone level for a given
;; source/destination city combination due to local trail updating
;; --------------------------------------------------------------------

(defun local-trail-update (source destination)
  (+ 
    (*
      (- 1 (info-alpha *info*))
      (tau source destination)
    )
    (*
      (info-alpha *info*)
      (info-tau0 *info*)
    )
  )
)

;; --------------------------------------------------------------------
;; global-trail-update
;; --------------------------------------------------------------------
;; source         : index of source city
;; destination    : index of destination city
;; shortest-tour  : length of shortest tour found in iteration
;; --------------------------------------------------------------------
;; Calculates the value to set the new pheremone level for a given
;; source/destination city combination due to global trail updating
;; --------------------------------------------------------------------
  
(defun global-trail-update (source destination shortest-tour)
  (+ 
    (*
      (- 1 (info-alpha *info*))
      (tau source destination)
    )
    (*
      (info-alpha *info*)
      (/ 1 shortest-tour)
    )
  )
)

;; --------------------------------------------------------------------
;; update-tau
;; --------------------------------------------------------------------
;; source           : index of source city
;; destination      : index of destination city
;; update-function  : function used to update for each leg of tour
;; --------------------------------------------------------------------
;; Performs the actual update based on the two cities and update func
;; --------------------------------------------------------------------

(defun update-tau (source destination update-function)
  (set-tau 
    source 
    destination
    (funcall update-function source destination)
  )
)

;; --------------------------------------------------------------------
;; select-city-using-probability-distribution
;; --------------------------------------------------------------------
;; atour  : a current tour with remaining unvisited cities
;; --------------------------------------------------------------------
;; Creates a probability distribution by calculating the tau * nu
;; component of the aco selection formula, then dividing each value by
;; the sum of all the values. This gives a probability for each 
;; unvisited city. This distribution is passed to the 
;; select-from-distribution function to select one city based on a
;; random number
;; --------------------------------------------------------------------

(defun select-city-using-probability-distribution (atour)
  (let
    (
      (list-of-probabilities '())                 ; list holding (index, probability) sublists
      (sum-of-tau-times-nu 0)                     ; total of all tau-times-nu components
      (current-city (last-visited-city atour))    ; source city used for each calculation
    )
  
    ; create a list of (index, tau-times-nu) sublists, one for each unvisited city
    (setf 
      list-of-probabilities
      (mapcar
        #'(lambda (acity) (list (third acity) (tau-times-nu current-city acity)))
        (unvisited-cities atour)
      )
    )
      
    ; sum each of the tau-times-nu components
    (setf 
      sum-of-tau-times-nu 
      (sum list-of-probabilities 'second)
    )

    ; divide each value (second item in each sub-list) by the total sum to find probability
    (setf 
      list-of-probabilities
      (mapcar #'(lambda (item) (list (first item) (/ (second item) sum-of-tau-times-nu))) list-of-probabilities)
    )
  
    ; select an item according to a random number
    (select-from-distribution list-of-probabilities (random 1.0))
  
  )
)

;; --------------------------------------------------------------------
;; select-from-distribution
;; --------------------------------------------------------------------
;; list-of-probabilities  : list of lists for the probability 
;;                          distribution, each in the form of 
;;                          (city-index, probability)
;; random-probability     : currently selected random number
;; --------------------------------------------------------------------
;; Recursive function used to select a city from a list of cities
;; based on a probability-distribution. First checks if the current
;; city (first in the list) should be selected. If not, recalls self
;; with the rest of the cities, reducing the probabilty by that of the
;; first city
;; --------------------------------------------------------------------

(defun select-from-distribution (list-of-probabilities random-probability)
  (cond
    
    ; if there's only one item left, then it is selected
    ((= 1 (length list-of-probabilities)) (first (first list-of-probabilities)))
    
    ; if probability is less than the current item's probability, it's current item
    ((<= random-probability (second (first list-of-probabilities))) 
      (first (first list-of-probabilities)))
    
    ; otherwise, call this recursively with the rest of the list and a reduced probability
    (t 
      (select-from-distribution 
        (rest list-of-probabilities) 
        (- random-probability (second (first list-of-probabilities)))
      )
    ) 
  )
)  
  
;; --------------------------------------------------------------------
;; tau-times-nu
;; --------------------------------------------------------------------
;; source       : source city
;; destination  : destination city
;; --------------------------------------------------------------------
;; Calculates the tau * nu component of the aco formula for two cities
;; --------------------------------------------------------------------

(defun tau-times-nu (source destination)
  (*
    (tau (third source) (third destination))
    (expt
      (/ 1 (distance source destination))
      (info-beta *info*)
    )
  )
)  

;; --------------------------------------------------------------------
;; length-using-nearest-neighbor
;; --------------------------------------------------------------------
;; atour  : a tour object used to generate a tour using the nearest
;;          neighbor heuristic
;; --------------------------------------------------------------------
;; Uses the build-tour method of the tour object to generate a tour. It
;; passes in a selection function:
;;        0 - distance(source, destination)
;;
;; because it wants to minimize the distance, which is the same as 
;; maximizing the negative of the distance 
;; --------------------------------------------------------------------

(defun length-using-nearest-neighbor (atour)
  (build-tour atour #'(lambda (source destination) (- 0 (distance source destination))))
  (tour-length atour)
)  

;; --------------------------------------------------------------------
;; initialize
;; --------------------------------------------------------------------
;; Initializes the aco algorithm by calculating the initial pheremone
;; array
;; --------------------------------------------------------------------
 
(defun initialize ()
  (initialize-pheremones (length (info-points *info*)) (initial-tau0))
  (print-header)
)  

;; --------------------------------------------------------------------
;; initialize-pheremones
;; --------------------------------------------------------------------
;; number-of-points : total number of citites for the matrix
;; tau0             : initial value to set for each pheremone entry
;; --------------------------------------------------------------------
;; Sets the tau0 parameter and creates an array to hold the pheremone
;; matrix values
;; --------------------------------------------------------------------

(defun initialize-pheremones (number-of-points tau0)
  (setf (info-tau0 *info*) tau0)
  (setf (info-pheremones *info*) 
    (make-array (list number-of-points number-of-points) :initial-element tau0)
  )  
)

;; --------------------------------------------------------------------
;; intial-tau0
;; --------------------------------------------------------------------
;; Calculates the intial tau0 value based on the aco formula 1/(n*Lnn)
;; --------------------------------------------------------------------

(defun initial-tau0 ()
  (let 
    ((nearest-neighbor (length-using-nearest-neighbor (new-tour))))
    
    (if (> nearest-neighbor 0)
      (/ 1 (* (length (info-points *info*)) nearest-neighbor))
      0
    )
  )
)
  
;; --------------------------------------------------------------------
;; tau
;; --------------------------------------------------------------------
;; source       : index of source city
;; destination  : index of destination city
;; --------------------------------------------------------------------
;; Retrieves the pheremone level for the given source/destination 
;; city combinatino
;; --------------------------------------------------------------------

(defun tau (source destination)
  (aref (info-pheremones *info*) source destination)
)

;; --------------------------------------------------------------------
;; set-tau
;; --------------------------------------------------------------------
;; source       : index of source city
;; destination  : index of destination city
;; new-value    : value to set as new value
;; --------------------------------------------------------------------
;; Sets the pheremone level for the given source/destination
;; city combination
;; --------------------------------------------------------------------

(defun set-tau (source destination new-value)
  (setf (aref (info-pheremones *info*) source destination) new-value)
)

;; --------------------------------------------------------------------
;; tour class
;; --------------------------------------------------------------------
;; Slots:
;;
;; visited-cities   : list of cities on tour that have been visited
;; unvisited-cities : list of cities on tour that have not been visited
;; city-list        : list of city data used to initialize tour object
;; starting-city    : integer index of city to be used as starting city
;; --------------------------------------------------------------------
;; tour class manages the state of a city tour, keeping track of which
;; cities have been visited and which are still available to visit. it
;; manages a list of city objects
;; --------------------------------------------------------------------

(defclass tour ()
  (
    (visited-cities 
      :accessor visited-cities
      :initform '()
    )
    
    (unvisited-cities 
      :accessor unvisited-cities
      :initform '()
    )
  
    (city-list
      :accessor city-list
      :initarg :city-list
      :initform (error "Must supply a list of cities using the :city-list parameter")
    )
  
    (starting-city
      :accessor starting-city
      :initarg :starting-city
      :initform (error "Must supply the city to start the tour using the :starting-city parameter")
    )
  
  )
)

;; --------------------------------------------------------------------
;; initialize-instance
;; --------------------------------------------------------------------
;; Initialize the tour object by first creating a list of city objects
;; for the city information, and then visiting the first city of the
;; tour
;; --------------------------------------------------------------------

(defmethod initialize-instance :after ((atour tour) &key)
  (setf (unvisited-cities atour) (city-list atour))
  (unless (null (unvisited-cities atour))
    (visit-city atour (starting-city atour))
  )
)

;; --------------------------------------------------------------------
;; visit-city
;; --------------------------------------------------------------------
;; city-index    : index of city to visit
;; --------------------------------------------------------------------
;; Moves city with city-index to the end of the visited cities list
;; and removes it from the unvisited cities list
;; --------------------------------------------------------------------

(defmethod visit-city ((atour tour) city-index)
  (move-city-to-visited-cities-list atour (get-city (city-list atour) city-index))
)

;; --------------------------------------------------------------------
;; tour-length
;; --------------------------------------------------------------------
;; Calculates the length of the tour
;; --------------------------------------------------------------------

(defmethod tour-length ((atour tour))
  ; if there's only one city in the tour, no traveling = no distance
  (if (<= (length (visited-cities atour)) 1)
    0
    
    ; otherwise call recursive function to find distances between each city in our tour
    (compute-distances (visited-cities atour) (length (visited-cities atour)))
  )
)

;; --------------------------------------------------------------------
;; tour-complete-p
;; --------------------------------------------------------------------
;; Returns true or false indicating whether every city has been visited
;; --------------------------------------------------------------------
(defmethod tour-complete-p ((atour tour))
  (null (unvisited-cities atour))
)

;; --------------------------------------------------------------------
;; build-tour
;; --------------------------------------------------------------------
;; selection-function : two-parameter function that accepts a source
;;                      and destination city and calculates a selection
;;                      value for whether the city should be visited
;;                      next
;; --------------------------------------------------------------------
;; Builds a complete tour by recursively first selecting the next city,
;; visiting that city, and then calling itself to continue with the
;; process until there are no more cities left to visit
;; --------------------------------------------------------------------

(defmethod build-tour ((atour tour) selection-function)
  (if (tour-complete-p atour)
    atour
    
    (progn
      (visit-city atour (select-next-city atour selection-function))
      (build-tour atour selection-function)
    )
  )
)

;; --------------------------------------------------------------------
;; select-next-city
;; --------------------------------------------------------------------
;; selection-function : two-parameter function that accepts a source
;;                      and destination city and calculates a selection
;;                      value for whether the city should be visited
;;                      next
;; --------------------------------------------------------------------
;; Calls the selection function for each unvisited city to obtain a
;; selection value for each, then selects the maximum value of those
;; to determine which city should be visited next. Returns the index
;; of the selected city
;; --------------------------------------------------------------------

(defmethod select-next-city ((atour tour) selection-function)
  (third
    (maximize 
      (unvisited-cities atour) 
      #'(lambda (item) (funcall selection-function (last-visited-city atour) item))
    )
  )
)

;; --------------------------------------------------------------------
;; last-visited-city
;; --------------------------------------------------------------------
;; Returns the most recently visited city from the visited city list
;; --------------------------------------------------------------------

(defmethod last-visited-city ((atour tour))
  (first (last (visited-cities atour)))
)

;; --------------------------------------------------------------------
;; compute-distances
;; --------------------------------------------------------------------
;; citites              : list of city objects
;; remaining-shifts     : number of "legs" of the tour left to sum up
;; --------------------------------------------------------------------
;; Recursive function to calculate the distance between cities in a
;; tour. Each shift calculates the distance between the first and
;; second city of the currently shifted list and sums up each by 
;; recursively calling self with the next two cities in the front of
;; the list
;; --------------------------------------------------------------------

(defun compute-distances (cities remaining-shifts)
  (if (= 0 remaining-shifts)
    0
    (+ 
      (distance (first cities) (second cities))
      (compute-distances (rotate-left-by-n cities 1) (- remaining-shifts 1))
    )
  )
)

;; --------------------------------------------------------------------
;; move-city-to-visited-cities-list
;; --------------------------------------------------------------------
;; atour    : tour on which the city will be moved
;; acity    : city object to be moved from the unvisited-cities list to
;;            the visited-cities list
;; --------------------------------------------------------------------
;; Moves the city object from one list to the other, effectively making
;; it the last visited city
;; --------------------------------------------------------------------

(defun move-city-to-visited-cities-list (atour acity)
  (setf (visited-cities atour) (append (visited-cities atour) (list acity)))
  (setf (unvisited-cities atour) (remove-city (unvisited-cities atour) (third acity)))
)

;; --------------------------------------------------------------------
;; get-city
;; --------------------------------------------------------------------
;; list-of-cities    : list containing cities to select from
;; city-index        : index of the city to select
;; --------------------------------------------------------------------
;; Selects a city with a given index from a list of cities
;; --------------------------------------------------------------------

(defun get-city (list-of-cities city-index)
  (nth city-index list-of-cities)
)

;; --------------------------------------------------------------------
;; remove-city
;; --------------------------------------------------------------------
;; list-of-cities    : list containing cities to select from
;; city-index        : index of the city to remove
;; --------------------------------------------------------------------
;; Removes a city with a given index from a list of cities
;; --------------------------------------------------------------------

(defun remove-city (city-list city-index)
  (remove-if #'(lambda (acity) (= city-index (third acity))) city-list)
)

;; --------------------------------------------------------------------
;; distance
;; --------------------------------------------------------------------
;; source       : city list for source city
;; destination  : city list for destination city
;; --------------------------------------------------------------------
;; Calculates the distance between two cities using the pythagorean
;; theorem and their (x,y) coordinates
;; --------------------------------------------------------------------

(defun distance (source destination)
  (sqrt
    (+
      (expt (- (first source) (first destination)) 2)
      (expt (- (second source) (second destination)) 2)
    )
  )
)

;; --------------------------------------------------------------------
;; select
;; --------------------------------------------------------------------
;; alist              : a list of items to select from
;; selection-function : single parameter function that returns either 
;;                      true or false to determine if a list item 
;;                      should be selected
;; --------------------------------------------------------------------
;; Select the first item from a list where the selection-function 
;; returns true for the item
;; --------------------------------------------------------------------

(defun select (alist selection-function)
  (cond 
    ((null alist) nil)
    ((funcall selection-function (first alist)) (first alist))
    (t (select (rest alist) selection-function))
  )  
)

;; --------------------------------------------------------------------
;; rotate-left-by-n
;; --------------------------------------------------------------------
;; alist : A list to rotate
;; n     : number of times to shift the list
;; --------------------------------------------------------------------
;; Rotate a list left by n shifts
;; --------------------------------------------------------------------

(defun rotate-left-by-n (alist n)
  (append (nthcdr (mod n (length alist)) alist) (butlast alist (- (length alist) (mod n (length alist)))))
)

;; --------------------------------------------------------------------
;; maximize
;; --------------------------------------------------------------------
;; alist                : list of items to choose maximum of
;; function-to-maximize : single parameter function that returns a 
;;                        float value for each item in the list
;; --------------------------------------------------------------------
;; Select an item from a list by maximizing the result of 
;; function-to-maximize for each list item
;; --------------------------------------------------------------------

(defun maximize (alist function-to-maximize)
  (cond
    ((null alist) nil)
    (t 
      (maximize-aux
        (funcall function-to-maximize (first alist))
        (first alist)
        (rest alist)
        function-to-maximize
      )
    )  
  )
)

;; --------------------------------------------------------------------
;; maximize-aux
;; --------------------------------------------------------------------
;; current-max-value    : highest found value
;; current-max-item     : list item with maximum
;; remaining-items      : items yet to be checked
;; function-to-maximize : single parameter function that returns a 
;;                        float value for each item in the list
;; --------------------------------------------------------------------
;; Recursively call self comparing the highest item found to the first
;; of the remaining list until there's no items left
;; --------------------------------------------------------------------

(defun maximize-aux (current-max-value current-max-item remaining-items function-to-maximize)
  (if (null remaining-items) 
    current-max-item
  
    (let
      ((next-value (funcall function-to-maximize (first remaining-items))))
    
      (if (> next-value current-max-value)
        (maximize-aux next-value (first remaining-items) (rest remaining-items) function-to-maximize)
        (maximize-aux current-max-value current-max-item (rest remaining-items) function-to-maximize)
      )
 
    )   
  )
)

;; --------------------------------------------------------------------
;; sum
;; --------------------------------------------------------------------
;; alist            : list to find the average of
;; function-to-sum  : single parameter function that takes a list
;;                    item and computes a value to be summed
;; --------------------------------------------------------------------
;; Recursively call self adding the value of the current item to the
;; sum of the remaining items
;; --------------------------------------------------------------------

(defun sum (alist function-to-sum)
  (if (null alist)
    0
    (+
      (funcall function-to-sum (first alist))
      (sum (rest alist) function-to-sum)
    )
  )
)