A Genetic Algorithm for the Traveling Salesman Problem
;;; GENETIC2000.LSP
;;; A "genetic" algorithm for the Traveling Salesman Problem.
;;; (C) Copyright 1995 by Steven L. Tanimoto.
;;; This program is described in Chapter 5 ("Search") of
;;; "The Elements of Artificial Intelligence Using Common Lisp," 2nd ed.,
;;; published by W. H. Freeman, 41 Madison Ave., New York, NY 10010.
;;; Permission is granted for noncommercial use and modification of
;;; this program, provided that this copyright notice is retained
;;; and followed by a notice of any modifications made to the program.
;;; Note that due to the use of random numbers, the results
;;; vary from run to run.
;;; Our problem uses a graph whose nodes present cities and
;;; whose arcs carry distances, much as for the UNIFORM-COST
;;; search and A* programs.
;;; Here is a hash table to store the distance information:
(let ((distance-info (make-hash-table :size 20)) )
(defun set-distances (x y)
(setf (gethash x distance-info) y) )
(defun get-distances (x)
(gethash x distance-info) )
)
;;; Here is the set of cities for this problem:
(defparameter *cities*
'(seattle portland spokane wenatchee bellingham) )
(defparameter *ncities* (length *cities*))
;;; Here are the distances.
;;; (These were estimated and not from a map)
(set-distances 'seattle
'((portland . 150)(spokane . 350)
(wenatchee . 100)(bellingham . 90) ) )
(set-distances 'portland
'((seattle . 150)(spokane . 400)
(wenatchee . 200)(bellingham . 235) ) )
(set-distances 'spokane
'((portland . 400)(seattle . 350)
(wenatchee . 275)(bellingham . 385) ) )
(set-distances 'wenatchee
'((portland . 200)(spokane . 275)
(seattle . 100)(bellingham . 130) ) )
(set-distances 'bellingham
'((portland . 235)(seattle . 90)
(spokane . 385)(wenatchee . 130) ) )
;;; We represent an individual as a dotted pair whose left part
;;; is a list of cities and whose right part is a strength value.
(defun get-path (individual)
"Returns the list of cities associated with INDIVIDUAL."
;; You don't have to use the word "return" in the code
)
(defun get-strength (individual)
"Returns the strength value associated with INDIVIDUAL."
;; You don't have to use the word "return" in the code
)
(defparameter *initial-population*
'( ((seattle seattle seattle seattle seattle) . 0) ) )
(defparameter *test-population*
'( ((bellingham spokane portland seattle wenatchee) . 0) ) )
(defvar *population*)
(defvar *current-min-strength*)
(defvar *current-pop-size*)
(defparameter *mutateDebug* 'both)
(defparameter *debug* t)
(defparameter *population-limit* 15)
(defun distance (a b)
"Returns the distance between cities A and B."
(if (eql a b) 0
(rest (assoc b (get-distances a))) ) )
(defun cycle-cost (path)
"Returns length of the PATH, including a closing
arc from the last to the first element of PATH."
(+ (distance (first path) (first (last path)))
(path-cost path) ) )
(defun path-cost (path)
"Returns the length of the PATH."
;; Recursive version:
;; if the length of the path is less than or equal to 1
;; return 0 (you don't have to use the word "return")
;; else add together the distance between the first two
;; cities in the path plus the recursive call on
;; the rest of the path.
)
(defun non-tour-penalty (path)
"Computes how far PATH is from being a tour.
If PATH is a tour, then the penalty returned is 0."
(* 100
(+ (length (set-difference path *cities*))
(length (set-difference *cities* path)) ) ) )
(defun chromosome-strength (individual)
"Returns a value that is highest when INDIVIDUAL is a
mimimum cost tour."
(/ 10000.0
(+ (* 2 (cycle-cost (get-path individual)))
(* 50 (non-tour-penalty (get-path individual))) ) ) )
(defun mutate (individual)
"Performs either MUTATE1 or MUTATE2, choosing randomly."
;;;Randomly choose between calling mutate1 and mutate2 functions
)
(defun mutate1 (individual)
"Returns a slightly altered INDIVIDUAL, with the
alteration generated randomly. One city is randomly changed."
;;;Create 3 local variables with a let* form, so that the local
;;;variables can be sequentially initialized
;;; "path" is initialized from the individual
;;; "where" is a random number from 0..(length of path)-1
;;; "new-city" is an nth city picked from *cities*
;;; Now cons NEWPATH onto 0, where NEWPATH is the result of
;;; calling function "replace-nth", which replaces an nth
;;; city in a path with a new city --> path position new-city
;;; NOTE: Using functional programming style, you should NOT have
;;; to use another variable called NEWPATH - NEWPATH is a
;;; "virtual" variable
)
(defun mutate2 (individual)
"Returns a slightly altered INDIVIDUAL, with the
alteration generated randomly. Two cities are transposed."
;;; Declare 5 local variables using let*
;;; "path": is the path associated with individual
;;; "where1" and "where2" are random numbers from 0..(length of path)-1
;;; "city1" is the nth city at where1 from path
;;; "city2" is the nth city at where2 from path
;;; cons NEWPATH onto 0, where NEWPATH is the path resulting from
;;; swapping city1 and city2. Call replace-nth twice. You
;;; should NOT have to use a new variable for NEWPATH.
;;; Use functional programming style.
)
(defun replace-nth (lst n elt)
"Returns result of replacing the N-th element of LST by ELT."
;;;Recursive function, use a cond form:
;;; If the lst is null, return nil
;;; If n is 0, cons elt onto the rest of lst
;;; Otherwise cons the first of ls onto ???? (recursive call goes here)
)
;;; In CROSSOVER we assume that PATH1 and PATH2 are of the same length.
(defun crossover (individual1 individual2)
"Returns a new path resulting from
genetic crossover of PATH1 and PATH2."
;;; Declare 3 local variables using a let* form.
;;; "path1" is the path associated with individual1
;;; "path2" is the path associated with individual2
;;; "where" is a random number from 0..(length of path1)-1
;;; Cons NEWPATH onto 0, where NEWPATH is the result of appending
;;; the left part of path1 and the right part of path2 together.
;;; Using functional style, you should NOT have to use a separate
;;; variable for NEWPATH. Call the helper functions left-part and
;;; right-part.
)
(defun left-part (path k)
"Returns the prefix of PATH having length K."
;;; A convenient function to use is Lisp function: subseq, used to return
;;; the subsequence of a list.
;;; There are two possible forms of subseq:
;;; (subseq sequence start) and (subseq sequence start end)
;;; Choose the best version that applies
)
(defun right-part (path k)
"Returns the suffix of PATH starting at position K."
)
(defun random-individual ()
"Returns a randomly selected member of the population."
(nth (random (length *population*)) *population*) )
(defun another-individual (previous-rand-indiv)
"Returns a randomly selected member of the population
but makes an effort to find one that is different
from PREVIOUS-RAND-INDIV."
(let ((current-population-size (length *population*))
(previous-path (get-path previous-rand-indiv))
candidate)
(dotimes (i 5 candidate) ; try at most 5 times.
(setf candidate
(nth (random current-population-size)
*population*) )
(if (not (equal (get-path candidate) previous-path))
(return candidate) ) ) ) )
(defun evolve (ngenerations nmutations ncrossovers)
"Runs the genetic algorithm for NGENERATIONS times."
(setf *population* *initial-population*)
(dotimes (i ngenerations)
(dotimes (j nmutations)
;;; Mutate a random individual and add the individual to the population.
;;; You can use a let form for a local variable "mutated-one"
)
(dotimes (j ncrossovers)
(let* ((individual1 (random-individual))
(individual2
(another-individual individual1) )
(crossing-result
(crossover individual1
individual2) ) )
;;; Add the cross over result to the population
)
)
(format t "~%In generation ~D, population is: ~S.~%"
(1+ i) *population*)
) )
(defun add-individual (individual)
"Computes and stores the chromosome-strength of INDIVIDUAL.
Then adds the INDIVIDUAL to the population
if the population limit has not yet been reached.
Otherwise, if its strength exceeds that of the weakest
member it replaces the weakest member."
#|
(let (declare a local variable "strength" for the
Chromosone strength of this individual
--> use function chromosone-strength)
Use setf to associate this new strength with the individual
(if the current population size equals the population limit,
(progn
(if this new strength is greater than the current minimum strength
of the population
;;; Remove weakest current member:
(progn
(let ( create a local variable "k" which is a
number representing the position of the minumum
strength in the population. Use a call to
the function "where-strength-occurs" with
paramters for the current minumum strength and
the population.)
Use setf to set the population to the result of removing
the kth element from the population. Use remove-kth
;;; Insert INDIVIDUAL into the population:
Use push. Then update the value for the minimum strength
of the population - use update-minimum-strength
)
)
;;; Else there's still room in population...
(progn
Push the new individual onto the population
Set the current minimum strength to the minumum of this
individual's strength and the current minimum strength
Increase the current population size
|#
)
(defun update-min-strength ()
"Computes and saves the minimum of all strengths of
current members of the population."
;;; (setf *current-min-strength*
;;; apply the function min onto the result of mapping the
;;; get-strength function over the entire population
)
(defun where-strength-occurs (val population-list)
"Returns the first position in POPULATION-LIST where VAL occurs
as the strength of that individual."
;;; Non-tail recursive function, use a cond form:
;;; If population list is empty, return nil
;;; If val equals the strength of the first of the population list,
;;; return 0.
;;; Otherwise add 1 to the recursive call.
)
(defun remove-kth (k lst)
"Returns a list consisting of LST with the Kth element deleted."
;;; See the comments for the function replace-nth for help. The
;;; two functions are similar.
)
(defun test (&optional (ngenerations 10)
(nmutations 10)
(ncrossovers 10))
"Does a trial run of EVOLVE."
(setf *population* *initial-population*)
(setf *current-min-strength* 0)
(setf *current-pop-size* 1)
(evolve ngenerations nmutations ncrossovers )
; 10, 10, 10 often lead to convergence at strength 4.78.
)
#|
(defun test ()
"Does a trial run of EVOLVE."
(setf *population* *initial-population*)
(setf *current-min-strength* 0)
(setf *current-pop-size* 1)
(evolve 10 10 10) ; these values often lead to convergence at strength 4.78.
)
|#
;;;(test)