Tweet
' This is a PowerBasic translation I have made of a Genetic Algorithm
' program in BASIC for DOS made by David A. Coley.
' The original program is available at this link:
'
' http://www.centres.ex.ac.uk/cee/ga/LGADOS.BAS
'
' The program has been written to accompany David A. Coley's fine book:
' "An Introduction to Genetic Algorithms for 'Scientists and Engineers",
' World Scientific 1998.
'
' Besides crossover and mutation this program can apply elitism
' and selection proportional to fitness ("roulettewheel selection").
'
' In the present simple illustrative version of the program the
' particular problem to be solved by the genetic algorithm is to
' maximize the function f = x^2 + sin(y) (see SUB FindFitness)
' for the following intervals: x (0 to 1) and y (-PI to PI)
' (see SUB DefineRange). The program will very fast approach the
' optimal values for x: 1 and y: PI/2 = 1.57079. This simple problem,
' which may easily be solved directly using simple mathematics,
' only serves to illustrate the method. Other more complex problems,
' which may not be solved so easily in a simple direct way e.g. the
' Traveling Salesman Problem (TSP), can be solved using
' the genetic algorithm by adapting the subroutines mentioned above
' and some other parts of the program (including
' SUB DisplayGeneration) to the problem at hand.
'
' Best regards
'
' Erik Christensen ---------- March 22, 2008
'
' P.S. See also the simple genetic algorithm demonstration program
' in this thread: http://www.powerbasic.com/support/pb...ad.php?t=36549
' program in BASIC for DOS made by David A. Coley.
' The original program is available at this link:
'
' http://www.centres.ex.ac.uk/cee/ga/LGADOS.BAS
'
' The program has been written to accompany David A. Coley's fine book:
' "An Introduction to Genetic Algorithms for 'Scientists and Engineers",
' World Scientific 1998.
'
' Besides crossover and mutation this program can apply elitism
' and selection proportional to fitness ("roulettewheel selection").
'
' In the present simple illustrative version of the program the
' particular problem to be solved by the genetic algorithm is to
' maximize the function f = x^2 + sin(y) (see SUB FindFitness)
' for the following intervals: x (0 to 1) and y (-PI to PI)
' (see SUB DefineRange). The program will very fast approach the
' optimal values for x: 1 and y: PI/2 = 1.57079. This simple problem,
' which may easily be solved directly using simple mathematics,
' only serves to illustrate the method. Other more complex problems,
' which may not be solved so easily in a simple direct way e.g. the
' Traveling Salesman Problem (TSP), can be solved using
' the genetic algorithm by adapting the subroutines mentioned above
' and some other parts of the program (including
' SUB DisplayGeneration) to the problem at hand.
'
' Best regards
'
' Erik Christensen ---------- March 22, 2008
'
' P.S. See also the simple genetic algorithm demonstration program
' in this thread: http://www.powerbasic.com/support/pb...ad.php?t=36549
Code:
' Genetic algorithm at work
'
' This is a PowerBasic translation I have made of a Genetic Algorithm
' program in BASIC for DOS made by David A. Coley.
' The original program is available at this link:
'
' http://www.centres.ex.ac.uk/cee/ga/LGADOS.BAS
'
' The program has been written to accompany David A. Coley's fine book:
' "An Introduction to Genetic Algorithms for 'Scientists and Engineers",
' World Scientific 1998.
'
' Besides crossover and mutation this program can apply elitism
' and selection proportional to fitness ("roulettewheel selection").
'
' In the present simple illustrative version of the program the
' particular problem to be solved by the genetic algorithm is to
' maximize the function f = x^2 + sin(y) (see SUB FindFitness)
' for the following intervals: x (0 to 1) and y (-PI to PI)
' (see SUB DefineRange). The program will very fast approach the
' optimal values for x: 1 and y: PI/2 = 1.57079. This simple problem,
' which may easily be solved directly using simple mathematics,
' only serves to illustrate the method. Other more complex problems,
' which may not be solved so easily in a simple direct way e.g. the
' Traveling Salesman Problem (TSP), can be solved using
' the genetic algorithm by adapting the subroutines mentioned above
' and some other parts of the program (including
' SUB DisplayGeneration) to the problem at hand.
'
' Best regards
'
' Erik Christensen ---------- March 22, 2008
'
' P.S. See also the simple genetic algorithm demonstration program
' in this thread: http://www.powerbasic.com/support/pbforums/showthread.php?t=36549
'
#COMPILE EXE
#DIM ALL
#INCLUDE "WIN32API.INC"
%IDC_BUTTON1 = 1004
%IDC_BUTTON2 = 1005
%IDC_LABEL1 = 1002
%IDC_LISTBOX1 = 1006
%IDD_DIALOG1 = 101
'
FUNCTION PBMAIN()
LOCAL lRslt AS LONG
LOCAL hDlg AS DWORD
DIALOG NEW %HWND_DESKTOP, "Genetic Algorithm Demonstration", 70, 70, 429, 239, _
%WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME OR %WS_CAPTION OR _
%WS_SYSMENU OR %WS_MINIMIZEBOX OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR _
%DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, _
%WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
%WS_EX_RIGHTSCROLLBAR, TO hDlg
CONTROL ADD BUTTON, hDlg, %IDC_BUTTON1, "&Run Program", 148, 212, 128, 16
CONTROL ADD BUTTON, hDlg, %IDC_BUTTON2, "E&xit", 360, 212, 56, 16
CONTROL ADD LABEL, hDlg, %IDC_LABEL1, "Generation"+$TAB+" Max Fitness"+$TAB+$TAB+ _
"MeanFitness"+$TAB+$TAB+"X"+$TAB+$TAB+"Y", 12, 12, 404, 12
CONTROL ADD LISTBOX, hDlg, %IDC_LISTBOX1, , 12, 24, 404, 164, %WS_CHILD _
OR %WS_VISIBLE OR %WS_TABSTOP OR %WS_VSCROLL OR _
%LBS_NOTIFY OR %LBS_USETABSTOPS, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR _
%WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
FUNCTION = lRslt
END FUNCTION
'
SUB CrossOver(BYREF Mate1 AS LONG, BYREF Mate2 AS LONG, BYREF NewIndividual AS LONG, _
BYVAL TotalStringLength AS LONG, BYREF NewStrings() AS LONG, BYREF Strings() AS LONG)
'Perform single point crossover.
LOCAL CrossSite AS LONG, BitB AS LONG
CrossSite = INT((TotalStringLength - 1) * RND + 1) 'Pick the cross-site at random.
FOR BitB = 1 TO CrossSite 'Swap bits to the left of the cross-site.
NewStrings(NewIndividual, BitB) = Strings(Mate1, BitB)
NewStrings(NewIndividual + 1, BitB) = Strings(Mate2, BitB)
NEXT BitB
FOR BitB = CrossSite + 1 TO TotalStringLength 'Swap bits to the right of the cross-site.
NewStrings(NewIndividual, BitB) = Strings(Mate2, BitB)
NewStrings(NewIndividual + 1, BitB) = Strings(Mate1, BitB)
NEXT BitB
END SUB
'
SUB DefineRange(BYREF Range() AS SINGLE)
'Defines the upper and lower bounds of each unknown.
'Add other ranges using the same format if more than two unknowns in the problem.
LOCAL Unknown AS LONG
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(BYREF SumFitness AS SINGLE, BYREF FittestIndividual AS LONG, BYREF Fitness() AS SINGLE, _
BYREF EliteFitness AS SINGLE, BYREF EliteString() AS LONG, BYREF EliteIntegers() AS LONG, _
BYREF EliteUnknowns() AS SINGLE, BYREF Strings() AS LONG, BYREF Integers() AS LONG, _
BYREF Unknowns() AS SINGLE, BYVAL TotalStringLength AS LONG, BYVAL NumberOfUnknowns AS LONG, _
BYVAL PopulationSize AS LONG)
LOCAL BitB AS LONG, Individual AS LONG, Unknown AS LONG
'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 BitB = 1 TO TotalStringLength
Strings(Individual, BitB) = EliteString(BitB)
NEXT BitB
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 BitB = 1 TO TotalStringLength
EliteString(BitB) = Strings(FittestIndividual, BitB)
NEXT BitB
EliteFitness = Fitness(FittestIndividual)
FOR Unknown = 1 TO NumberOfUnknowns
EliteIntegers(Unknown) = Integers(FittestIndividual, Unknown)
EliteUnknowns(Unknown) = Unknowns(FittestIndividual, Unknown)
NEXT Unknown
END SUB
'
SUB FindFitness(BYVAL PopulationSize AS LONG, BYREF Fitness() AS SINGLE, BYREF Unknowns() AS SINGLE)
LOCAL Individual AS LONG
'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(BYVAL PopulationSize AS LONG, BYVAL TotalStringLength AS LONG, BYVAL NumberOfUnknowns AS LONG, _
BYREF Integers() AS LONG, BYVAL SubstringLength AS LONG, BYREF Strings() AS LONG)
'Decode the strings to sets of decimal integers.
DIM BitB AS LOCAL LONG
LOCAL Individual AS LONG, Unknown AS LONG, StringBit AS LONG
FOR Individual = 1 TO PopulationSize
BitB = TotalStringLength + 1
FOR Unknown = NumberOfUnknowns TO 1 STEP -1
Integers(Individual, Unknown) = 0
FOR StringBit = 1 TO SubstringLength
BitB = BitB - 1
IF Strings(Individual, BitB) = 1 THEN
Integers(Individual, Unknown) = Integers(Individual, Unknown) + 2 ^ (StringBit - 1)
END IF
NEXT StringBit
NEXT Unknown
NEXT Individual
END SUB
'
SUB FindUnknowns(BYVAL PopulationSize AS LONG, BYVAL TotalStringLength AS LONG, BYVAL NumberOfUnknowns AS LONG, _
BYREF Integers() AS LONG, BYVAL SubstringLength AS LONG, BYREF Strings() AS LONG, _
BYREF Unknowns() AS SINGLE, BYREF Range() AS SINGLE)
LOCAL Individual AS LONG, Unknown AS LONG
'Decode the strings to real numbers.
'First decode the strings to sets of decimal integers.
CALL FindIntegers(PopulationSize, TotalStringLength, NumberOfUnknowns, Integers(), SubstringLength, Strings())
'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(BYVAL PopulationSize AS LONG, BYVAL TotalStringLength AS LONG, BYVAL NumberOfUnknowns AS LONG, _
BYREF Integers() AS LONG, BYVAL SubstringLength AS LONG, BYREF Strings() AS LONG, _
BYREF Unknowns() AS SINGLE, BYREF Range() AS SINGLE)
'Create the initial random population.
LOCAL Individual AS LONG, BitB AS LONG
FOR Individual = 1 TO PopulationSize
FOR BitB = 1 TO TotalStringLength
IF RND > .5 THEN
Strings(Individual, BitB) = 1
ELSE
Strings(Individual, BitB) = 0
END IF
NEXT BitB
NEXT Individual
'Decode strings to real numbers.
CALL FindUnknowns(PopulationSize, TotalStringLength, NumberOfUnknowns, Integers(), SubstringLength, Strings(), Unknowns(), Range())
END SUB
'
SUB Mutate(BYVAL PopulationSize AS LONG, BYVAL TotalStringLength AS LONG, BYREF NewStrings() AS LONG, _
BYVAL MutationProbability AS SINGLE)
'Visit each bit of each string very occasionally flipping a "1" to a "0" or vice versa.
LOCAL Individual AS LONG, BitB AS LONG
FOR Individual = 1 TO PopulationSize
FOR BitB = 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, BitB) = 1 THEN
NewStrings(Individual, BitB) = 0
ELSE
NewStrings(Individual, BitB) = 1
END IF
END IF
NEXT BitB
NEXT Individual
END SUB
'
SUB NoCrossover (BYREF Mate1 AS LONG, BYREF Mate2 AS LONG, BYREF NewIndividual AS LONG, _
BYVAL TotalStringLength AS LONG, BYREF NewStrings() AS LONG, BYREF Strings() AS LONG)
'Pass the selected strings to the temporary population without applying crossover.
LOCAL BitB AS LONG
FOR BitB = 1 TO TotalStringLength
NewStrings(NewIndividual, BitB) = Strings(Mate1, BitB)
NewStrings(NewIndividual + 1, BitB) = Strings(Mate2, BitB)
NEXT BitB
END SUB
'
SUB DisplayGeneration (BYVAL Generation AS LONG, BYVAL MeanFitness AS SINGLE, BYVAL FittestIndividual AS LONG, _
BYREF Fitness() AS SINGLE, BYVAL NumberOfUnknowns AS LONG, BYREF Unknowns() AS SINGLE, _
BYVAL PopulationSize AS LONG, BYREF Strings() AS LONG, BYVAL hCtl AS LONG)
'Display results on the screen.
LOCAL s AS STRING, t AS STRING, Unknown AS LONG, N AS LONG
s = LTRIM$(STR$(Generation))+$TAB+$TAB+LTRIM$(STR$(Fitness(FittestIndividual)))+$TAB+$TAB+LTRIM$(STR$(MeanFitness))
' 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
t = t + $TAB + $TAB + LTRIM$(STR$(Unknowns(FittestIndividual, Unknown)))
NEXT Unknown
LISTBOX ADD hCtl, %IDC_LISTBOX1, s + t
' scroll to display last results
CONTROL SEND hCtl,%IDC_LISTBOX1, %LB_GETCOUNT, 0, 0 TO N
CONTROL SEND hCtl, %IDC_LISTBOX1, %LB_SETTOPINDEX, N-1, 0
' If you wish you can obtain the full information by adapting the following code:
'
' 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 BitB = 1 TO TotalStringLength
' PRINT #2, RIGHT$(STR$(Strings(Individual, BitB)), 1); ","; 'File LGADOS.ALL
' NEXT BitB
'
' PRINT #2, 'Carriage return
'
' NEXT Individual
END SUB
'
SUB ReplaceR(BYREF Strings() AS LONG, NewStrings() AS LONG)
'Replace the old population with the new one.
'FOR Individual = 1 TO PopulationSize
' FOR BitB = 1 TO TotalStringLength
' Strings(Individual, BitB) = NewStrings(Individual, BitB)
' NEXT BitB
'NEXT Individual
'ERASE NewStrings 'Clear the old array of strings.
MAT Strings() = NewStrings()
MAT NewStrings() = ZER
END SUB
'
SUB Scaling (BYVAL ScalingConstant AS SINGLE, BYVAL FittestIndividual AS LONG, BYREF SumFitness AS SINGLE, _
BYREF MeanFitness AS SINGLE, BYREF Fitness() AS SINGLE, BYVAL PopulationSize AS LONG)
LOCAL a AS SINGLE, b AS SINGLE, Individual AS LONG
'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 (BYREF mate AS LONG, BYREF SumFitness AS SINGLE, BYREF MeanFitness AS SINGLE, _
BYREF Fitness() AS SINGLE, PopulationSize AS LONG)
'Select a single individual by fitness proportional selection.
LOCAL Sum AS SINGLE, Individual AS LONG, RouletteWheel AS SINGLE
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 (BYREF MeanFitness AS SINGLE, BYREF SumFitness AS SINGLE, BYREF FittestIndividual AS LONG, BYVAL Generation AS LONG, _
BYREF Fitness() AS SINGLE, BYREF EliteFitness AS SINGLE, BYREF EliteString() AS LONG, BYREF EliteIntegers() AS LONG, _
BYREF EliteUnknowns() AS SINGLE, BYREF Strings() AS LONG, BYREF Integers() AS LONG, _
BYREF Unknowns() AS SINGLE, BYVAL TotalStringLength AS LONG, BYVAL NumberOfUnknowns AS LONG, BYVAL PopulationSize AS LONG, BYVAL Elitism AS STRING)
'Calculate the sum of fitness across the population and find the best individual,
'then apply elitism if required.
LOCAL Individual AS LONG, MaxFitness AS LONG
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, Fitness(), EliteFitness, EliteString(), _
EliteIntegers(), EliteUnknowns(), Strings(), Integers(), Unknowns(), _
TotalStringLength, NumberOfUnknowns, PopulationSize)
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
'
CALLBACK FUNCTION ShowDIALOG1Proc()
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG
' Initialization handler
STATIC PopulationSize AS LONG, NumberOfUnknowns AS LONG, SubstringLength AS LONG, TotalStringLength AS LONG
STATIC MaxGeneration AS LONG, CrossOverProbability AS SINGLE, MutationProbability AS SINGLE
STATIC Elitism AS STRING, ScalingConstant AS SINGLE, NewIndividual AS LONG
STATIC Generation AS LONG, MeanFitness AS SINGLE, SumFitness AS SINGLE, FittestIndividual AS LONG
STATIC Mate1 AS LONG, Mate2 AS LONG
'------- SET ALL THE IMPORTANT FIXED PARAMETERS. -------
'These should be set by the user.
PopulationSize = 20 'Must be even.
NumberOfUnknowns = 2
SubstringLength = 12 'All sub-strings have the same length.
TotalStringLength = NumberOfUnknowns * SubstringLength
MaxGeneration = 400 'G.
CrossOverProbability = .6 'Pc. >=0 and <=1.
MutationProbability = 1 / TotalStringLength 'Pm, >=0 and <1.
Elitism = "on" '"on" or "off".
ScalingConstant = 1.2 'A value of 0 implies no scaling.
'------DECLARE ALL STATIC ARRAY-VARIABLES----------
'The arrays that hold the individuals within the current population.
DIM Unknowns(PopulationSize, NumberOfUnknowns) AS STATIC SINGLE
DIM Integers(PopulationSize, NumberOfUnknowns) AS STATIC LONG
DIM Strings(PopulationSize, TotalStringLength) AS STATIC LONG
DIM Fitness(PopulationSize) AS STATIC SINGLE
'The new population.
DIM NewStrings(PopulationSize, TotalStringLength) AS STATIC LONG
'The array that defines the range of the unknowns.
DIM Range(2, NumberOfUnknowns) AS STATIC SINGLE
'The best individual in the past generation. Used if elitism is on.
DIM EliteString(TotalStringLength) AS STATIC LONG
DIM EliteIntegers(NumberOfUnknowns) AS STATIC LONG
DIM EliteFitness AS STATIC SINGLE
DIM EliteUnknowns(NumberOfUnknowns) AS STATIC SINGLE
CALL DefineRange(Range()) '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 the program is run.
RANDOMIZE TIMER
CASE %WM_NCACTIVATE
STATIC hWndSaveFocus AS DWORD
IF ISFALSE CBWPARAM THEN
' Save control focus
hWndSaveFocus = GetFocus()
ELSEIF hWndSaveFocus THEN
' Restore control focus
SetFocus(hWndSaveFocus)
hWndSaveFocus = 0
END IF
CASE %WM_COMMAND
' Process control notifications
SELECT CASE AS LONG CBCTL
CASE %IDC_BUTTON1 ' run program
IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
MAT EliteString() = ZER
MAT EliteIntegers() = ZER
EliteFitness = 0.0!
MAT EliteUnknowns() = ZER
LISTBOX RESET CBHNDL, %IDC_LISTBOX1
'------- START OF THE GENETIC ALGORITHM -------
'------- CREATE AN INITIAL POPULATION, GENERATION 1 ------
Generation = 1
'Build a population of strings at random.
CALL InitialPopulation(PopulationSize, TotalStringLength, NumberOfUnknowns, Integers(), SubstringLength, Strings(), Unknowns(), Range())
'Find the fitness of each member of the population.
CALL FindFitness(PopulationSize, Fitness(), Unknowns())
'Find the mean fitness and the fittest individual.
CALL Statistics(MeanFitness, SumFitness, FittestIndividual, Generation, _
Fitness(), EliteFitness, EliteString(), EliteIntegers(), _
EliteUnknowns(), Strings(), Integers(), _
Unknowns(), TotalStringLength, NumberOfUnknowns, PopulationSize, Elitism)
'Display generation.
CALL DisplayGeneration(Generation, MeanFitness, FittestIndividual, _
Fitness(), NumberOfUnknowns, Unknowns(), PopulationSize, _
Strings(), CBHNDL)
'If linear fitness scaling is "on" then scale population prior to selection.
CALL Scaling(ScalingConstant, FittestIndividual, SumFitness, MeanFitness, _
Fitness(), PopulationSize)
'------- 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, Fitness(), PopulationSize) 'Choose first mate.
CALL Selection(Mate2, SumFitness, MeanFitness, Fitness(), PopulationSize) '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, TotalStringLength, NewStrings(), Strings())
ELSE 'Don't perform crossover.
CALL NoCrossover(Mate1, Mate2, NewIndividual, TotalStringLength, NewStrings(), Strings())
END IF
NEXT NewIndividual
'Mutate the temporary population.
CALL Mutate(PopulationSize, TotalStringLength, NewStrings(), MutationProbability)
'Replace the old population completely by the new one.
CALL ReplaceR(Strings(), NewStrings())
'De-code the new population to integers then real numbers.
CALL FindUnknowns(PopulationSize, TotalStringLength, NumberOfUnknowns, Integers(), SubstringLength, Strings(), Unknowns(), Range())
'Find the fitness of each member of the population.
CALL FindFitness(PopulationSize, Fitness(), Unknowns())
'Find the mean fitness and the fittest individual.
CALL Statistics(MeanFitness, SumFitness, FittestIndividual, Generation, _
Fitness(), EliteFitness, EliteString(), EliteIntegers(), _
EliteUnknowns(), Strings(), Integers(), _
Unknowns(), TotalStringLength, NumberOfUnknowns, PopulationSize, Elitism)
'Display generation.
CALL DisplayGeneration(Generation, MeanFitness, FittestIndividual, _
Fitness(), NumberOfUnknowns, Unknowns(), PopulationSize, _
Strings(), CBHNDL)
'If linear fitness scaling is "on" then scale population prior to selection.
CALL Scaling(ScalingConstant, FittestIndividual, SumFitness, MeanFitness, _
Fitness(), PopulationSize)
NEXT Generation 'Process the next generation.
END IF
CASE %IDC_BUTTON2 ' exit
IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN DIALOG END CBHNDL
END SELECT
END SELECT
END FUNCTION
Comment