Question

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

我得到的错误是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.)

你能帮忙吗？

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

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

在Shiny中设置反应数据帧中的行或单个值

1 个答案: