Tengo una shiny app hecha en RStudio donde a partir de un dataframe se generan opciones de filtro para los usuarios, y como output se genera una tabla resumen. La idea es que los datos del dataframe surgen de un archivo de excel .xlsx. Si leo el archivo al inicio de la app, funciona correctamente. Pero me gustaría cambiar eso, de manera que sea el usuario el que cargue el archivo con los datos.
Los datos en el excel tienen la siguiente estructura:
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)
La app funcionando es la siguiente:
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)
Y mi intento de implementar la carga por el usuario es el siguiente:
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)
Pero me da el 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", que no estoy segura cómo solucionar. Les agradecería mucho cualquier ayuda!