mercredi 19 juin 2019

Updating checkboxGroupInput based off selection from previous checkboxGroupInput

I have multiple inputs for a ggplot function that creates a heatmap of a strikezone.

What I am trying to do is to have the "HitType" and "PlayResult" checkbox inputs appear if ONLY the "In Play" box is selected within the "PitchResult" checkbox.

With my current code, the "HitType" and "PlayResult" checkboxes are overruling the other checkboxes above and affecting the ggplot's data shown to only be data that is "In Play".

I want to be able to select all data, whether the data is "In Play" or not in play ("StrikeCalled","BallCalled",etc.).

I've read about the shinyjs package but I'm not sure if that's what I need here.

data$Date <- as.Date(data$Date, "%m/%d/%Y")
PitchTypeList <- c("Fastball","Cutter","Sinker","Curveball","Slider","Changeup" = "ChangeUp","Splitter")
PitchResultList <- c("Hit By Pitch" = "HitByPitch","Ball Called" = "BallCalled","Strike Called" = "StrikeCalled",
                     "Strike Swinging" = "StrikeSwinging","Foul Ball" = "FoulBall","In Play" = "InPlay")
HitTypeList <- c("Bunt","Groundball" = "GroundBall","Line Drive" = "LineDrive","Fly Ball" = "FlyBall","Popup")
PlayResultList <- c("Out","Single","Double","Triple","Home Run" = "HomeRun")

ui = fluidPage(
  titlePanel("Heatmaps - 2019 Big Ten Conference Database"),

  sidebarLayout(
    sidebarPanel(
      selectInput(inputId="TeamInput", label="Select Team", choices = sort(unique(data$BatterTeam)), selected = "IOW_HAW"),
      selectInput(inputId="BatterInput", label="Select Player", choices = ""),
      dateRangeInput(input="DateRange", label="Select the date range", start=min(data$Date), end=max(data$Date)),
      checkboxGroupInput(inputId = "PitcherHandedness", label = "Pitcher Handedness", inline = TRUE,
                         choices = c("LHP"="Left","RHP"="Right"), selected = c("LHP"="Left","RHP"="Right")),
      fluidRow(  
      column(5, wellPanel(
       checkboxGroupInput(inputId = "PitchType", label= "Pitch Type", choices = PitchTypeList, selected = PitchTypeList) ) ),
      column(5, wellPanel(
       checkboxGroupInput(inputId = "PitchResult", label = "Pitch Result", choices = PitchResultList, selected = PitchResultList) ) )
               ),
      fluidRow(  
      column(5, wellPanel(
       checkboxGroupInput(inputId = "HitType", label= "Hit Type", choices = HitTypeList, selected = HitTypeList) ) ),
      column(5, wellPanel(
       checkboxGroupInput(inputId = "PlayResult", label = "Play Result", choices = PlayResultList, selected = PlayResultList) ) )
               )  
      ), #sidebarPanel closing

    mainPanel(
      plotOutput("myZone")
             )))

server = function(input, output, session) {

  observeEvent(
    input$TeamInput,
    updateSelectInput(session, "BatterInput", "Select Player",
                      choices = sort(unique(data$Batter[data$BatterTeam==input$TeamInput])))
  )

  output$myZone <- renderPlot({

    data$PlateLocSide <- (data$PlateLocSide * -1)

    dataFilter <- reactive({
      data %>% filter(
        between(Date, input$DateRange[1], input$DateRange[2]),
        BatterTeam %in% c(input$TeamInput),
        Batter %in% c(input$BatterInput),
        PitcherThrows %in% c(input$PitcherHandedness),
        TaggedPitchType %in% c(input$PitchType),
        PitchCall %in% c(input$PitchResult),
        HitType %in% c(input$HitType),
        PlayResult %in% c(input$PlayResult))
    })

    ggplot(data = dataFilter(), aes(x = PlateLocSide, y = PlateLocHeight)) + 
      stat_density_2d(geom = "tile", aes(fill = ..density..), contour = FALSE, na.rm = TRUE) +
      xlim(-2.5,2.5) + ylim(0,5) + geom_point(na.rm = TRUE) +
      labs(x = "", y = "") + facet_wrap(~ Batter, ncol = 2) +
      theme(strip.text = element_text(size=20, face="bold")) +
      scale_fill_gradientn(colors = c("white", "blue", "yellow", "red"), 
      values = scales::rescale(c(0, .05, 0.10, 0.15, .20))) + theme(legend.position="none")
  },
  width=425, height=500)


}

shinyApp(ui, server)




Aucun commentaire:

Enregistrer un commentaire