Code: Select all
' program Ga_Tutorial:
' code to illustrate the use of a genetic algorithm
' to solve the problem described at
' http://www.ai-junkie.com/ga/intro/gat1.html
'
' by Mat Buckland aka fupp
' ported to FreeBasic by Detlef Jürgen Peters (aka Joshy)
const as single CROSSOVER_RATE = 0.7
const as single MUTATION_RATE = 0.001
const as integer POP_SIZE = 40 ' must be an even number
const as integer CHROMO_LENGTH = 200
const as integer GENE_LENGTH = 4
const as integer MAX_ALLOWABLE_GENERATIONS = 200
' define a data structure which will define a chromosome
type TChromo
bits as string
fitness as single
end type
' global storage for our population of chromosomes.
dim shared g_Population(POP_SIZE-1) as TChromo
' Initializes chromosone
function Chromo(bits as string = "",fitness as single = 0.0) as TChromo
dim result as TChromo
result.bits = bits
result.fitness = fitness
return result
end function
' This function returns a string of random 1s and 0s of the desired length.
function GetRandomBits(length as integer) as string
dim i as integer
dim result as string
result = space(length)
for i = 0 to length-1
if (rnd > 0.5) then
result[i]= asc("1")
else
result[i]= asc("0")
end if
next
return result
end function
' converts a binary string into a decimal integer
function BinToDec(bits as string) as integer
dim i as integer, value_to_add as integer
dim result as integer = 0
value_to_add = 1
for i = len(bits)-1 to 0 step -1
if bits[i] = asc("1") then
result = result + value_to_add
end if
value_to_add = value_to_add * 2
next
return result
end function
' Given a chromosome this function will step through the genes one at a time and insert
' the decimal values of each gene (which follow the operator - number - operator rule)
' into a buffer. Returns the number of elements in the buffer
function ParseBits(bits as string, buffer() as integer) as integer
dim i as integer
dim cBuff as integer
dim this_gene as integer
dim bOperator as integer ' boolean
' counter for buffer position
cBuff= 0
' step through bits a gene at a time until end and store decimal values
' of valid operators and numbers. Don't forget we are looking for operator -
' number - operator - number and so on...
' We ignore the unused genes 1111 and 1110
' flag to determine if we are looking for an operator or a number
bOperator = -1 'true
i=1
while i <= CHROMO_LENGTH
' convert the current gene to decimal
this_gene = BinToDec(mid(bits, i, GENE_LENGTH))
' find a gene which represents an operator
if bOperator then
if ( (this_gene >= 10) and (this_gene <= 13) ) then
bOperator=0 ' false
buffer(cBuff)= this_gene
cBuff= cBuff + 1
end if
else
' find a gene which represents a number
if (this_gene <= 9) then
bOperator=-1 ' true
buffer(cBuff) = this_gene
cBuff = cBuff + 1
end if
end if
i = i + GENE_LENGTH
wend ' next gene
' now we have to run through buffer to see if a possible divide by zero
' is included and delete it. (ie a '/' followed by a '0'). We take an easy
' way out here and just change the '/' to a '+'. This will not effect the
' evolution of the solution
for i= 0 to cBuff-1
if ( (buffer(i) = 13) and (buffer(i+1) = 0) ) then
buffer(i) = 10
end if
next
return cBuff
end function
' given a string of bits and a target value
' this function will calculate its representation
' and return a fitness score accordingly
function AssignFitness(bits as string,target_value as single) as single
' holds decimal values of gene sequence
dim buffer((CHROMO_LENGTH\GENE_LENGTH)-1) as integer
dim i as integer
dim num_elements as integer
num_elements = ParseBits(bits, buffer())
' ok, we have a buffer filled with valid values of:
' operator - number - operator - number..
' now we calculate what this represents.
dim result as single = 0.0
i = 0
while i < (num_elements-1)
select case buffer(i)
case 10: result= result + buffer(i+1)
case 11: result= result - buffer(i+1)
case 12: result= result * buffer(i+1)
case 13: result= result / buffer(i+1)
end select
i = i + 2
wend
' Now we calculate the fitness.
' First check to see if a solution has been found
' and assign an arbitarily high fitness score if this is so.
if (result = target_value) then
result = 999
else
result = 1.0 / abs(target_value - result)
end if
return result
end function
' given an integer this function outputs its meaning to the screen
sub PrintGeneSymbol(value as integer)
if (value < 10 ) then
print value & " ";
else
select case value
case 10: print "+";
case 11: print "-";
case 12: print "*";
case 13: print "/";
end select
print " ";
end if
end sub
' decodes and prints a chromo to screen
sub PrintChromo(bits as string)
' holds decimal values of gene sequence
dim buffer((CHROMO_LENGTH\GENE_LENGTH)-1) as integer
dim i as integer
dim num_elements as integer
' parse the bit string
num_elements = ParseBits(bits, buffer())
' now we have the buffer step through and print values
for i = 0 to num_elements-1
PrintGeneSymbol(buffer(i))
next
print
end sub
' Mutates a chromosomes bits dependent on the MUTATION_RATE
sub Mutate(bits as string)
dim i as integer
for i = 0 to len(bits)-1
if (rnd < MUTATION_RATE) then
if bits[i] = asc("1") then
bits[i] = asc("0")
else
bits[i] = asc("1")
end if
end if
next
end sub
' selects a chromosome from the population via roulette wheel selection
function Roulette(total_fitness as single) as string
dim Slice as single
dim FitnessSoFar as single
dim i as integer
dim result as string = ""
' generate a random number between 0 & total fitness count
Slice = rnd * total_fitness
' go through the chromosones adding up the fitness so far
FitnessSoFar=0
for i = 0 to POP_SIZE-1
FitnessSoFar = FitnessSoFar + g_Population(i).fitness
' if the fitness so far > random number return the chromo at this point
if (FitnessSoFar >= Slice) then
return g_Population(i).bits
end if
next
return result
end function
'
' main
'
dim Target as single
dim TotalFitness as single
dim i as integer
dim GenerationsRequiredToFindASolution as integer
dim cPop as integer
dim crossover as integer
dim bFound as integer ' boolean
dim temp(POP_SIZE-1) as TChromo
dim bits1 as string
dim bits2 as string
dim t1 as string
dim t2 as string
print "press [ctrl]+[c] to abort"
print
while 1 ' run endless
' seed the random number generator
Randomize(timer)
print
' get a target number from the user. (no error checking)
Input "Input a target number: "; Target
' first create a random population
for i = 0 to POP_SIZE-1
g_Population(i) = Chromo(GetRandomBits(CHROMO_LENGTH))
next
GenerationsRequiredToFindASolution=0
' we will set this flag if a solution has been found
bFound = 0 ' false
' enter the main GA loop
while (bFound=0)
' this is used during roulette wheel sampling
TotalFitness = 0
' test and update the fitness of the population.
for i = 0 to POP_SIZE-1
g_Population(i).fitness = AssignFitness(g_Population(i).bits, Target)
TotalFitness = TotalFitness + g_Population(i).fitness
next
' check to see if we have found any solutions (fitness will be 999)
for i = 0 to POP_SIZE-1
if (g_Population(i).fitness = 999) then
print "Solution found in " & GenerationsRequiredToFindASolution & " generations!"
PrintChromo(g_Population(i).bits)
bFound =-1 ' true
exit for
end if
next
if bFound then exit while
' create a new population by roulette wheel sampling of the
' old population. Including crossover and mutation.
cPop= 0
' loop until we have created POP_SIZE new chromosomes
while (cPop < POP_SIZE)
' we are going to create the new population by grabbing members
' of the old population 2 at a time via roulette wheel selection.
bits1=Roulette(TotalFitness)
bits2=Roulette(TotalFitness)
' now add crossover if required
if (rnd < CROSSOVER_RATE) then
' create a random crossover point
crossover = int(rnd*CHROMO_LENGTH)+1
t1=mid(bits1, 1, crossover) & mid(bits2, crossover+1, CHROMO_LENGTH)
t2=mid(bits2, 1, crossover) & mid(bits1, crossover+1, CHROMO_LENGTH)
'assert(length(t1) = CHROMO_LENGTH)
'assert(length(t2) = CHROMO_LENGTH)
bits1= t1
bits2= t2
end if
' now mutate
Mutate(bits1)
Mutate(bits2)
' now add to new population
temp(cPop)= Chromo(bits1)
cPop= cPop + 1
temp(cPop)= Chromo(bits2)
cPop= cPop + 1
wend
' copy temp population into main population array
for i = 0 to POP_SIZE-1
g_Population(i)= temp(i)
next
GenerationsRequiredToFindASolution+=1
' exit app if no solution found within the maximum
' allowable number of generations
if (GenerationsRequiredToFindASolution > MAX_ALLOWABLE_GENERATIONS) then
print "No solutions found this run"
print
bFound=-1 ' true
end if
wend
wend