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 If

        Next

 

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 If

        Next

 

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

        Next 

 

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

        Next

        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

            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

        Next

        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

                End If

            End If

        Next 

        'Updating Array Pheno with conversion    

        For n = 1 To SZ

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

        Next

        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)

        Next

        '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

                End If

            End If

        Next  'n

        'Updating Array Pheno with conversion    

        For n = 1 To SZ

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

        Next

        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

        Next

        '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

                Next

            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

            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

            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

        Next 

        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)

        Next

 

End Sub

 

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

 

End Class