## "Genetic Algorithm Tutorial" only the source code

D.J.Peters
Posts: 7852
Joined: May 28, 2005 3:28

### "Genetic Algorithm Tutorial" only the source code

http://www.ai-junkie.com/index.html

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.7const as single  MUTATION_RATE  = 0.001const as integer POP_SIZE       = 40 ' must be an even numberconst as integer CHROMO_LENGTH  = 200const as integer GENE_LENGTH    = 4const as integer MAX_ALLOWABLE_GENERATIONS = 200' define a data structure which will define a chromosometype TChromo  bits    as string  fitness as singleend type' global storage for our population of chromosomes.dim shared g_Population(POP_SIZE-1) as TChromo' Initializes chromosonefunction Chromo(bits as string = "",fitness as single = 0.0) as TChromo  dim result as TChromo  result.bits    = bits  result.fitness = fitness  return resultend 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 resultend function' converts a binary string into a decimal integerfunction 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 resultend 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 bufferfunction 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 cBuffend function' given a string of bits and a target value ' this function will calculate its representation' and return a fitness score accordinglyfunction 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 resultend function' given an integer this function outputs its meaning to the screensub 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 ifend sub' decodes and prints a chromo to screensub 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  printend sub' Mutates a chromosomes bits dependent on the MUTATION_RATEsub 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  nextend sub' selects a chromosome from the population via roulette wheel selectionfunction 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 resultend function'' main'dim Target       as singledim TotalFitness as singledim i            as integerdim GenerationsRequiredToFindASolution as integerdim cPop      as integerdim crossover as integerdim bFound    as integer ' booleandim temp(POP_SIZE-1) as TChromodim bits1 as stringdim bits2 as stringdim t1    as string dim t2    as stringprint "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  wendwend`
Mentat
Posts: 332
Joined: Oct 27, 2007 15:23
Location: NC, US
Contact:
Cool. I'm a GA fan.