library(shiny)
library(ggvis)
library(dplyr)
library(axelRod)
# load strategies in memory
strats <- defaultStrategies()
# define global variables
counter <- 1
steps <- 1
dat <- data.frame(rep = 1, player = c("Player 1", "Player 2"), cum_score = 0)
# ui
ui <- navbarPage(
title = "Axelrod Tournament",
theme = "www/bootstrap.css",
fluid = FALSE,
collapsible = TRUE,
tabPanel("Tournament",
fluidRow(
column(width = 3, align = "center", style = "background-color:#ebb397;",
div(style = "height:450px;",
selectInput("strat1", label = h5("Player 1's Strategy"),
choices = lapply(strats, function(x) x$name),
selected = 1),
tags$hr(),
verbatimTextOutput("strat1"))),
column(width = 6, align = "center", style = "background-color:#f5f5f5;",
ggvisOutput("display")),
column(width = 3, align = "center", style = "background-color:#9ecfbf;",
div(style = "height:450px;",
selectInput("strat2", label = h5("Player 2's Strategy"),
choices = lapply(strats, function(x) x$name),
selected = 1),
tags$hr(),
verbatimTextOutput("strat2")))
),
fluidRow(style = "background-color:#f5f5f5;",
column(width = 2, align = "center", offset = 2,
selectInput("tournament", label = h5("Tournament type"),
choices = list("One time" = "onetime", "Repeated" = "repeated"),
selected = 1)),
column(width = 2, align = "center",
uiOutput("rounds")),
column(width = 2, align = "center",
sliderInput("reps", label = h5("Number of replicates"), min = 1,
max = 100, value = 20)),
column(width = 2, align = "center",
h5(HTML(" ")),
actionButton("play", "Play", width = "100%"))
)
),
tabPanel("Instructions"),
tabPanel("About"),
tabPanel(tagList(tags$html("Powered by"),
tags$img(src = "www/white-rstudio-logo.png",
height = "20")),
value = "RStudio",
tags$head(tags$script(src = "www/actions.js"))
)
)
# server
server <- function(input, output) {
react <- reactiveValues(reset_draw = 0, draw = 0)
observe({
react$reset_draw
counter <<- 1
steps <<- max(dat$rep)
isolate({ react$draw <- react$draw + 1 })
})
react_dat <- reactive({
react$draw
if (counter <= steps) {
counter <<- counter + 1
invalidateLater(60, NULL)
}
dat %>% filter(rep == counter - 1)
})
output$strat1 <- renderText({
idx <- which(sapply(strats, function(x, y) x$name == y, y = input$strat1))
strats[[idx]]$description
})
output$strat2 <- renderText({
idx <- which(sapply(strats, function(x, y) x$name == y, y = input$strat2))
strats[[idx]]$description
})
output$rounds <- renderUI({
if (input$tournament == "onetime") {
sliderInput("rounds", label = h5("Number of rounds"), min = 1,
max = 1, value = 1)
} else {
sliderInput("rounds", label = h5("Number of rounds"), min = 1,
max = 100, value = 20)
}
})
observe({
if (input$play > 0) {
isolate({
idx1 <- which(sapply(strats, function(x, y) x$name == y, y = input$strat1))
idx2 <- which(sapply(strats, function(x, y) x$name == y, y = input$strat2))
tournament <- Tournament$new(type = input$tournament,
players = list("Player 1" = strats[[idx1]]$fn,
"Player 2" = strats[[idx2]]$fn),
nreps = input$reps, nrounds = input$rounds)
tournament$play()
dat <<- group_by(tournament$res, player, rep) %>%
summarize(score = sum(score)) %>%
mutate(cum_score = cumsum(score) / rep)
react$reset_draw <- react$reset_draw + 1
})
}
})
react_dat %>%
ggvis(x = ~player, y = ~cum_score, fill = ~player, stroke = ~player) %>%
layer_bars() %>%
scale_nominal("fill", range = c("#ebb397", "#9ecfbf")) %>%
scale_nominal("stroke", range = c("#ebb397", "#9ecfbf")) %>%
hide_legend(c("fill", "stroke")) %>%
add_tooltip(axelRod:::.all_values, "hover") %>%
add_axis("x", title = "", properties = axis_props(labels = list(fontSize = 18))) %>%
add_axis("y", title = "y", properties = axis_props(
labels = list(fontSize = 16),
title = list(fontSize = 20, stroke = "#f5f5f5", fill = "#f5f5f5"))) %>%
add_axis("y", title = "y", orient = "right", properties = axis_props(
labels = list(fontSize = 16),
title = list(fontSize = 20, stroke = "#f5f5f5", fill = "#f5f5f5"))) %>%
set_options(width = "auto", height = "450px", resizable = FALSE, duration = 30) %>%
bind_shiny("display")
}
# run app
shinyApp(ui = ui, server = server)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.