“The happiness of the drop is to die in the river.” [Imam Al-Ghazali]
Abstract
Do you know for the game of Risk 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)
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.
Appendix – Game of Risk Code
Please note that you should also include the SystemState class.
Please read my Disclaimer.
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
Please read my Disclaimer.
Chances_at_Game_of_Risk.xlsm [5) KB Excel file, open and use at your own risk]