r语言 - 使用选定输入在 dplyr 中进行反应式数据帧操作

Question

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

我正在尝试操作依赖于用户选择的"输入"的数据框。我想在 ui 中使用下拉菜单，但无法使其在服务器中工作(使用 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)