inst/shiny-examples/RunsLogits2/app.R

In bayesball/ShinyBaseball: Shiny Baseball Applications

library(shiny)
library(dplyr)
library(tidyr)
library(ggplot2)
library(readr)

logit_work <- function(Observed){
  observed <- matrix(Observed$N, 5, 24)
  states <- c("000 0", "000 1", "000 2",
              "001 0", "001 1", "001 2",
              "010 0", "010 1", "010 2",
              "011 0", "011 1", "011 2",
              "100 0", "100 1", "100 2",
              "101 0", "101 1", "101 2",
              "110 0", "110 1", "110 2",
              "111 0", "111 1", "111 2")
  run_values <- c("0", "1", "2", "3", "4+")
  dimnames(observed) <- list(run_values, states)
  compute_logits <- function(counts){
    prob <- counts / sum(counts)
    cum_prob <- cumsum(prob)
    logits <- log(cum_prob / (1 - cum_prob))
    logits[1:4]
  }
  L_20_seasons <- apply(observed, 2, compute_logits)
  data.frame(L_20_seasons) %>%
    mutate(Breakpoint = 1:4)
}
compare_logit_plot3 <- function(C_all,
                                states,
                                bases_outs = "bases",
                                logit_type = "<="){

  require(tidyr)
  require(ggplot2)

  cols <- c( paste("X", states, ".0", sep = ""),
             paste("X", states, ".1", sep = ""),
             paste("X", states, ".2", sep = ""))

  many_states <- C_all[, c("Type", "Breakpoint", cols)]
  N <- length(cols)

  restate <- function(state){
    s <- unlist(strsplit(state, ""))
    s[2] <- ifelse(s[2] == 1, "2", "0")
    s[3] <- ifelse(s[3] == "1", "3", "0")
    paste(s[1], s[2], s[3], sep = "")
  }

  pivot_longer(many_states,
               cols = starts_with("X"),
               names_to = "State",
               values_to = "Logit") %>%
    mutate(Bases = substr(State, 2, 4),
           Outs = paste("Outs =",
                        substr(State, 6, 6))) -> Many_States

  Many_States$Bases <- sapply(Many_States$Bases, restate)

  breakpoints <- c("0/1", "1/2", "2/3", "3/4+")

  if(bases_outs == "bases"){
    p1 <- ggplot(Many_States,
                 aes(Breakpoint, Logit, color = Bases)) +
      geom_point(size = 4) + geom_line() +
      facet_wrap(Type ~ Outs)
  } else {
    p1 <- ggplot(Many_States,
                 aes(Breakpoint, Logit, color = Outs)) +
      geom_point(size = 4) + geom_line() +
      facet_wrap(Type ~ Bases)
  }
  p1 <- p1 +
    ylab("Cumulative Logit") +
    ggtitle(paste("Cumulative Logits P(Runs ",
                  logit_type, " j)", sep = "")) +
    xlab("Breakpoint (j | j + 1)") +
    theme(text=element_text(size=18)) +
    scale_x_continuous(breaks = 1:4,
                       labels = breakpoints) +
    theme(plot.title = element_text(colour = "blue",
                                    size = 18,
                                    hjust = 0.5, vjust = 0.8, angle = 0))
  print(p1)
}

#########################
S <- twenty_seasons_counts
S %>%
  group_by(STATE, O_RUNS.ROI) %>%
  summarize(N = sum(N),
            .groups = "drop") -> S_20_seasons
L_20 <- logit_work(S_20_seasons)
L_20 %>%
  mutate(Type = "Observed") -> L_20

S1 <- ordinal_model_logits %>%
  mutate(Type = "Model") -> S1

L_all <- rbind(L_20, S1)

bases <- c("000", "100", "020", "120",
           "003", "103", "023", "123")
############################
ui <- fluidPage(
  titlePanel("Logit Comparison of Run Scoring Across States: 2000-2019"),
  sidebarLayout(
    sidebarPanel(
      br(),
      checkboxGroupInput("sel_bases",
                         "Selected Runners on Base:",
                         choices = bases,
                         selected = c("000", "100"),
                         inline = FALSE),
      radioButtons("logit_type",
                   "Select Logit Type:",
                   choices = c("<=", ">"),
                   inline = TRUE),
      radioButtons("outs_bases",
                    "Compare Bases or Outs:",
                    choices = c("bases", "outs"),
                    inline = TRUE)
    ),
    mainPanel(
      plotOutput("plot",
                 height = '550px'))
  )
)

server <- function(input, output) {

  output$plot <- renderPlot({
    req(input$sel_bases)
    bases <- input$sel_bases
    bases <- ifelse(bases == "020", "010", bases)
    bases <- ifelse(bases == "120", "110", bases)
    bases <- ifelse(bases == "103", "101", bases)
    bases <- ifelse(bases == "023", "011", bases)
    bases <- ifelse(bases == "123", "111", bases)
    bases <- ifelse(bases == "003", "001", bases)

    if(input$logit_type == ">"){
      L_all[, 1:24] <- - L_all[, 1:24]
    }
    compare_logit_plot3(L_all,
                        bases,
                        input$outs_bases,
                        input$logit_type)
})
}

# Run the application
shinyApp(ui = ui, server = server)