REM group choice and vigilance REM Guy Beauchamp, May 2016 # lang "qb" Const l = 900 REM number of sites Const r = 200 REM population size Const tmax = 500 REM number of time steps Const f = 50 REM number of food items per patch Const patches = 18 REM number of food patches Const simmax = 2000 REM number of generations Const mutarate = 0.0001 REM mutation rate Const replic = 15 Rem number of replications Const gs = 40 Const rgs = r/gs Const attackrate = 0.05 Rem probability of attack per Time unit per bird Dim tactjoin(r,5) As Single Dim tactvig(r,5) As Single Dim food(l) As Single Dim fr(l) As Integer Dim nposit(l) As Integer Dim position(r,2) As Integer Dim status(r,2) As Integer Dim seeds(r) As Single Dim hotspot(r) As Integer Dim target(r) As Integer Dim success(r) As Single Dim rank(r) As Single Dim sort(r) As Single Dim id1(r) As Integer Dim id2(r) As Integer Dim sum(5) As Single Dim meanjoin(5) As Single Dim meanvig(5) As Single Dim sumjoin(5) As Single Dim sumvig(5) As Single Dim surv(r) As Single Dim grouppos(l) As Integer Dim idsite(r) As Integer Rem Randomize 5,1 Open "c:\...\output.txt" for Output As #1 For v = 1 To replic Randomize v,1 GoSub initsim For t = 1 to simmax Print v, t For s = 1 To rgs GoSub initparam For u = 1 To tmax GoSub prog GoSub pred Next u Next s GoSub fitness GoSub reproduction GoSub results Next t Print #1, v, "joining", meanjoin(1), meanjoin(2), meanjoin(3), meanjoin(4), meanjoin(5) Print #1, v, "vigilance", meanvig(1), meanvig(2), meanvig(3), meanvig(4), meanvig(5) Next v CLOSE #1 End REM initial parameters initsim: For i = 1 to r For j = 1 To 5 tactjoin(i, j) = Rnd tactvig(i, j) = Rnd Next j Next i For i = 1 To 5 meanjoin(i) = 0 meanvig(i) = 0 Next i Return REM start of one generation initparam: REM distribution of food For i = 1 TO l food(i) = 0 fr(i) = 0 nposit(i) = 0 grouppos(i) = 0 Next i For i = 1 TO patches chance = CINT(RND*899) + 1 WHILE food(chance) > 0 chance = CINT(899*RND) + 1 WEND fr(chance) = 1 luck = Rnd IF luck <= 0.333 THEN food(chance) = 0.5*f IF (luck > 0.333) AND (luck <= 0.666) THEN food(chance) = f IF luck > 0.666 THEN food(chance) = 1.5*f Next i REM distribution of individuals For j = 1 TO gs i=(s-1)*gs + j position(i, 1) = CINT(RND*899) + 1 status(i, 1) = 0 status(i, 2) = 0 seeds(i) = 0 hotspot(i) = 0 target(i) = -1 idsite(i) = -1 surv(i) = 1 Next j For j = 1 To 5 sumjoin(j) = 0 sumvig(j) = 0 Next j patchprod=0 patchscr=0 feeding=0 Return REM main program prog: For j = 1 TO gs i=(s-1)*gs + j site = position(i, 1) If status(i, 1) = 0 Then If food(site) = 0 Then GoSub target If target(i) = -1 then status(i, 2) = 0 GoSub move End If If target(i) > -1 Then ntarget = nposit(target(i)) If ntarget > 5 Then ntarget = 5 chance = Rnd If chance <= tactjoin(i,ntarget) Then status(i, 2) = 2 GoSub smove End If If chance > tactjoin(i,ntarget) Then status(i, 2) = 0 target(i) = -1 GoSub move End If End If End If If food(site) > 0 Then nposit(site) = nposit(site) + 1 hotspot(i) = site status(i, 2) = 1 target(i) = -1 GoSub exploit seeds(i) = seeds(i) + reward position(i, 2) = site If i = r Then patchprod = patchprod + 1 feeding = feeding + reward EndIf End If End If If status(i, 1) = 1 Then If food(site) = 0 Then GoSub move nposit(site) = nposit(site) - 1 status(i, 2) = 0 target(i) = -1 hotspot(i) = 0 End if If food(site) > 0 then status(i, 2) = 1 GoSub exploit seeds(i) = seeds(i) + reward position(i, 2) = site If i = r Then feeding = feeding + reward End If End If If status(i, 1) = 2 Then If food(target(i)) > 0 Then GoSub smove If food(target(i))<= 0 Then GoSub move status(i, 2) = 0 target(i) = -1 EndIf EndIf position(i, 1) = position(i, 2) status(i, 1) = status(i, 2) Next j Return REM subroutine movements move: chance = RND If chance < .25 Then position(i, 2) = position(i, 1) - 30 For a = 1 To 30 If position(i, 1) = a Then position(i, 2) = position(i, 1) + 30 Next a End If If (chance >= .25) and (chance < .5) Then position(i, 2) = position(i, 1) + 30 For a = 1 To 30 If position(i, 1) = 870 + a Then position(i, 2) = position(i, 1) - 30 Next a End If If (chance >= .5) and (chance < .75) Then position(i, 2) = position(i, 1) + 1 For a = 1 To 30 If position(i, 1) = 30*a Then position(i, 2) = position(i, 1) - 1 Next a End If If chance >= .75 Then position(i, 2) = position(i, 1) - 1 For a = 0 To 29 If position(i, 1) = (30 * a) + 1 then position(i, 2) = position(i, 1) + 1 Next a End If Return REM subroutine recreate patches recreate: chance = CINT(RND*899) + 1 While food(chance) > 0 chance = CINT(899*RND) + 1 Wend fr(chance) = 1 luck = Rnd If luck <= 0.333 THEN food(chance) = 0.5*f If (luck > 0.333) AND (luck <= 0.666) THEN food(chance) = f If luck > 0.666 THEN food(chance) = 1.5*f Return REM subroutine exploitation exploit: npred = nposit(site) If npred > 5 Then npred = 5 reward = fr(site)*(1-tactvig(i, npred)) fpatch = food(site) - reward If fpatch > 0 Then food(site) = fpatch End If If fpatch = 0 Then GoSub recreate food(site) = 0 fr(site) = 0 End If If fpatch < 0 Then reward = food(site) GoSub recreate food(site) = 0 fr(site) = 0 End If Return Rem subroutine predation pred: attack = 0 idgroup = 0 gsize = 0 siteattack = -1 idattack = -1 forage = 0 nsite = 0 iddead = -1 attacksuccess = 0 If Rnd < attackrate Then Rem attack launched attack = 1 For a = 1 To l If nposit(a) > 0 Then idgroup = idgroup + 1 grouppos(idgroup) = a EndIf Next idattack = CInt((idgroup - 1)*Rnd + 1) siteattack = grouppos(idattack) For a = 1 To gs b = (s - 1)*gs + a If position(b, 1) = siteattack Then gsize = gsize + 1 idsite(gsize) = b EndIf Next If gsize > 0 Then If gsize > 5 Then nsite = 5 If gsize <= 5 Then nsite = gsize For a = 1 To gsize If Rnd > tactvig(idsite(a), nsite) Then forage = forage + 1 Next If forage = gsize Then iddead = CInt((gsize - 1)*Rnd + 1) surv(idsite(iddead)) = 0 attacksuccess = 1 position(idsite(iddead), 1) = CINT(RND*899) + 1 nposit(siteattack) = nposit(siteattack) - 1 status(idsite(iddead), 1) = 0 Rem dead individual reallocated elsewhere EndIf EndIf EndIf Return Rem subroutine find a target target: threshold = 1000 For a = 1 TO r if hotspot(a) > 0 Then diff = abs(hotspot(a) - position(i, 1)) c1 = cint(diff/30) c2 = diff - (c1*30) if c2 < 0 Then c1 = c1 - 1 c2 = diff - (c1*30) steps = c1 + c2 if steps < threshold Then threshold = steps target(i) = hotspot(a) End If End If Next a Return Rem subroutine joining patches smove: posvar = position(i, 1) - target(i) If posvar = 0 and food(position(i, 1)) > 0 Then status(i, 2) = 1 nposit(site) = nposit(site) + 1 hotspot(i) = position(i, 1) position(i, 2) = site If i = r Then patchscr = patchscr + 1 End If If posvar = 0 and food(position(i, 1)) <= 0 Then status(i, 2) = 0 target(i) = -1 End If If posvar >= 30 Then position(i, 2) = position(i, 1) - 30 If (posvar >= 1) And (posvar < 30) Then position(i, 2) = position(i, 1) - 1 If posvar <= -30 Then position(i, 2) = position(i, 1) + 30 If (posvar <= -1) and (posvar > -30) Then position(i, 2) = position(i, 1) + 1 Return REM fitness fitness: For i = 1 to r rank(i) = 0 success(i) = seeds(i)/tmax If surv(i) = 0 Then success(i) = 0 Next i rank(1) = success(1) For i = 2 to r if success(i) > rank(i-1) Then rank(i) = success(i) if success(i) <= rank(i-1) Then var1 = 0 For j = 1 to i-1 if success(i) <= rank(j) Then var1 = j For k = j to i-1 sort(k) = rank(k) Next k For k = j to i-1 rank(k+1) = sort(k) Next k rank(var1) = success(i) End If if var1 > 0 Then j = i Next j End If Next i Return REM reproduction and mutation reproduction: j = 0 k = 0 for i = 1 to r If success(i) <= rank(0.5*r) Then j = j + 1 id1(j) = i End If If success(i) > rank(0.5*r) Then k = k + 1 id2(k) = i End If Next i For i = 1 to r/2 For j = 1 To 5 tactjoin(id1(i), j) = tactjoin(id2(i), j) tactvig(id1(i), j) = tactvig(id2(i), j) Next j Next i For i = 1 to r For j = 1 To 5 if Rnd < mutarate Then tactjoin(i, j) = Rnd If Rnd < mutarate Then tactvig(i, j) = Rnd Next j Next i Return REM results results: fit = 0 meanfitness = 0 For i = 1 to r fit = fit + success(i) For j = 1 To 5 sumjoin(j) = sumjoin(j) + tactjoin(i, j) sumvig(j) = sumvig(j) + tactvig(i, j) Next j Next i meanfitness = fit/r meanvig1 = sumvig(1)/r meanvig2 = sumvig(2)/r meanvig5 = sumvig(5)/r meanjoin1 = sumjoin(1)/r If t = simmax Then For j = 1 To 5 meanjoin(j) = sumjoin(j)/r meanvig(j) = sumvig(j)/r Next j EndIf Return