I have a shiny app made in RStudio where filter options are generated for users from a dataframe, and a summary table is generated as output. The idea is that the data in the dataframe comes from an excel .xlsx file. If I read the file at the start of the app, it works correctly. But I would like to change that, so that the user loads the file with the data.
The data in excel has the following structure:
ID <- c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19)
Provincia <- c("Santa Fe", "Santa Fe", "Cordoba" ,"Santa Fe" ,"Santa Fe", "Cordoba", "Cordoba" ,"Santa Fe", "Cordoba" ,"Cordoba" ,"Santa Fe", "Santa Fe", "Santa Fe" ,"Santa Fe", "Santa Fe", "Cordoba", "Cordoba" ,"Cordoba","Santa Fe")
Ciudad <- c("Carlos Paz", "Esperanza" ,"Rafaela" ,"Carlos Paz", "Carlos Paz" ,"Rafaela" ,"Villa General" ,"Belgrano" ,"Villa General Belgrano", "Rafaela","Esperanza", "Rafaela", "Esperanza" ,"Esperanza", "Villa General" ,"Belgrano", "Carlos Paz", "Carlos Paz", "Esperanza")
Valor1 <- rpois(n = 19, lambda = 10)
Valor2 <- runif(n = 19, min = 1, max = 10)
Color <- c("Rojo", "Azul", "Rojo", "Azul","Rojo", "Azul","Rojo", "Azul","Rojo", "Azul","Rojo", "Azul","Rojo", "Azul","Rojo", "Azul","Rojo", "Azul","Rojo")
df <- data.frame(ID,Provincia,Ciudad,Valor1,Valor2,Color)
The working app is as follows:
library(shiny)
library(tidyverse)
library(readxl)
library(arsenal)
base <- read_excel("Libro1.xlsx")
prov_list <- base %>% distinct(Provincia)%>%arrange(Provincia)
todos <- " ALL"
prov_list <- rbind(todos, prov_list)
prov_list <- split(prov_list,prov_list$Provincia)
ui <- fluidPage(
titlePanel("Título"),
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "var1",
label = "Select province",
choices = ls(prov_list),
selected = " ALL",
multiple = FALSE
),
selectInput(
inputId = "var2",
label = "Select city",
choices = NULL
)
),
mainPanel(
tabsetPanel(
type = "tabs",
tabPanel(
"Tabla 1",
htmlOutput("table")
)
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$var1,{
updateSelectInput(session,'var2',
choices=c(" ALL",unique(base$Ciudad[base$Provincia==input$var1])))
})
My_Uploaded_Data <- reactive({
My_Uploaded_Data<-base
My_Uploaded_Data
})
filtered_data_0 <- reactive({
filtered_data_0<-My_Uploaded_Data()
filtered_data_0 %>%filter(if(input$var1!= ' ALL') (Provincia == input$var1) else TRUE)
})
filtered_data <- reactive({
filtered_data<-filtered_data_0()
filtered_data %>%filter(if(input$var2!= ' ALL') (Ciudad == input$var2) else TRUE)
})
controles <- reactive({
tableby.control(
test = T,
total = T,
numeric.test = "anova", cat.test = "chisq",
numeric.stats = c("meanCI"),
cat.stats = c("countpct"),
stats.labels = list(
meanCI = "Media (95%CI)",
countpct = "n (%)")
)
})
output$table <- function(){
x <- filtered_data()
my_controls <- controles()
tab1 <- tableby(Color ~ Valor1+Valor2,
data=x,
control=my_controls)
aver <- as.data.frame(summary(tab1,digits=1,
text = "html"))
kable(aver,align = "lccc", escape = FALSE)%>%
kable_styling(bootstrap_options = c("striped", "hover","condensed","responsive"), full_width = TRUE)
}
}
shinyApp(ui = ui, server = server)
And my attempt to implement user loading is as follows:
library(shiny)
library(tidyverse)
library(readxl)
library(arsenal)
ui <- fluidPage(
titlePanel("Título"),
sidebarLayout(
sidebarPanel(
fileInput("upload", "Please select file", accept = c(".xlsx")),
selectInput(
inputId = "var1",
label = "Select province",
choices = ls(prov_list),
selected = " ALL",
multiple = FALSE
),
selectInput(
inputId = "var2",
label = "Select city",
choices = NULL
)
),
mainPanel(
tabsetPanel(
type = "tabs",
tabPanel(
"Tabla 1",
htmlOutput("table")
)
)
)
)
)
server <- function(input, output, session) {
base <- reactive({
upload <- input$upload
base <- read_excel(upload$datapath)
})
prov_list <- base() %>% distinct(Provincia)%>%arrange(Provincia)
todos <- " ALL"
prov_list <- rbind(todos, prov_list)
prov_list <- split(prov_list,prov_list$Provincia)
observeEvent(input$var1,{
updateSelectInput(session,'var2',
choices=c(" ALL",unique(base()$Ciudad[base()$Provincia==input$var1])))
})
My_Uploaded_Data <- reactive({
My_Uploaded_Data<-base()
My_Uploaded_Data
})
filtered_data_0 <- reactive({
filtered_data_0<-My_Uploaded_Data()
filtered_data_0 %>%filter(if(input$var1!= ' ALL') (Provincia == input$var1) else TRUE)
})
filtered_data <- reactive({
filtered_data<-filtered_data_0()
filtered_data %>%filter(if(input$var2!= ' ALL') (Ciudad == input$var2) else TRUE)
})
controles <- reactive({
tableby.control(
test = T,
total = T,
numeric.test = "anova", cat.test = "chisq",
numeric.stats = c("meanCI"),
cat.stats = c("countpct"),
stats.labels = list(
meanCI = "Media (95%CI)",
countpct = "n (%)")
)
})
output$table <- function(){
x <- filtered_data()
my_controls <- controles()
tab1 <- tableby(Color ~ Valor1+Valor2,
data=x,
control=my_controls)
aver <- as.data.frame(summary(tab1,digits=1,
#labelTranslations = my_labels,
text = "html"))
kable(aver,align = "lccc", escape = FALSE)%>%
kable_styling(bootstrap_options = c("striped", "hover","condensed","responsive"), full_width = TRUE)
}
}
shinyApp(ui = ui, server = server)
But it gives me the error "Error : Operation not allowed without an active reactive context. You tried to do something that can only be done from inside a reactive consumer", which I'm not sure how to fix. I would greatly appreciate any help!
those reactivity errors are very common, the problem is exactly here:
Where the correct would be:
Since you are generating reactive values from base() which is also reactive
That said, we could make the following changes:
On the other hand, once the above has been corrected, I take advantage of the post to mention that you will find yourself facing another error here:
Where we must do the following to treat it:
Basically, this is to return a null in the path of the file to be uploaded by the user, as long as no file has been uploaded.
The final code would look like this:
You would need to solve the problem in
ui
thechoices = ls(prov_list)
Since now that would not exist
I hope I've helped