I'm currently struggling to figure out how to get a Shiny app update button to work the way I'd like. What I want is for the data to update only when the filters in the top portion (above where it says "Player comparison correlation graph selection" in the UI) and for the filters below that section to remain the same. This is what I currently have, but it's not producing the correct results. I tried the eventReactive option but that isn't giving me what I'd like. Any suggestions on how to fix this?
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fluidRow(
column(6, selectInput(inputId = "website",
label = "Select DFS platform",
choices = c("DraftKings", "FanDuel"), selected = "DraftKings")),
column(6, selectInput(inputId = "team",
label = "Select team",
choices = c("ARI", "ATL", "BAL", "BUF", "CAR", "CHI", "CIN", "CLE",
"DAL", "DEN", "DET", "GB", "HOU", "IND", "JAX",
"KC", "LAC", "LAR", "LV", "MIA", "MIN", "NE", "NO",
"NYG", "NYJ", "PHI", "PIT", "SEA", "SF", "TB", "TEN", "WAS"), selected = "ARI"))),
sliderInput(inputId = "week",
label = "Select weeks",
min = 1,
max = 17,
value = c(1, 17)
),
sliderInput(inputId = "szn",
label = "Select years",
min = 2014,
max = 2020,
value = c(2019, 2020),
sep = ""),
actionButton("update", "Update Filters"),
fluidRow(
column(6, uiOutput(outputId = "player1UI")),
column(6, uiOutput(outputId = "player2UI")))),
mainPanel(
plotOutput("matrix_plot", height = "600px"),
plotOutput("cor_plot", height = "600px")
)
)
)
server <- function(input, output) {
base_data <- eventReactive(input$update,
{data <- read_csv(url(paste0("https://raw.githubusercontent.com/samhoppen/NFL-Analysis/main/Data/",input$website,"%20Weekly%20Scores%20Total.csv")))})
player_filter <- reactive({
#input$update
start_szn <- min(as.numeric(input$szn))
end_szn <- max(as.numeric(input$szn))
start_wk <- min(as.numeric(input$week))
end_wk <- max(as.numeric(input$week))
player_filter <- base_data() %>%
filter(Team == input$team,
year == end_szn) %>%
group_by(player) %>%
summarize(games = n()) %>%
filter(games >= as.numeric(input$min_games)) %>%
select(player)})
correlation_data <- eventReactive(input$update,{
start_szn <- min(as.numeric(input$szn))
end_szn <- max(as.numeric(input$szn))
start_wk <- min(as.numeric(input$week))
end_wk <- max(as.numeric(input$week))
base_data() %>%
dplyr::filter(Team == input$team,
week >= start_wk,
week <= end_wk,
year >= start_szn,
year <= end_szn) %>%
select(player, FPTS, week, year) %>%
arrange(desc(player)) %>%
subset(player %in% player_filter()$player) %>%
pivot_wider(names_from = player, values_from = FPTS) %>%
select(-c("week", "year"))
})
output$player1UI <- renderUI({selectInput("player1",
paste0("Player 1"),
c("Select player" ="", player_filter()$player))
})
output$player2UI <- renderUI({selectInput("player2",
paste0("Player 2"),
c("Select player" ="", player_filter()$player))
})
matrix <- eventReactive(input$update,{cor(x = correlation_data(), use = "pairwise.complete.obs")})
matrix_data <- eventReactive(input$update,{
reshape::melt(matrix(), na.rm = TRUE) %>% filter(!is.na(value))})
output$matrix_plot <- renderPlot({
input$update
ggplot(data = matrix_data()) +
geom_tile(aes(x = X1, y = X2, fill = value))+
scale_fill_gradient2(low = brewer.pal(n=5, "RdYlGn")[1],
mid = brewer.pal(n=5, "RdYlGn")[3],
high = brewer.pal(n=5, "RdYlGn")[5],
midpoint = 0) +
geom_text(aes(x = X1, y = X2, label = round(value, 2)), size = 5)+
theme_bw()+
theme(axis.title.x = element_blank(),
axis.title.y = element_blank(),
plot.title = element_text(size=22),
axis.text = element_text(size = 15),
axis.text.x = element_text(angle = -45, hjust = 1),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank())+
coord_fixed()+
scale_x_discrete(position = "top") +
labs(title = paste0(input$team, " player correlation (from ", min(as.numeric(input$szn)), "-", max(as.numeric(input$szn)), ")"),
fill = "Correlation")
})
output$cor_plot <- renderPlot({
req(input$player1, input$player2)
player1 <- as.name(input$player1)
player2 <- as.name(input$player2)
ggplot(data = correlation_data()) +
geom_smooth(aes_string(x = as.name(input$player1), y = as.name(input$player2)),
method = "loess",
se = F) +
geom_point(aes_string(x = as.name(input$player1), y = as.name(input$player2)),
show.legend = FALSE)+
theme_bw()+
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank())+
labs(title = paste0(input$player1, " and ", input$player2, " correlation"))
})
}