dilemma.bas

Sub prisionDilemma()

Dim player1() As String, player2() As String, prevp1 As String, prevp2 As String
Dim round As Integer
Dim k As Integer, n As Integer
Dim play1 As String, play2 As String
Dim legitfriedman As Boolean, legitdavis As Boolean
Dim good As Double, bad As Double, nice1 As Double, nice2 As Double, total_C As Double, total_D As Double
Dim p1score() As Integer, p2score() As Integer, ttlscore1() As Integer, ttlscore2() As Integer

legitfriedman = True
legitdavis = True
k = 200

good = 1#
bad = 0#
nice1 = 0
nice2 = 0
total_C = 0
total_D = 0

play1 = InputBox("What strategy do player 1 should use? You don't need to capitalize (random, tit for tat, davis, grofman, friedman, davis, downing)")
play2 = InputBox("What strategy do player 2 should use? You don't need to capitalize (random, tit for tat, davis, grofman, friedman, davis, downing)")

ReDim player1(1 To k)
ReDim player2(1 To k)
ReDim p1score(1 To k)
ReDim p2score(1 To k)
ReDim ttlscore1(1 To k)
ReDim ttlscore2(1 To k)

For round = 1 To k

If play1 = "random" Then
Call random(round, prevp2, prevp1, player1(), k)
ElseIf play1 = "tit for tat" Then
Call titfortat(round, prevp2, prevp1, player1(), k)
ElseIf play1 = "grofman" Then
Call grofman(round, prevp2, prevp1, player1(), k)
ElseIf play1 = "friedman" Then
Call friedman(round, prevp2, prevp1, player1(), k, legitfriedman)
ElseIf play1 = "davis" Then
Call davis(round, prevp2, prevp1, player1(), k, legitdavis)
ElseIf play1 = "downing" Then
Call downing(round, prevp2, prevp1, player1(), k, good, bad, nice1, nice2, total_C, total_D)
End If

If play2 = "random" Then
Call random(round, prevp1, prevp2, player2(), k)
ElseIf play2 = "tit for tat" Then
Call titfortat(round, prevp1, prevp2, player2(), k)
ElseIf play2 = "grofman" Then
Call grofman(round, prevp1, prevp2, player2(), k)
ElseIf play2 = "friedman" Then
Call friedman(round, prevp1, prevp2, player2(), k, legitfriedman)
ElseIf play2 = "davis" Then
Call davis(round, prevp1, prevp2, player2(), k, legitdavis)
ElseIf play2 = "downing" Then
Call downing(round, prevp1, prevp2, player2(), k, good, bad, nice1, nice2, total_C, total_D)
End If

Next round

' Score the score of players
Call score(player1, player2, p1score, p2score, k)

' Find the total scores
ttlscore1(1) = p1score(1)
ttlscore2(1) = p2score(1)


For Z = 2 To k

    ttlscore1(Z) = p1score(Z) + ttlscore1(Z - 1)
    ttlscore2(Z) = p2score(Z) + ttlscore2(Z - 1)

Next Z

' Print this value on the excel files
For n = 2 To k + 1
Cells(n, 1).Value = player1(n - 1)
Next n

For n = 2 To k + 1
Cells(n, 2).Value = player2(n - 1)
Next n

For n = 2 To k + 1
Cells(n, 3).Value = p1score(n - 1)
Next n

For n = 2 To k + 1
Cells(n, 4).Value = p2score(n - 1)
Next n

For n = 2 To k + 1
Cells(n, 5).Value = ttlscore1(n - 1)
Next n

For n = 2 To k + 1
Cells(n, 6).Value = ttlscore2(n - 1)
Next n

Cells(3, 8).Value = Cells(k + 1, 5).Value
Cells(3, 9).Value = Cells(k + 1, 6).Value


'Print out results
'For n = 2 To k + 1
'Cells(n, 1).Value = player1(n - 1)
'Next n

'For n = 2 To k + 1
'Cells(n, 2).Value = player2(n - 1)
'Next n
  
End Sub

Sub random(round As Integer, prevopponent As String, selfprev As String, random() As String, k As Integer)
Dim n As Integer
Dim x As Integer
ReDim Preserve random(1 To k + 1)



x = WorksheetFunction.RandBetween(1, 10)
If x < 5 Then
random(round) = "C"
Else: random(round) = "D"
End If
    
If round = 1 Then
selfprev = random(1)
Else: selfprev = random(round - 1)
End If

End Sub

Sub titfortat(round As Integer, prevopponent As String, selfprev As String, titfortat() As String, k As Integer)
Dim n As Integer
ReDim Preserve titfortat(1 To k)

If round = 1 Then
titfortat(1) = "C"
Else
titfortat(round) = prevopponent
End If

If round = 1 Then
selfprev = titfortat(1)
Else: selfprev = titfortat(round - 1)
End If

End Sub

Sub grofman(round As Integer, prevopponent As String, selfprev As String, grofman() As String, k As Integer)

ReDim Preserve grofman(1 To k)

If round = 1 Then grofman(round) = "C"
If round > 1 Then
    If prevopponent <> grofman(round - 1) Then
    x = WorksheetFunction.RandBetween(1, 9)
    If x < 3 Then
    grofman(round) = "C"
    Else: grofman(round) = "D"
    End If
    Else: grofman(round) = "C"
    End If
End If

If round = 1 Then
selfprev = grofman(1)
Else: selfprev = grofman(round - 1)
End If

End Sub

Sub friedman(round As Integer, prevopponent As String, selfprev As String, friedman() As String, k As Integer, legit As Boolean)

ReDim Preserve friedman(1 To k)

If legit = False Then
friedman(round) = "D"
Exit Sub
End If

If round = 1 Then friedman(round) = "C"
If round > 1 Then
    If prevopponent = "D" Then
    legit = False
    friedman(round) = "D"
    Else: friedman(round) = "C"
    End If
End If

If round = 1 Then
selfprev = friedman(1)
Else: selfprev = friedman(round - 1)
End If

End Sub

Sub davis(round As Integer, prevopponent As String, selfprev As String, davis() As String, k As Integer, legit As Boolean)

ReDim Preserve davis(1 To k)

If legit = False Then
davis(round) = "D"
Exit Sub
End If

If round <= 10 Then davis(round) = "C"
If round > 10 Then
    If prevopponent = "D" Then
    legit = False
    davis(round) = "D"
    Else: davis(round) = "C"
    End If
End If

If round = 1 Then
selfprev = davis(1)
Else: selfprev = davis(round - 1)
End If

End Sub

Sub downing(round As Integer, prevopponent As String, selfprev As String, downing() As String, k As Integer, good As Double, bad As Double, nice1 As Double, nice2 As Double, total_C As Double, total_D As Double)

Dim c As Double
Dim alt As Double

If round <= 2 Then
downing(round) = "D"
Exit Sub
End If

If round > 2 Then
    If downing(round - 1) = "D" Then
        If prevopponent = "C" Then
        nice2 = nice2 + 1
        total_D = total_D + 1
        bad = nice2 / total_D
        End If
    Else:
        If prevopponent = "C" Then
        nice1 = nice1 + 1
        total_C = total_C + 1
        good = nice1 / total_C
        End If
    End If
End If

c = 6 * good - 8 * bad - 2
alt = 4 * good - 5 * bad - 1

If c >= 0 And c >= alt Then
    downing(round) = "C"
ElseIf c >= 0 And c < alt Then
    If downing(round - 1) = "C" Then downing(round) = "D"
    If downing(round - 1) = "D" Then downing(round) = "C"
ElseIf alt >= 0 Then
    If downing(round - 1) = "C" Then downing(round) = "D"
    If downing(round - 1) = "D" Then downing(round) = "C"
Else: downing(round) = "D"
End If

If round = 1 Then
selfprev = downing(1)
Else: selfprev = downing(round - 1)
End If


End Sub

Sub score(player1() As String, player2() As String, player1score() As Integer, player2score() As Integer, k)

Dim y As Integer
ReDim Preserve player1(1 To k)
ReDim Preserve player2(1 To k)
ReDim Preserve player1score(1 To k)
ReDim Preserve player2score(1 To k)

For y = 1 To k

    If player1(y) = "C" And player2(y) = "C" Then
        player1score(y) = 3
        player2score(y) = 3
    ElseIf player1(y) = "C" And player2(y) = "D" Then
        player1score(y) = 0
        player2score(y) = 5
    ElseIf player1(y) = "D" And player2(y) = "C" Then
        player1score(y) = 5
        player2score(y) = 0
    ElseIf player1(y) = "D" And player2(y) = "D" Then
        player1score(y) = 1
        player2score(y) = 1
    End If

Next y

End Sub

Sub tournament()

Dim player1() As String, player2() As String, prevp1 As String, prevp2 As String
Dim round As Integer
Dim k As Integer, n As Integer, m As Integer, g As Integer, j As Integer, y As Integer
Dim play1 As String, play2 As String
Dim legitfriedman As Boolean, legitdavis As Boolean
Dim good As Double, bad As Double, nice1 As Double, nice2 As Double, total_C As Double, total_D As Double
Dim p1score() As Integer, p2score() As Integer, ttlscore1() As Integer, ttlscore2() As Integer

legitfriedman = True
legitdavis = True
k = 200

ReDim player1(1 To k)
ReDim player2(1 To k)
ReDim p1score(1 To k)
ReDim p2score(1 To k)
ReDim ttlscore1(1 To k)
ReDim ttlscore2(1 To k)

good = 1#
bad = 0#
nice1 = 0
nice2 = 0
total_C = 0
total_D = 0
legitfriedman = True
legitdavis = True

For n = 1 To 6

For round = 1 To 200
Call random(round, prevp2, prevp1, player1(), k)

If n = 1 Then
Call random(round, prevp1, prevp2, player2(), k)
ElseIf n = 2 Then
Call titfortat(round, prevp1, prevp2, player2(), k)
ElseIf n = 3 Then
Call grofman(round, prevp1, prevp2, player2(), k)
ElseIf n = 4 Then
Call friedman(round, prevp1, prevp2, player2(), k, legitfriedman)
ElseIf n = 5 Then
Call davis(round, prevp1, prevp2, player2(), k, legitdavis)
ElseIf n = 6 Then
Call downing(round, prevp1, prevp2, player2(), k, good, bad, nice1, nice2, total_C, total_D)
End If

Next round

Call score(player1, player2, p1score, p2score, k)

ttlscore1(1) = p1score(1)
ttlscore2(1) = p2score(1)


For Z = 2 To k
    ttlscore1(Z) = p1score(Z) + ttlscore1(Z - 1)
    ttlscore2(Z) = p2score(Z) + ttlscore2(Z - 1)
Next Z

If n = 1 Then Cells(8, 8).Value = ttlscore1(200)
If n = 2 Then
Cells(8, 9).Value = ttlscore1(200)
Cells(9, 8).Value = ttlscore2(200)
ElseIf n = 3 Then
Cells(8, 10).Value = ttlscore1(200)
Cells(10, 8).Value = ttlscore2(200)
ElseIf n = 4 Then
Cells(8, 11).Value = ttlscore1(200)
Cells(11, 8).Value = ttlscore2(200)
ElseIf n = 5 Then
Cells(8, 12).Value = ttlscore1(200)
Cells(12, 8).Value = ttlscore2(200)
ElseIf n = 6 Then
Cells(8, 13).Value = ttlscore1(200)
Cells(13, 8).Value = ttlscore2(200)
End If

Next n

'#2

good = 1#
bad = 0#
nice1 = 0
nice2 = 0
total_C = 0
total_D = 0
legitfriedman = True
legitdavis = True

For m = 1 To 5

For round = 1 To 200
Call titfortat(round, prevp2, prevp1, player1(), k)

If m = 1 Then
Call titfortat(round, prevp1, prevp2, player2(), k)
ElseIf m = 2 Then
Call grofman(round, prevp1, prevp2, player2(), k)
ElseIf m = 3 Then
Call friedman(round, prevp1, prevp2, player2(), k, legitfriedman)
ElseIf m = 4 Then
Call davis(round, prevp1, prevp2, player2(), k, legitdavis)
ElseIf m = 5 Then
Call downing(round, prevp1, prevp2, player2(), k, good, bad, nice1, nice2, total_C, total_D)
End If

Next round

Call score(player1, player2, p1score, p2score, k)

ttlscore1(1) = p1score(1)
ttlscore2(1) = p2score(1)


For Z = 2 To k
    ttlscore1(Z) = p1score(Z) + ttlscore1(Z - 1)
    ttlscore2(Z) = p2score(Z) + ttlscore2(Z - 1)
Next Z

If m = 1 Then Cells(9, 9).Value = ttlscore1(200)
If m = 2 Then
Cells(9, 10).Value = ttlscore1(200)
Cells(10, 9).Value = ttlscore2(200)
ElseIf m = 3 Then
Cells(9, 11).Value = ttlscore1(200)
Cells(11, 9).Value = ttlscore2(200)
ElseIf m = 4 Then
Cells(9, 12).Value = ttlscore1(200)
Cells(12, 9).Value = ttlscore2(200)
ElseIf m = 5 Then
Cells(9, 13).Value = ttlscore1(200)
Cells(13, 9).Value = ttlscore2(200)
End If

Next m

'#3

good = 1#
bad = 0#
nice1 = 0
nice2 = 0
total_C = 0
total_D = 0
legitfriedman = True
legitdavis = True

For g = 1 To 4

For round = 1 To 200
Call grofman(round, prevp2, prevp1, player1(), k)

If g = 1 Then
Call grofman(round, prevp1, prevp2, player2(), k)
ElseIf g = 2 Then
Call friedman(round, prevp1, prevp2, player2(), k, legitfriedman)
ElseIf g = 3 Then
Call davis(round, prevp1, prevp2, player2(), k, legitdavis)
ElseIf g = 4 Then
Call downing(round, prevp1, prevp2, player2(), k, good, bad, nice1, nice2, total_C, total_D)
End If

Next round

Call score(player1, player2, p1score, p2score, k)

ttlscore1(1) = p1score(1)
ttlscore2(1) = p2score(1)


For Z = 2 To k
    ttlscore1(Z) = p1score(Z) + ttlscore1(Z - 1)
    ttlscore2(Z) = p2score(Z) + ttlscore2(Z - 1)
Next Z

If g = 1 Then Cells(10, 10).Value = ttlscore1(200)
If g = 2 Then
Cells(10, 11).Value = ttlscore1(200)
Cells(11, 10).Value = ttlscore2(200)
ElseIf g = 3 Then
Cells(10, 12).Value = ttlscore1(200)
Cells(12, 10).Value = ttlscore2(200)
ElseIf g = 4 Then
Cells(10, 13).Value = ttlscore1(200)
Cells(13, 10).Value = ttlscore2(200)
End If

Next g

'#4
good = 1#
bad = 0#
nice1 = 0
nice2 = 0
total_C = 0
total_D = 0
legitfriedman = True
legitdavis = True

For j = 1 To 3

For round = 1 To 200
Call friedman(round, prevp2, prevp1, player1(), k, legitfriedman)


If j = 1 Then
Call friedman(round, prevp1, prevp2, player2(), k, legitfriedman)
ElseIf j = 2 Then
Call davis(round, prevp1, prevp2, player2(), k, legitdavis)
ElseIf j = 3 Then
Call downing(round, prevp1, prevp2, player2(), k, good, bad, nice1, nice2, total_C, total_D)
End If

Next round

Call score(player1, player2, p1score, p2score, k)

ttlscore1(1) = p1score(1)
ttlscore2(1) = p2score(1)


For Z = 2 To k
    ttlscore1(Z) = p1score(Z) + ttlscore1(Z - 1)
    ttlscore2(Z) = p2score(Z) + ttlscore2(Z - 1)
Next Z

If j = 1 Then Cells(11, 11).Value = ttlscore1(200)
If j = 2 Then
Cells(11, 12).Value = ttlscore1(200)
Cells(12, 11).Value = ttlscore2(200)
ElseIf j = 3 Then
Cells(11, 13).Value = ttlscore1(200)
Cells(13, 11).Value = ttlscore2(200)
End If

Next j

'#5
good = 1#
bad = 0#
nice1 = 0
nice2 = 0
total_C = 0
total_D = 0
legitfriedman = True
legitdavis = True

For y = 1 To 2

For round = 1 To 200
Call davis(round, prevp2, prevp1, player1(), k, legitdavis)

If y = 1 Then
Call davis(round, prevp1, prevp2, player2(), k, legitdavis)
ElseIf y = 2 Then
Call downing(round, prevp1, prevp2, player2(), k, good, bad, nice1, nice2, total_C, total_D)
End If

Next round

Call score(player1, player2, p1score, p2score, k)

ttlscore1(1) = p1score(1)
ttlscore2(1) = p2score(1)


For Z = 2 To k
    ttlscore1(Z) = p1score(Z) + ttlscore1(Z - 1)
    ttlscore2(Z) = p2score(Z) + ttlscore2(Z - 1)
Next Z

If y = 1 Then Cells(12, 12).Value = ttlscore1(200)
If y = 2 Then
Cells(12, 13).Value = ttlscore1(200)
Cells(13, 12).Value = ttlscore2(200)

End If

Next y

'#6
good = 1#
bad = 0#
nice1 = 0
nice2 = 0
total_C = 0
total_D = 0
legitdavis = True

For round = 1 To 200

Call downing(round, prevp2, prevp1, player1(), k, good, bad, nice1, nice2, total_C, total_D)
Call downing(round, prevp1, prevp2, player2(), k, good, bad, nice1, nice2, total_C, total_D)

Next round

Call score(player1, player2, p1score, p2score, k)

ttlscore1(1) = p1score(1)
ttlscore2(1) = p2score(1)

For Z = 2 To k
    ttlscore1(Z) = p1score(Z) + ttlscore1(Z - 1)
    ttlscore2(Z) = p2score(Z) + ttlscore2(Z - 1)
Next Z

Cells(13, 13).Value = ttlscore1(200)






End Sub