'----------------------------------------------------------------------- '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 D.A.Coley@exeter.ac.uk 'Please email comments and corrections to D.A.Coley@exeter.ac.uk '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