I am a supporter of
St. Joseph's hospice.
 If you find this site useful or if it helped you, consider a small donation to
St. Joseph's, please.

Information on
St. Joseph's

JustGiving - Sponsor me now!

 

Risk

Most of us know the strategic board game Risk.

But do you also know which chances you have to win an attack if you have 15 armies on your country and the defending neighbour has 11?

Now, with the new (current) rules of the game you could attack with 14 of your 15 armies and you would have a chance of about 79% to win: (see blue circle in the bottom matrix)

Risk_Chances_02_Screen

I have applied a conditional format which colours the back in red for chances of about 50% and below, the colour is yellowish for chances between 50% and 75% and becomes green if your chances are higher than 75%.

Please notice that both matrices should theoretically be identical for the first two columns. Small differences are due to "incomplete" randomness of the finite Monte Carlo run with 10,000 tries.

The code:

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.
'Reverse(moc.liborplus.www) V0.1 30-Sep-2012
Dim ws As Worksheet
'Include SystemState class from http://sulprobil.com/html/systemstate.html
Dim state As SystemState
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)

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

'Include SystemState class from http://sulprobil.com/html/systemstate.html
Dim state As SystemState
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

Sulprobil   Get it done   Contact   Disclaimer   Download