inst/appweb/include_server/meds-repets-anova-server.R

# autor --------------------------------------
# carlos.perez7@udea.edu.co
# carlos.perezoft@gmail.com
# 31/03/2022 4:40:35 p. m.
# autor --------------------------------------
#
# Se usa "reactive" para reprocesar la "funcion" en caso que un input cambie.
# En este caso todas las variables dentro de la funcion son constantes, por lo tanto
# se ejecuta una sola vez, evitanto relectura de datos cada vez que se invoque.
loadGnralDBData <- reactive({
   #
   # Rangos para la hoja de excel: MAY.22: A1:AB48805, JUL.22: A1:AB65484, AGO.22: A1:AB74412
   gnral_est_DB <- read_excel(paste0(hiperviz_data_path,"GNRAL-ESTACIONES_CONSOLIDADO_c15mins-AGO22.xlsx"), col_names=TRUE,
                              sheet="MEDICION_ESTACION", range="A1:AB74412") # <- Cambiar el rango aqui...
   #
   # Se usa la funcion "print" para que desde la APP Web se genere en consola el texto enviado como parametro:
   #print(head(gnral_est_DB))
   return(gnral_est_DB)
})
#
output$boxplotEstacionesPlotMR <- renderPlotly({
   dsBase <- loadGnralDBData()
   req(dsBase)
   #
   if(!is.null(input$boxplotEstacionMesMR)) {
      dsBase <- dsBase %>% filter(MES %in% input$boxplotEstacionMesMR)
   }
   #
   if(input$boxplotEstacDiaMesMR != "T") {
      dsBase <- dsBase %>% filter(DIA_MES == input$boxplotEstacDiaMesMR)
   }
   #
   if(!is.null(input$boxplotEstacDiaSemMR)) {
      dsBase <- dsBase %>% filter(DIA_SEMANA %in% input$boxplotEstacDiaSemMR)
   }
   #
   shiny::validate(
      shiny::need(nrow(dsBase) > 0, # Este check valida la condicion de forma "afirmativa"..
                  "No se tienen mediciones disponibles para los filtros usados.")
   )
   #
   dataSerie <- dsBase[c("fila_id", "ESTACION_TXT", input$boxplotEstacionesParamMR)]
   selected_label <- param_MR_labels %>% filter(param_bs == input$boxplotEstacionesParamMR) %>% select("desc")
   names(dataSerie) <- c("fila_id", "estacion", "parametro")
   #
   gpy <- dataSerie %>% # pointpos: Posicion donde salen los puntos, aqui el centro (0).
      plot_ly(x=~estacion, y=~parametro, color=~estacion, type = "box", jitter=0.3, pointpos=0,
              boxpoints = if_else(input$boxplotEstacionPtosCheckMR, "all", "none"), # <- Los valores deben ser del mismo tipo: String.
              marker=list(color='rgba(219, 64, 82, 0.6)'), boxmean = "sd" # Atributo que activa la presentaciĆ³n de la media y la desviacion estandar en el box-plot.
      ) %>% layout(xaxis=list(title="Estaci\u00F3n"),
                   yaxis=list(title = sprintf("%s %s","Valor ", selected_label), zeroline = T))
   #
   return(gpy)
})
#
output$violinEstacionesPlotMR <- renderPlotly({
   dsBase <- loadGnralDBData()
   req(dsBase)
   #
   if(!is.null(input$violinEstacionMesMR)) {
      dsBase <- dsBase %>% filter(MES %in% input$violinEstacionMesMR)
   }
   #
   if(input$violinEstacDiaMesMR != "T") {
      dsBase <- dsBase %>% filter(DIA_MES == input$violinEstacDiaMesMR)
   }
   #
   if(!is.null(input$violinEstacDiaSemMR)) {
      dsBase <- dsBase %>% filter(DIA_SEMANA %in% input$violinEstacDiaSemMR)
   }
   #
   shiny::validate(
      shiny::need(nrow(dsBase) > 0, # Este check valida la condicion de forma "afirmativa"..
                  "No se tienen mediciones disponibles para los filtros usados.")
   )
   #
   dataSerie <- dsBase[c("fila_id", "ESTACION_TXT", input$violinEstacionesParamMR)]
   selected_label <- param_MR_labels %>% filter(param_bs == input$violinEstacionesParamMR) %>% select("desc")
   names(dataSerie) <- c("fila_id", "estacion", "parametro")
   #
   gpy <- dataSerie %>%
      plot_ly(x = ~estacion, y = ~parametro, split = ~estacion, type = "violin",
              box = list(visible = T), meanline = list(visible = T)
      ) %>% layout(xaxis=list(title="Estaci\u00F3n"),
                   yaxis=list(title = sprintf("%s %s","Valor ", selected_label), zeroline = T))
   #
   return(gpy)
})
#
output$distriDensiEstacionesPlotMR <- renderPlotly({
   dsBase <- loadGnralDBData()
   req(dsBase)
   #
   if(!is.null(input$densidadEstacionMesMR)) {
      dsBase <- dsBase %>% filter(MES %in% input$densidadEstacionMesMR)
   }
   #
   if(input$densidadEstacDiaMesMR != "T") {
      dsBase <- dsBase %>% filter(DIA_MES == input$densidadEstacDiaMes)
   }
   #
   if(!is.null(input$densidadEstacDiaSemMR)) {
      dsBase <- dsBase %>% filter(DIA_SEMANA %in% input$densidadEstacDiaSemMR)
   }
   #
   shiny::validate(
      shiny::need(nrow(dsBase) > 0, # Este check valida la condicion de forma "afirmativa"..
                  "No se tienen mediciones disponibles para los filtros usados.")
   )
   #
   dataSerie <- dsBase[c("fila_id", "ESTACION_TXT", input$densidadEstacionesParamMR)]
   selected_label <- param_MR_labels %>% filter(param_bs == input$densidadEstacionesParamMR) %>% select("desc")
   names(dataSerie) <- c("fila_id", "estacion", "parametro")
   #
   # alpha: 0.2 (colores claros) / 0.55 (colores intermedios),
   # es el parametro para el nivel de transparencia de las densidades presentadas:
   ggp <- ggplot(dataSerie, aes(x = parametro, group = estacion, fill = estacion)) + geom_density(alpha=0.55) +
      labs(title = sprintf("%s",selected_label), x = sprintf("%s %s","Valores: ",selected_label), y = "Densidad") +
      theme(
         legend.position="right"
      )
   # Se usa el objeto "ggp" para una invocacion mas limpia...
   ggplotly(ggp)
})
#
output$boxplotVarTempPlotMR <- renderPlotly({
   dsBase <- loadGnralDBData()
   req(dsBase)
   #
   dsBase <- dsBase %>% filter(ESTACION_TXT == input$boxplotVarTempEstacionMR)
   #
   if(!is.null(input$boxplotVarTempMesMR)) {
      dsBase <- dsBase %>% filter(MES %in% input$boxplotVarTempMesMR)
   }
   #
   if(input$boxplotVarTempDiaMesMR != "T") {
      dsBase <- dsBase %>% filter(DIA_MES == input$boxplotVarTempDiaMesMR)
   }
   #
   if(!is.null(input$boxplotVarTempDiaSemMR)) {
      dsBase <- dsBase %>% filter(DIA_SEMANA %in% input$boxplotVarTempDiaSemMR)
   }
   #
   shiny::validate(
      shiny::need(nrow(dsBase) > 0, # Este check valida la condicion de forma "afirmativa"..
                  "No se tienen mediciones disponibles para los filtros usados.")
   )
   #
   dataSerie <- dsBase[c("fila_id", "MES", input$boxplotVarTempParamMR)]
   names(dataSerie) <- c("fila_id", "mes", "parametro")
   selected_label <- param_MR_labels %>% filter(param_bs == input$boxplotVarTempParamMR) %>% select("desc")
   dataSerie <- dataSerie %>% transmute(fila_id = fila_id, mes = dplyr::case_when(
      # IMPORTANTE: Se usa el numero+nombre del mes, para que en el grafico se presente en orden numerico ASC.
      mes == 1 ~ "2022-01-Enero",mes == 2 ~ "2022-02-Febrero",mes == 3 ~ "2022-03-Marzo",mes == 4 ~ "2022-04-Abril",
      mes == 5 ~ "2022-05-Mayo",mes == 6 ~ "2022-06-Junio",mes == 7 ~ "2022-07-Julio",mes == 8 ~ "2022-08-Agosto",
      mes == 9 ~ "2022-09-Septiembre",mes == 10 ~ "2022-10-Octubre",mes == 11 ~ "2022-11-Noviembre",mes == 12 ~ "2021-12-Diciembre"
   ), parametro = parametro)
   #
   gpy <- dataSerie %>% # pointpos: Posicion donde salen los puntos, aqui el centro (0).
      plot_ly(x=~mes, y=~parametro, color=~mes, type = "box", jitter=0.3, pointpos=0,
              boxpoints = if_else(input$boxplotVarTempPtosCheckMR, "all", "none"), # <- Los valores deben ser del mismo tipo: String.
              marker=list(color='rgba(219, 64, 82, 0.6)'), boxmean = "sd" # Atributo que activa la presentaciĆ³n de la media y la desviacion estandar en el box-plot.
      ) %>% layout(xaxis=list(title = sprintf("%s %s","Mes / ", input$boxplotVarTempEstacionMR)),
                   yaxis=list(title = sprintf("%s %s","Valor ", selected_label), zeroline = T))
   #
   return(gpy)
})
#
loadMRContornoDB <- reactive({
   #
   # Hojas de Excel: MR_CONDUCTIVIDAD, MR_PH, MR_OD, MR_TURBIEDAD, MR_POTENCIAL_REDOX, MR_TEMPERATURA
   # Se lee desde la columna A1 por el uso de los filtros. Luego en la funcion repectiva se seleccionan las columnas necesarias.
   #
   xlsFileDB <- read_excel(paste0(hiperviz_data_path,"TODO_MR_E",substr(input$contornoFiltroEstacionMR,1,1),"_CONV_825_c15mins-AGO22.xlsx"),
                                col_names=TRUE, sheet=input$contornoParamMR, range="A1:CW275")
   #
   # Se usa la funcion "print" para que desde la APP Web se genere en consola el texto enviado como parametro:
   #print(head(xlsFileDB))
   return(xlsFileDB)
})
#
output$contornoEstacionPlotMR <- renderPlotly({
   # Hojas de Excel: MR_CONDUCTIVIDAD, MR_PH, MR_OD, MR_TURBIEDAD, MR_POTENCIAL_REDOX, MR_TEMPERATURA
   #
   MR_ESTACION_DB <- loadMRContornoDB()
   req(MR_ESTACION_DB)
   #print(nrow(MR_ESTACION_DB))
   #
   #
   if(!is.null(input$contornoNivelEstMR)) {
      MR_ESTACION_DB <- MR_ESTACION_DB %>% filter(NIVEL %in% input$contornoNivelEstMR)
   }
   #
   if(!is.null(input$contornoEstacionMesMR)) {
      MR_ESTACION_DB <- MR_ESTACION_DB %>% filter(MES %in% input$contornoEstacionMesMR)
   }
   #
   if(!is.null(input$contornoAnioEstMR)) {
      MR_ESTACION_DB <- MR_ESTACION_DB %>% filter(ANIO %in% input$contornoAnioEstMR)
   }
   #
   shiny::validate(
      shiny::need(nrow(MR_ESTACION_DB) > 0, # Este check valida la condicion de forma "afirmativa"..
                  "No se tienen mediciones disponibles para los filtros usados.")
   )
   # Luego de aplicar los filtros especificos, se seleccionan SOLO las columnas de datos para el grafico:
   MR_ESTACION_DB <- MR_ESTACION_DB[,c(8:ncol(MR_ESTACION_DB))]
   #print(nrow(MR_ESTACION_DB))
   PARAMETRO <- as.matrix(MR_ESTACION_DB) # <-funcion en paquete "base" de R
   selected_label <- param_MR_labels %>% filter(param_mr == input$contornoParamMR) %>% select("desc")
   #
   #*[A] Contorno: Al usar el nombre de los colores entre "comillas" se asigna un
   # objeto del color con la escala por defecto. P. ej: Blues(3),Spectral,Reds,Blues,Oranges
   contourPlot <- plot_ly(z=~PARAMETRO, type = "contour", colors=cool_warm(10)) %>%
                  layout(title=list(text = sprintf("%s :: %s",input$contornoFiltroEstacionMR, selected_label)))
   return(contourPlot)
})
#
loadMR3DSuperDB <- reactive({
   #
   # Hojas de Excel: MR_CONDUCTIVIDAD, MR_PH, MR_OD, MR_TURBIEDAD, MR_POTENCIAL_REDOX, MR_TEMPERATURA
   # Se lee desde la columna A1 por el uso de los filtros. Luego en la funcion repectiva se seleccionan las columnas necesarias.
   #
   xlsFileDB <- read_excel(paste0(hiperviz_data_path,"TODO_MR_E",substr(input$super3DFiltroEstacionMR,1,1),"_CONV_825_c15mins-AGO22.xlsx"),
                              col_names=TRUE, sheet=input$super3DParamMR, range="A1:CW275")
   #
   # Se usa la funcion "print" para que desde la APP Web se genere en consola el texto enviado como parametro:
   #print(head(xlsFileDB))
   return(xlsFileDB)
})
#
output$super3dEstacionPlotMR <- renderPlotly({
   # Hojas de Excel: MR_CONDUCTIVIDAD, MR_PH, MR_OD, MR_TURBIEDAD, MR_POTENCIAL_REDOX, MR_TEMPERATURA
   #
   MR_ESTACION_DB <- loadMR3DSuperDB()
   req(MR_ESTACION_DB)
   #print(nrow(MR_ESTACION_DB))
   #
   if(!is.null(input$super3DNivelEstMR)) {
      MR_ESTACION_DB <- MR_ESTACION_DB %>% filter(NIVEL %in% input$super3DNivelEstMR)
   }
   #
   if(!is.null(input$super3DEstacionMesMR)) {
      MR_ESTACION_DB <- MR_ESTACION_DB %>% filter(MES %in% input$super3DEstacionMesMR)
   }
   #
   if(!is.null(input$super3DAnioEstMR)) {
      MR_ESTACION_DB <- MR_ESTACION_DB %>% filter(ANIO %in% input$super3DAnioEstMR)
   }
   #
   shiny::validate(
      shiny::need(nrow(MR_ESTACION_DB) > 0, # Este check valida la condicion de forma "afirmativa"..
                  "No se tienen mediciones disponibles para los filtros usados.")
   )
   #
   # Luego de aplicar los filtros especificos, se seleccionan SOLO las columnas de datos para el grafico:
   MR_ESTACION_DB <- MR_ESTACION_DB[,c(8:ncol(MR_ESTACION_DB))]
   #print(nrow(MR_ESTACION_DB))
   PARAMETRO <- as.matrix(MR_ESTACION_DB) # <-funcion en paquete "base" de R
   selected_label <- param_MR_labels %>% filter(param_mr == input$super3DParamMR) %>% select("desc")
   #
   #*[A] Superficie: Al usar el nombre de los colores entre "comillas" se asigna un
   # objeto del color con la escala por defecto. P. ej: Blues(3),Spectral,Reds,Blues,Oranges
   super3DPlot <- plot_ly(z=~PARAMETRO, colors=cool_warm(10))
   super3DPlot <- super3DPlot %>% add_surface() %>%
                  layout(title=list(text = sprintf("%s :: %s",input$super3DFiltroEstacionMR,selected_label)))
   ##
   # Genera al superficie 3D con el contorno en la base (eje x)
   # super3DPlot <- plot_ly(z=~PARAMETRO, colors=cool_warm(10))
   # super3DPlot <- super3DPlot %>% add_surface(
   #    contours = list(
   #       z = list(
   #          show=TRUE,
   #          usecolormap=TRUE,
   #          highlightcolor="#ff0000",
   #          project=list(z=TRUE)
   #       )
   #    )
   # )
   ##
   return(super3DPlot)
})
#
carlosperezoft/hipervizr documentation built on Nov. 17, 2022, 9:24 a.m.