About a year ago, I tried to make my first GA...worked out well for what I wanted it to do, more or less. Recently, we've had a math-related school project and I decided to create another GA, this time one that would solve the traveling salesman problem for the capitals of the 48 continental US states. It works pretty well, except that it's slow. It usually takes less than 75 generations to form a good solution, but it tends to easily get stuck in local minimums. I also haven't commented the crossover part, just because I got lazy
. The type of crossover is called a "Sequential Constructive Crossover", an essay over it can be found at
http://www.cscjournals.org/csc/manuscript/Journals/IJBB/volume3/Issue6/IJBB-41.pdf.
Rem Project: TSP Matrix1Utils
Rem Created: 2/6/2011 11:24:52 PM
Rem ***** Main Source File *****
setup_display()
disable escapekey
global pop_size
global cross_rate as float
global mut_rate as float
global total# `total fitness
global avg# `avg fitness
global a# `keeps time of when program first starts
global iteration `keeps num of generations
global save `determines what to inc snapshots by
global old_best as float `old best distance
global available$ `used in crossover to show available cities
old_best = 999999999999.0
avg# = 0.0
total# = 0.0
type _pop
gene as string
fitness as double float
fit_ind as double float
dist as double float
endtype
type _city_loc
x as integer
y as integer
endtype
input "Population size: ", pop_size
print ""
input "Crossover rate (decimal): ", cross_rate
print ""
input "Mutation rate (decimal): ", mut_rate
print ""
ink rgb(0,0,0),1
lock pixels
cities = setup_arrays(pop_size) `total number of cities, 1 subtracted to account for 0
calc_dist(cities, 1, pop_size*2)
fitness_all(pop_size, cities)
repeat
inc x
file$ = "log "+str$(x)
until file exist(file$+".txt") = 0
open to write 1, file$+".txt"
a# = timer()
unlock pixels
do
lock pixels
inc iteration
cross(pop_size, cities, cross_rate, mut_rate)
display(pop_size, cities, iteration)
if escapekey()=1 or iteration > 60000
close file 1
end
endif
nice wait 1
unlock pixels
sync
loop
function write_log(time#, it, pop, cities)
write string 1, "Time: "+str$(time#/1000.0)
write string 1, "Iterations: "+str$(it)
write string 1, "Best gene: "+pop$(1).gene
write string 1, "Best fitness: "+str$(pop$(1).fit_ind)
write string 1, "Best distance: "+str$(pop$(1).dist)+" miles"
write string 1, "Approx. " + str$(abs(9200 - (pop$(1).dist*2))) + " miles from optimization ("+ str$( ((abs(9200 - pop$(1).dist*2))/9200) * 100.0)+"%)"
write string 1, " "
for x = 1 to pop
write string 1, "Gene: "+pop$(x).gene
write string 1, "Fitness: "+str$(pop$(x).fit_ind)
write string 1, "Distance: "+str$(pop$(x).dist)
next x
write string 1, " "
endfunction
function display(pop, cities, it)
if pop$(1).dist < old_best
old_best = pop$(1).dist
b# = timer()
write_log(b#-a#, iteration, pop, cities)
inc save
changed = 1
endif
cls
if it mod 1000 = 0
delete image 1
load image "uscapzm.jpg", 1
endif
paste image 1,0,0
s$ = "Iteration: "+str$(it)
text 5,5, s$
s$ = "Best fitness: "+str$(pop$(1).fit_ind)
text 5,25, s$
s$ = "Best distance: "+str$(pop$(1).dist*2)+" miles"
text 5,45, s$
s$ = "Approx. " + str$(abs(9200 - (pop$(1).dist*2))) + " miles from optimization ("+ str$( ((abs(9200 - pop$(1).dist*2))/9200)*100.0)+"%)"
text 5,65, s$
s$ = "Average fitness: "+str$(avg#)
text 5,85, s$
split string pop$(1).gene, ";"
for x = 1 to cities
fill circle city_loc(x).x, city_loc(x).y, 5
c1 = val(split word$(x))
c2 = val(split word$(x+1))
if x <> cities then line city_loc(c1).x, city_loc(c1).y, city_loc(c2).x, city_loc(c2).y
next x
c1 = val(split word$(1))
c2 = val(split word$(cities))
line city_loc(c1).x, city_loc(c1).y, city_loc(c2).x, city_loc(c2).y
`uncomment this to save a snapshot of the path when it finds a new best path
` if changed = 1
` unlock pixels
` save current bitmap "Snap "+str$(save)+".jpg"
` lock pixels
` endif
endfunction
function cross(pop, cities, cross as float, mut as float)
for member = 1 to pop `cycle through every member
if (rnd(100) <= (cross*100) ) `check to see if crossover occurs at all
pop$(member+pop).gene = ""
pop$(member+pop).fitness = 0
pop$(member+pop).fit_ind = 0
pop$(member+pop).dist = 0
repeat
roulette_one = rnd(100) `get the two values to choose the two cities to crossover
roulette_two = rnd(100)
member_one = 1 `holds index of first city to be crossed over
member_two = 1 `holds index of second city to be crossed over
while ( (member_one < pop) and ((pop$(member_one).fitness*100) <= roulette_one) ) `increments member_one until the fitness of the gene is greater than the chosen value (roulette)
inc member_one
endwhile
while ( (member_two < pop) and ((pop$(member_two).fitness*100) < roulette_two) )
inc member_two
endwhile
until (member_one <> member_two)
one_avail$ = available$
two_avail$ = available$
parent_one$ = pop$(member_one).gene
parent_two$ = pop$(member_two).gene
current_city$ = padleft$(str$(rnd(cities-1)+1),"0",4)
pop$(member+pop).gene = pop$(member+pop).gene + current_city$ + ";"
one_avail$ = replace$(one_avail$, current_city$, "0000")
two_avail$ = replace$(two_avail$, current_city$, "0000")
for alelle = 1 to cities - 1 `account for first node already known
num_one = 1
num_two = 1
split string parent_one$, ";"
while ( compare( split word$(num_one), current_city$ ) <> 0)
inc num_one
endwhile
inc num_one
while ( (instr(one_avail$, split word$(num_one)) = 0) and (num_one < cities))
inc num_one
endwhile
if instr(one_avail$, split word$(num_one)) > 0
city_one$ = split word$(num_one)
else
num_one = 1
split string one_avail$, ";"
while ( split word$(num_one) = "0000" )
inc num_one
endwhile
city_one$ = split word$(num_one)
endif
split string parent_two$, ";"
while ( compare( split word$(num_two), current_city$ ) <> 0)
inc num_two
endwhile
inc num_two
while ( (instr(two_avail$, split word$(num_two)) = 0) and (num_two < cities))
inc num_two
endwhile
if instr(two_avail$, split word$(num_two)) > 0
city_two$ = split word$(num_two)
else
num_two = 1
split string two_avail$, ";"
while ( split word$(num_two) = "0000" )
inc num_two
endwhile
city_two$ = split word$(num_two)
endif
cc = val(current_city$)
c1 = val(city_one$)
c2 = val(city_two$)
if ( city_dist( cc, c1 ) <= city_dist( cc, c2 ) )
pop$(member+pop).gene = pop$(member+pop).gene + city_one$ + ";"
current_city$ = city_one$
else
pop$(member+pop).gene = pop$(member+pop).gene + city_two$ + ";"
current_city$ = city_two$
endif
one_avail$ = replace$(one_avail$, current_city$, "0000")
two_avail$ = replace$(two_avail$, current_city$, "0000")
next alelle
endif
`mutation
if (rnd(100) <= (mut*100))
repeat
parent = rnd(pop-1)+1
until (pop$(parent+pop).gene <> "")
repeat
city_2$ = str$(rnd(cities-1)+1)
city_1$ = str$(rnd(cities-1)+1)
until ( (val(city_1$)) <> (val(city_2$)) and (val(city_1$) <> 1) and (val(city_2$) <> 1) ) `find two cities to replace and make sure they're NOT the same city....kinda pointless if they are
city_1$=padleft$(city_1$, "0", 4) `pad it to make it conform with the rest of the string
city_2$=padleft$(city_2$, "0", 4)
place_1=instr( pop$(parent+pop).gene, city_1$) `find position of the city to replace in the string
place_2=instr( pop$(parent+pop).gene, city_2$)
pop$(parent+pop).gene = replace$( pop$(parent+pop).gene, place_1, 4, city_2$) `replace one city with the other
pop$(parent+pop).gene = replace$( pop$(parent+pop).gene, place_2, 4, city_1$)
endif
next member
calc_dist(cities, 1, pop*2)
sort array pop$(), 4 `sort array in ascending order by distance
fitness_all(pop, cities)
endfunction
function fitness_all(pop, cities)
total# = 0.0
total2# = 0.0
`need to calculate both parent and child, though parent really only needs to be calculated on first iteration..
for member = 1 to pop
pop$(member).fitness = 1.0 / pop$(member).dist
pop$(member).fit_ind = pop$(member).fitness
pop$(member+pop).fitness = 1.0 / pop$(member+pop).dist
pop$(member+pop).fit_ind = pop$(member+pop).fitness
total_fit# = total_fit# + pop$(member).fitness
pop$(member).fitness = total_fit#
total_fit2# = total_fit2# + pop$(member+pop).fitness
pop$(member+pop).fitness = total_fit2#
next member
for member = 1 to pop
pop$(member).fitness = pop$(member).fitness / total_fit#
pop$(member+pop).fitness = pop$(member+pop).fitness / total_fit2#
next member
avg# = total_fit# / pop
endfunction
function calc_dist(cities, start, finish)
for member = start to finish
split string pop$(member).gene, ";" `split the gene up into different sections using ";" as the splitter
for city = 1 to cities `cycle through all of the cities present in the string, start from 1 and end 1 away from end to compensate for cyclic nature
city_1 = val(split word$(city)) `city is the location in the string you're looking for, split word$() returns the value at that location
city_2 = val(split word$(city+1))
dist# = dist# + city_dist(city_1, city_2) `add all of the distances together
next city
city_1 = val(split word$(cities+1)) `account for the last city needing to be linked to the first city
city_2 = val(split word$(1))
dist# = dist# + city_dist(city_1, city_2) `add the distance on...
total# = total# + dist# `accumulated total of all the distances, at the end each city distance divided by total city distance (when summed, the result should be 1)
pop$(member).dist = dist#
dist# = 0 `reset distance
next member
endfunction
function setup_arrays(pop)
load image "uscapzm.jpg", 1
open to read 1, "US Capitals.txt"
while ( file end(1) = 0 )
read string 1,a$
inc cities
endwhile
close file 1
open to read 1, "US Capitals.txt"
cls:cls
dim pop$(pop*2) as _pop `create array to hold the population and fitness
dim city_loc(cities) as _city_loc `create an array to hold the x and y position of each city
dim city_dist(cities, cities) as double float `create array to hold distances between every city
`first populate the arrays with every city in order
for gene = 1 to cities `cycle through every gene except the last one because it doesn't need a delimiter
alelle$ = alelle$ + padleft$( str$(gene), "0", 4) + ";" `add delimiter to the string if it isn't the last item
if gene = 1 `set every city except first one as available for crossover
avail$ = avail$ + "0;"
else
avail$ = avail$ + "1;"
endif
next gene
for member = 1 to pop*2 `cycle through every member
pop$(member).gene = alelle$ `set member equal to the alelle
next member
`mix up the array elements
for member = 1 to (pop*2) `cycle through every member
for gene = 1 to cities `cycle through every gene
repeat
city_2$ = str$(rnd(cities-1)+1)
city_1$ = str$(rnd(cities-1)+1)
until ( (val(city_1$)) <> (val(city_2$)) and (val(city_1$) <> 1) and (val(city_2$) <> 1) ) `find two cities to replace and make sure they're NOT the same city....kinda pointless if they are
city_1$=padleft$(city_1$, "0", 4) `pad it to make it conform with the rest of the string
city_2$=padleft$(city_2$, "0", 4)
place_1=instr( pop$(member).gene, city_1$) `find position of the city to replace in the string
place_2=instr( pop$(member).gene, city_2$)
pop$(member).gene = replace$( pop$(member).gene, place_1, 4, city_2$) `replace one city with the other
pop$(member).gene = replace$( pop$(member).gene, place_2, 4, city_1$)
next gene
next member
`determine location for every city
for city = 1 to cities
read string 1, line$
split string line$, ","
city_loc(city).x = val(split word$(1))
city_loc(city).y = val(split word$(2))
next city
close file 1
`calculate the distances between every city
for city_1 = 1 to cities
for city_2 = 1 to cities
d_x# = (city_loc(city_1).x - city_loc(city_2).x)
d_y# = (city_loc(city_1).y - city_loc(city_2).y)
city_dist(city_1, city_2) = sqrt((d_x# * d_x#) + (d_y# * d_y#))
if city_1 = city_2 then city_dist(city_1, city_2) = 9999999999
next city_2
next city_1
for generate = 1 to cities `used for crossover
available$ = available$ + padleft$(str$(generate), "0", 4) + ";"
next generate
endfunction cities
function setup_display()
perform checklist for display modes
for c=1 to checklist quantity()
width=checklist value a(c)
height=checklist value b(c)
depth=checklist value c(c)
next c
set display mode width, height, 16
set window position 0,0
endfunction
I've also attached a .zip with a compiled version, as well as the files needed to run the program (if editing/compiling, Matrix1Utils needed).
It works well, but I need to optimize the crossover more...
