Question

我对ggplot函数有多个输入，该函数创建了打击区的热图。

如果仅在“ PitchResult”复选框中选中“正在播放”框，我想做的就是显示“ HitType”和“ PlayResult”复选框输入。

使用我当前的代码，“ HitType”和“ PlayResult”复选框会否决上面的其他复选框，并影响ggplot的数据，显示为仅是“正在播放”的数据。

我希望能够选择所有数据，无论数据是“正在播放”还是不在播放中（“ StrikeCalled”，“ BallCalled”等）。

我已经阅读了Shinyjs软件包，但是我不确定这是否是我需要的。

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)

根据先前的checkboxGroupInput

0 个答案: