riskApp

server.R

library(shiny)

#Dice funtion.  Leave sides flexible for alternate rules analysis.
dice<-function(rolls,sided=6){
  #Sorted rolls
  sort(sample(1:sided,rolls, replace=TRUE),decreasing=TRUE)
} 

#Function to choose attacker dice.
chooseAttackDice<-function(attackArmies){
  if(attackArmies > 3){
    attackDice<-3
  } else if(attackArmies == 3){
    attackDice<-2
  } else if(attackArmies == 2){
    attackDice<-1
  } else attackDice<-0
}

#Function to choose defender dice
chooseDefenseDice<-function(defenseArmies){
  if(defenseArmies > 1){
    defenseDice<-2
  } else if(defenseArmies == 1){
    defenseDice<-1
  } else defenseDice<-0  
}

#Function to battle to the last man.
battle<-function(attackArmies,defenseArmies){  
  
  while(attackArmies>1 && defenseArmies>0){  
    attackDice<-chooseAttackDice(attackArmies)
    defenseDice<-chooseDefenseDice(defenseArmies)
    
    #Roll Dice
    attackRoll<-dice(attackDice)
    defenseRoll<-dice(defenseDice)
    
    #Compare Rolls
    minSize<-min(length(attackRoll),length(defenseRoll))
    results<-head(attackRoll,minSize)-head(defenseRoll,minSize)
    defenseLoses<-sum(results>0)
    attackLoses<-sum(results<1)
    
    #result<-c(attackArmies-attackLoses,defenseArmies-defenseLoses)
    #print(result)
    attackArmies=attackArmies-attackLoses
    defenseArmies=defenseArmies-defenseLoses
  }
  #Record the results into two vectors.
  if(defenseArmies==0){
    aWins<<-aWins+1
    winVector[attackArmies]<<-winVector[attackArmies]+1
  } else dWins<<-dWins+1
  loseVector[defenseArmies]<<-loseVector[defenseArmies]+1
  
  new<-c(attackArmies,defenseArmies)
  
}

#Simulation function
sim<-function(att,def,sims=1000,sided=6,
              attColor="grey",defColor="palegreen",
              attLeft=5, defLeft=2){
  aWins<<-0
  dWins<<-0
  winVector<<-rep(0,att)
  loseVector<<-rep(0,def)
  
  for(i in 1:sims){
    battle(att,def)
  }
  
  #create statistics for simulations
  winProb<-aWins/(aWins+dWins)
  winOdds<-aWins/dWins
  aWinPerc<<-round(aWins/sims*100,digits=0)
  dWinPerc<-dWins/sims*100
  attmin1<-att-1
  
  #Create vectors for bar graph  
  fullVector<<-(c(rev(loseVector),tail(winVector,att-1))/sims)*100
  colorVector<<-c(rev(rep(defColor,def)),rep(attColor,att-1) )
  nameVector<<-c(length(loseVector):1,2:att )
  valueVector<<-c(1:(att+def-1))
  
  if(attLeft <=att){
    attLeftProb<<-round(sum(tail(fullVector,att-attLeft+1)),digits=0)
  } else attLeftProb<<-0
  
  #Give plain-language assessments based on probability of attacker victory
  if(aWinPerc >= 98){
    phrase<<-"Victory is certain."
  } else if(aWinPerc >= 70){
    phrase<<-"All signs point to 'yes'"
  } else if(aWinPerc >=60){
    phrase<<-"Likely to win, but upset possible"
  } else if (aWinPerc >=40){
    phrase<<-"Could go either way."
  } else if (aWinPerc >=30){
    phrase<<-"Don't get your hopes up."
  } else if (aWinPerc >=5) {
    phrase<<-"Count on losing"
  } else phrase<<-"Ain't happenin."
  
  #Calculate Expected Value
  expectedValue<<-round(sum((fullVector/100)*valueVector))
  if(expectedValue>def){
  remaining<<-nameVector[expectedValue]
  } else remaining<<-"None"
  
  
  plot<-c(aWinPerc,dWinPerc)
  
}

shinyServer(function(input, output) {  
  
  result <- reactive(function(){
    sim(input$att,input$def,attColor=input$attColor,
        defColor=input$defColor,attLeft=input$cumProbAtt,
        sims=input$simulations
    )    
  })  
  
  output$pithyQuote<-reactivePrint(function(){
    result()
    quote<-tags$html(
      tags$body(h3(span(phrase,style="color:black"),
                   h4(paste("Probability of Conquest = ",aWinPerc, "%")),
                   h5(paste("Probability of attacker winning with at least ",
                            input$cumProbAtt," armies = ",attLeftProb,"%")),
                   h5(paste("Expected Value of Remaining Armies: ",remaining)))
      )
    )
    
    cat(as.character(quote))
  })
  
  

  
  output$distPlot <- reactivePlot(function() {
    result()    
    barplot(fullVector,col=c(colorVector),ylim=c(0,max(fullVector)),
            ylab="Probability (%)",names.arg=nameVector,
            xlab="Defender Win with X Armies  <----->  Attacker Win With X Armies",
            sub="All Possible Outcomes if Attacker Fights to the Last Man")
  })
})

ui.R

library(shiny)

# Define UI for application that plots random distributions 
shinyUI(pageWithSidebar(
  
  # Application title
  headerPanel("Risk"),
  
  # Sidebar with a slider input for number of observations
  
  sidebarPanel(
    
    
    selectInput("attColor", "Attacker Color:", 
                list("Red"="firebrick", 
                     "Black"="black", "Blue"="lightskyblue3", 
                     "Green"="palegreen3","Yellow"="yellow3",
                     "Grey"="grey51")),    
    
    sliderInput("att", 
                "# Armies", 
                min = 0, 
                max = 72, 
                value = 7),
    
    selectInput("defColor", "Defender Color:", 
                list("Grey"="grey51",
                     "Yellow"="yellow3","Green"="palegreen3",
                     "Red"="firebrick", 
                     "Black"="black", "Blue"="lightskyblue3"                      
                )),    
    
    sliderInput("def", 
                "# Armies", 
                min = 0, 
                max = 72, 
                value = 4),    
    
    numericInput("cumProbAtt",
                 "What are the chances attacker will win with at least X armies remaining?",
                 5,min=2, max=72),
    
    sliderInput("simulations","Number of Simulations:",
                min= 1,
                max=5000,
                value=1000,ticks=TRUE,step=500),
    
    helpText("Note that attacker's remaining armies are armies remaining
             before moving into the conquered territory.  Probabilities are taken 
             from simulation and may change slightly with each iteration.  For higher accuracy,
             use more simulations.")
  ),
  
  
  
  # Show a plot of the generated distribution
  mainPanel(
    htmlOutput("pithyQuote"), 
    textOutput("chances"),
    textOutput("attLeftText"),
    plotOutput("distPlot"),
    htmlOutput("pithQuote2")
    
  )
))