我有下面这个闪亮的应用程序，我需要在 2 个数据集之间切换，但到目前为止我只得到 2024 年的一个。
library(shiny)
library(ggplot2)
library(dplyr)
library(glue)
library(reactable)
final_2023_with_percentile <- structure(list(player_name = c("Abbott, Andrew", "Abbott, Andrew",
"Abbott, Andrew", "Abbott, Andrew", "Abreu, Bryan"), api_pitch_type = c("CH",
"CU", "FF", "ST", "FF"), `Horizontal Break` = c(14.5784810126582,
-8.75646017699115, 7.72310797174571, -11.787027027027, -7.55102362204724
), `Induced Vertical Break` = c(10.763164556962, -3.3975221238938,
16.3276286579213, 5.79423423423423, 16.278188976378), `Pitch Velocity` = c(86.6278481012658,
80.8719764011799, 92.7466195761857, 82.9141141141141, 97.5663385826772
), pitch_usage = c(15.959595959596, 17.1212121212121, 50.050505050505,
16.8181818181818, 41.1336032388664), avg_arm_angle = c(44.6095238095238,
49.552380952381, 45.7190476190476, 43.8, 40.1347222222222), pitch_group = c("Offspeed",
"Breaking", "Fastball", "Breaking", "Fastball"), year = c(2023,
2023, 2023, 2023, 2023), expected_arm_angle = c(45.3313248212314,
48.0091346481901, 43.3291879571372, 45.1739731517787, 42.3795663314202
), difference = c(-0.721801011707591, 1.54324630419084, 2.38985966191041,
-1.3739731517787, -2.24484410919793), difference_percentile = c(11,
36, 61, 32, 59)), row.names = c(NA, -5L), class = c("tbl_df",
"tbl", "data.frame"))
final_2024_with_percentile <- structure(list(player_name = c("Abbott, Andrew", "Abbott, Andrew",
"Abbott, Andrew", "Abbott, Andrew", "Abreu, Bryan"), api_pitch_type = c("CH",
"CU", "FF", "ST", "FF"), `Horizontal Break` = c(14.8485, -8.75612903225807,
8.8715142198309, -12.5934841628959, -6.10478571428571), `Induced Vertical Break` = c(12.4713,
-4.08215053763441, 16.2903920061491, 4.45031674208145, 16.6883571428571
), `Pitch Velocity` = c(84.73375, 80.7849462365591, 92.7887009992314,
82.9180995475113, 96.6285714285714), pitch_usage = c(16.4812525751957,
11.495673671199, 53.6052740008241, 18.2117840955913, 46.6666666666667
), avg_arm_angle = c(43.508, 48.376, 44.82, 44.376, 43.0328947368421
), pitch_group = c("Offspeed", "Breaking", "Fastball", "Breaking",
"Fastball"), year = c(2024, 2024, 2024, 2024, 2024), expected_arm_angle = c(45.5588206160552,
49.1467520143948, 43.9438816766548, 46.2666308980996, 41.945208160932
), difference = c(-2.0508206160552, -0.770752014394823, 0.876118323345224,
-1.8906308980996, 1.08768657591006), difference_percentile = c(44,
19, 24, 43, 30)), row.names = c(NA, -5L), class = c("tbl_df",
"tbl", "data.frame"))
# UI
ui <- fluidPage(
titlePanel("Arm Angle/Pitch Movement Plots!"),
sidebarLayout(
sidebarPanel(
width = 3,
selectInput("dataset", "Select Dataset:",
choices = c("2023 Data" = "2023", "2024 Data" = "2024"),
selected = "2024"),
selectizeInput("pitcher", "Select Pitcher:", choices = NULL)
),
mainPanel(
width = 9,
reactableOutput("pitcher_table"), # Changed to reactable for better UI
)
)
)
# Server
server <- function(input, output, session) {
# Cache the dataset selection to avoid redundant data processing
dataset_cached <- reactive({
dataset <- switch(input$dataset,
"2023" = final_2023_with_percentile,
"2024" = final_2024_with_percentile)
dataset
}) %>% bindCache(input$dataset)
# Update pitcher choices based on cached dataset selection
observe({
dataset <- dataset_cached()
updateSelectizeInput(session, "pitcher",
choices = unique(dataset$player_name)) # Assuming the dataset uses `player_name`
})
selected_data <- reactive({
dataset <- dataset_cached()
filtered_data <- dataset %>%
filter(player_name == input$pitcher) %>%
select(
Pitcher = player_name,
`Pitch Type` = api_pitch_type,
`Horizontal Break`,
`Induced Vertical Break`,
`Pitch Velocity`,
Usage = pitch_usage,
`Arm Angle` = avg_arm_angle,
`xArm Angle` = expected_arm_angle,
Delta = difference,
`Percentile Difference` = difference_percentile # Include the difference_percentile column
)
if (nrow(filtered_data) == 0) {
return(NULL) # Return NULL if no data for the selected pitcher
}
return(filtered_data)
}) %>% bindCache(input$pitcher)
output$pitcher_name <- renderText({
paste("Pitcher:", input$pitcher)
})
output$pitcher_table <- renderReactable({
data <- selected_data()
if (is.null(data)) {
return(data.frame()) # Return an empty data frame if no data is selected
}
# Round all numeric columns to 1 decimal place
data <- data %>% mutate(across(where(is.numeric), ~ round(.x, 1)))
reactable::reactable(data, pagination = TRUE) # Interactive table
}) %>% bindCache(input$pitcher)
}
# Run the app
shinyApp(ui = ui, server = server)
bindCache()SelectInput()library(shiny)
library(ggplot2)
library(dplyr)
library(glue)
library(reactable)
final_2023_with_percentile <- structure(list(player_name = c("Abbott, Andrew", "Abbott, Andrew",
"Abbott, Andrew", "Abbott, Andrew", "Abreu, Bryan"), api_pitch_type = c("CH",
"CU", "FF", "ST", "FF"), `Horizontal Break` = c(14.5784810126582,
-8.75646017699115, 7.72310797174571, -11.787027027027, -7.55102362204724
), `Induced Vertical Break` = c(10.763164556962, -3.3975221238938,
16.3276286579213, 5.79423423423423, 16.278188976378), `Pitch Velocity` = c(86.6278481012658,
80.8719764011799, 92.7466195761857, 82.9141141141141, 97.5663385826772
), pitch_usage = c(15.959595959596, 17.1212121212121, 50.050505050505,
16.8181818181818, 41.1336032388664), avg_arm_angle = c(44.6095238095238,
49.552380952381, 45.7190476190476, 43.8, 40.1347222222222), pitch_group = c("Offspeed",
"Breaking", "Fastball", "Breaking", "Fastball"), year = c(2023,
2023, 2023, 2023, 2023), expected_arm_angle = c(45.3313248212314,
48.0091346481901, 43.3291879571372, 45.1739731517787, 42.3795663314202
), difference = c(-0.721801011707591, 1.54324630419084, 2.38985966191041,
-1.3739731517787, -2.24484410919793), difference_percentile = c(11,
36, 61, 32, 59)), row.names = c(NA, -5L), class = c("tbl_df",
"tbl", "data.frame"))
final_2024_with_percentile <- structure(list(player_name = c("Abbott, Andrew", "Abbott, Andrew",
"Abbott, Andrew", "Abbott, Andrew", "Abreu, Bryan"), api_pitch_type = c("CH",
"CU", "FF", "ST", "FF"), `Horizontal Break` = c(14.8485, -8.75612903225807,
8.8715142198309, -12.5934841628959, -6.10478571428571), `Induced Vertical Break` = c(12.4713,
-4.08215053763441, 16.2903920061491, 4.45031674208145, 16.6883571428571
), `Pitch Velocity` = c(84.73375, 80.7849462365591, 92.7887009992314,
82.9180995475113, 96.6285714285714), pitch_usage = c(16.4812525751957,
11.495673671199, 53.6052740008241, 18.2117840955913, 46.6666666666667
), avg_arm_angle = c(43.508, 48.376, 44.82, 44.376, 43.0328947368421
), pitch_group = c("Offspeed", "Breaking", "Fastball", "Breaking",
"Fastball"), year = c(2024, 2024, 2024, 2024, 2024), expected_arm_angle = c(45.5588206160552,
49.1467520143948, 43.9438816766548, 46.2666308980996, 41.945208160932
), difference = c(-2.0508206160552, -0.770752014394823, 0.876118323345224,
-1.8906308980996, 1.08768657591006), difference_percentile = c(44,
19, 24, 43, 30)), row.names = c(NA, -5L), class = c("tbl_df",
"tbl", "data.frame"))
# UI
ui <- fluidPage(
titlePanel("Arm Angle/Pitch Movement Plots!"),
sidebarLayout(
sidebarPanel(
width = 3,
selectInput("dataset", "Select Dataset:",
choices = c("2023 Data" = "2023", "2024 Data" = "2024"),
selected = "2024"),
selectizeInput("pitcher", "Select Pitcher:", choices = NULL)
),
mainPanel(
width = 9,
reactableOutput("pitcher_table"), # Changed to reactable for better UI
)
)
)
# Server
server <- function(input, output, session) {
# Cache the dataset selection to avoid redundant data processing
dataset_cached <- reactive({
dataset <- switch(input$dataset,
"2023" = final_2023_with_percentile,
"2024" = final_2024_with_percentile)
dataset
})
# Update pitcher choices based on cached dataset selection
observe({
dataset <- dataset_cached()
updateSelectizeInput(session, "pitcher",
choices = unique(dataset$player_name)) # Assuming the dataset uses `player_name`
})
selected_data <- reactive({
dataset <- dataset_cached()
filtered_data <- dataset %>%
filter(player_name == input$pitcher) %>%
select(
Pitcher = player_name,
`Pitch Type` = api_pitch_type,
`Horizontal Break`,
`Induced Vertical Break`,
`Pitch Velocity`,
Usage = pitch_usage,
`Arm Angle` = avg_arm_angle,
`xArm Angle` = expected_arm_angle,
Delta = difference,
`Percentile Difference` = difference_percentile # Include the difference_percentile column
)
if (nrow(filtered_data) == 0) {
return(NULL) # Return NULL if no data for the selected pitcher
}
return(filtered_data)
})
output$pitcher_name <- renderText({
paste("Pitcher:", input$pitcher)
})
output$pitcher_table <- renderReactable({
data <- selected_data()
if (is.null(data)) {
return(data.frame()) # Return an empty data frame if no data is selected
}
# Round all numeric columns to 1 decimal place
data <- data %>% mutate(across(where(is.numeric), ~ round(.x, 1)))
reactable::reactable(data, pagination = TRUE) # Interactive table
})
}
# Run the app
shinyApp(ui = ui, server = server)