Option Explicit

Const GCMonteCarloRuns = 10000

Sub Schedule()
'Calculate chances for an attacker at the game of risk for both the original
'version (both attacker and defender roll up to 3 dice) and the new version
'(attacker rolls up to 3 dice, defender only up to 2).
'Calls parametrized sub Calculate_Chances twice.
'Source (EN): http://www.sulprobil.de/game_of_risk_en/
'Source (DE): http://www.berndplumhoff.de/brettspiel_risiko_de/
'(C) (P) by Bernd Plumhoff 30-Sep-2012 PB V0.1
Dim ws As Worksheet
Dim cPerf As clsPerf 'See: https://jkp-ads.com/Articles/performanceclass.asp

'Include SystemState class from http://sulprobil.com/html/systemstate.html
Dim state As SystemState
If gbDebug Then
  Set cPerf = New clsPerf
  cPerf.SetRoutine "Schedule"
End If
Application.StatusBar = False
Set state = New SystemState

'Preparation
Set ws = Sheets("Chances")
ws.Cells.ClearContents

Call Calculate_Chances("Old Version: Both Attacker and defender roll up to" & _
  " 3 dice.", 1, 3)
Call Calculate_Chances("New Version: Attacker rolls up to 3 dice, defender" & _
  " only up to 2.", 23, 2)
                        
Call ReportPerformance

End Sub

Sub Calculate_Chances(sTitle As String, _
    lOutputRow As Long, _
    lMaxDefenderArmies As Long)
'Calculate chances for an attacker at the game of risk.
'This sub calculates the chances for a matrix of 2 to 20 attacking armies
'against 1 to 20 defending armies.
'Reverse(moc.liborplus.www) V0.1 30-Sep-2012
Dim i As Long
Dim j As Long
Dim k As Long
Dim m As Long
Dim lAttackerDice As Long
Dim lAttackerThrow As Long
Dim lAttackerResult(1 To 3) As Long
Dim lAttackerWins As Long
Dim lDefenderDice As Long
Dim lDefenderThrow As Long
Dim lDefenderResult(1 To 3) As Long
Dim ws As Worksheet
Dim cPerf As clsPerf 'See: https://jkp-ads.com/Articles/performanceclass.asp

'Include SystemState class from http://sulprobil.com/html/systemstate.html
Dim state As SystemState
If gbDebug Then
  Set cPerf = New clsPerf
  cPerf.SetRoutine "Calculate_Chances"
End If

Application.StatusBar = False
Set state = New SystemState

With Application.WorksheetFunction
'Preparation
Set ws = Sheets("Chances")
ws.Cells(lOutputRow, 1) = sTitle
ws.Cells(lOutputRow + 1, 1) = "Attacker armies \ Defender armies"
For i = 2 To 20
  Application.StatusBar = "Calculating " & i & " attackers for " & sTitle
  For j = 1 To 20
    ws.Cells(i + lOutputRow, 1) = i
    ws.Cells(1 + lOutputRow, j + 1) = j
    lAttackerWins = 0
    For k = 1 To GCMonteCarloRuns
      lAttackerDice = i - 1 'One army needs to occupy the land and
                            'cannot be used to attack
      lDefenderDice = j
      Do While lAttackerDice > 0 And lDefenderDice > 0
        lAttackerThrow = lAttackerDice
        If lAttackerThrow > 3 Then lAttackerThrow = 3
        lDefenderThrow = lDefenderDice
        If lDefenderThrow > lMaxDefenderArmies Then
          lDefenderThrow = lMaxDefenderArmies
        End If
        'Roll the dice
        For m = 2 To 3
          lAttackerResult(m) = 0
          lDefenderResult(m) = 0
        Next m
        For m = 1 To lAttackerThrow
          lAttackerResult(m) = Int(1 + Rnd * 6)
        Next m
        For m = 1 To lDefenderThrow
          lDefenderResult(m) = Int(1 + Rnd * 6)
        Next m
        'Sort results
        If lAttackerResult(1) < lAttackerResult(2) Then
          If lAttackerResult(1) < lAttackerResult(3) Then
              If lAttackerResult(2) < lAttackerResult(3) Then
                  '3-2-1
                  m = lAttackerResult(1)
                  lAttackerResult(1) = lAttackerResult(3)
                  lAttackerResult(3) = m
              Else
                  '2-3-1
                   m = lAttackerResult(1)
                  lAttackerResult(1) = lAttackerResult(2)
                  lAttackerResult(2) = lAttackerResult(3)
                  lAttackerResult(3) = m
              End If
          Else
              '2-1-3
              m = lAttackerResult(1)
              lAttackerResult(1) = lAttackerResult(2)
              lAttackerResult(2) = m
          End If
        Else
          If lAttackerResult(1) < lAttackerResult(3) Then
              If lAttackerResult(2) < lAttackerResult(3) Then
                  '3-1-2
                  m = lAttackerResult(1)
                  lAttackerResult(1) = lAttackerResult(3)
                  lAttackerResult(3) = lAttackerResult(2)
                  lAttackerResult(2) = m
              End If
          Else
              If lAttackerResult(2) < lAttackerResult(3) Then
                  '1-3-2
                  m = lAttackerResult(2)
                  lAttackerResult(2) = lAttackerResult(3)
                  lAttackerResult(3) = m
              End If
          End If
        End If
        If lDefenderResult(1) < lDefenderResult(2) Then
          If lDefenderResult(1) < lDefenderResult(3) Then
            If lDefenderResult(2) < lDefenderResult(3) Then
              '3-2-1
              m = lDefenderResult(1)
              lDefenderResult(1) = lDefenderResult(3)
              lDefenderResult(3) = m
            Else
              '2-3-1
               m = lDefenderResult(1)
              lDefenderResult(1) = lDefenderResult(2)
              lDefenderResult(2) = lDefenderResult(3)
              lDefenderResult(3) = m
            End If
          Else
            '2-1-3
            m = lDefenderResult(1)
            lDefenderResult(1) = lDefenderResult(2)
            lDefenderResult(2) = m
          End If
        Else
          If lDefenderResult(1) < lDefenderResult(3) Then
            If lDefenderResult(2) < lDefenderResult(3) Then
              '3-1-2
              m = lDefenderResult(1)
              lDefenderResult(1) = lDefenderResult(3)
              lDefenderResult(3) = lDefenderResult(2)
              lDefenderResult(2) = m
            End If
          Else
            If lDefenderResult(2) < lDefenderResult(3) Then
              '1-3-2
              m = lDefenderResult(2)
              lDefenderResult(2) = lDefenderResult(3)
              lDefenderResult(3) = m
            End If
          End If
        End If
        'Analyze result and reduce armies
        For m = 1 To 3
          If lAttackerResult(m) > 0 And lDefenderResult(m) > 0 Then
            If lAttackerResult(m) > lDefenderResult(m) Then
              lDefenderDice = lDefenderDice - 1
            Else
              lAttackerDice = lAttackerDice - 1
            End If
          Else
            Exit For
          End If
        Next m
      Loop
      If lAttackerDice > 0 Then
        lAttackerWins = lAttackerWins + 1
      End If
    Next k
    ws.Cells(i + lOutputRow, j + 1) = lAttackerWins / GCMonteCarloRuns
  Next j
Next i
End With
End Sub