lgados.bas

An Introduction to Genetic Algorithms for Scientists and Engineers By David Coley, World Scientific

'-----------------------------------------------------------------------
'LGADOS - A DOS based version of the LGA Genetic Algorithm.

'For Distribution with the book "An Introduction to Genetic Algorithms for
'Scientists and Engineers", World Scientific 1998.

'David A. Coley
'Complex Systems Group
'Physics Building
'University of Exeter
'Exeter
'EX4 4QL
'UK
'email [e-mail]

'Please email comments and corrections to [e-mail]

'Version = 17th July 1998

'Before using this software please check for updates and corrections at
'http://www.ex.ac.uk/cee/ga


'-----------------------------------------------------------------------


'------- DECLARE ALL THE SUBROUTINES (PROCEDURES) USED BY THE PROGRAM -------

DECLARE SUB OpenFiles ()
DECLARE SUB Scaling (ScalingConstant!, FittestIndividual!, SumFitness!, MeanFitness!)
DECLARE SUB Elite (SumFitness!, FittestIndividual!)
DECLARE SUB Selection (mate!, SumFitness!, MeanFitness!)
DECLARE SUB CrossOver (Mate1!, Mate2!, NewIndividual!)
DECLARE SUB FindFitness ()
DECLARE SUB PrintGeneration (Generation, MeanFitness!, FittestIndividual!)
DECLARE SUB DefineRange ()
DECLARE SUB FindIntegers ()
DECLARE SUB FindUnknowns ()
DECLARE SUB InitialPopulation ()
DECLARE SUB NoCrossover (Mate1!, Mate2!, NewIndividual!)
DECLARE SUB Mutate ()
DECLARE SUB Replace ()
DECLARE SUB Statistics (MeanFitness!, SumFitness!, FittestIndividual!, Generation)

'------- SET ALL THE IMPORTANT FIXED PARAMETERS. -------

'These should be set by the user.
CONST PopulationSize = 20 'Must be even.
CONST NumberOfUnknowns = 2
CONST SubstringLength = 12 'All sub-strings have the same length.
CONST TotalStringLength = NumberOfUnknowns * SubstringLength
CONST MaxGeneration = 20 'G.
CONST CrossOverProbability = .6  'Pc. >=0 and <=1.
CONST MutationProbability = 1 / TotalStringLength  'Pm, >=0 and <1.
CONST Elitism = "on" '"on" or "off".
CONST ScalingConstant = 1.2 'A value of 0 implies no scaling.


'------DECLARE ALL SHARED (IE. GLOBAL) VARIABLES----------

'The arrays that hold the individuals within the current population.
DIM SHARED Unknowns(PopulationSize, NumberOfUnknowns) AS SINGLE
DIM SHARED Integers(PopulationSize, NumberOfUnknowns) AS LONG
DIM SHARED Strings(PopulationSize, TotalStringLength) AS INTEGER
DIM SHARED Fitness(PopulationSize) AS SINGLE

'The new population.
DIM SHARED NewStrings(PopulationSize, TotalStringLength) AS INTEGER

'The array that defines the range of the unknowns.
DIM SHARED Range(2, NumberOfUnknowns) AS SINGLE

'The best individual in the past generation. Used if elitism is on.
DIM SHARED EliteString(TotalStringLength) AS INTEGER
DIM SHARED EliteIntegers(NumberOfUnknowns) AS LONG
DIM SHARED EliteFitness AS SINGLE
DIM SHARED EliteUnknowns(NumberOfUnknowns) AS SINGLE

CLS  'Clear the screen.

CALL DefineRange  'Define the range of each unknown. These should also be set by the user.

'Set the random number generator so it produces a different set of numbers
'each time LGADOS is run.
RANDOMIZE TIMER

CALL OpenFiles  'Open files used to store results.

'------- START OF THE GENETIC ALGORITHM -------

'------- CREATE AN INITIAL POPULATION, GENERATION 1 ------

Generation = 1

CALL InitialPopulation  'Build a population of strings at random.

CALL FindFitness  'Find the fitness of each member of the population.

CALL Statistics(MeanFitness, SumFitness, FittestIndividual, Generation)  'Find the mean fitness and the fittest individual.

CALL PrintGeneration(Generation, MeanFitness, FittestIndividual)  'Print generation to file.

CALL Scaling(ScalingConstant, FittestIndividual, SumFitness, MeanFitness)   'If linear fitness scaling is "on" then scale population prior to selection.

'------- LOOP OVER ALL THE GENERATIONS -------

FOR Generation = 2 TO MaxGeneration

  FOR NewIndividual = 1 TO PopulationSize STEP 2  'Loop over the population choosing pairs of mates.

    CALL Selection(Mate1, SumFitness, MeanFitness)  'Choose first mate.
    CALL Selection(Mate2, SumFitness, MeanFitness)  'Choose second mate.
                                                       
    'Pass individuals to the temporary population either with or without performing crossover.
    IF RND <= CrossOverProbability THEN  'Perform crossover.
      CALL CrossOver(Mate1, Mate2, NewIndividual)
    ELSE 'Don't perform crossover.
      CALL NoCrossover(Mate1, Mate2, NewIndividual)  'Don't perform crossover.
    END IF

  NEXT NewIndividual

  CALL Mutate  'Mutate the temporary population.

  CALL Replace  'Replace the old population completely by the new one.

  CALL FindUnknowns  'De-code the new population to integers then real numbers.

  CALL FindFitness  'Find the fitness of each member of the population.

  CALL Statistics(MeanFitness, SumFitness, FittestIndividual, Generation)  'Find the mean fitness and the fittest individual.
        
  CALL PrintGeneration(Generation, MeanFitness, FittestIndividual)  'Print generation to file.

  CALL Scaling(ScalingConstant, FittestIndividual, SumFitness, MeanFitness)  'If linear fitness scaling is "on" then scale population prior to selection.

NEXT Generation  'Process the next generation.

CLOSE  'Close all files

SUB CrossOver (Mate1, Mate2, NewIndividual)
'Perform single point crossover.

CrossSite = INT((TotalStringLength - 1) * RND + 1) 'Pick the cross-site at random.

FOR bit = 1 TO CrossSite 'Swap bits to the left of the cross-site.
  NewStrings(NewIndividual, bit) = Strings(Mate1, bit)
  NewStrings(NewIndividual + 1, bit) = Strings(Mate2, bit)
NEXT bit

FOR bit = CrossSite + 1 TO TotalStringLength 'Swap bits to the right of the cross-site.
  NewStrings(NewIndividual, bit) = Strings(Mate2, bit)
  NewStrings(NewIndividual + 1, bit) = Strings(Mate1, bit)
NEXT bit

END SUB

SUB DefineRange
'Defines the upper and lower bounds of each unknown.
'Add other ranges using the same format if more than two unknowns in the problem.

Unknown = 1 'the first unknown.
Range(1, Unknown) = 0 'The lower bound.
Range(2, Unknown) = 1 'The upper bound.

Unknown = 2 'the second unknown.
Range(1, Unknown) = -3.14159
Range(2, Unknown) = 3.14159

'Add other ranges if more than two unknowns in your problem.

END SUB

SUB Elite (SumFitness, FittestIndividual)
'Applies elitism by replacing a randomly chosen individual by the elite member
'from the previous population if the new max fitness is less then the previous value.

IF Fitness(FittestIndividual) < EliteFitness THEN

  Individual = INT(PopulationSize * RND + 1) 'Chosen individual to be replaced.

  FOR bit = 1 TO TotalStringLength
    Strings(Individual, bit) = EliteString(bit)
  NEXT bit

  Fitness(Individual) = EliteFitness

  FOR Unknown = 1 TO NumberOfUnknowns
    Integers(Individual, Unknown) = EliteIntegers(Unknown)
    Unknowns(Individual, Unknown) = EliteUnknowns(Unknown)
  NEXT Unknown

  FittestIndividual = Individual

END IF

FOR bit = 1 TO TotalStringLength
        EliteString(bit) = Strings(FittestIndividual, bit)
NEXT bit

EliteFitness = Fitness(FittestIndividual)
                      
FOR Unknown = 1 TO NumberOfUnknowns
  EliteIntegers(Unknown) = Integers(FittestIndividual, Unknown)
  EliteUnknowns(Unknown) = Unknowns(FittestIndividual, Unknown)
NEXT Unknown

END SUB

SUB FindFitness
'The problem at hand is used to assign a positive (or zero) fitness to each individual in turn.

'The problem is f = x^2 + sin(y).
FOR Individual = 1 TO PopulationSize
  Fitness(Individual) = Unknowns(Individual, 1) ^ 2 + SIN(Unknowns(Individual, 2))
  IF Fitness(Individual) < 0 THEN Fitness(Individual) = 0
NEXT Individual
        
END SUB

SUB FindIntegers
'Decode the strings to sets of decimal integers.

DIM bit AS INTEGER

FOR Individual = 1 TO PopulationSize

  bit = TotalStringLength + 1
  FOR Unknown = NumberOfUnknowns TO 1 STEP -1

    Integers(Individual, Unknown) = 0
    FOR StringBit = 1 TO SubstringLength

      bit = bit - 1
      IF Strings(Individual, bit) = 1 THEN
        Integers(Individual, Unknown) = Integers(Individual, Unknown) + 2 ^ (StringBit - 1)
      END IF

    NEXT StringBit

  NEXT Unknown

NEXT Individual
    
END SUB

SUB FindUnknowns
'Decode the strings to real numbers.

CALL FindIntegers 'First decode the strings to sets of decimal integers.

'Now convert these integers to reals.
FOR Individual = 1 TO PopulationSize
  FOR Unknown = 1 TO NumberOfUnknowns
    Unknowns(Individual, Unknown) = Range(1, Unknown) + Integers(Individual, Unknown) * (Range(2, Unknown) - Range(1, Unknown)) / (2 ^ SubstringLength - 1)
  NEXT Unknown
NEXT Individual
   
END SUB

SUB InitialPopulation
'Create the initial random population.

FOR Individual = 1 TO PopulationSize

  FOR bit = 1 TO TotalStringLength
    IF RND > .5 THEN
      Strings(Individual, bit) = 1
    ELSE
      Strings(Individual, bit) = 0
    END IF
  NEXT bit
        
NEXT Individual

CALL FindUnknowns 'Decode strings to real numbers.

END SUB

SUB Mutate
'Visit each bit of each string very occasionally flipping a "1" to a "0" or vice versa.

FOR Individual = 1 TO PopulationSize
  FOR bit = 1 TO TotalStringLength
    
    'Throw a random number and see if it is less than or equal to the mutation probability.
    IF RND <= MutationProbability THEN
           
      'Mutate.
      IF NewStrings(Individual, bit) = 1 THEN
              NewStrings(Individual, bit) = 0
      ELSE
              NewStrings(Individual, bit) = 1
      END IF

    END IF
                 
  NEXT bit

NEXT Individual
             
END SUB

SUB NoCrossover (Mate1, Mate2, NewIndividual)
'Pass the selected strings to the temporary population without applying crossover.

FOR bit = 1 TO TotalStringLength
  NewStrings(NewIndividual, bit) = Strings(Mate1, bit)
  NewStrings(NewIndividual + 1, bit) = Strings(Mate2, bit)
NEXT bit

END SUB

SUB OpenFiles
'Open result files. See Chapter 2 for a description of their contents.

OPEN "LGADOS.RES" FOR OUTPUT AS #1
OPEN "LGADOS.ALL" FOR OUTPUT AS #2

END SUB

SUB PrintGeneration (Generation, MeanFitness, FittestIndividual)
'Print results to the screen and the files.

PRINT Generation; Fitness(FittestIndividual); MeanFitness;  'Screen.
PRINT #1, Generation; ","; Fitness(FittestIndividual); ","; MeanFitness; 'File LGADOS.RES.

FOR Unknown = 1 TO NumberOfUnknowns
  PRINT Unknowns(FittestIndividual, Unknown); 'Screen.
  PRINT #1, ","; Unknowns(FittestIndividual, Unknown); ","; 'File LGADOS.RES
NEXT Unknown

PRINT 'Carriage return.
PRINT #1, 'Carriage return.

FOR Individual = 1 TO PopulationSize
 
  PRINT #2, Generation; ","; Fitness(Individual); ","; 'File LGADOS.ALL

  FOR Unknown = 1 TO NumberOfUnknowns
    PRINT #2, Unknowns(Individual, Unknown); ","; 'File LGADOS.ALL
  NEXT Unknown
 
  FOR bit = 1 TO TotalStringLength
    PRINT #2, RIGHT$(STR$(Strings(Individual, bit)), 1); ","; 'File LGADOS.ALL
  NEXT bit
 
  PRINT #2, 'Carriage return

NEXT Individual

END SUB

SUB Replace
'Replace the old population with the new one.

FOR Individual = 1 TO PopulationSize
  FOR bit = 1 TO TotalStringLength
    Strings(Individual, bit) = NewStrings(Individual, bit)
  NEXT bit
NEXT Individual

ERASE NewStrings 'Clear the old array of strings.

END SUB

SUB Scaling (ScalingConstant, FittestIndividual, SumFitness, MeanFitness)

'Apply Linear Fitness Scaling,
'      scaledfitness = a * fitness + b.
'Subject to,
'      meanscaledfitness = meanfitness
'and
'      bestscaledfitness = c * meanfitness,
'where c, the scaling constant, is set by the user.

'If the scaling constant is set to zero, or all individuals have the same
'fitness, scaling is not applied.
IF ScalingConstant <> 0 AND Fitness(FittestIndividual) - MeanFitness > 0 THEN
  'Find a and b.

  a = (ScalingConstant - 1) * MeanFitness / (Fitness(FittestIndividual) - MeanFitness)

  b = (1 - a) * MeanFitness

  'Adjust the fitness of all members of the population.
  SumFitness = 0
  FOR Individual = 1 TO PopulationSize
    Fitness(Individual) = a * Fitness(Individual) + b
    IF Fitness(Individual) < 0 THEN Fitness(Individual) = 0 'Avoid negative values near the end of a run.
    SumFitness = SumFitness + Fitness(Individual) 'Adjust the sum of all the fitnesses.
  NEXT Individual

  'Adjust the mean of all the fitnesses.
  MeanFitness = SumFitness / PopulationSize
END IF

END SUB

SUB Selection (mate, SumFitness, MeanFitness)
'Select a single individual by fitness proportional selection.

Sum = 0
Individual = 0

RouletteWheel = RND * SumFitness

DO
  Individual = Individual + 1
  Sum = Sum + Fitness(Individual)
LOOP UNTIL Sum >= RouletteWheel OR Individual = PopulationSize

mate = Individual

END SUB

SUB Statistics (MeanFitness, SumFitness, FittestIndividual, Generation)
'Calculate the sum of fitness across the population and find the best individual,
'then apply elitism if required.

FittestIndividual = 0
MaxFitness = 0

FOR Individual = 1 TO PopulationSize
  IF Fitness(Individual) > MaxFitness THEN
    MaxFitness = Fitness(Individual)
    FittestIndividual = Individual
  END IF
NEXT Individual

IF Elitism = "on" THEN 'Apply elitism.
  CALL Elite(SumFitness, FittestIndividual)
END IF

SumFitness = 0 'Sum the fitness.
FOR Individual = 1 TO PopulationSize
  SumFitness = SumFitness + Fitness(Individual)
NEXT Individual

'Find the average fitness of the population.
MeanFitness = SumFitness / PopulationSize

END SUB