The following is the code of the program used in Jaffe & Cipriani (in press, Journal of Artificial Societies and Social Simulation)

The following is the code of the program used in Jaffe & Cipriani (in press, Journal of Artificial Societies and Social Simulation). The code is written in MS Visual Basic 2005, following more a functional style rather than an object oriented style. Main subroutines and functions are reproduced but instructions related to the GUI are not shown. Routines are presented in no particular order. If you are intersted in a running copy of this program or its source code, please write to Klaus Jaffe (kjaffe@usb.ve) or Roberto Cipriani (rcipri@usb.ve).

Option Strict Off

Option Explicit On

Friend Class frmMain

Inherits System.Windows.Forms.Form

Dim SimStop, ViewCounter As Boolean

-----------------------------------

Sub Calculate_Natural_Mortality (ByRef Geno() As Short, ByRef Pheno() As Short, ByRef SZ As Integer, ByRef PNCOM As Double, ByRef PCOM As Double)

Dim r1 As Single

Dim z As Integer

Dim ires As Short

For z = 1 To SZ

ires = Pheno(z)

r1 = Rnd()

'Natural Mortality - Non-collaborators

If ires = 1 Then

If r1 <= PNCOM Then

Pheno(z) = 0

Geno(z) = 0

End If

'Natural Mortality - Collaborators

ElseIf ires = 2 Then

If r1 <= PCOM Then

Pheno(z) = 0

Geno(z) = 0

End If

End Sub

-----------------------------------

Sub Calculate_Reproduction(ByRef Geno() As Short, ByRef Pheno() As Short, ByRef SZ As Integer, ByRef PRCO As Double, ByRef PRNCO As Double)

Dim h As Integer

Dim ires As Short

Dim r1 As Single

Randomize()

For h = 1 To SZ

If Me.RadioButton1.Checked Then

ires = Geno(h)

ElseIf Me.RadioButton2.Checked Then

ires = Pheno(h)

End If

If ires = 0 Then 'if an empty space is found, then...

r1 = Rnd()

If r1 <= PRNCO Then

Geno(h) = 1 'a non-collaborator recruits

Pheno(h) = 1

Else

Geno(h) = 2 'a collaborator recruits

Pheno(h) = 2

End If

End Sub

-----------------------------------

Sub Count_Members(ByRef Geno() As Short, ByRef Pheno() As Short, ByRef SZ As Integer, ByRef SNCO As Integer, ByRef SCO As Integer, ByRef geneSNCO As Integer, ByRef geneSCO As Integer, ByRef SCO_0V As Integer, ByRef SCO_1V As Integer, ByRef SCO_2V As Integer, ByRef SEM As Integer)

Dim m As Integer

Dim ires_N1, ires, ires_N2 As Short, gires As Short

Dim loc_N1, loc_N2 As Integer

For m = 1 To SZ

ires = Pheno(m)

loc_N1 = Neig(m, SZ, -1)

ires_N1 = Pheno(loc_N1)

loc_N2 = Neig(m, SZ, 1)

ires_N2 = Pheno(loc_N2)

If Me.RadioButton1.Checked Then gires = Geno(m)

If ires = 1 Then

SNCO = SNCO + 1

ElseIf ires = 2 Then

SCO = SCO + 1

ElseIf ires = 0 Then

SEM = SEM + 1

End If

If Me.RadioButton1.Checked Then

If gires = 1 Then

geneSNCO = geneSNCO + 1

ElseIf gires = 2 Then

geneSCO = geneSCO + 1

End If

ElseIf Me.RadioButton2.Checked Then

geneSNCO = 0

geneSCO = 0

End If

'Collaborators + 0 neighbors

If ires = 2 And (ires_N1 <> 2 And ires_N2 <> 2) Then 'collaborator 0V

SCO_0V = SCO_0V + 1

'Collaborators + 2 neighbors

ElseIf ires = 2 And ires_N1 = 2 And ires_N2 = 2 Then 'collaborator 2V

SCO_2V = SCO_2V + 1

'Collaborators + 1 neighbor

ElseIf ires = 2 And ((ires_N1 = 2 And ires_N2 <> 2) Or (ires_N1 <> 2 And ires_N2 = 2)) Then 'collaborator 2V

SCO_1V = SCO_1V + 1

End If

End Sub

-----------------------------------

Sub Calculate_Heredity(ByRef PRCO As Double, ByRef PRNCO As Double, ByRef SCO As Integer, ByRef SNCO As Integer)

PRCO = SCO / (SNCO + SCO)

PRNCO = SNCO / (SNCO + SCO)

End Sub

-----------------------------------

Function Neig(ByRef ii As Integer, ByRef SS As Integer, ByRef icheck As Short) As Integer

If ii = 1 And icheck < 0 Then

Neig = SS

ElseIf ii = SS And icheck > 0 Then

Neig = 1

ElseIf ii = 1 And icheck > 0 Then

Neig = ii + 1

ElseIf ii = SS And icheck < 0 Then

Neig = ii – 1

ElseIf (ii < SS And ii > 1) And icheck < 0 Then

Neig = ii - 1

ElseIf (ii < SS And ii > 1) And icheck > 0 Then

Neig = ii + 1

End If

End Function

-----------------------------------

Sub Calculate_Predation(ByRef Geno() As Short, ByRef Pheno() As Short, ByRef SZ As Integer, ByRef PNCO As Double, ByRef PCO0V As Double, ByRef PCO1V As Double, ByRef PCO2V As Double)

Dim q As Integer

Dim ires_N1, ires, ires_N2 As Short

Dim loc_N1, loc_N2 As Integer

Dim r1 As Double

Dim PhenoCopy(SZ)

For q = 1 To SZ

PhenoCopy(q) = 0

For q = 1 To SZ

ires = Pheno(q)

loc_N1 = Neig(q, SZ, -1)

ires_N1 = Pheno(loc_N1)

loc_N2 = Neig(q, SZ, 1)

ires_N2 = Pheno(loc_N2)

r1 = CDbl(Rnd())

If Me.CheckBox2.Checked Then 'if free riders around…

'Free riders

If ires = 1 And ires_N1 <> 2 And ires_N2 <> 2 Then

If r1 <= PNCO Then PhenoCopy(q) = 1

'0 neighbors

ElseIf ires = 2 And ires_N1 <> 2 And ires_N2 <> 2 Then

If r1 <= PCO0V Then PhenoCopy(q) = 1

'2 neighbors

ElseIf (ires = 2 Or ires = 1) And ires_N1 = 2 And ires_N2 = 2 Then

If r1 <= PCO2V Then PhenoCopy(q) = 1

'1 neighbor

ElseIf (ires = 2 Or ires = 1) And ((ires_N1 = 2 And ires_N2 <> 2) Or (ires_N1 <> 2 And ires_N2 = 2)) Then

If r1 <= PCO1V Then PhenoCopy(q) = 1

End If

Else

'Non-collaborators

If ires = 1 Then

If r1 <= PNCO Then PhenoCopy(q) = 1

'Collaborators + 0 neighbors

ElseIf ires = 2 And ires_N1 <> 2 And ires_N2 <> 2 Then

If r1 <= PCO0V Then PhenoCopy(q) = 1

'Collaborators + 2 neighbors

ElseIf ires = 2 And ires_N1 = 2 And ires_N2 = 2 Then

If r1 <= PCO2V Then PhenoCopy(q) = 1

'Collaborators + 1 neighbor

ElseIf ires = 2 And ((ires_N1 = 2 And ires_N2 <> 2) Or (ires_N1 <> 2 And ires_N2 = 2)) Then

If r1 <= PCO1V Then PhenoCopy(q) = 1

End If

Next 'q

'Updating Array Pheno with deaths by predation

For q = 1 To SZ

If PhenoCopy(q) = 1 Then

Pheno(q) = 0 'Dead by predation

Geno(q) = 0

End If

Erase PhenoCopy

End Sub

-----------------------------------

Sub Calculate_Conversion(ByRef Pheno() As Short, ByRef SZ As Integer, ByRef PC As Double)

Dim n As Integer

Dim r1 As Double

Dim PhenoCopy(SZ)

For n = 1 To SZ

If Pheno(n) = 1 Then

r1 = CDbl(Rnd())

If n = 1 Then

If Pheno(SZ) = 2 Or Pheno(n + 1) = 2 Then

If r1 <= PC Then PhenoCopy(n) = 1

End If

ElseIf n > 1 And n < SZ Then

If Pheno(n - 1) = 2 Or Pheno(n + 1) = 2 Then

If r1 <= PC Then PhenoCopy(n) = 1

End If

ElseIf n = SZ Then

If Pheno(n - 1) = 2 Or Pheno(1) = 2 Then

If r1 <= PC Then PhenoCopy(n) = 1

End If

'Updating Array Pheno with conversion

For n = 1 To SZ

If PhenoCopy(n) = 1 Then Pheno(n) = 2 'Converted to CO

Erase PhenoCopy

End Sub

-----------------------------------

Sub Calculate_Conversion_Majority(ByRef Pheno() As Short, ByRef SZ As Integer, ByRef PC As Double)

Dim n As Integer

Dim r1 As Double

Dim PhenoCopy(SZ)

For n = 1 To SZ

PhenoCopy(n) = Pheno(n)

'Tranformacion noc a co y co a nco

For n = 1 To SZ

r1 = CDbl(Rnd())

If r1 <= PC Then

If n = 1 Then

If Pheno(SZ) = Pheno(n + 1) And Pheno(SZ) > 0 And Pheno(n) > 0 Then

PhenoCopy(n) = Pheno(SZ)

End If '

ElseIf n > 1 And n < SZ Then

If Pheno(n - 1) = Pheno(n + 1) And Pheno(n - 1) > 0 And Pheno(n) > 0 Then

PhenoCopy(n) = Pheno(n - 1)

End If

ElseIf n = SZ Then

If Pheno(n - 1) = Pheno(1) And Pheno(n - 1) > 0 And Pheno(n) > 0 Then

PhenoCopy(n) = Pheno(n - 1)

End If

Next 'n

'Updating Array Pheno with conversion

For n = 1 To SZ

Pheno(n) = PhenoCopy(n) 'Converted to CO

Erase PhenoCopy

End Sub

-----------------------------------

Private Function Limit(ByRef ii As Integer, ByVal SS As Integer) As Integer

If ii > SS Then Return ii - SS Else Return ii

End Function

-----------------------------------

Sub Main_Model()

'Improved routine that simulates a modified model based on that of Cipriani & Jaffe 2004

Randomize()

'Dimension Variables

Dim i As Integer, j As Integer

Dim idat As Short

Dim r1 As Double

Dim r2 As Integer, r3 As Integer

Dim NumIter As Integer, interval As Integer

Dim P_CO_2V As Double, P_CO_0V As Double, P_CO_1V As Double, P_NCO As Double

Dim P_Rep_CO As Double, P_Rep_NCO As Double

Dim P_conv As Double, P_CO_M As Double, P_NCO_M As Double, nn As Double, cc As Double

Dim sumCO As Integer, sumNCO As Integer, GsumCO As Integer, GsumNCO As Integer, sumES As Integer

Dim sumCO_2V As Integer, sumCO_0V As Integer, sumCO_1V As Integer, sumNCO_0V As Integer

Dim SampleSize As Integer

Dim Heredity As Boolean

Dim bb As String, st As String, pp As String

Dim fn2 As String, fn3 As String, fn As String

Dim prop_nco As Double, prop_co As Double

'Variable Values

'Heredity

bb = ""

If Me.CheckBox4.Checked Then 'heredity

bb = "H"

Heredity = True

P_Rep_CO = 0

P_Rep_NCO = 0

Else 'NO heredity

Heredity = False

bb = "NH"

P_Rep_CO = 0.5

P_Rep_NCO = 0.5

End If

'Mortality by Natural Causes

P_CO_M = CDbl(Me.Text4(4).Text) 'mortality

P_NCO_M = CDbl(Me.Text4(5).Text)

'Mortality by Predation

P_CO_0V = CDbl(Me.Text4(1).Text)

P_CO_1V = CDbl(Me.Text4(2).Text)

P_CO_2V = CDbl(Me.Text4(3).Text)

P_NCO = CDbl(Me.Text4(0).Text)

'Conversion

P_conv = CDbl(Me.Text4(6).Text)

'Initial conditions (%)

nn = CDbl(Me.Text4(8).Text) 'Non-collaborators

cc = CDbl(Me.Text4(7).Text) 'Collaborators

Me.TextBox3.Text = CStr(CInt(VB.Timer()))

pp = Me.TextBox3.Text

fn = ""

'Iterations and Sample Size

NumIter = CInt(Me.Text3.Text)

SampleSize = CInt(Me.Text2.Text)

interval = 10

'Parameters and Titles for text file

If Me.CheckBox3.Checked Then 'if print checked

'Parameters(File * OK)

st = CStr(Today) & " " & CStr(TimeOfDay) & Chr(13)

st = st & "Iterations:," & CStr(NumIter) & Chr(13)

st = st & "Ecosystem Size:," & CStr(SampleSize) & Chr(13)

st = st & "Prob. Nat. Mortality CO:," & CStr(P_CO_M) & Chr(13)

st = st & "Prob. Nat. Mortality NCO:," & CStr(P_NCO_M) & Chr(13)

st = st & "Prob. Pred. Mortality CO + 0V:," & CStr(P_CO_0V) & Chr(13)

st = st & "Prob. Pred. Mortality CO + 1V:," & CStr(P_CO_1V) & Chr(13)

st = st & "Prob. Pred. Mortality CO + 2V:," & CStr(P_CO_2V) & Chr(13)

st = st & "Prob. Pred. Mortality NCO:," & CStr(P_NCO) & Chr(13)

st = st & "Prob. Conversion:," & CStr(P_conv) & Chr(13)

st = st & "Heredity:," & CStr(Heredity)

fn = My.Application.Info.DirectoryPath & "\RoleProp_" & CStr(nn) & "_cc" & CStr(cc) & "_" & bb & "_" & CStr(pp) & ".csv"

fn2 = My.Application.Info.DirectoryPath & "\SimParam_" & CStr(nn) & "_cc" & CStr(cc) & "_" & bb & "_" & CStr(pp) & ".csv"

FileOpen(1, fn2, OpenMode.Output)

PrintLine(1, st)

FileClose(1)

'Title Data File

st = ""

st = "N.iter, CO, NCO, g-CO, g-NCO,ES, NCO_0V, CO_0V, CO_1V, CO_2V"

FileOpen(1, fn, OpenMode.Output)

PrintLine(1, st)

FileClose(1)

End If

'Dimension Array -----------------------------------------------------------------

Dim Pheno(SampleSize) As Short

Dim Geno(SampleSize) As Short

'Initialization --------------------------------------------------------------------

For i = 1 To SampleSize

r1 = CDbl(Rnd())

If r1 <= nn Then

idat = 1 'non collaborators

ElseIf r1 > nn And r1 <= (nn + cc) Then

idat = 2 'collaborators

ElseIf r1 > (nn + cc) Then

idat = 0 'empty

End If

Geno(i) = idat

'Gene Expression ----------------------------------------------------------------------

'Genotypes expresses the phenotype

Gene_Expression(Geno, Pheno, SampleSize)

'First Count ----------------------------------------------------------------------

sumCO = 0

sumNCO = 0

GsumCO = 0

GsumNCO = 0

sumES = 0

sumCO_0V = 0

sumCO_1V = 0

sumCO_2V = 0

sumNCO_0V = 0

Count_Members(Geno, Pheno, SampleSize, sumNCO, sumCO, GsumNCO, GsumCO, sumCO_0V, sumCO_1V, sumCO_2V, sumES)

prop_co = sumCO / (sumNCO + sumCO)

prop_nco = sumNCO / (sumNCO + sumCO)

Me.TextBox1.Text = Format(prop_co, "#0.0##")

Me.TextBox2.Text = Format(prop_nco, "#0.0##")

If Me.RadioButton1.Checked Then 'if Darwinian

prop_co = GsumCO / (GsumNCO + GsumCO)

prop_nco = GsumNCO / (GsumNCO + GsumCO)

Me.TextBox5.Text = Format(prop_co, "#0.0##")

Me.TextBox4.Text = Format(prop_nco, "#0.0##")

ElseIf Me.RadioButton2.Checked Then

Me.TextBox5.Text = "0.0"

Me.TextBox4.Text = "0.0"

End If

'Estimating heredity First Time ---------------------------------------------------------

If Heredity Then

P_Rep_CO = 0

P_Rep_NCO = 0

If Me.RadioButton1.Checked Then

Calculate_Heredity(P_Rep_CO, P_Rep_NCO, GsumCO, GsumNCO)

ElseIf Me.RadioButton2.Checked Then

Calculate_Heredity(P_Rep_CO, P_Rep_NCO, sumCO, sumNCO)

End If

Else

P_Rep_CO = 0.5

P_Rep_NCO = 0.5

End If

'Saving Data ---------------------------------------------------------------------------

If Me.CheckBox3.Checked Then

st = ""

st = st & CStr(0) & "," & CStr(sumCO) & "," & CStr(sumNCO) & "," & CStr(GsumCO) & "," & CStr(GsumNCO) & "," & CStr(sumES) & "," &

…CStr(sumNCO_0V) & "," & CStr(sumCO_0V) & "," & CStr(sumCO_1V) & "," & CStr(sumCO_2V)

FileOpen(1, fn, OpenMode.Append)

PrintLine(1, st)

FileClose(1)

End If

'Loop STARTS HERE

ViewCounter = True

SimStop = False

For j = 1 To NumIter

System.Windows.Forms.Application.DoEvents()

If ViewCounter Then

If j Mod interval = 0 Then Me.Text1.Text = CStr(j)

Me.Text1.Refresh()

End If

If SimStop = True Then

Me.Text1.Text = "Ready"

Me.Text1.Refresh()

System.Array.Clear(Pheno, 0, Pheno.Length)

'System.Array.Clear(PhenoCopy, 0, PhenoCopy.Length)

System.Array.Clear(Geno, 0, Geno.Length)

Exit Sub

End If

'SIMULATION CORE *******************************************************************

'Conversion OK--------------------------------------------------------------------

Calculate_Conversion_Majority(Pheno, SampleSize, P_conv)

''Shuffling____________________________________________________________________

Dim dummy As Short

If Me.CheckBox1.CheckState = 1 Then

For i = 1 To SampleSize * 2

r2 = CInt((SampleSize - 1) * Rnd() + 1)

r3 = CInt((SampleSize - 1) * Rnd() + 1)

dummy = Pheno(r2)

Pheno(r2) = Pheno(r3)

Pheno(r3) = dummy

dummy = Geno(r2)

Geno(r2) = Geno(r3)

Geno(r3) = dummy

End If

'Selective Predation----------------------------------------------------------------

Calculate_Predation(Geno, Pheno, SampleSize, P_NCO, P_CO_0V, P_CO_1V, P_CO_2V)

'Dead by Natural Mortality----------------------------------------------------

Calculate_Natural_Mortality(Geno, Pheno, SampleSize, P_NCO_M, P_CO_M)

'Counting----------------------------------------------------------------------

If Me.Check1.CheckState = 1 Then

sumCO = 0

sumNCO = 0

GsumCO = 0

GsumNCO = 0

sumES = 0

sumCO_0V = 0

sumCO_1V = 0

sumCO_2V = 0

sumNCO_0V = 0

Count_Members(Geno, Pheno, SampleSize, sumNCO, sumCO, GsumNCO, GsumCO, sumCO_0V, sumCO_1V, sumCO_2V, sumES)

End If

'Phenotypes

If j Mod interval = 0 And ViewCounter Then

prop_co = sumCO / (sumNCO + sumCO)

prop_nco = sumNCO / (sumNCO + sumCO)

If Me.RadioButton1.Checked Then 'if Darwinian

prop_co = GsumCO / (GsumNCO + GsumCO)

prop_nco = GsumNCO / (GsumNCO + GsumCO)

ElseIf Me.RadioButton2.Checked Then

‘

End If

'Heredity------------------------------------------------------------

If Heredity Then

P_Rep_CO = 0

P_Rep_NCO = 0

If Me.RadioButton1.Checked Then

Calculate_Heredity(P_Rep_CO, P_Rep_NCO, GsumCO, GsumNCO)

ElseIf Me.RadioButton2.Checked Then

Calculate_Heredity(P_Rep_CO, P_Rep_NCO, sumCO, sumNCO)

End If

Else

P_Rep_CO = 0.5

P_Rep_NCO = 0.5

End If

'Reproduction-----------------------------------------------------------------

Calculate_Reproduction(Geno, Pheno, SampleSize, P_Rep_CO, P_Rep_NCO)

'Evolutionary Stable Strategy - Invasions -----------------------------------------------------------------

If Me.CheckBox6.Checked And j = CInt(Me.TextBox10.Text) Then Calculate_ESS_Invasion(Geno, Pheno, SampleSize)

'Counting----------------------------------------------------------------------

If Me.Check1.CheckState = 0 Then

sumCO = 0

sumNCO = 0

GsumCO = 0

GsumNCO = 0

sumES = 0

sumCO_0V = 0

sumCO_1V = 0

sumCO_2V = 0

sumNCO_0V = 0

Count_Members(Geno, Pheno, SampleSize, sumNCO, sumCO, GsumNCO, GsumCO, sumCO_0V, sumCO_1V, sumCO_2V, sumES)

End If

'Phenotypes

If j Mod interval = 0 And ViewCounter Then

prop_co = sumCO / (sumNCO + sumCO) 'Phenotypes

prop_nco = sumNCO / (sumNCO + sumCO)

If Me.RadioButton1.Checked Then 'if Darwinian

prop_co = GsumCO / (GsumNCO + GsumCO)

prop_nco = GsumNCO / (GsumNCO + GsumCO)

ElseIf Me.RadioButton2.Checked Then

‘

End If

'***********************************************************************************

'Saving Data------------------------------------------------------------------------------

If Me.CheckBox3.Checked Then

st = ""

st = st & CStr(j) & "," & CStr(sumCO) & "," & CStr(sumNCO) & "," & CStr(GsumCO) & "," & CStr(GsumNCO) & "," & CStr(sumES) &

…"," & CStr(sumNCO_0V) & "," & CStr(sumCO_0V) & "," & CStr(sumCO_1V) & "," & CStr(sumCO_2V)

FileOpen(1, fn, OpenMode.Append)

PrintLine(1, st)

FileClose(1)

End If

Me.Text1.Text = "Ready"

Me.Text1.Refresh()

System.Array.Clear(Pheno, 0, Pheno.Length)

System.Array.Clear(Geno, 0, Geno.Length)

End Sub

-----------------------------------

Private Sub Gene_Expression(ByRef Geno() As Short, ByRef Pheno() As Short, ByRef NZ As Integer)

Dim i As Integer

For i = 1 To NZ

Pheno(i) = Geno(i)

End Sub

-----------------------------------

End Class