disconnected from the server

[Jorge-hercas]

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

    )

  })

}

[bthieurmel]

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