在 Shiny 的反应性数据框中设置行或单个值的子集

Question

我一直在尝试几种方法来按行或单个值对反应性数据框进行子集化，但到目前为止没有运气。互联网上的大多数示例都与列子集有关，这对我来说很好，或者基于用户输入的子集（再次按列）。 如果我的反应数据框是demand()，我试过：demand()[1,]; demand()["2017",]; demand()[1,1] --> 不走运。

我得到的错误是Warning: Error in .getReactiveEnvironment()$currentContext: Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)

你能帮忙吗？

见下面的代码。非常感谢。

library(shiny)
library(DT)

ui <- fluidPage(
  fluidRow(
    column(width = 6, 
           headerPanel(title = h4(strong("Change the Demand"))),
           wellPanel(
             navlistPanel(
               tabPanel(title = "Professional",
                        sliderInput(inputId = "dem_prof_2017", label = "Demand 2017 % increase", min = -100, max = 100, value = 0, step = 5),
                        sliderInput(inputId = "dem_prof_2018", label = "Demand 2018 % increase", min = -100, max = 100, value = 0, step = 5),
                        sliderInput(inputId = "dem_prof_2019", label = "Demand 2019 % increase", min = -100, max = 100, value = 0, step = 5),
                        sliderInput(inputId = "dem_prof_2020", label = "Demand 2020 % increase", min = -100, max = 100, value = 0, step = 5)
               ),
               tabPanel(title = "Full Size", 
                        sliderInput(inputId = "dem_fs_2017", label = "Demand 2017 % increase", min = -100, max = 100, value = 0, step = 5),
                        sliderInput(inputId = "dem_fs_2018", label = "Demand 2018 % increase", min = -100, max = 100, value = 0, step = 5),
                        sliderInput(inputId = "dem_fs_2019", label = "Demand 2019 % increase", min = -100, max = 100, value = 0, step = 5),
                        sliderInput(inputId = "dem_fs_2020", label = "Demand 2020 % increase", min = -100, max = 100, value = 0, step = 5)
               ),
               tabPanel(title = "Humidifier",
                        sliderInput(inputId = "dem_hum_2017", label = "Demand 2017 % increase", min = -100, max = 100, value = 0, step = 5),
                        sliderInput(inputId = "dem_hum_2018", label = "Demand 2018 % increase", min = -100, max = 100, value = 0, step = 5),
                        sliderInput(inputId = "dem_hum_2019", label = "Demand 2019 % increase", min = -100, max = 100, value = 0, step = 5),
                        sliderInput(inputId = "dem_hum_2020", label = "Demand 2020 % increase", min = -100, max = 100, value = 0, step = 5)
               ),
               tabPanel(title = "Hair Care",
                        sliderInput(inputId = "dem_hc_2017", label = "Demand 2017 % increase", min = -100, max = 100, value = 0, step = 5),
                        sliderInput(inputId = "dem_hc_2018", label = "Demand 2018 % increase", min = -100, max = 100, value = 0, step = 5),
                        sliderInput(inputId = "dem_hc_2019", label = "Demand 2019 % increase", min = -100, max = 100, value = 0, step = 5),
                        sliderInput(inputId = "dem_hc_2020", label = "Demand 2020 % increase", min = -100, max = 100, value = 0, step = 5)
               ),
               tabPanel(title = "New Category",
                        sliderInput(inputId = "dem_nc_2017", label = "Demand 2017 % increase", min = -100, max = 100, value = 0, step = 5),
                        sliderInput(inputId = "dem_nc_2018", label = "Demand 2018 % increase", min = -100, max = 100, value = 0, step = 5),
                        sliderInput(inputId = "dem_nc_2019", label = "Demand 2019 % increase", min = -100, max = 100, value = 0, step = 5),
                        sliderInput(inputId = "dem_nc_2020", label = "Demand 2020 % increase", min = -100, max = 100, value = 0, step = 5))
             ) #end of wellpanel
           )), # end of column
    column(width = 4, offset = 1, 
           fluidRow(dataTableOutput(outputId = "demand_table")),
           fluidRow(verbatimTextOutput(outputId = "demand_2017"))
    ) # end of column
  ) # end of fluid row
) # end of fluidPage


server <- function(input, output) {
  
  demand_actual <-
    data.frame(
      year = c("2017", "2018", "2019", "2020"),
      professional = round(runif(n = 4, min = 1000000, 10000000), 0),
      full_size = round(runif(n = 4, min = 1000000, 10000000), 0),
      humidifier = round(runif(n = 4, min = 1000000, 10000000), 0),
      hair_care = round(runif(n = 4, min = 1000000, 10000000), 0),
      new_category = round(runif(n = 4, min = 1000000, 10000000), 0)
    )
  
  demand <- reactive({
    data.frame(
      year = c("2017", "2018", "2019", "2020"),
      
      professional = demand_actual$professional *
        (c(input$dem_prof_2017, input$dem_prof_2018, input$dem_prof_2019, input$dem_prof_2020) / 100 + 1),
      
      full_size =  demand_actual$full_size *
        (c( input$dem_fs_2017, input$dem_fs_2018, input$dem_fs_2019, input$dem_fs_2020) / 100 + 1),
      
      humidifier = demand_actual$humidifier *
        (c( input$dem_hum_2017, input$dem_hum_2018, input$dem_hum_2019, input$dem_hum_2020) / 100 + 1),
      
      hair_care =  demand_actual$hair_care *
        (c(input$dem_hc_2017, input$dem_hc_2018, input$dem_hc_2019, input$dem_hc_2020) / 100 + 1),
      
      new_category = demand_actual$new_category *
        (c(input$dem_nc_2017, input$dem_nc_2018, input$dem_nc_2019, input$dem_nc_2020) / 100 + 1)
    )
  }) # end of demand
  
  demand_2017 <- reactive({demand()["2017",]}) # OR subset each element individually: demand()[1,2] OR demand()["2017",]
  
  output$demand_table <- renderDataTable({demand()})
  output$demand_2017 <- textOutput(demand_2017())
  
}# end of server

    shinyApp(ui = ui, server = server)     

Answer 1

试试：

 demand_2017 <- reactive({    
 tmp <- demand()
 tmp[ tmp$year == "2017",]})
 output$demand_2017 <- renderDataTable(demand_2017())

或者使用 dplyr

library(tidyverse)
demand_2017 <- reactive({    
     filter(demand(), year == "2017")
                        })