shinymanager
shinymanager copied to clipboard
Published
20 hours ago •
datastorm-open
datastorm-open
disconnected from the server
Hello and thanks for reading me. First of all I would like to thank you for this incredible package, it has helped me a lot, only now I am having an issue. When I run the application it automatically disconnects me from the server. In another issue I noticed that this occurs due to the NULL in the filter () function, however I have not managed to solve the problem with the req() function. Do you know if it's a bug in my code or a bug in the package? I appreciate your help in advance
my code is the following:
library(shiny)
library(readxl)
library(echarts4r)
library(reactable)
library(dplyr)
library(forecast)
library(shinyWidgets)
library(ggplot2)
library(ggfortify)
library(lubridate)
#library(leaflet)
library(data.table)
library(shinymanager)
credentials <- data.frame(
user = c(1,"shiny", "shinymanager"),
password = c(1,"azerty", "12345"),
stringsAsFactors = FALSE
)
ui <- fluidPage(
setSliderColor("gray", 1),
chooseSliderSkin("Flat"),
column(width = 12,
div(style="display: inline-block;vertical-align:top; width: 350px;",
selectInput("filtro", label = "Cuenta:", choices = unique(cuenta_grup$Cuenta) )),
div(style="display: inline-block;vertical-align:top; width: 350px;",
selectInput("filtro_final", "Servicio:", choices = NULL)),
div(style="display: inline-block;vertical-align:top; width: 350px;",
selectInput("filtro_final1", "Subservicio:", choices = NULL)),
sliderInput("periodos", "Escoge un número de periodos a pronosticar:",
36, min = 1, max = 100)
),
column(width = 4,
tags$head(tags$style(".shiny-output-error{visibility: hidden}")),
tags$head(tags$style(".shiny-output-error:after{content: 'Se necesitan más datos para poder comparar 2020.';visibility: visible}")),
reactableOutput("tabla1", width = 300)
),
column(width = 8,
echarts4rOutput("grafico_bandas", width = 750, height = 400),
echarts4rOutput("grafico", width = 750, height = 400)
)
)
ui <- secure_app(ui)
server <- function(input, output, session){
res_auth <- secure_server(
check_credentials = check_credentials(credentials)
)
example <- reactive({
base |>
#group_by(.data[[input$filtro]]) |>
filter(Cuenta == input$filtro ) |>
group_by(Servicio) |>
summarise(n = n()) |>
setNames(c("Valor", "Valor2"))
})
observe({
req(example())
updateSelectInput(session, "filtro_final", choices = c( example()$Valor ))
})
example2 <- reactive({
base |>
#group_by(.data[[input$filtro]]) |>
filter(Cuenta == input$filtro & Servicio == input$filtro_final ) |>
group_by(Subservicio) |>
summarise(n = n()) |>
setNames(c("Valor", "Valor2"))
})
observe({
req(example2())
updateSelectInput(session, "filtro_final1", choices = c( example2()$Valor ))
})
##### PRONÓSTICOS #####
output$grafico <- renderEcharts4r({
req(example())
datos_mod <- base |>
filter(Cuenta == input$filtro & Subservicio == input$filtro_final1 & Servicio == input$filtro_final) |>
group_by(Año_mes) |>
summarise(total = sum(`Número de Servicios`, na.rm = TRUE))
datos_mod$Año_mes <- as.Date(datos_mod$Año_mes)
if (length(datos_mod$total ) >6 ){
ts_data <- ts(datos_mod$total,
start = as.numeric(substr(datos_mod$Año_mes[1], 1,4)),
frequency = 12
)
modelo <- forecast::forecast(forecast::auto.arima(ts_data, trace = FALSE, approximation = TRUE), h = input$periodos)
data_modelo <- fortify(modelo)
data_modelo$`Point Forecast`[data_modelo$`Point Forecast` < 0] <- 0
data_modelo |>
e_charts(Index) |>
e_line(Data, symbol = "none", name = "Valor observado") |>
e_line(`Point Forecast`, symbol = "none", name = "Pronóstico") |>
e_legend(FALSE) |>
e_tooltip(trigger = "axis",
confine = TRUE,
textStyle = list(fontFamily = "Roboto Condensed", fontSize = 12)) |>
e_theme("auritus") |>
e_title(paste0("Cuenta: '",input$filtro, "'" ), paste0("Pronóstico considerando 2020. Periodos pronosticados: ",
input$periodos),
left = "center",
textStyle = list(
color = "gray",
fontFamily = "Roboto Condensed"
)
)
}else if(input$filtro_final == "Asistencia Médica"){
datos1 <- base |>
filter(Cuenta == input$filtro &
Servicio == input$filtro_final &
Subservicio ==input$filtro_final1 &
Año_mes >"2020-01-01")
datos_ts <- ts(datos1$`Número de Servicios`, start = 2020, frequency = 12)
airforecast <- forecast(bats(datos_ts
), level = 90, h = 24)
observado <- fortify(airforecast, ts.connect = FALSE)
final <- observado |>
left_join(filter(base, Cuenta == input$filtro &
Servicio == input$filtro_final &
Subservicio ==input$filtro_final1 &
Año_mes >"2020-01-01"),
by = c("Index" = "Año_mes"))
final |>
e_charts(Index) |>
e_title("Pronostico", paste0("De la variable: ", "input$filtro" ) ) |>
e_line(Data, symbol = "none") |>
e_line(`Point Forecast`, symbol = "none") |>
#e_line(`Número de Servicios`, symbol = "none") |>
e_tooltip(trigger = "axis") |>
e_theme("auritus") |>
e_color(color =RColorBrewer::brewer.pal(7,"Set2"))
}else{
ult_valor <- data.frame(
Año_mes = seq.Date(from = tail(datos_mod$Año_mes,1) %m+% months(1),
to = tail(datos_mod$Año_mes,1) %m+% months(input$periodos),
by = "month"),
total = rep(tail(datos_mod$total,1),input$periodos)
) |>
setNames(c("Año_mes", "Forecast"))
datos_mod |>
bind_rows(ult_valor) |>
e_charts(Año_mes) |>
e_line(total, symbol = "none", name = "Valor observado") |>
e_line(Forecast, symbol = "none", name = "Pronóstico") |>
e_legend(FALSE) |>
e_tooltip(trigger = "axis",
confine = TRUE,
textStyle = list(fontFamily = "Roboto Condensed", fontSize = 12)) |>
e_theme("auritus") |>
e_title(paste0("Cuenta: '",input$filtro, "'" ), paste0("Pronóstico (último valor). Periodos pronosticados: ",
input$periodos),
left = "center",
textStyle = list(
color = "gray",
fontFamily = "Roboto Condensed"
)
)
}
})
output$grafico_bandas <- renderEcharts4r({
datos_mod <- base |>
filter(Cuenta == input$filtro & Subservicio == input$filtro_final1 & Servicio == input$filtro_final & Año_mes < "2020-02-01") |>
group_by(Año_mes) |>
summarise(total = sum(`Número de Servicios`))
ts_data <- ts(datos_mod$total,
start = as.numeric(substr(datos_mod$Año_mes[1], 1,4)),
frequency = 12
)
modelo <- forecast::forecast(forecast::auto.arima(ts_data, trace = FALSE, approximation = TRUE), h = input$periodos)
data_modelo <- fortify(modelo)
val_2020 <- base |>
filter(Cuenta == input$filtro & Subservicio == input$filtro_final1 & Servicio == input$filtro_final & Año_mes > "2020-02-01") |>
group_by(Año_mes) |>
summarise(total = sum(`Número de Servicios`))
val_2020$Año_mes <- as.Date(val_2020$Año_mes)
data_modelo <- data_modelo |>
left_join(val_2020, by = c("Index" = "Año_mes"))
valor_ajuste <- (data_modelo$`Point Forecast`[which(data_modelo$total == tail(na.omit(data_modelo$total),1) )]
- data_modelo$total[which(data_modelo$total == tail(na.omit(data_modelo$total),1) )]
)
data_modelo <- data_modelo |>
mutate(ajuste = (`Point Forecast`-
valor_ajuste ) )
data_modelo$ajuste[data_modelo$ajuste < 0] <- 0
data_modelo |>
e_charts(Index) |>
e_line(Data, symbol = "none", name = "Valor observado") |>
e_line(ajuste, symbol = "none", name = "Pronóstico") |>
e_line(total, symbol = "none", name = "Valor observado en 2020") |>
e_legend(FALSE) |>
e_tooltip(trigger = "axis",
confine = TRUE,
textStyle = list(fontFamily = "Roboto Condensed", fontSize = 12)) |>
e_theme("auritus") |>
e_title(paste0("Cuenta: '",input$filtro, "'" ), paste0("Pronóstico sin considerar 2020. Periodos pronosticados: ",
input$periodos),
left = "center",
textStyle = list(
color = "gray",
fontFamily = "Roboto Condensed"
)
)
})
output$tabla1 <- renderReactable({
datos_mod <- base |>
filter(Cuenta == input$filtro & Subservicio == input$filtro_final1 & Servicio == input$filtro_final & Año_mes < "2020-02-01") |>
group_by(Año_mes) |>
summarise(total = sum(`Número de Servicios`))
ts_data <- ts(datos_mod$total,
start = as.numeric(substr(datos_mod$Año_mes[1], 1,4)),
frequency = 12
)
modelo <- forecast::forecast(forecast::auto.arima(ts_data, trace = FALSE, approximation = TRUE), h = input$periodos)
data_modelo <- fortify(modelo)
val_2020 <- base |>
filter(Cuenta == input$filtro & Subservicio == input$filtro_final1 & Servicio == input$filtro_final & Año_mes > "2020-02-01") |>
group_by(Año_mes) |>
summarise(total = sum(`Número de Servicios`))
val_2020$Año_mes <- as.Date(val_2020$Año_mes)
data_modelo <- data_modelo |>
left_join(val_2020, by = c("Index" = "Año_mes"))
valor_ajuste <- (data_modelo$`Point Forecast`[which(data_modelo$total == tail(na.omit(data_modelo$total),1) )]
- data_modelo$total[which(data_modelo$total == tail(na.omit(data_modelo$total),1) )]
)
data_modelo <- data_modelo |>
mutate(ajuste = (`Point Forecast`-
valor_ajuste ) )
data_modelo$ajuste[data_modelo$ajuste < 0] <- 0
data_modelo$Index <- as.Date(data_modelo$Index)
tabla <- data_modelo |>
select(Index, total, ajuste) |>
mutate(variacion = abs((total/ajuste)-1)) |>
setNames(c("Fecha", "Valor Observado", "Pronóstico", "Variación porcentual")) |>
na.omit()
reactable(tabla,
theme = reactableTheme(backgroundColor = "transparent"
),
columns = list(
Pronóstico = colDef(format = colFormat( digits = 0)),
`Variación porcentual` = colDef(format = colFormat( digits = 2, percent = TRUE))
)
)
})
}
Hi, I think there are some missing req() in your code. See the error in R console, and so add one or severals req().
For example here :
example <- reactive({
req(input$filtro)
base |>
#group_by(.data[[input$filtro]]) |>
filter(Cuenta == input$filtro ) |>
group_by(Servicio) |>
summarise(n = n()) |>
setNames(c("Valor", "Valor2"))
})
Or you can use the one more global and brutal (but not really recommended) solution :
server <- function(input, output, session) {
auth_out <- secure_server(....)
observe({
if(is.null(input$shinymanager_where) || (!is.null(input$shinymanager_where) && input$shinymanager_where %in% "application")){
# your server app code
}
})
}
