# 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)
})
#
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.