DECLARE SUB ReportDeltaX (f5$, state() AS ANY) DECLARE SUB MODELFITNESS (Y1a!, Y2a!, Y1b!, Y2b!, pFeedNoisy!, afitness!, bfitness!) DECLARE SUB GrowUp (xParent() AS SINGLE, xchild() AS SINGLE, OldChrom() AS INTEGER, Chrom() AS INTEGER) DECLARE SUB ReportMeanAverages (f4$) DECLARE SUB InitBatch (folderList$(), iLine%) DECLARE SUB StatsMain (xBird() AS SINGLE, Xmean() AS SINGLE, Xsdev() AS SINGLE) DECLARE SUB SexFitness (xChick1() AS SINGLE, xChick2() AS SINGLE, xParent() AS SINGLE, iMom%, fit1!, fit2!) DECLARE SUB SexDecode (BirdChrom() AS INTEGER, xBird() AS SINGLE) DECLARE SUB ReportGraph (Xmean() AS SINGLE, Xsdev() AS SINGLE, summutate!, sumcross!) DECLARE SUB InitMain (Chrom() AS INTEGER, xchild() AS SINGLE) DECLARE SUB InitFileLoad (f1$, f2$, GA AS ANY, sim AS ANY) DECLARE SUB ReportMain (f3$, f4$, gen AS INTEGER) DECLARE SUB SexMain (OldChrom() AS INTEGER, Chrom() AS INTEGER) DECLARE SUB UtilPause (seconds!) DECLARE SUB InitPop (Chrom() AS INTEGER, xchild() AS SINGLE) DECLARE SUB InitReport (f3$, f4$, GA AS ANY) DECLARE FUNCTION SexMutation% (alleleval%, pmutation!, nmutation%) DECLARE FUNCTION SexSelectParent% (popsize AS INTEGER, sumfitness!) DECLARE FUNCTION UtilFlip% (pWin!) DECLARE SUB SexCrossover (OldChrom() AS INTEGER, mate1%, mate2%, OneChrom() AS INTEGER, CrossPosn%) DECLARE SUB InitArrays (GA AS ANY) DEFINT I-J, N REM $STATIC '-----set upper bounds for arrays if static '-----redefine dynamic arrays when loading parameter file CONST maxchromLength = 1, maxpop = 1, maxvar = 1, maxgen = 1 DIM SHARED true AS INTEGER DIM SHARED false AS INTEGER false = 0: true = NOT false DIM f$ '-----parameter file name DIM gen AS INTEGER '-----generation DIM ParentSumFitness AS SINGLE '-----total fitness of population DIM inest '-----the current nest simulation '--------------GA OVERVIEW --------------------------------------- ' a population consists of genotypes and phenotypes ' genotypes are chromosomes (chrom) of length (lchrom) and are divided into ' a number of segments of length (lvar). ' Each segment is decoded into a variable and a phenotype is a list of ' variables (with the number of variables = nvar) ' Parent and child populations are tracked : the population of parent ' genotypes is described by oldchrom(npop, lchrom) and phenotypes ' are described by xParent(npop, nvar); Similarly child populations ' are described by chrom(npop, lchrom) and xchild(npop, nvar) ' populations are user specified and do not vary '--------------END OVERVIEW --------------------------------------- '-----user supplied paramaters for GA TYPE GAtype npop AS INTEGER '-----the population size nvar AS INTEGER '-----the number of variables describing phenotype lvar AS INTEGER '-----the number of alleles in each variable lchrom AS INTEGER '-----lchrom = nvar * lvar maxdecode AS INTEGER '-----the largest value a variable can take maxgen AS INTEGER '-----the number of generations to model pCross AS SINGLE '-----the probability of crossover pMutate AS SINGLE '-----the probability of mutation related AS INTEGER '-----percentage relatedness of sibs END TYPE DIM GA AS GAtype '-----user supplied paramaters for simulation TYPE ModelType Foodsupply AS SINGLE '-----food available to the parent each feeding aMaxBegCost AS SINGLE '-----the energetic cost of begging for the A chick bMaxBegCost AS SINGLE '-----the energetic cost of begging for the B chick aNeed AS SINGLE '-----multiplied by food to reduce or increase need bNeed AS SINGLE '-----multiplied by food to reduce or increase need bhandicap AS SINGLE '-----reduce condition to increase pStarvation Predation AS SINGLE '-----the predation cost of begging ability AS SINGLE '-----the "A" chicks ability to outcompete "B" starve AS SINGLE END TYPE DIM sim AS ModelType '-----population level statistics for each generation TYPE ztype ncross AS INTEGER nmutate AS INTEGER END TYPE DIM z AS ztype '-----parameters for plotting fitness TYPE stateType Amean AS SINGLE Amax AS SINGLE Amin AS SINGLE aLastAlive AS INTEGER Bmean AS SINGLE Bmax AS SINGLE Bmin AS SINGLE bLastAlive AS INTEGER flag AS INTEGER END TYPE '======================BEGIN DYNAMIC ARRAYS REM $DYNAMIC maxnest = 1000 DIM state(0 TO maxnest) AS stateType '-----chromosomes (arrays of boolean) = genotype DIM Chrom(1 TO maxpop, 1 TO maxchromLength) AS INTEGER DIM OldChrom(1 TO maxpop, 1 TO maxchromLength) AS INTEGER '-----array: vector of x values (Phenotype) for each bird DIM xParent(1 TO maxpop, 1 TO maxvar) AS SINGLE DIM xchild(1 TO maxpop, 1 TO maxvar) AS SINGLE '-----statistics for each variable for each generation DIM Xmean(1 TO maxgen, 1 TO maxvar) AS SINGLE DIM Xsdev(1 TO maxgen, 1 TO maxvar) AS SINGLE '-----track chick deaths nchicks = 2: DIM ChickDeaths(1 TO maxgen, 1 TO nchicks) AS INTEGER DIM folderList$(Run1 TO nruns) '----dimensioned in initbatch REM $STATIC '======================END DYNAMIC ARRAYS '-----M A I N P R O G R A M SCREEN 12 graphtime% = 5 '-----repeat program for several batch runs f1$ = "chrom.dat": f2$ = "enviro.dat" f3$ = "detail.out": f4$ = "plotvar.out" f5$ = "DeltaX.out" RANDOMIZE (TIMER) gen = 0 '-----Init run: load param file, generate starting children & initial stats ERASE state: REDIM state(0 TO maxnest) AS stateType CALL InitMain(Chrom(), xchild()) CALL StatsMain(xchild(), Xmean(), Xsdev()) '--summutate = 0: sumcross =0 '-----begin current run: Sex (cross) & evaluate fitness for maxgen DO '-----BREED gen = gen + 1: LOCATE 1, 75: PRINT USING "###"; gen; CALL GrowUp(xParent(), xchild(), OldChrom(), Chrom()) '--child become parent '--ParentSumFitness = 0 '----not used CALL SexMain(OldChrom(), Chrom()) CALL StatsMain(xchild(), Xmean(), Xsdev()) '-----REPORT IF gen MOD graphtime% = 0 OR gen = 1 THEN CALL ReportMain(f3$, f4$, gen) CALL ReportGraph(Xmean(), Xsdev(), summutate, sumcross) END IF '-----USER INTERUPT ch$ = UCASE$(INKEY$) IF ch$ = "X" THEN CLS : DO LOCATE 12, 12: INPUT ; "DO YOU WISH TO EXIT (Y or N)? "; response$ response$ = UCASE$(response$) LOOP UNTIL response$ = "Y" OR response$ = "N" IF response$ = "Y" THEN STOP ELSE CLS END IF LOOP UNTIL gen >= GA.maxgen CALL ReportMeanAverages(f4$) CALL ReportDeltaX(f5$, state()) END SUB GrowUp (xParent() AS SINGLE, xchild() AS SINGLE, OldChrom() AS INTEGER, Chrom() AS INTEGER) SHARED GA AS GAtype '-----offspring become parents (for next generation) '-----note that stats on children now apply to parents FOR i = 1 TO GA.npop: FOR j = 1 TO GA.nvar xParent(i, j) = xchild(i, j) xchild(i, j) = 0 NEXT j, i FOR i = 1 TO GA.npop: FOR j = 1 TO GA.lchrom OldChrom(i, j) = Chrom(i, j) Chrom(i, j) = 0 NEXT j, i END SUB SUB InitArrays (GA AS GAtype) SHARED xParent() AS SINGLE, xchild() AS SINGLE SHARED Chrom() AS INTEGER, OldChrom() AS INTEGER SHARED Xmean() AS SINGLE, Xsdev() AS SINGLE SHARED ChickDeaths() AS INTEGER '-----mating routine requires that popsize is divisible by two IF GA.npop MOD 2 <> 0 THEN GA.npop = GA.npop + 1 CLS : BEEP: PRINT "Warning: population size must be an even number" CALL UtilPause(2) END IF '-----REDIMENSION DYNAMIC ARRAYS '-----note that 1 is added to chick arrays to allow evaluation of last... '.....chick (as an aChick) who needs to have a SIB ERASE xParent: REDIM xParent(1 TO GA.npop, 1 TO GA.nvar) AS SINGLE ERASE xchild: REDIM xchild(1 TO GA.npop + 1, 1 TO GA.nvar) AS SINGLE ERASE Xmean: REDIM Xmean(0 TO GA.maxgen, 1 TO GA.nvar) AS SINGLE ERASE Xsdev: REDIM Xsdev(0 TO GA.maxgen, 1 TO GA.nvar) AS SINGLE ERASE Chrom: REDIM Chrom(1 TO GA.npop + 1, 1 TO GA.lchrom) AS INTEGER ERASE OldChrom: REDIM OldChrom(1 TO GA.npop, 1 TO GA.lchrom) AS INTEGER nchicks = 2 ERASE ChickDeaths: REDIM ChickDeaths(1 TO GA.maxgen, 1 TO nchicks) AS INTEGER '----- END SUB SUB InitFileLoad (f1$, f2$, GA AS GAtype, sim AS ModelType) OPEN (f1$) FOR INPUT AS #1 LINE INPUT #1, title$ LINE INPUT #1, title$ INPUT #1, GA.npop, GA.nvar, GA.lvar, GA.maxgen, GA.pCross, GA.pMutate, GA.related CLOSE #1 GA.lchrom = GA.nvar * GA.lvar GA.maxdecode = 2 ^ GA.lvar - 1 OPEN (f2$) FOR INPUT AS #1 LINE INPUT #1, title$ LINE INPUT #1, title$ INPUT #1, sim.Foodsupply, sim.aMaxBegCost, sim.bMaxBegCost, sim.aNeed, sim.bNeed, sim.Predation, sim.ability, sim.bhandicap, sim.starve CLOSE #1 END SUB SUB InitMain (Chrom() AS INTEGER, xchild() AS SINGLE) SHARED folder$, f1$, f2$, f3$, f4$ SHARED GA AS GAtype SHARED sim AS ModelType '-----load param for new run CALL InitFileLoad(f1$, f2$, GA, sim) CALL InitArrays(GA) CALL InitPop(Chrom(), xchild()) CALL InitReport(f3$, f4$, GA) END SUB SUB InitPop (Chrom() AS INTEGER, xchild() AS SINGLE) SHARED GA AS GAtype '-----temporary arrays for chicks before becoming population members DIM ChickChrom(GA.lchrom) AS INTEGER DIM xChick(GA.nvar) AS SINGLE '-----for each child in pop, randomly assign allele (bit) value FOR ibird = 1 TO GA.npop '-----initialize chromosome and phenotype FOR iAllele = 1 TO GA.lchrom ChickChrom(iAllele) = UtilFlip%(.5) NEXT iAllele CALL SexDecode(ChickChrom(), xChick()) '-----add chick to the population FOR j = 1 TO GA.lchrom Chrom(ibird, j) = ChickChrom(j): ChickChrom(j) = 0 NEXT j FOR j = 1 TO GA.nvar xchild(ibird, j) = xChick(j): xChick(j) = 0 NEXT j NEXT ibird END SUB SUB InitReport (f3$, f4$, GA AS GAtype) SHARED sim AS ModelType SHARED z AS ztype CLS 'OPEN "con" FOR OUTPUT AS #1 OPEN (f3$) FOR OUTPUT AS #1 PRINT #1, "--------------------------------------------------------------" PRINT #1, " SGA version 23b, 1994" PRINT #1, "--------------------------------------------------------------" PRINT #1, PRINT #1, USING "SGA parameters read from file: \ \"; folder$ + f3$ PRINT #1, PRINT #1, USING "Population size: ######"; GA.npop PRINT #1, USING "Chromosome length: ######"; GA.lchrom PRINT #1, USING "Max Generations: ######"; GA.maxgen PRINT #1, USING "Crossover Probability: ##.###"; GA.pCross PRINT #1, USING "Mutation Probability: ##.###"; GA.pMutate PRINT #1, "--------------------------------------------------------------" PRINT #1, CLOSE #1 OPEN (f4$) FOR OUTPUT AS #1 PRINT #1, " npop maxgen pCross pMutate" PRINT #1, USING " #####.##"; GA.npop; GA.maxgen; GA.pCross; GA.pMutate; sim.Foodsupply PRINT #1, " FoodSupply amaxbegcost bmaxbegcost Predation Abilty" PRINT #1, USING " #####.##"; sim.Foodsupply; sim.aMaxBegCost; sim.bMaxBegCost; sim.Predation; sim.ability PRINT #1, PRINT #1, "gen x means | x sdevs adead bdead" CLOSE #1 END SUB SUB MODELFITNESS (Y1a, Y2a, Y1b, Y2b, pFeedNoisy, afitness, bfitness) SHARED inest, state() AS stateType SHARED sim AS ModelType SHARED gen AS INTEGER SHARED GA AS GAtype DIM interval AS SINGLE '===================INITIALIZATION===================================== '-----Initialize chick state (condition and hunger) adead = 0: bdead = 0 Xa = 0: Xb = 0 '--condition Ha = 0: Hb = 0 '--Hunger '-----let average chick condition (mass) be represented by MeanX MeanX = .5 * itime '-----to limit chromosome length, only represent portion of state space... '.....using distance from mean = DeltaX DeltaXmin = -5 '--5 units below xMean: min condition=xmean+DeltaXmin DeltaXmax = 5 '--5 units above xMean: max condition=xmean+DeltaXmax '-----initialize number of classes to divide DeltaX into Xrange = (DeltaXmax - DeltaXmin) '-----Initialize chick energy requirements Cm = .5 '--daily cost of maintenance '--begcost from file enviro.dat Digestion = 1 '-----assume parent does not choose amount to feed Foodload = sim.Foodsupply '--read from file enviro.dat TotDeltaXa = 0: TotDeltaXB = 0 '-----M O D E L '-----model chick state, parent state, begging and response to begging FOR itime = 1 TO 100 '-- 10 hours for 10 days '-----let X describe chick condition and meanX = average chick OldXa = Xa: OldXb = Xb MeanX = .5 * itime '-----B I G S T A R V A T I O N IF NOT adead THEN '-----calc bird state relative to mean DeltaXa = Xa - MeanX '--above mean is +, below is - '-----Model starvation as f(deltaX) IF DeltaXa <= DeltaXmin THEN adead = -1 ELSE IF DeltaXa >= 0 THEN pDeathA = 0 ELSE pSurviveA = -5.9 / (1 + 100 * EXP(DeltaXa + 3)) + 1 pDeathA = (1 - pSurviveA) * sim.starve END IF adead = UtilFlip%(pDeathA) END IF END IF '-----B I G B E G G I N G = f(DeltaX) based on Chrom '-----begging should include condition, hunger and other chicks response IF NOT adead THEN xprop = (DeltaXa - DeltaXmin) / Xrange yprop = xprop * (Y2a - Y1a) abeg = Y1a + yprop abeg = abeg * sim.ability ELSE '-- IF adead Xa = -6: DeltaXa = -6: abeg = 0 END IF '--a not dead '-----S M A L L S T A R V A T I O N IF NOT bdead THEN DeltaXb = Xb - MeanX IF DeltaXb <= DeltaXmin THEN bdead = -1 ELSE IF DeltaXb >= 0 THEN pDeathB = 0 ELSE pSurviveB = -5.9 / (1 + 100 * EXP((DeltaXb - sim.bhandicap) + 3)) + 1 pDeathB = (1 - pSurviveB) * sim.starve END IF bdead = UtilFlip%(pDeathB) END IF END IF '-----S M A L L B E G IF NOT bdead THEN xprop = (DeltaXb - DeltaXmin) / Xrange yprop = xprop * (Y2b - Y1b) bbeg = Y1b + yprop ELSE '--b dead Xb = -6: DeltaXb = -6: bbeg = 0 END IF 'b not dead '-----P R E D A T I O N maxBeg = 1 + sim.ability 'total max volume of both chicks totbeg = (abeg + bbeg) / maxBeg pPredation = totbeg * sim.Predation IF UtilFlip%(pPredation) THEN adead = -1: bdead = -1 GOTO endit: END IF '-----P A R E N T R E S P O N S E Noisy = 0: Quiet = 0 aFood = 0: bFood = 0 IF UtilFlip%(pFeedNoisy) THEN Noisy = 1 ELSE Quiet = 1 IF (adead + bdead) = 0 THEN '-----determine begging situation in nest and respond IF abeg = bbeg THEN IF UtilFlip%(.5) THEN aFood = Foodload ELSE bFood = Foodload ELSEIF abeg > bbeg THEN aFood = Foodload * Noisy: bFood = Foodload * Quiet ELSEIF abeg < bbeg THEN aFood = Foodload * Quiet: bFood = Foodload * Noisy END IF ELSEIF (adead + bdead) = -1 THEN '-----assume if one dies, the other always gets fed IF bdead THEN aFood = Foodload ELSE bFood = Foodload END IF '----no beg --> no food IF abeg = 0 THEN aFood = 0 IF bbeg = 0 THEN bFood = 0 '----- B I G C H I C K S T A T E (hunger, condition, rank?) IF NOT adead THEN '-----determine efficiency of food conversion to mass change aFoodValue = 1 '--proportion of food intake used ie efficiency IF DeltaXa > 0 THEN aFoodValue = -5.9 / (1 + 100 * EXP(-DeltaXa + 2)) + 1 aFoodValue = aFoodValue * sim.aNeed '--need reflects growth rate '-----update condition: energy used for BMR and begging '-----note that growth costs are not included here but are part of deltaX aBegCost = (abeg / sim.ability) * sim.aMaxBegCost Xa = Xa + (aFood * aFoodValue) - Cm - aBegCost '--age also influences END IF'-- not adead '----- S M A L L C H I C K S T A T E (hunger, condition, rank?) IF NOT bdead THEN bFoodValue = 1 IF DeltaXb > 0 THEN bFoodValue = -5.9 / (1 + 100 * EXP(-DeltaXb + 2)) + 1 bFoodValue = bFoodValue * sim.bNeed bBegCost = bbeg * sim.bMaxBegCost Xb = Xb + (bFood * bFoodValue) - Cm - bBegCost END IF '--not bdead '-----update parent state (condition) '--assume no long term impacts: survival to next year assured after fledge debuginfo = 0 IF debuginfo THEN CLS PRINT USING " itime =####.##"; itime PRINT USING " MeanX =####.##"; MeanX PRINT USING " pPredation=#.#####"; pPredation PRINT USING " pFeedNoisy=#.#####"; pFeedNoisy PRINT PRINT USING "----Chick----#######"; 1; 2 PRINT USING " Y1 =####.##"; Y1a; Y1b PRINT USING " Y2 =####.##"; Y2a; Y2b PRINT USING " OldX =####.##"; OldXa; OldXb PRINT USING " DeltaX =####.##"; DeltaXa; DeltaXb PRINT USING " Beg =####.##"; abeg; bbeg PRINT USING " BegCost =####.##"; aBegCost; bBegCost PRINT USING " Foodval =####.##"; aFoodValue; bFoodValue PRINT USING " pDeath =#.#####"; pDeathA; pDeathB PRINT USING " X =####.##"; Xa; Xb PRINT INPUT "Press any key"; jnk$ END IF '-----S T A T S on deltax for all nests of last generation IF gen = GA.maxgen THEN IF NOT adead THEN TotDeltaXa = TotDeltaXa + DeltaXa IF DeltaXa > state(inest).Amax THEN state(inest).Amax = DeltaXa IF DeltaXa < state(inest).Amin THEN state(inest).Amin = DeltaXa state(inest).aLastAlive = itime END IF IF NOT bdead THEN TotDeltaXB = TotDeltaXB + DeltaXb IF DeltaXb > state(inest).Bmax THEN state(inest).Bmax = DeltaXb IF DeltaXb < state(inest).Bmin THEN state(inest).Bmin = DeltaXb state(inest).bLastAlive = itime END IF END IF NEXT itime '-----end of user model for one time step endit: '-----jump to here if both chicks are dead IF adead THEN afitness = 0 ELSE afitness = 1 '(MeanDeltaXa / 5) + 5 IF bdead THEN bfitness = 0 ELSE bfitness = 1 '(MeanDeltaXb / 5) + 5 IF gen = GA.maxgen THEN state(inest).flag = -1 IF state(inest).aLastAlive = 0 THEN state(inest).Amean = 0 ELSE state(inest).Amean = TotDeltaXa / state(inest).aLastAlive END IF IF state(inest).bLastAlive = 0 THEN state(inest).Bmean = 0 ELSE state(inest).Bmean = TotDeltaXB / state(inest).bLastAlive END IF END IF END SUB SUB ReportDeltaX (f5$, state() AS stateType) maxnest = 0 DO: maxnest = maxnest + 1 LOOP UNTIL state(maxnest).flag = 0 OR maxnest = 1000 maxnest = maxnest - 1 OPEN (f5$) FOR OUTPUT AS #1 PRINT #1, "Chick condition for the last generation" PRINT #1, "NEST Amean Amax Amin aLastalive | Bmean Bmax Bmin bLastAlive" FOR inest = 1 TO maxnest PRINT #1, USING "####"; inest; PRINT #1, USING " ###.##"; state(inest).Amean; state(inest).Amax; state(inest).Amin; state(inest).aLastAlive; PRINT #1, " | "; PRINT #1, USING " ###.##"; state(inest).Bmean; state(inest).Bmax; state(inest).Bmin; state(inest).bLastAlive; PRINT #1, NEXT inest CLOSE #1 END SUB SUB ReportGraph (Xmean() AS SINGLE, Xsdev() AS SINGLE, summutate, sumcross) SHARED GA AS GAtype SHARED gen AS INTEGER SHARED z AS ztype SHARED ChickDeaths() AS INTEGER DIM style&(1 TO 5) style&(1) = &HE7E7: style&(2) = &HFFFF: style&(3) = &HF00F style&(4) = &HAAA: style&(5) = &HAAA SCREEN 12 CLS VIEW (1, 1)-(600, 400), , 15 xMax = GA.maxgen Xmin = 0 Xrange = xMax - Xmin xedge = .1 * Xrange Ymin = 0: Ymax = 1 Yrange = Ymax - Ymin yedge = .1 * Yrange WINDOW (Xmin - xedge, Ymin - yedge)-(xMax + xedge, Ymax + yedge) '-----plot each variable FOR ivar = 1 TO GA.nvar oldx = 0: oldy = Xmean(0, ivar) FOR i = 1 TO gen x = i: y = Xmean(i, ivar) LINE (oldx, oldy)-(x, y), 15, , style&(ivar) oldx = x: oldy = y NEXT i NEXT ivar '--reset screen coord VIEW '---print mutation rate and crossover rate for whole run LOCATE 1, 1: PRINT USING "#####"; Ymax LOCATE 25, 1: PRINT USING "#####"; Ymin LOCATE 27, 1: PRINT USING "Big deaths = ######"; ChickDeaths(gen, 1); PRINT SPACE$(10); PRINT USING "Small Deaths = ######"; ChickDeaths(gen, 2); '-----print the vars of the best bird (child) LOCATE 28, 1: PRINT "Means: "; FOR ivar = 1 TO GA.nvar PRINT USING "####.##"; Xmean(gen, ivar); NEXT ivar FOR ivar = 1 TO GA.nvar PRINT USING "####.##"; Xsdev(gen, ivar); NEXT ivar LOCATE 25, 40: PRINT "Press x to exit" END SUB SUB ReportMain (f3$, f4$, gen AS INTEGER) SHARED OldChrom() AS INTEGER SHARED Chrom() AS INTEGER SHARED xchild() AS SINGLE, xParent() AS SINGLE SHARED Xmean() AS SINGLE, Xsdev() AS SINGLE SHARED ChickDeaths() AS INTEGER SHARED GA AS GAtype SHARED z AS ztype DIM chromstring$ '-----report population stats for current generation 'OPEN "con" FOR OUTPUT AS #1 OPEN (f3$) FOR APPEND AS #1 PRINT #1, FOR i = 1 TO 80: PRINT #1, "="; : NEXT i PRINT #1, PRINT #1, USING " Generation ##### "; gen - 1; gen PRINT #1, " Child Phenotype variables Child Phenotype variables" '-----report on idividuals FOR ibird = 1 TO GA.npop '--old pop stats on left FOR i = 1 TO GA.nvar: PRINT #1, USING "###.##"; xParent(ibird, i); : NEXT i PRINT #1, SPACE$(3); PRINT #1, " | "; '--current pop stats on right PRINT #1, SPACE$(2); FOR i = 1 TO GA.nvar: PRINT #1, USING "###.##"; xchild(ibird, i); : NEXT i PRINT #1, SPACE$(3); PRINT #1, NEXT ibird '-----report on population level stats PRINT #1, " Mean on first line, SDev on second" FOR i = 1 TO GA.nvar: PRINT #1, USING "###.##"; Xmean(gen - 1, i); : NEXT i PRINT #1, "-----"; FOR i = 1 TO GA.nvar: PRINT #1, USING "###.##"; Xmean(gen, i); : NEXT i PRINT #1, FOR i = 1 TO GA.nvar: PRINT #1, USING "###.##"; Xsdev(gen - 1, i); : NEXT i PRINT #1, "-----"; FOR i = 1 TO GA.nvar: PRINT #1, USING "###.##"; Xsdev(gen, i); : NEXT i PRINT #1, PRINT #1, CLOSE #1 OPEN (f4$) FOR APPEND AS #1 PRINT #1, USING "####"; gen; PRINT #1, SPACE$(5); FOR ivar = 1 TO GA.nvar PRINT #1, USING "###.##"; Xmean(gen, ivar); NEXT ivar FOR ivar = 1 TO GA.nvar PRINT #1, USING "###.##"; Xsdev(gen, ivar); NEXT ivar PRINT #1, USING "#####"; ChickDeaths(gen, 1); PRINT #1, USING "#####"; ChickDeaths(gen, 2) CLOSE #1 END SUB SUB ReportMeanAverages (f4$) SHARED Xmean() AS SINGLE, Xsdev() AS SINGLE SHARED ChickDeaths() AS INTEGER SHARED GA AS GAtype DIM sum AS DOUBLE, sumsquared AS DOUBLE DIM MeanMean(GA.nvar) AS SINGLE, SdevMean(GA.nvar) AS SINGLE DIM MeanSdev(GA.nvar) AS SINGLE, SdevSdev(GA.nvar) AS SINGLE n = 50 '---calculate averages for thelast 50 generations startgen = GA.maxgen - n + 1 FOR ivar = 1 TO GA.nvar '-----mean and sdev of means sum = 0: sumsquared = 0 FOR igen = startgen TO GA.maxgen sum = sum + Xmean(igen, ivar) sumsquared = sumsquared + Xmean(igen, ivar) ^ 2 NEXT igen MeanMean(ivar) = sum / n tmp = SQR(ABS((sumsquared - ((sum * 1!) ^ 2 / n)) / n) / 1!) SdevMean(ivar) = tmp '------mean and sdev of sdevs sum = 0: sumsquared = 0 FOR igen = startgen TO GA.maxgen sum = sum + Xsdev(igen, ivar) sumsquared = sumsquared + Xsdev(igen, ivar) ^ 2 NEXT igen MeanSdev(ivar) = sum / n tmp = SQR(ABS((sumsquared - ((sum * 1!) ^ 2 / n)) / n) / 1!) SdevSdev(ivar) = tmp NEXT ivar FOR igen = startgen TO GA.maxgen sum1 = sum1 + ChickDeaths(igen, 1) sum2 = sum2 + ChickDeaths(igen, 2) NEXT igen MeanDead1 = sum1 / n MeanDead2 = sum2 / n OPEN (f4$) FOR APPEND AS #1 PRINT #1, PRINT #1, USING "Generations ####"; startgen; PRINT #1, USING "- ####"; GA.maxgen PRINT #1, "Means "; FOR ivar = 1 TO GA.nvar: PRINT #1, USING "###.##"; MeanMean(ivar); : NEXT ivar FOR ivar = 1 TO GA.nvar: PRINT #1, USING "###.##"; MeanSdev(ivar); : NEXT ivar PRINT #1, PRINT #1, "Sdevs "; FOR ivar = 1 TO GA.nvar: PRINT #1, USING "###.##"; SdevMean(ivar); : NEXT ivar FOR ivar = 1 TO GA.nvar: PRINT #1, USING "###.##"; SdevSdev(ivar); : NEXT ivar PRINT #1, PRINT #1, USING "A deaths = ##### "; MeanDead1; PRINT #1, USING "B deaths = #####"; MeanDead2 CLOSE #1 END SUB SUB SexCrossover (OldChrom() AS INTEGER, mate1%, mate2%, OneChrom() AS INTEGER, CrossPosn%) SHARED GA AS GAtype SHARED z AS ztype '-----determine if crossover occurs (probability pCross) and Crossover posn IF UtilFlip%(GA.pCross) THEN CrossPosn% = INT((GA.lchrom - 1 + 1) * RND + 1) 'random btwn 1 and lchrom z.ncross = z.ncross + 1 ELSE CrossPosn% = GA.lchrom '-- so that mutation routine is used END IF '-----Transfer each allele individually and give it a chance to mutate '-----child takes from parent 1 FOR iAllele = 1 TO CrossPosn% OneChrom(iAllele) = SexMutation%(OldChrom(mate1%, iAllele), GA.pMutate, z.nmutate) NEXT iAllele '-----child takes from parent 2 FOR iAllele = CrossPosn% + 1 TO GA.lchrom OneChrom(iAllele) = SexMutation%(OldChrom(mate2%, iAllele), GA.pMutate, z.nmutate) NEXT iAllele END SUB SUB SexDecode (BirdChrom() AS INTEGER, xBird() AS SINGLE) SHARED GA AS GAtype DIM accum AS SINGLE DIM powerof2 AS SINGLE '-----CONVERT GENOTYPE TO PHENOTYPE '-----Divide chrom into the number of vars based on length of var FOR ivar = 1 TO GA.nvar firstbit = ((ivar - 1) * GA.lvar) + 1: lastbit = (ivar * GA.lvar) '--OR firstbit = lastbit + 1: lastbit = lastbit + GA.lvar '-----decode binary string as unsigned integer accum = 0: powerof2 = 1 FOR i = lastbit TO firstbit STEP -1 IF BirdChrom(i) THEN accum = accum + powerof2 powerof2 = powerof2 * 2 NEXT i xBird(ivar) = accum / GA.maxdecode NEXT ivar END SUB SUB SexFitness (xChick1() AS SINGLE, xChick2() AS SINGLE, xParent() AS SINGLE, iMom, fit1, fit2) SHARED GA AS GAtype '-----assign begging slopes Y1a = xChick1(1) Y2a = xChick1(2) Y1b = xChick2(3) Y2b = xChick2(4) '-----assign parental response to begging IF GA.nvar = 5 THEN pFeedNoisy = xParent(iMom, 5) ELSE pFeedNoisy = 1 END IF '-----note that chicks called aChick and bChick in simulation CALL MODELFITNESS(Y1a, Y2a, Y1b, Y2b, pFeedNoisy, fit1, fit2) END SUB SUB SexMain (OldChrom() AS INTEGER, Chrom() AS INTEGER) SHARED GA AS GAtype, z AS ztype, inest SHARED xchild() AS SINGLE SHARED xParent() AS SINGLE SHARED ChickDeaths() AS INTEGER SHARED gen AS INTEGER SHARED folder$ '--note that z.sum = ParentSumfitness but since z.sum calc for children '--and children become parents, z.sum was considered confusing DIM mate1 AS INTEGER, mate2 AS INTEGER '--parents selected by fitness DIM child1 AS INTEGER, child2 AS INTEGER '--children selected sequentially DIM Mom AS INTEGER '-----define temporary arrays for chicks entering simulation DIM ChickChrom1(GA.lchrom) AS INTEGER, ChickChrom2(GA.lchrom) AS INTEGER DIM xChick1(GA.nvar) AS SINGLE, xChick2(GA.nvar) AS SINGLE DIM xtot1(GA.nvar) AS SINGLE, xtot2(GA.nvar) AS SINGLE '-----initialize counters z.nmutate = 0 z.ncross = 0 '-----create new generation via selection of Parents, crossover & mutation '-----must use even numbered population size ChickDeaths(gen, 1) = 0: ChickDeaths(gen, 2) = 0 ChicksUsed = 0 iSurvivor = 0 inest = 0 DO SELECT CASE GA.related CASE 50 '-----select 2 parents from pop randomly (with replacement) mate1 = SexSelectParent%(GA.npop, ParentSumFitness) mate2 = SexSelectParent%(GA.npop, ParentSumFitness) '-----crossover and mutation in same subroutine: cross once for each child CALL SexCrossover(OldChrom(), mate1, mate2, ChickChrom1(), CrossSite%) IF UtilFlip%(.5) THEN CALL SexCrossover(OldChrom(), mate1, mate2, ChickChrom2(), CrossSite%) ELSE CALL SexCrossover(OldChrom(), mate2, mate1, ChickChrom2(), CrossSite%) END IF CASE 0 '-----select 2 parents from pop randomly (with replacement) mate1 = SexSelectParent%(GA.npop, ParentSumFitness) mate2 = SexSelectParent%(GA.npop, ParentSumFitness) '-----crossover and mutation in same subroutine: cross once for each child CALL SexCrossover(OldChrom(), mate1, mate2, ChickChrom1(), CrossSite%) '-----select 2 parents from pop randomly (with replacement) mate1 = SexSelectParent%(GA.npop, ParentSumFitness) mate2 = SexSelectParent%(GA.npop, ParentSumFitness) '-----crossover and mutation in same subroutine: cross once for each child CALL SexCrossover(OldChrom(), mate1, mate2, ChickChrom2(), CrossSite%) CASE 100 '-----select 2 parents from pop randomly (with replacement) mate1 = SexSelectParent%(GA.npop, ParentSumFitness) mate2 = SexSelectParent%(GA.npop, ParentSumFitness) '-----crossover and mutation in same subroutine: cross once for each child CALL SexCrossover(OldChrom(), mate1, mate2, ChickChrom1(), CrossSite%) FOR j = 1 TO GA.lchrom: ChickChrom2(j) = ChickChrom1(j): NEXT j CASE ELSE PRINT "ERROR: relatedness must be one of (0,50,100)" BEEP END SELECT '--for the new children, decode string CALL SexDecode(ChickChrom1(), xChick1()) CALL SexDecode(ChickChrom2(), xChick2()) '-----calculate fitness of each chick with simulation inest = inest + 1 IF UtilFlip%(.5) THEN Mom = mate1 ELSE Mom = mate2 CALL SexFitness(xChick1(), xChick2(), xParent(), Mom, fit1, fit2) '-----add surviving chicks to the population IF fit1 > 0 THEN iSurvivor = iSurvivor + 1 FOR j = 1 TO GA.lchrom Chrom(iSurvivor, j) = ChickChrom1(j): ChickChrom1(j) = 0 NEXT j FOR j = 1 TO GA.nvar xchild(iSurvivor, j) = xChick1(j): xChick1(j) = 0 NEXT j ELSE ChickDeaths(gen, 1) = ChickDeaths(gen, 1) + 1 END IF IF fit2 > 0 AND iSurvivor <= GA.npop THEN iSurvivor = iSurvivor + 1 FOR j = 1 TO GA.lchrom Chrom(iSurvivor, j) = ChickChrom2(j): ChickChrom2(j) = 0 NEXT j FOR j = 1 TO GA.nvar xchild(iSurvivor, j) = xChick2(j): xChick2(j) = 0 NEXT j ELSE ChickDeaths(gen, 2) = ChickDeaths(gen, 2) + 1 END IF '-----report debug information to screen debuginfo = -1 ChicksUsed = ChicksUsed + 2: Big = 1: Small = 2 IF debuginfo THEN LOCATE 3, 1: PRINT USING "chicks born = ####"; ChicksUsed; PRINT USING " new population size = ####"; iSurvivor; LOCATE 4, 1: PRINT USING "Big Deaths = ####"; ChickDeaths(gen, Big); PRINT USING " Small Deaths = ####"; ChickDeaths(gen, Small); END IF LOOP UNTIL iSurvivor >= GA.npop FOR j = 1 TO GA.nvar: xtot1(j) = 0: NEXT j FOR i = 1 TO GA.npop: FOR j = 1 TO GA.nvar xtot1(j) = xtot1(j) + xchild(i, j) NEXT j, i PRINT FOR j = 1 TO GA.nvar: PRINT USING " ##.##"; xtot1(j) / GA.npop; : NEXT j PRINT 'don't need to do this anymore 'note that arrays are dimensioned to one larger than npop so that 'simulations may be completed for last chick who needs a sib END SUB FUNCTION SexMutation% (alleleval%, pmutation, nmutation) '-----mutate allele with probability = pmutation, count num mutations DIM mutant AS INTEGER DIM bit AS INTEGER mutant = UtilFlip%(pmutation) IF mutant THEN nmutation = nmutation + 1 bit = NOT alleleval% ELSE bit = alleleval% END IF SexMutation% = bit END FUNCTION FUNCTION SexSelectParent% (popsize AS INTEGER, sumfitness) DIM rand AS SINGLE DIM partsum AS SINGLE '--accumulate fitness sums SHARED GA AS GAtype '-----initialize 'rand = RND * sumfitness 'partsum = 0!: ibird = 0 '-----select a single individual from pop. via roulette wheel selection 'DO ' ibird = ibird + 1 ' partsum = partsum + Parent(ibird).fitness 'LOOP UNTIL partsum > rand 'SexSelectParent% = ibird rand = RND * GA.npop SexSelectParent% = INT(rand) + 1 END FUNCTION SUB StatsMain (xBird() AS SINGLE, Xmean() AS SINGLE, Xsdev() AS SINGLE) SHARED GA AS GAtype SHARED gen AS INTEGER DIM sumsquared AS DOUBLE DIM tmp AS DOUBLE FOR ivar = 1 TO GA.nvar sum = xBird(1, ivar) sumsquared = xBird(1, ivar) ^ 2 FOR ibird = 2 TO GA.npop sum = sum + xBird(ibird, ivar) sumsquared = sumsquared + xBird(ibird, ivar) ^ 2 NEXT ibird n = GA.npop tmp = SQR(ABS((sumsquared - ((sum * 1!) ^ 2 / n)) / n) / 1!) Xsdev(gen, ivar) = tmp Xmean(gen, ivar) = (sum / n) NEXT ivar END SUB FUNCTION UtilFlip% (pWin) '-----biased coin flip 0 <= pWinning > 1 IF RND <= pWin THEN i = true ELSE i = false UtilFlip% = i END FUNCTION DEFSNG I-J, N SUB UtilPause (seconds) begintime = TIMER DO WHILE ABS(TIMER - begintime) < seconds: LOOP END SUB