Trying to add an update button for shiny app

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"))
    })
}

Could you make a minimal example to show where your problem is?

Maybe two tips.

To react to a buttons use observeEvent:

observeEvent(input$update, ({
#code to be triggered
})

Use isolate()

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")))})

In the above code your base_data is refreshed on both input$update but also input$website. If you want to refresh only on input$update you can use isolate(input$website).

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.