I've been trying a couple of ways to subset a reactive dataframe by row or individual values, but had no luck so far. Most of the examples on the internet relate to column subsetting which works fine for me or subsetting based on user input (again by column).
If my reactive dataframe is demand()
, I tried: demand()[1,]
; demand()["2017",]
; demand()[1,1]
--> no luck.
The error I get is 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.)
Can you help, please?
See code below. Thanks a lot, 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
Try:
demand_2017 <- reactive({
tmp <- demand()
tmp[ tmp$year == "2017",]})
output$demand_2017 <- renderDataTable(demand_2017())
Or use dplyr
library(tidyverse)
demand_2017 <- reactive({
filter(demand(), year == "2017")
})
No comments:
Post a Comment