RShiny 中的反应性数据问题

Question

我正在为一个包含一些足球统计数据的个人项目制作一个闪亮的仪表板。每当我更改要绘制的统计数据和/或过滤器时，我都会得到与第一个数据集中相同的玩家。例如，当我启动该应用程序时，该应用程序创建了一个学校历史上排名前十的冲球者的图表，其中冲球尝试的过滤器 >= 0。但是，当我将统计选择更改为冲球平均值时，这十名球员就是那些显示，这是不正确的。

library(readxl)
library(tidyverse)
library(purrr)
library(shiny)

interface <- fluidPage(
    titlePanel(" "), 
    sidebarLayout(
        sidebarPanel(
            h1("Stats!"), 
            selectInput("stat_selection", 
                        label = "Select a season statistics", 
                        choices = c("Rushing Yards",
                                    "Rushing Touchdowns",
                                    "Rushing Average",
                                    "Reciving Yards",
                                    "Receptions",
                                    "Receiving Touchdowns",
                                    "Receiving Average"),
                        selected = "Rushing Yards"), 
            selectInput("filter_input", 
                        label = "Select a statistic to filter by", 
                        choices = c("Rushing Yards",
                                    "Rushing Touchdowns",
                                    "Rushing Average",
                                    "Rushing Attempts",
                                    "Reciving Yards",
                                    "Receptions",
                                    "Receiving Touchdowns",
                                    "Receiving Average"),
                        selected = "Rushing Attempts"), 
            numericInput("filter_number", 
                         label = "Type a number for the filter (>=)", 
                         value = 0, min = 0), 
            actionButton("button", "Graph")), 
        mainPanel(
            plotOutput("plot_button"),
            tableOutput("table_button")
        )
    )
)

server_osu <- function(input, output) {
    dataInput <- reactive({
        switch(input$stat_selection, 
               "Rushing Yards" = rush_yds, 
               "Rushing Touchdowns" = rush_tds, 
               "Rushing Average" = rush_avg,
               "Reciving Yards" = rec_yds,
               "Receptions" = rec_rec,
               "Receiving Touchdowns" = rec_td,
               "Receiving Average" = rec_avg)
    })
    filterInput <- reactive({
        switch(input$filter_input, 
               "Rushing Yards" = rush_yds, 
               "Rushing Touchdowns" = rush_tds, 
               "Rushing Average" = rush_avg,
               "Rushing Attempts" = rush_att,
               "Reciving Yards" = rec_yds,
               "Receptions" = rec_rec,
               "Receiving Touchdowns" = rec_td,
               "Receiving Average" = rec_avg)
    })
    filter_number <- reactive(as.double(input$filter_number))
    table_button_react <- eventReactive(input$button, {
        dataset <- dataInput()
        val <- filter_number()
        colnames(dataset)[1] = "Player and Season"
        dataset_filter <- filterInput()
        colnames(dataset_filter)[1] = "Player and Season"
        dataset <- left_join(dataset, dataset_filter)
        colnames(dataset)[1] = "Player and Season"
        og <- colnames(dataset)[3]
        colnames(dataset)[3] = "filter"
        original <- colnames(dataset)[2]
        colnames(dataset)[2] = 'selected'
        dataset <- dataset %>% 
            filter(filter >= val)
        dataset <- dataset %>% 
            top_n(10) %>% 
            arrange(-selected)
        colnames(dataset)[2] = original
        colnames(dataset)[3] = og
        dataset
    })
    plot_button_react <- eventReactive(input$button, {
        dataset <- dataInput()
        val <- filter_number()
        colnames(dataset)[1] = "Player and Season"
        dataset_filter <- filterInput()
        colnames(dataset_filter)[1] = "Player and Season"
        dataset <- left_join(dataset, dataset_filter)
        colnames(dataset)[1] = "Player and Season"
        colnames(dataset)[2] = "selected"
        colnames(dataset)[3] = "filter"
        dataset <- dataset %>% 
            filter(filter >= val)
        top_ten <- dataset %>% top_n(10)
        min = min(top_ten$selected)
        max = max(top_ten$selected)
        ggplot(top_ten, aes(x = reorder(`Player and Season`, -selected), y = selected)) +
            geom_bar(stat = 'identity') + theme_minimal() + xlab('SEASON') +
            ylab(input$stat_selection) + theme(text=element_text(size=16)) +
            scale_fill_manual(values = c('#BBBBBB', '#BB0000')) +
            theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
            theme(legend.position = 'none') +
            coord_cartesian(ylim=c(min - 0.05*min, max + 0.05*max)) +
            theme(axis.title.y = element_text(margin = margin(t = 0, r = 10, b = 0, l = 10))) +
            theme(axis.title.x = element_text(margin = margin(t = 10, r = 0, b = 10, l = 0))) +
            theme(axis.text.y = element_text(size=14),
                  axis.title=element_text(size=16,face='bold')) + 
            labs(caption = '')
    })
    output$plot_button <- renderPlot({
        plot_button_react()
    })
    output$table_button <- renderTable({
        table_button_react()
    })
}

Answer 1

如上所述，reprex（包括输入数据）将帮助我们为您提供帮助。也就是说，我认为问题在于您的XXX_button_reacts 仅依赖于input$button。它们不依赖于input$stat_selection、input$filter_number 或input$filter_input。这就是为什么它们不会按您希望的那样更新。

修复很简单。只需在每个 XXXX_button_react 的顶部添加它们（如果您愿意，可以通过调用 req()），例如：

plot_button_react <- eventReactive(input$button, {
  input$stat_selection
  input$filter_number
  input$filter_input

  <your code here>
})

作为一种风格，我觉得将数据生成与数据展示分开会更好。它使您的代码逻辑更明显，减少出错的机会，减少代码重复的需要并使您的代码更可重用。

在您的情况下，我将创建一个反应式来保存您希望制表和绘制的数据，然后在您的每个 render_XXXX 函数中引用该反应式。这也将消除您对input$button 的需要：每当您更改其他输入小部件之一时，绘图和图形都会自动更新。