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