使用选定输入在 dplyr 中进行 R Shiny Reactive 数据帧操作

Question

我无法让我的 dplyr 代码在 Shiny 中工作。

我正在尝试根据用户选择的“输入”来操作数据框。我想在 ui 中使用下拉菜单，但无法在 server 中使用（使用 dplyr select() 时）。我已经让它与“动作按钮”一起工作，但这会产生非常重复的代码（每个observeEvent() 基本上都有相同的代码）。

我正在调整用 RMarkdown 编写的代码，其中我更改了笔记本开头的 TARGET 变量的定义，该变量在我重新编织时会影响所有后续模型、绘图和表格。通过注释 In/Out 一行，我生成了几个不同目标变量的结果（它们共享一些，但不是所有数据）。我想在 Shiny 中为其他用户实现自助服务。

# I would like to do it "this" way, but it doesn't work

library(shiny)
library(ggplot2)
library(dplyr)
library(datasets)
library(lubridate)


df <- airquality %>% 
    mutate(date = make_datetime(day = Day, month = Month), 
           Ozone1 = Ozone + 1, Temp1 = Temp + 1,
           Ozone_predictor = Ozone / 2, Temp_predictor = Temp / 2) %>% 
    select(date, everything(), -Month, -Day)


ui <- fluidPage(

    # Title
    titlePanel("New York AirQuality Measurements"),

    # Input Selection used to build dataframe
    sidebarLayout(
        sidebarPanel(
            selectInput(inputId = "target", 
                        label = "Choose a prediction target for visualization", 
                        choices = list("Ozone", "Ozone1", "Temp")
            )
        ), 

        # Plot
        mainPanel(
            plotOutput("plot", height = "1200px")
        )
    )
)


server <- function(input, output) {

    df <- reactive({
        if(input$target == "Ozone"){
            df <- df %>%
                select(-Ozone1, -contains("Temp")) %>% 
                tidyr::gather(key = key, value = value, -date)
            if(input$target == "Ozone1"){
                df <- df %>%
                    select(-Ozone, -contains("Temp")) %>% 
                    tidyr::gather(key = key, value = value, -date)
            }else{
                df <- df %>%
                    select(-contains("Ozone")) %>% 
                    tidyr::gather(key = key, value = value, -date)
            }
        }
    })


    output$plot <- renderPlot({
        ggplot(df(), aes(date, value)) +
            geom_line() +
            facet_wrap(key ~ ., scales = "free", ncol = 1) +
            labs(y = "", x = "") +
            theme_classic()
    })
}

# Run the application 
shinyApp(ui = ui, server = server)



# This does work... but is repetitive and may be problematic 
# if I have more target variables.

library(shiny)
library(ggplot2)
library(dplyr)
library(datasets)
library(lubridate)


df <- airquality %>%
    mutate(date = make_datetime(day = Day, month = Month),
           Ozone1 = Ozone + 1, Temp1 = Temp + 1,
           Ozone_predictor = Ozone / 2, Temp_predictor = Temp / 2) %>%
    select(date, everything(), -Month, -Day)


ui <- fluidPage(

    # Title
    titlePanel("New York AirQuality Measurements"),

    # Action buttons to define dataframe selection
    sidebarLayout(
        sidebarPanel(
            actionButton(inputId = "Ozone", label = "Ozone"),
            actionButton(inputId = "Ozone1", label = "Ozone One"),
            actionButton(inputId = "Temp", label = "Temperature")),

        # Plot
        mainPanel(
            plotOutput("plot", height = "1200px")
        )
    )
)


server <- function(input, output) {
    rv <- reactiveValues(
        data = df %>%
            tidyr::gather(key = key, value = value, -date)
    )

    observeEvent(input$Ozone,
                 { rv$data <-
                     df %>%
                     select(-Ozone1, -contains("Temp")) %>%
                     tidyr::gather(key = key, value = value, -date)
                 })

    observeEvent(input$Ozone1,
                 { rv$data <-
                     df %>%
                     select(-Ozone, -contains("Temp")) %>%
                     tidyr::gather(key = key, value = value, -date)
                 })

    observeEvent(input$Temp,
                 { rv$data <-
                     df %>%
                     select(-contains("Ozone")) %>%
                     tidyr::gather(key = key, value = value, -date)
                 })


    output$plot <- renderPlot({
        ggplot(data = rv$data, aes(date, value)) +
            geom_line() +
            facet_wrap(key ~ ., scales = "free", ncol = 1) +
            labs(y = "", x = "") +
            theme_minimal()
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

错误：'select_'没有适用的方法应用于类“c（'reactiveExpr'，'reactive'）”的对象

Answer 1

（主要）问题是，您定义了一个反应式df，它与您的应用程序启动时创建的全局环境df 中的非反应式数据框同名。这似乎把事情搞混了。我将反应的名称更改为data。

在您的反应式中，if 语句没有相互连接，我使用 else if 做到了这一点。此外，您不需要将<- 数据分配给临时变量（在您的情况下为df）。如果你使用 assign，你需要在响应式结束时（或者在每个 if/else 语句结束时）调用这个临时对象。

library(shiny)
library(ggplot2)
library(dplyr)
library(datasets)
library(lubridate)


df <- airquality %>% 
  mutate(date = make_datetime(day = Day, month = Month), 
         Ozone1 = Ozone + 1, Temp1 = Temp + 1,
         Ozone_predictor = Ozone / 2, Temp_predictor = Temp / 2) %>% 
  select(date, everything(), -Month, -Day)


ui <- fluidPage(

  # Title
  titlePanel("New York AirQuality Measurements"),

  # Input Selection used to build dataframe
  sidebarLayout(
    sidebarPanel(
      selectInput(inputId = "target", 
                  label = "Choose a prediction target for visualization", 
                  choices = list("Ozone", "Ozone1", "Temp")
      )
    ), 

    # Plot
    mainPanel(
      plotOutput("plot", height = "1200px")
    )
  )
)


server <- function(input, output) {

  data <- reactive({

    if(input$target == "Ozone"){
      df %>%
        select(-Ozone1, -contains("Temp")) %>% 
        tidyr::gather(key = key, value = value, -date)
      } else if(input$target == "Ozone1"){
        df %>%
          select(-Ozone, -contains("Temp")) %>% 
          tidyr::gather(key = key, value = value, -date)
      }else if (input$target == "Temp") {
        df %>%
          select(-contains("Ozone")) %>% 
          tidyr::gather(key = key, value = value, -date)
      }


  })


  output$plot <- renderPlot({
    ggplot(data(), aes(date, value)) +
      geom_line() +
      facet_wrap(key ~ ., scales = "free", ncol = 1) +
      labs(y = "", x = "") +
      theme_classic()
  })
}

# Run the application 
shinyApp(ui = ui, server = server)