R/multivariado.R

In carlosperezoft/hipervizr: Dashboard para Hipercartas y Cartas de Control de Red Rio.

#
# Paquetes necesarios para los graficos BASE y 3D solo con plotly
library(readxl, quietly=TRUE)  # v1.3.1
library(tidyverse, quietly=TRUE) # v1.3.1
library(ggplot2, quietly=TRUE) # v3.3.5
library(plotly, quietly=TRUE)    # v4.10.0
library(heatmaply, quietly=TRUE) # v1.3.0
library(dygraphs, quietly=TRUE)  # v1.1.1.6
#
# # Paquetes necesarios para los graficos descriptivos complementarios:
library(parcoords, quietly=TRUE) # v1.0.0
library(reshape2, quietly=TRUE)  # v1.4.4
library(corrplot, quietly=TRUE)  # v0.92
library(qgraph, quietly=TRUE)    # v1.9
library(GGally, quietly=TRUE)    # v2.1.2
library(rstatix, quietly=TRUE)   # v0.7.0
library(circlize, quietly=TRUE)  # v0.4.14
#
# Ruta base para los archivos de datos de la app HIPERVIZ:
hiperviz_data_path <- "C:\\Temp\\"
#
#
mrE1Data <- read_excel(paste0(hiperviz_data_path,"Cartas_E1_02_06_22.xlsx"), col_names=TRUE,
                       sheet="CARTA_CTRL_NIVEL2", range="A1:X97")
head(mrE1Data, 10)
#
HC62E3Data <- read_excel(paste0(hiperviz_data_path,"HiperCarta_AnconSur-62-E3_DIC21-ENE22.xlsx"), col_names=TRUE,
                         sheet="HIPERCARTA", range="A1:S97")
head(HC62E3Data, 10)
cartaE3Medias <- HC62E3Data[c("id_t","MED_PH","MED_COND","MED_OXD","MED_TURB","MED_PRDX","MED_TMP")]
cartaE3Uno <- HC62E3Data[c("id_t","LI_PH","MED_PH","LS_PH")]
#
HC63E8Data <- read_excel(paste0(hiperviz_data_path,"HiperCarta_AulaAmb-63-E8_DIC21-ENE22.xlsx"),col_names=TRUE,
                         sheet="HIPERCARTA", range="A1:U97")
head(HC61E1Data, 10)
#
HC61E1Data <- read_excel(paste0(hiperviz_data_path,"HiperCarta_SanMiguel-61-E1_JUL-DIC2018.xlsx"),col_names=TRUE,
                         sheet="HIPERCARTA", range="A1:Y145")
head(HC61E1Data, 10)
#
cartaE1Medias <- HC61E1Data[c("id_t","MED_PH","MED_COND","MED_OXD","MED_TURB","MED_PRDX","MED_TMP")]
cartaE1Uno <- HC61E1Data[c("id_t","LI_PH","MED_PH","LS_PH")]

#
cartaE3LI <- HC62E3Data[c("id_t","LI_PH","LI_COND","LI_OXD","LI_TURB","LI_PRDX","LI_TMP")]
cartaE3LS <- HC62E3Data[c("id_t","LS_PH","LS_COND","LS_OXD","LS_TURB","LS_PRDX","LS_TMP")]
#id_t	LI_PH MED_PH LS_PH MED_COND LI_COND	LS_COND	MED_OXD	LI_OXD	LS_OXD	MED_TURB	LI_TURB	LS_TURB	MED_PRDX	LI_PRDX	LS_PRDX	MED_TMP	LI_TMP	LS_TMP
#
#
mrE1CPar <- parcoords(data=mrE1Data, reorderable=TRUE,withD3=TRUE, # debe ser True para el uso de los colores!
   rownames=FALSE, width=NULL, autoresize=TRUE,
   brushMode="1D-axes", alphaOnBrushed=0.1, alpha=1.0, # alpha-->intensidad del color de las lineas, de 0 a 1.
   color = list(
       colorBy = "id_t",
       colorScale = "scaleOrdinal",
       colorScheme = "schemeCategory10"
   )
)
mrE1CPar
#
#********************************************************************************************
##### INICIO DE SECCION ANALISIS GRAFICO EXPLORATORIO NUEVO:
# nuevos graficos con datos DIC.2021->ABR.2022:
# [16.JUN.2022] Nuevos datos usando dos SET de datos por cada hoja de excel:
# CARTA_CTRL_NIVEL2 y CARTA_CTRL_NIVEL2, el nivel-X se refiere a nivel de lluvia, siendo 3 el más alto.
#********************************************************************************************
hiperviz_data_path <- "C:\\Temp\\"
carta61E1Data <- read_excel(paste0(hiperviz_data_path,"Cartas_E1_02_06_22.xlsx"), col_names=TRUE, sheet="CARTA_CTRL_NIVEL2", range="A1:Y97")
head(carta61E1Data)
cartaE1Medias <- carta61E1Data[c("t_id","MEDIASph2","MEDIAScondu2","MEDIASod2","MEDIASturbie2","MEDIASpotredox2","MEDIAStempera2")]
#
mediasE1CPar <- parcoords(data=cartaE1Medias, reorderable=TRUE,withD3=TRUE, # debe ser True para el uso de los colores!
    rownames=FALSE, width=NULL, autoresize=TRUE,
    brushMode="1D-axes", alphaOnBrushed=0.1, alpha=1.0, # alpha-->intensidad del color de las lineas, de 0 a 1.
    color = list(
       colorBy = "t_id",
       colorScale = "scaleOrdinal",
       colorScheme = "schemeCategory10"
    )
)
#
mediasE1CPar
#TEST5#######################################################
cartaE1OnlyMedias <- cartaE1Medias[,c(2:ncol(cartaE1Medias))]
# Mean's Correlogram:
corrplot(cor(cartaE1OnlyMedias), method="circle", type="full", mar=c(1, 1, 2, 1), is.corr = TRUE,
         addCoef.col="black", title = "Correlograma-Medias Nivel 2")

#
qgraph(cor(cartaE1OnlyMedias), layout="groups", posCol="darkgreen", negCol="darkred",
       graph="pcor",sampleSize = nrow(cartaE1OnlyMedias)) #graph=glasso, require: layout="spring" and threshold = TRUE
#
qgraph(cor(cartaE1OnlyMedias), layout="spring", posCol="darkgreen", negCol="darkred",
       graph="glasso", sampleSize=nrow(cartaE1OnlyMedias), threshold=TRUE)
#
#
cartaE1OnlyMedias <- na.omit(cartaE1OnlyMedias)
splomMatrix <- GGally::ggpairs(cartaE1OnlyMedias, lower=list(continuous = "smooth"), mapping=ggplot2::aes(colour=I("cadetblue")))
ggplotly(splomMatrix)
###TEST4#####################################################
# [c("t_id","Linf_ph_n2","MEDIASph2","Lsup_ph_n2")]
# [c("t_id","Linf_condu_n2","MEDIAScondu2","Lsup_condu_n2")]
# [c("t_id","Linf_od_n2","MEDIASod2","Lsup_od_n2")]
# [c("t_id","Linf_turbie_n2","MEDIASturbie2","Lsup_turbie_n2")]
# [c("t_id","Linf_potredx_n2","MEDIASpotredox2","Lsup_potredx_n2")]
# [c("t_id","Linf_tempera_n2","MEDIAStempera2","Lsup_tempera_n2")]
#####TEST3###################################################
limlsE1Carta <- carta61E1Data[c("t_id","Linf_tempera_n2","MEDIAStempera2","Lsup_tempera_n2")]
#
limlsE1CPar <- parcoords(data=limlsE1Carta, reorderable=TRUE,withD3=TRUE, # debe ser True para el uso de los colores!
                       rownames=FALSE, width=NULL, autoresize=TRUE,
                       brushMode="1D-axes", alphaOnBrushed=0.1, alpha=1.0, # alpha-->intensidad del color de las lineas, de 0 a 1.
                       color = list(
                          colorBy = "t_id",
                          colorScale = "scaleOrdinal",
                          colorScheme = "schemeCategory10"
                       )
)
#
limlsE1CPar
#
# cartaE1Uno <- HC61E1Data[c("id_t","LI_TMP","MED_TMP","LS_TMP")]
cartaE1Uno <- limlsE1Carta
# function melt is in reshape2 library:
unoMeltData <- melt(cartaE1Uno,id="t_id", variable.name="variable", value.name="media") # datos en formato id, variable, valor
#
# split = ~variable -> importante para generar separacion por colores y selector para ocultar en el grafico plotly.
boxPlotAll <- plot_ly(unoMeltData, x = ~variable, y = ~media, type = "box", jitter=0.3, pointpos=0, # <- Posicion donde salen los puntos, aqui el centro.
                      boxpoints = "none", split = ~variable, # <- Los valores deben ser del mismo tipo: String.
                      marker = list(color = 'rgba(219, 64, 82, 0.6)'), line = list(color = 'rgb(8,81,156)'),
                      boxmean = "sd" # Atributo que activa la presentación de la media y la desviacion estandar en el box-plot.
) %>% layout(xaxis = list(title = "variable"), yaxis = list(title = "media", zeroline = T))
#
boxPlotAll
#
# split = ~variable -> importante para generar separacion por colores y selector para ocultar en el grafico plotly.
violinPlotAll <- unoMeltData %>%
   plot_ly(x = ~variable, y = ~media, split = ~variable, type = "violin",
           box = list(visible = T), meanline = list(visible = T)
   ) %>% layout(xaxis = list(title = "variable"), yaxis = list(title = "media", zeroline = T))
#
violinPlotAll
#
# Graficos de DENSIDAD
# **************************************************************
varName <- colnames(cartaE1Uno)[3]
ggp <- ggplot(unoMeltData, aes(x = media, group = variable, fill = variable)) + geom_density(alpha=0.55) +
   labs(title = sprintf("%s",varName), x = sprintf("%s %s","MEDIA",varName), y = "Densidad") +
   theme(
      legend.position="none"
   )
# Se usa el objeto "ggp" para una invocacion mas limpia...
ggplotly(ggp)
# *******Scatter Plot***********************************
# HC61E1Data %>% select(c("id_t","MED_TMP"))
# HC61E1Data[c("id_t","MED_TMP")]"
oneMediaCastData <- carta61E1Data[c("t_id","MEDIAStempera2")]
#
scatPlot <- ggplot(oneMediaCastData,
                   aes_string(x=colnames(oneMediaCastData)[1], y=colnames(oneMediaCastData)[2], color=colnames(oneMediaCastData)[2])) +
   labs(x = "t-sub-j", y = paste("Variable:", colnames(oneMediaCastData)[2]), title = sprintf("%s",colnames(oneMediaCastData)[2])) +
   geom_point() + geom_rug(col="steelblue", alpha=0.5, size=1.5) +
   # al usar poly(..) se tiene una curva con mejor ajuste en el smooth:
   geom_smooth(method=lm , formula = y ~ poly(x, 4), color="red", se=TRUE) +
   scale_colour_gradient(low = "blue", high = "orange")
#
ggplotly(scatPlot)
#********Serie plot ********************
# cartaE1Uno <- HC61E1Data[c("id_t","LI_TMP","MED_TMP","LS_TMP")]
cartaE1Uno <- limlsE1Carta
varName <- colnames(cartaE1Uno)[3]
colnames(cartaE1Uno) <- c("t_id", "lwr", "fit", "upr") # No es cómodo para interacción / adecuado para snapshot
#
unoGSerie <- dygraph(cartaE1Uno, main = paste("Serie Hipercarta:", varName),
                     xlab="t_id", ylab=varName, group="ghiper_sincro") %>%
   dyRangeSelector() %>%  dyHighlight(highlightSeriesOpts = list(strokeWidth = 2)) %>%
   dyOptions(drawGrid=TRUE, fillGraph=FALSE,
             drawPoints=TRUE, pointSize=2, pointShape="dot") %>%
   dyLegend(width = 500)
#
unoGSerie <- unoGSerie %>% dySeries(c("lwr", "fit", "upr"), label=varName) # No es cómodo para interacción / / adecuado para snapshot
unoGSerie <- unoGSerie %>% dyCrosshair()
#
unoGSerie
############TEST2############################################
#*******************************************************
## FIN DE SECCION ANALISIS GRAFICO EXPLORATORIO NUEVO
## 16.JUN.2022 Datos DIC.2021 - ABR.2022
######################TEST1##################################
#
# cartaE1Uno <- HC61E1Data[c("id_t","LI_PH","MED_PH","LS_PH")]
# cartaE1Uno <- HC61E1Data[c("id_t","LI_COND","MED_COND","LS_COND")]
# cartaE1Uno <- HC61E1Data[c("id_t","LI_OXD","MED_OXD","LS_OXD")]
# cartaE1Uno <- HC61E1Data[c("id_t","LI_TURB","MED_TURB","LS_TURB")]
# cartaE1Uno <- HC61E1Data[c("id_t","LI_PRDX","MED_PRDX","LS_PRDX")]
cartaE1Uno <- HC61E1Data[c("id_t","LI_TMP","MED_TMP","LS_TMP")]
#
unoE1CPar <- parcoords(data=cartaE1Uno, reorderable=TRUE,withD3=TRUE, # debe ser True para el uso de los colores!
     rownames=FALSE, width=NULL, autoresize=TRUE,
     brushMode="1D-axes", alphaOnBrushed=0.1, alpha=1.0, # alpha-->intensidad del color de las lineas, de 0 a 1.
     color = list(
        colorBy = "id_t",
        colorScale = "scaleOrdinal",
        colorScheme = "schemeCategory10"
     )
)
#
unoE1CPar
#
LIE3CPar <- parcoords(data=cartaE3LI, reorderable=TRUE,withD3=TRUE, # debe ser True para el uso de los colores!
                       rownames=FALSE, width=NULL, autoresize=TRUE,
                       brushMode="1D-axes", alphaOnBrushed=0.1, alpha=1.0, # alpha-->intensidad del color de las lineas, de 0 a 1.
                       color = list(
                          colorBy = "id_t",
                          colorScale = "scaleOrdinal",
                          colorScheme = "schemeCategory10"
                       )
)
#
LIE3CPar
#
LSE3CPar <- parcoords(data=cartaE3LS, reorderable=TRUE,withD3=TRUE, # debe ser True para el uso de los colores!
                      rownames=FALSE, width=NULL, autoresize=TRUE,
                      brushMode="1D-axes", alphaOnBrushed=0.1, alpha=1.0, # alpha-->intensidad del color de las lineas, de 0 a 1.
                      color = list(
                         colorBy = "id_t",
                         colorScale = "scaleOrdinal",
                         colorScheme = "schemeCategory10"
                      )
)
#
LSE3CPar
#
#cartaE1Medias <- HC61E1Data[c("id_t","MED_PH","MED_COND","MED_OXD","MED_TURB","MED_PRDX","MED_TMP")]
mediasMeltData <- melt(cartaE1Medias,id="id_t", variable.name="variable", value.name="media") # datos en formato id, variable, valor
head(mediasMeltData, 10)
#
# cartaE1Uno <- HC61E1Data[c("id_t","LI_PH","MED_PH","LS_PH")]
# cartaE1Uno <- HC61E1Data[c("id_t","LI_COND","MED_COND","LS_COND")]
# cartaE1Uno <- HC61E1Data[c("id_t","LI_OXD","MED_OXD","LS_OXD")]
# cartaE1Uno <- HC61E1Data[c("id_t","LI_TURB","MED_TURB","LS_TURB")]
# cartaE1Uno <- HC61E1Data[c("id_t","LI_PRDX","MED_PRDX","LS_PRDX")]
cartaE1Uno <- HC61E1Data[c("id_t","LI_TMP","MED_TMP","LS_TMP")]
#head(unoMeltData, 10)
# function melt is in reshape2 library:
unoMeltData <- melt(cartaE1Uno,id="id_t", variable.name="variable", value.name="media") # datos en formato id, variable, valor
#
# split = ~variable -> importante para generar separacion por colores y selector para ocultar en el grafico plotly.
violinPlotAll <- unoMeltData %>%
   plot_ly(x = ~variable, y = ~media, split = ~variable, type = "violin",
           box = list(visible = T), meanline = list(visible = T)
   ) %>% layout(xaxis = list(title = "variable"), yaxis = list(title = "media", zeroline = T))
#
violinPlotAll
#
# split = ~variable -> importante para generar separacion por colores y selector para ocultar en el grafico plotly.
boxPlotAll <- plot_ly(unoMeltData, x = ~variable, y = ~media, type = "box", jitter=0.3, pointpos=0, # <- Posicion donde salen los puntos, aqui el centro.
                      boxpoints = "none", split = ~variable, # <- Los valores deben ser del mismo tipo: String.
                      marker = list(color = 'rgba(219, 64, 82, 0.6)'), line = list(color = 'rgb(8,81,156)'),
                      boxmean = "sd" # Atributo que activa la presentación de la media y la desviacion estandar en el box-plot.
) %>% layout(xaxis = list(title = "variable"), yaxis = list(title = "media", zeroline = T))
#
boxPlotAll
#
# PENDIENTE en la primera entrega Graficos de DENSIDAD Y CONTORNO:
# **************************************************************
varName <- colnames(cartaE1Uno)[3]
ggp <- ggplot(unoMeltData, aes(x = media, group = variable, fill = variable)) + geom_density(alpha=0.55) +
   labs(title = sprintf("%s",varName), x = sprintf("%s %s","MEDIA",varName), y = "Densidad") +
   theme(
      legend.position="none"
   )
# Se usa el objeto "ggp" para una invocacion mas limpia...
ggplotly(ggp)
# **************************************************************
#
# oneMediaCastData <- HC61E1Data[c("id_t","MED_PH")]
# oneMediaCastData <- HC61E1Data[c("id_t","MED_COND")]
# oneMediaCastData <- HC61E1Data[c("id_t","MED_OXD")]
# oneMediaCastData <- HC61E1Data[c("id_t","MED_TURB")]
# oneMediaCastData <- HC61E1Data[c("id_t","MED_PRDX")]
oneMediaCastData <- HC61E1Data[c("id_t","MED_TMP")]
#
scatPlot <- ggplot(oneMediaCastData,
                   aes_string(x=colnames(oneMediaCastData)[1], y=colnames(oneMediaCastData)[2], color=colnames(oneMediaCastData)[2])) +
   labs(x = "t-sub-j", y = paste("Variable:", colnames(oneMediaCastData)[2]), title = sprintf("%s",colnames(oneMediaCastData)[2])) +
   geom_point() + geom_rug(col="steelblue", alpha=0.5, size=1.5) +
   # al usar poly(..) se tiene una curva con mejor ajuste en el smooth:
   geom_smooth(method=lm , formula = y ~ poly(x, 4), color="red", se=TRUE) +
   scale_colour_gradient(low = "blue", high = "orange")
#
ggplotly(scatPlot)
#
cartaE1OnlyMedias <- HC61E1Data[c("MED_PH","MED_COND","MED_OXD","MED_TURB","MED_PRDX","MED_TMP")]
# Mean's Correlogram:
corrplot(cor(cartaE1OnlyMedias), method="circle", type="full", mar=c(1, 1, 2, 1), is.corr = TRUE,
         addCoef.col="black", title = "Correlograma de las medias")
#
# Correlation network:
# layout: circle, groups, spring (currently: circle and groups have the same efect). Spring works very well with glasso
# Conclution: layout=circle and graph=cor and threshold = FALSE (first option) / layout=spring and graph=glasso and threshold = TRUE (second option)
# graph' argument must be one of 'default', 'cor', 'pcor', 'glasso', 'ggmModSelect', or 'factorial'
qgraph(cor(cartaE1OnlyMedias), layout="groups", posCol="darkgreen", negCol="darkred",
       graph="pcor",sampleSize = nrow(cartaE1OnlyMedias)) #graph=glasso, require: layout="spring" and threshold = TRUE
#
qgraph(cor(cartaE1OnlyMedias), layout="spring", posCol="darkgreen", negCol="darkred",
       graph="glasso", sampleSize=nrow(cartaE1OnlyMedias), threshold=TRUE)
#
#
cartaE1OnlyMedias <- na.omit(cartaE1OnlyMedias)
splomMatrix <- GGally::ggpairs(cartaE1OnlyMedias, lower=list(continuous = "smooth"), mapping=ggplot2::aes(colour=I("cadetblue")))
ggplotly(splomMatrix)
#
# Series Graphics:
medGSerie <- dygraph(y, main = paste("Serie Hipercarta:", "media_labels"),
                  xlab="id_t", ylab="media_labels", group="ghiper_sincro") %>%
   dyRangeSelector() %>%  dyHighlight(highlightSeriesOpts = list(strokeWidth = 2)) %>%
   dyOptions(drawGrid=TRUE, fillGraph=TRUE,
             drawPoints=TRUE, pointSize=2, pointShape="dot") %>%
   dyLegend(width = 500)
#
medGSerie
#
# cartaE1Uno <- HC61E1Data[c("id_t","LI_PH","MED_PH","LS_PH")]
# cartaE1Uno <- HC61E1Data[c("id_t","LI_COND","MED_COND","LS_COND")]
# cartaE1Uno <- HC61E1Data[c("id_t","LI_OXD","MED_OXD","LS_OXD")]
# cartaE1Uno <- HC61E1Data[c("id_t","LI_TURB","MED_TURB","LS_TURB")]
# cartaE1Uno <- HC61E1Data[c("id_t","LI_PRDX","MED_PRDX","LS_PRDX")]
cartaE1Uno <- HC61E1Data[c("id_t","LI_TMP","MED_TMP","LS_TMP")]
varName <- colnames(cartaE1Uno)[3]
colnames(cartaE1Uno) <- c("id_t", "lwr", "fit", "upr") # No es cómodo para interacción / adecuado para snapshot
#
unoGSerie <- dygraph(cartaE1Uno, main = paste("Serie Hipercarta:", varName),
                  xlab="id_t", ylab=varName, group="ghiper_sincro") %>%
   dyRangeSelector() %>%  dyHighlight(highlightSeriesOpts = list(strokeWidth = 2)) %>%
   dyOptions(drawGrid=TRUE, fillGraph=FALSE,
             drawPoints=TRUE, pointSize=2, pointShape="dot") %>%
   dyLegend(width = 500)
#
unoGSerie <- unoGSerie %>% dySeries(c("lwr", "fit", "upr"), label=varName) # No es cómodo para interacción / / adecuado para snapshot
unoGSerie <- unoGSerie %>% dyCrosshair()
#
unoGSerie
#
#***********************************************************
#* [28/04/2022 4:47:19 p. m.]
#* Data analysis of all stations with comparatives by month:
#
#***********************************************************
hiperviz_data_path <- "C:\\Temp\\"
#
AllinOneData <- read_excel(paste0(hiperviz_data_path,"DATA_ALLinONE_CONV_825_c15mins.xlsx"), col_names=TRUE,
                         sheet="STATIONS_DATA", range="A1:X15924")
# Debug daaserie, deleting rows with NA cells:
nrow(AllinOneData)
AllinOneData <- na.omit(AllinOneData)
nrow(AllinOneData)
#
head(AllinOneData, 10)
#
# Data frame to store the param's measure unit:
media_labels <- data.frame(
   variable = c("t_id", "COND", "PH", "OXD", "TURB", "PRDX", "TEMP"),
   desc = c(
      "t-sub-j",
      "Conductividad el\u00E9ctrica (\u03BCS/cm)",
      "pH (U de pH)",
      "Ox\u00EDgeno disuelto (mg/l)",
      "Turbiedad (NTU)",
      "Redox (mV)",
      "Temperatura (\u00BAC)"
   ),
   stringsAsFactors=FALSE
)
#
dataSerie <- AllinOneData[c("row_id", "ANIO", "ESTACION", "CONDUCTIVIDAD")]
selected_label <- media_labels %>% filter(variable == "COND") %>% select("desc")
names(dataSerie) <- c("row_id", "anio", "estacion", "parametro")
dataSerie <- dataSerie %>% convert_as_factor(row_id,anio,estacion)
#
#
# IMPORTANTE: Se usa la "~" antes de un parametro, cuando se usa el operador %>% al inicio con el
# SET de datos, esto siginifica que "nombre" luego de la "~" es una columna del SET de datos especifado.
gpy1 <- dataSerie %>%
   plot_ly(x=~estacion, y=~parametro, color=~estacion, type="box", jitter=0.3, pointpos=0, # pointpos: Posicion donde salen los puntos, aqui el centro (0).
           split=~estacion, marker=list(color='rgba(219, 64, 82, 0.6)'),
           boxpoints="none", # all <- Los valores deben ser del mismo tipo: String.
           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))
#
gpy1
#
gpy2 <- dataSerie %>%
   plot_ly(x=~anio, y=~parametro, color=~anio, type="box", jitter=0.3, pointpos=0, # pointpos: Posicion donde salen los puntos, aqui el centro (0).
           split=~anio, marker=list(color='rgba(219, 64, 82, 0.6)'),
           boxpoints="none", # all <- Los valores deben ser del mismo tipo: String.
           boxmean="sd" # Atributo que activa la presentación de la media y la desviacion estandar en el box-plot.
   ) %>% layout(xaxis=list(title="A\u00F1o"),
                yaxis=list(title = sprintf("%s %s","Valor ", selected_label), zeroline=T))
#
gpy2
#
# PRUEBA: Mosaico de gráficos en dos filas, funcion del paquete plotly:
subplot(gpy1, gpy2, titleX=T, titleY=T, nrows = 2, margin = 0.05)
#
# *********************************************
#* [29/04/2022 5:00:00 p. m.]
#* Density Distribution Plot group by estacion or anio:
# *********************************************
# alpha: 0.2 (colores claros) / 0.55 (colores intermedios),
# es el parametro para el nivel de transparencia de las densidades presentadas:
nrow(dataSerie)
dataSerie <- na.omit(dataSerie)
nrow(dataSerie)
#
ggp1 <- ggplot(dataSerie, aes(x=parametro, group=estacion, fill=estacion)) + geom_density(alpha=0.55) +
   labs(title = sprintf("%s",selected_label), x = sprintf("%s %s","Estaci\u00F3n: ",selected_label), y = "Densidad-Estaci\u00F3n") +
   theme(
      legend.position="right"
   )
# Se usa el objeto "ggp" para una invocacion mas limpia...
den1 <- ggplotly(ggp1)
den1
#
ggp2 <- ggplot(dataSerie, aes(x=parametro, group=anio, fill=anio)) + geom_density(alpha=0.55) +
   labs(title = sprintf("%s",selected_label), x = sprintf("%s %s","A\u00F1o: ",selected_label), y = "Densidad-A\u00F1o") +
   theme(
      legend.position="right"
   )
# Se usa el objeto "ggp" para una invocacion mas limpia...
den2 <- ggplotly(ggp2)
den2
#
subplot(den1, den2, titleX=T, titleY=T, nrows = 2, margin = 0.05)
#
ggpX <- ggplot(dataSerie, aes(x = estacion, y=parametro)) + geom_boxplot(alpha=0.55) +
   labs(title = sprintf("%s",selected_label), x = sprintf("%s %s","Valores: ",selected_label), y = "Densidad") +
   theme(
      legend.position="right"
   )
ggpX
# Se usa el objeto "ggp" para una invocacion mas limpia...
ggplotly(ggpX)
#
#*********************************************
#* [29/04/2022 5:00:00 p. m.]
#* Contorno Plot group by estacion or anio:
# *********************************************
cast_data <- AllinOneData[c("t_id", "PH")]
ejeX_label <- media_labels %>% filter(variable == "t_id") %>% select("desc")
ejeY_label <- media_labels %>% filter(variable == "PH") %>% select("desc")
#
cont1 <- ggplot(cast_data, aes_string(x=colnames(cast_data)[1], y=colnames(cast_data)[2])) +
   labs(x = sprintf("%s",ejeX_label), y = sprintf("%s",ejeY_label)) +
   stat_density_2d(aes(fill = ..level..), geom = "polygon" ) + # , colour="gray": ver lineas del poligono
   scale_fill_distiller(palette="GnBu", direction=1) +
   theme_gray() + scale_x_continuous(expand = c(0, 0)) +
   scale_y_continuous(expand = c(0, 0)) +
   theme(
      legend.position='right'
   )
#
poly <- ggplotly(cont1)
poly
#
cont2 <- ggplot(cast_data, aes_string(x=colnames(cast_data)[1], y=colnames(cast_data)[2])) +
   labs(x = sprintf("%s",ejeX_label), y = sprintf("%s",ejeY_label)) +
   stat_density_2d(aes(fill = ..density..), geom = "raster", contour = FALSE) +
   scale_fill_distiller(palette="Spectral", direction=-1) + # direction=-1: colores en orden invertido
   theme_gray() + scale_x_continuous(expand = c(0, 0)) +
   scale_y_continuous(expand = c(0, 0)) +
   theme(
      legend.position='right'
   )
#
spec <- ggplotly(cont2)
spec
#
#
subplot(poly, spec, titleX=T, titleY=T, nrows = 2, margin = 0.05)
#
#*********************************************
#* [01/05/2022 11:00:00 a. m.]
#* Correlograma plot, Glasso network plot and heatmap for station's extra data:
# *********************************************
#
# Filtro hecho especialmente para el heatmap, pues luego de 5000 mediciones es
# muy lento su procesamiento:
AllinOneData <- AllinOneData %>% filter(ESTACION == 61)
AllinOneData <- AllinOneData %>% filter(MES %in% 12)
cast_data <- AllinOneData[c("PH","COND","OXD","TURB","PRDX","TEMP")]
#
corMat <- cor(cast_data)
corrplot(corMat, method="circle", type="full", is.corr = TRUE,
         mar=c(1, 1, 2, 1), addCoef.col="black", title = "Correlograma de los Par\u00E1metros")
#
names(cast_data) <- c("PH","Cnd","OxD","Tur","P_R","Tmp")
qgraph(corMat, layout="spring", posCol="darkgreen", negCol="darkred",
       graph="glasso", sampleSize=nrow(cast_data), threshold=TRUE)
#
circos.clear()
col_fun = colorRamp2(c(-1, 0, 1), c("red", "white", "green"))
circlize::chordDiagram(corMat, symmetric = TRUE, col = col_fun,
                       directional = -1, direction.type = "arrows", link.arr.type = "big.arrow")
#
# No tine mucho aporte la SPLOM con la matriz de datos completa, al analizar estaciones.
# Adicionalmente, el tiempo de procesamiento es "alto", lo que no le da usabilidad en la app hiperviz
pm <- GGally::ggpairs(cast_data, lower = list(continuous = "smooth"), mapping = ggplot2::aes(colour=I("cadetblue")))
ggplotly(pm)
#
mapType <- "none"
if(mapType == "Normalizar") {
   cast_data <- heatmaply::normalize(cast_data)
}#
#
if(mapType == "Escalar") {
   hpy <- heatmaply(cast_data, scale = "column", margins = c(60,100,40,20), colors = RdYlBu,
                    main = paste("Transformaci\u00F3n aplicada:", mapType),
                    xlab = "par\u00E1metro", ylab = "Fila:valor", k_col = 2, k_row = 3, dendrogram="row")
} else {
   hpy <- heatmaply(cast_data, margins=c(60,100,40,20), k_col=2, k_row=3, colors=Oranges,
                    main=paste("Transformaci\u00F3n aplicada:", mapType),
                    xlab="par\u00E1metro", ylab="Fila:valor", dendrogram="none" ) #<-none, column, both, row
}
#
hpy # se tiene un inconveniente para presentarlo en RStudio Viewer, se queda hangout..plop
#
#*********************************************
#* [01/05/2022 11:00:00 a. m.] Inicio
#* [07/06/2022 10:00:00 a. m.] Continua
#* Plotly: Heatmap, contour and surface-3D plot used with repeat measures.
#* E1's data [san miguel - code 61]
#* E3's data [ancon sur - code 62]
#* E8's data [aula ambiental - code 63]
#* 14.SEP.22:
#* Se actualizan este conjunto de graficos usando un SET de datos
#* entre DIC.21 y JUL.22.
#* * NOTA: Este conjunto de graficos fue usado en el informe descriptivo ubicado
#* en la ruta: D:\PEREZOFT_EFECTO_BYTE_SAS\4_Proyecto_HIPERVIZ_R_UdeA\
#*             1-INFO-NEW-PROY-OCT21\IMGS-Analisis-Descriptivo-2022\DIC.21-MAY.22\61-SanMigl-E1\1-CONDUCTIVIDAD
#* Como ejemplo para el informe se usan los graficos [A] y [B] abajo en esta seccion:
# *********************************************
#
#######INICIO Analisis BASE de MR#####################################
#
hiperviz_data_path <- "C:\\Temp\\"
media_labels <- data.frame(
   variable = c("t_id", "COND", "PH", "OXD", "TURB", "PRDX", "TEMP"),
   desc = c(
      "t-sub-j",
      "Conductividad el\u00E9ctrica (\u03BCS/cm)",
      "pH (U de pH)",
      "Ox\u00EDgeno disuelto (mg/l)",
      "Turbiedad (NTU)",
      "Redox (mV)",
      "Temperatura (\u00BAC)"
   ),
   stringsAsFactors=FALSE
)
# Hojas de Excel: MR_CONDUCTIVIDAD, MR_PH, MR_OD, MR_TURBIEDAD, MR_POTENCIAL_REDOX, MR_TEMPERATURA
#
MR_ESTACION_DB <- read_excel(paste0(hiperviz_data_path,"TODO_MR_E8_CONV_825_c15mins-JUL22.xlsx"),
                             col_names=TRUE, sheet="MR_TEMPERATURA", range="F1:CW244")
#
head(MR_ESTACION_DB)
nrow(MR_ESTACION_DB)
#
TEMP <- as.matrix(MR_ESTACION_DB) # <-funcion en paquete "base" de R
#
#*[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
paramPlot <- plot_ly(z=~TEMP, type = "contour", colors=cool_warm(10))
paramPlot
#*[B] Superficie:
paramPlot3d <- plot_ly(z=~TEMP, colors=cool_warm(10))
paramPlot3d <- paramPlot3d %>% add_surface()
paramPlot3d
##
########FIN Analisis BASE de MR#############
##
#**** Se tienen a continuacion sentecias de una analisis mas amplio para MR!
# Debug daaserie, deleting rows with NA cells:
MR_E1_DB <- read_excel(paste0(hiperviz_data_path,"TODO_MR_E1_CONV_825_c15mins-JUL22.xlsx"),
                       col_names=TRUE, sheet="MR_CONDUCTIVIDAD", range="F1:CW244")

MR_E1_DB <- na.omit(MR_E1_DB) # NO se ejecuta para los graficos BASE en plotly
nrow(MR_E1_DB)
#
# TIP: El objeto MR_E1_DB es tipo tibble, compatible con data.frame;
# pero debe ser convertido a R-matrix para usar funciones de plotly:
# IMPORTANTE: Para generar los graficos plotly de heatmap, contorno y superfice 3D
# se debe ejecutar la siguiente sentencia:
COND <- as.matrix(MR_E1_DB) # <-funcion en paquete "base" de R
#
# MR_E1_DB <- heatmaply::normalize(MR_E1_DB)
#
#*******************************************
#* IMPORTANTE En cuanto al uso de las paletas de colores
#* predefinidas, se exploró en especial con Blues(n), Oranges(n), Greens(n), Reds(n), Greys(n),
#* Spectral(n) y cool_warm(n). Siendo ésta última la más adecuada para la presentación de los heatmap.
#* --Se resalta el parametro numerico extra "n" cool_warm(n), que se puede usar
#* en todas las paletas. Se usa el valor 10, para indicar que genere una paleta
#* cool_warm(10) con una escala de 10 colores, de azul a rojo, representando de frio
#* a calido (valores bajos a valores más altos).
#*
#*******************************************
varName <- "PH"
selected_label <- media_labels %>% filter(variable == varName) %>% select("desc")
heatMapX <- heatmaply(MR_E1_DB, margins=c(60,100,40,20), k_col=2, k_row=3, colors=cool_warm(10), #<-Blues(3),Spectral,Reds,Blues,Oranges,
                 main=paste("HEATMAP:",varName, "-Datos base"), # scale = "column",
                 xlab="t_id: Intervalo Quince-min", ylab=paste("Valor-dia:",selected_label),
                 dendrogram="none" ) # <-none, column, both, row
#
heatMapX
# TIP: Aún no he encontrado un parámetro adecuado para asignar los
# labels de los ejes (x,y,z). Por ahora cada matriz del parámetro
# graficado debe tener el nombre de forma explicita.
#
paramPlot <- plot_ly(z=~COND, type = "heatmap", colors=cool_warm(10))
paramPlot
#
#*[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
paramPlot <- plot_ly(z=~COND, type = "contour", colors=cool_warm(10))
paramPlot
#*[B] Superficie:
paramPlot <- plot_ly(z=~COND, colors=cool_warm(10))
paramPlot <- paramPlot %>% add_surface()
paramPlot
#
# Surface Plot With Contours, FULL OK!!
paramPlot <- plot_ly(z=~TEMP, colors=cool_warm(10))
paramPlot <- paramPlot %>% add_surface(
   contours = list(
      z = list(
         show=TRUE,
         usecolormap=TRUE,
         highlightcolor="#ff0000",
         project=list(z=TRUE)
      )
   )
)
paramPlot <- paramPlot %>% layout(
   scene = list(
      camera=list(
         eye = list(x=1.87, y=0.88, z=-0.64)
      )
   )
)
paramPlot
#
MR_E1_Norm <- heatmaply::normalize(MR_E1_DB)
#
heatNorm <- heatmaply(MR_E1_Norm, margins=c(60,100,40,20), k_col=2, k_row=3, colors=cool_warm(10), #<-cool_warm,Oranges,RdYlBu
                      main=paste("HEATMAP:",varName, "-Datos normalizados"), # scale = "column",
                      xlab="t_id: Intervalo Quince-min", ylab=paste("Valor-dia:",selected_label),
                      dendrogram="both" ) #<-none, column, both, row
#
heatNorm
#
MR_E1_DB <- na.omit(MR_E1_DB) # Se ejecuta para los graficos BASE en plotly:
nrow(MR_E1_DB)
#
TEMP <- as.matrix(MR_E1_DB) # <-funcion en paquete "base" de R
paramPlot <- plot_ly(z=~TEMP, type = "heatmap", colors=cool_warm(10))
paramPlot
#
paramPlot <- plot_ly(z=~TEMP, type = "contour", colors=cool_warm(10))
paramPlot
#
paramPlot <- plot_ly(z=~TEMP, colors=cool_warm(10))
paramPlot <- paramPlot %>% add_surface()
paramPlot
#
paramPlot <- plot_ly(z=~TEMP, colors=cool_warm(10))
paramPlot <- paramPlot %>% add_surface(
   contours = list(
      z = list(
         show=TRUE,
         usecolormap=TRUE,
         highlightcolor="#ff0000",
         project=list(z=TRUE)
      )
   )
)
paramPlot <- paramPlot %>% layout(
   scene = list(
      camera=list(
         eye = list(x=1.87, y=0.88, z=-0.64)
      )
   )
)
paramPlot
#
mrE1Data <- read_excel(paste0(hiperviz_data_path,"MR_E8_CONV_825_c15mins.xlsx"), col_names=TRUE,
                       sheet="MR_TEMPERATURA", range="F1:CX63", )
#
#selected_label <- media_labels %>% filter(variable == "PH") %>% select("desc")
subsetGSerie <- dygraph(mrE1Data, main = paste("Serie MR-",varName, " -Intervalo-Q15.min"),
                        xlab="t_id", ylab=sprintf("%s",selected_label), group="ghiper_sincro") %>%
   dyRangeSelector() %>%  dyHighlight(highlightSeriesOpts = list(strokeWidth = 2)) %>%
   dyOptions(drawGrid=TRUE, fillGraph=FALSE,
             drawPoints=TRUE, pointSize=2, pointShape="dot") %>%
   dyLegend(width=500, show="never") # ocultar labels de cada var. son 96 y no es util..
#
subsetGSerie <- subsetGSerie %>% dyCrosshair()
#
subsetGSerie
#
#subsetE1Uno <- mrE1Data[c("id_t","H00C1","H00C2","H00C3","H00C4")]
subsetE1Uno <- mrE1Data[c("id_t","H23C1","H23C2","H23C3","H23C4")]
# function melt is in reshape2 library:
unoMeltData <- melt(subsetE1Uno,id="id_t", variable.name="variable", value.name="media") # datos en formato id, variable, valor
#
# split = ~variable -> importante para generar separacion por colores y selector para ocultar en el grafico plotly.
violinPlotAll <- unoMeltData %>%
   plot_ly(x = ~variable, y = ~media, split = ~variable, type = "violin",
           box = list(visible = T), meanline = list(visible = T)
   ) %>% layout(xaxis = list(title = "variable"), yaxis = list(title = "media", zeroline = T))
#
violinPlotAll
#
mrE1CPar <- parcoords(data=subsetE1Uno, reorderable=TRUE,withD3=TRUE, # debe ser True para el uso de los colores!
    rownames=FALSE, width=NULL, autoresize=TRUE,
    brushMode="1D-axes", alphaOnBrushed=0.1, alpha=1.0, # alpha-->intensidad del color de las lineas, de 0 a 1.
    color = list(
       colorBy = "id_t",
       colorScale = "scaleOrdinal",
       colorScheme = "schemeCategory10"
    )
)
#
mrE1CPar
#
ggp <- ggplot(unoMeltData, aes(x = media, group = variable, fill = variable)) + geom_density(alpha=0.55) +
   labs(title = sprintf("%s",varName), x = sprintf("%s %s","MEDIA",varName), y = "Densidad") +
   theme(
      legend.position="none"
   )
# Se usa el objeto "ggp" para una invocacion mas limpia...
ggplotly(ggp)
#
#
str(mrE1Data) # descripcion de las columnas...
# selección de columnas usando la función select(..) de DPLYR
mrE1Data %>% select(starts_with('H00'))
mrE1Data %>% select(ends_with('C1'))
mrE1Data %>% select(contains('01'))
mrE1Data %>% select(c("id_t","H23C1","H23C2","H23C3","H23C4"))
#
toRename <- mrE1Data[,c(1,2,3)] # selección de columnas usando R base
names(toRename)[1] <- 'DIA_ID'
toRename <- toRename %>% rename(HxxC1 = H00C1) # funciona ok! tip: izq->nuevo, der->actual
toRename <- toRename %>% rename("HyyC2" = "H00C2") # funciona ok! tip: izq->nuevo, der->actual
toRename <- toRename %>% rename(HT01 = HxxC1, HT02 = HyyC2) # funciona ok!, se asigna uno a uno
toRename
#
# selección de columnas usando R base, evitando la 1ra y hasta la última:
mrE1Data[,c(2:ncol(mrE1Data))]
##
#*************************************************************
#* [10/07/2022 14:00:00] INICIO x ESTACION
#* Generar graficos descriptivos de comparacion por estacion
#* para el periodo DIC.2021 A MAY.2022:
#* E1's data [san miguel - code 61]
#* E3's data [ancon sur - code 62]
#* E8's data [aula ambiental - code 63]
#* --
#* 14.SEP.22 15:00:
#* Se actualiza este analisis para usar un SET de datos de DIC.21 a JUL.22
#* * NOTA: Este conjunto de graficos fue usado en el informe descriptivo ubicado
#* en la ruta: D:\PEREZOFT_EFECTO_BYTE_SAS\4_Proyecto_HIPERVIZ_R_UdeA\1-INFO-NEW-PROY-OCT21\
#*             IMGS-Analisis-Descriptivo-2022\DIC.21-MAY.22\00-Generales\1-CONDUCTIVIDAD
#* Como ejemplo para el informe se usan los graficos [A] y [B] abajo en esta seccion:
# ************************************************************
#
hiperviz_data_path <- "C:\\Temp\\"
#
media_labels <- data.frame(
   variable = c("t_id", "CONDUCTIVIDAD", "PH", "OXIGEN_DIS", "TURBIEDAD", "POTENCIAL_REDOX", "TEMPERATURA"),
   desc = c(
      "t-sub-j",
      "Conductividad el\u00E9ctrica (\u03BCS/cm)",
      "pH (U de pH)",
      "Ox\u00EDgeno disuelto (mg/l)",
      "Turbiedad (NTU)",
      "Redox (mV)",
      "Temperatura (\u00BAC)"
   ),
   stringsAsFactors=FALSE
)
#
gnral_est_DB <- read_excel(paste0(hiperviz_data_path,"GNRAL-ESTACIONES_CONSOLIDADO_c15mins-JUL22.xlsx"), col_names=TRUE,
                       sheet="MEDICION_ESTACION", range="A1:AB65484") # En MAY.22 el rango es: A1:AB48805
#*(BEGINNIG REPLACE)
head(gnral_est_DB)
nrow(gnral_est_DB)
gnral_est_DB <- na.omit(gnral_est_DB) # Elimina las filas con celdas sin valor numerico (NA)
nrow(gnral_est_DB)
#
## GRAFICO DE BOXPLOT sin filtrar por estacion la BD inicial:
dataSerie <- gnral_est_DB[c("fila_id", "ESTACION_TXT", "TEMPERATURA")]
selected_label <- media_labels %>% filter(variable == "TEMPERATURA") %>% select("desc")
names(dataSerie) <- c("fila_id", "estacion", "parametro")
#
# Grafico de boxplot discriminando por estacion: (no se filtra la estacion en la BD inicial)
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 = "none", # <- Los valores deben ser: none / all
           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))
#
gpy
##
## GRAFICO DE VIOLIN sin filtrar por estacion la BD inicial:
dataSerie <- gnral_est_DB[c("fila_id", "ESTACION_TXT", "TEMPERATURA")]
selected_label <- media_labels %>% filter(variable == "TEMPERATURA") %>% 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))
#
gpy
##
## GRAFICO DE DENSIDAD sin filtrar por estacion la BD inicial:
dataSerie <- gnral_est_DB[c("fila_id", "ESTACION_TXT", "TEMPERATURA")]
selected_label <- media_labels %>% filter(variable == "TEMPERATURA") %>% 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)
##
# Parametros a evaluar: "CONDUCTIVIDAD", "PH", "OXIGEN_DIS", "TURBIEDAD", "POTENCIAL_REDOX", "TEMPERATURA"
# SE DEBE FILTRAR POR ESTACION, pues cada estacion es independiente con respecto a los parametros medidos:
estacion_DB <- gnral_est_DB %>% filter(ESTACION_TXT == "8_AULA_AMBIENTAL")
head(estacion_DB)
nrow(estacion_DB)
#
dataSerie <- estacion_DB[c("fila_id", "MES", "TEMPERATURA")]
names(dataSerie) <- c("fila_id", "mes", "parametro")
selected_label <- media_labels %>% filter(variable == "TEMPERATURA") %>% 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)
#
#
# Grafico de boxplot discriminando por MES: (los meses estan enumerados por mes-año)
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 = "none", # <- Los valores deben ser: none / all
           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="Mes / 8_AULA_AMBIENTAL"),
                yaxis=list(title=sprintf("%s %s","Valor ", selected_label), zeroline=T))
#
gpy
##
#*(ENDING REPLACE)
#*************************************************************
#* [10/07/2022 14:00:00] FIN x ESTACION
#* Generar graficos descriptivos de comparacion por estacion
#* para el periodo DIC.2021 A MAY.2022.
# ************************************************************
#
#**********************************************************************
#* [28/07/2022 17:30:00] INICIO Prueba Maestro->Detalle
#* Hipercarta estacion E1 San Miguel --> Detalle medido por parametro.
#* Analisis por medio de graficos de SERIES:
#* E1's data [san miguel - E1 code 61]
#* E3's data [ancon sur - E3 code 62]
#* E8's data [aula ambiental - E8 code 63]
# *********************************************************************
#
hiperviz_data_path <- "C:\\Temp\\"
media_labels <- data.frame(
   variable = c("id_t", "MEDIA_Condu", "MEDIA_ph", "MEDIA_od", "MEDIA_turb", "MEDIA_potredox", "MEDIA_tempera"),
   desc = c(
      "t-sub-j",
      "Conductividad el\u00E9ctrica (\u03BCS/cm)",
      "pH (U de pH)",
      "Ox\u00EDgeno disuelto (mg/l)",
      "Turbiedad (NTU)",
      "Redox (mV)",
      "Temperatura (\u00BAC)"
   ),
   stringsAsFactors=FALSE
)
#
#
HIPER2018_DB <- read_excel(paste0(hiperviz_data_path,"HIPERCARTAS_JUL-DIC-2018_144.xlsx"),
                       col_names=TRUE, sheet="HIPERCARTAS-JUL-DIC-2018", range="A1:Y145")
#
head(HIPER2018_DB)
nrow(HIPER2018_DB)
#
HIPER2022_DB <- read_excel(paste0(hiperviz_data_path,"Cartas_E8_02_06_22.xlsx"),
                           col_names=TRUE, sheet="CARTA_CTRL_NIVEL2-OK", range="A1:Y97")
#
head(HIPER2022_DB)
nrow(HIPER2022_DB)
##
# Se grafica la Hipercarta base:
##
hiperSel <- "MEDIA_Condu"
hiperParams <- switch(hiperSel,
                      "MEDIA_Condu" = c("id_t", "LI_Condu", "MEDIA_Condu", "LS_Condu"),
                      "MEDIA_ph" = c("id_t", "LI_ph", "MEDIA_ph", "LS_ph"),
                      "MEDIA_od" = c("id_t", "LI_od", "MEDIA_od", "LS_od"),
                      "MEDIA_turb" = c("id_t", "LI_turb", "MEDIA_turb", "LS_turb"),
                      "MEDIA_potredox" = c("id_t", "LI_potredx", "MEDIA_potredox", "LS_potredx"),
                      "MEDIA_tempera" = c("id_t", "LI_tempera", "MEDIA_tempera", "LS_tempera")
)
#
# Obtencion del Data Frame de la serie usando manejo de columnas, funciona OK:
dataSerie <- HIPER2022_DB[hiperParams] # HIPER2018_DB[hiperParams]
colnames(dataSerie) <- c("id_t", "lwr", "fit", "upr")
#
selected_label <- media_labels %>% filter(variable == hiperSel) %>% select("desc")
#
gSerieHC <- dygraph(dataSerie, main=sprintf("%s",selected_label),
                  xlab=paste("t por Hipercarta"), ylab=paste("Intervalo para:", selected_label)) %>%
   dyRangeSelector() %>% dyHighlight(highlightSeriesOpts = list(strokeWidth = 2)) %>%
   dyOptions(drawGrid=T, drawPoints=TRUE, pointSize=2, pointShape="dot") %>%
   dyLegend(width=500) %>% dyCrosshair()
#
# Se selecciona el nombre del parametro usando la palabra inicial del item: selected_label
param_name_label <- sub( "\\s.*", "", selected_label)
gSerieHC <- gSerieHC %>% dySeries(c("lwr", "fit", "upr"), label=paste("Media", param_name_label))
#
gSerieHC # R-Studio presenta el grafico en la pestaña: Viewer
###
# Se grafica la carta de control segun un id_t de la HIPERCARTA anterior:
###
CARTACTRL2018_DB <- read_excel(paste0(hiperviz_data_path,"CARTAS_CONTROL_JUL-DIC-2018_144.xlsx"),
                           col_names=TRUE, sheet="CARTACTRL-JUL-DIC-2018", range="A1:T26497")
#
head(CARTACTRL2018_DB)
nrow(CARTACTRL2018_DB)
#
CARTACTRL2022_DB <- read_excel(paste0(hiperviz_data_path,"TODO_CONSOLIDADO_E8_CONV_825_c15mins-MAY22.xlsx"),
                               col_names=TRUE, sheet="E8-DATA-OK", range="A1:Z14853") #E1->Z17235; E3->Z16719; E8->Z14853
#
head(CARTACTRL2022_DB)
nrow(CARTACTRL2022_DB)
#
hiperSel <- "MEDIA_tempera"
# Inicialmente se seleccionan las columnas segun el parametro:
hiperParams <- switch(hiperSel,
                      "MEDIA_Condu" = c("LI_Condu", "MEDIA_Condu", "LS_Condu"),
                      "MEDIA_ph" = c("LI_ph", "MEDIA_ph", "LS_ph"),
                      "MEDIA_od" = c("LI_od", "MEDIA_od", "LS_od"),
                      "MEDIA_turb" = c("LI_turb", "MEDIA_turb", "LS_turb"),
                      "MEDIA_potredox" = c("LI_potredx", "MEDIA_potredox", "LS_potredx"),
                      "MEDIA_tempera" = c("LI_tempera", "MEDIA_tempera", "LS_tempera")
)
# Luego se restaura el valor a las columnas que tiene la carta de control:
hiperSel <- switch(hiperSel,
                   "MEDIA_Condu" = "CONDUCTIVIDAD",
                   "MEDIA_ph" = "PH",
                   "MEDIA_od" = "OD",
                   "MEDIA_turb" = "TURBIEDAD",
                   "MEDIA_potredox" = "POTENCIAL_REDOX",
                   "MEDIA_tempera" = "TEMPERATURA"
)
# Obtencion del Data Frame de la serie usando manejo de columnas, funciona OK:
dataSerie <- CARTACTRL2022_DB %>%
   filter(id_t == 49) %>%
   select(hiperSel, "TIPO_DIA", "MES", "DIA_SEMANA")
#
# Se procede a calcular la hora del T-subj seleccionado:
dataHipercartaTime <- CARTACTRL2022_DB %>%
   filter(id_t == 49) %>%
   select("id_t", "HORA_PARCIAL", "CUARTO") # "SEXTO")
#
# La primera es util, pues todas tienen el mismo valor para las cols seleccionadas:
dataHipercartaTime <- dataHipercartaTime[1,]
horaT <- paste0(dataHipercartaTime[1, "HORA_PARCIAL"], ":", 15*(as.numeric(dataHipercartaTime[1, "CUARTO"])-1)) # 10 / "SEXTO" -> para año 2018
#
#
hcIntervalo <- HIPER2022_DB %>%
   filter(id_t == 49) %>%
   select(hiperParams)
#
# Finalmente se deja la columna efectiva para la serie:
dataSerie <- dataSerie %>% select(hiperSel)
# Se adiciona explicitamente la columna el numero de fila como "row_id":
dataSerie$row_id <- seq(1:(nrow(dataSerie)))
# Reordenamiento de las columnas del data_frame para que el row_id sea la primera
# que el "dygraph" lo usa para el eje X:
dataSerie <- dataSerie[c("row_id", hiperSel)]
#
gSerieCC <- dygraph(dataSerie, main = paste(hiperSel, "t =", horaT),
                  xlab=paste("Observaciones t =", 49, "[", horaT, "]"),
                  ylab=paste("Monitoreo de:", hiperSel)) %>%
   dyRangeSelector() %>%  dyHighlight(highlightSeriesOpts = list(strokeWidth = 2)) %>%
   dyOptions(drawGrid=T, drawPoints=TRUE, pointSize=2, fillGraph = TRUE,
             includeZero = F, axisLineColor = "navy", gridLineColor = "lightblue", pointShape="ex") %>%
   dySeries(hiperSel, label=paste("Valor Puntual", hiperSel), color = "blue") %>% # Usar un label especifico
   dyLimit(as.numeric(hcIntervalo[hiperParams[1]]), color = "red",
           label = as.character(hcIntervalo[hiperParams[1]])) %>%  # hiperParams se usa un indice por ser (c)Vector
   dyLimit(as.numeric(hcIntervalo[hiperParams[2]]), color = "red",
           label = as.character(hcIntervalo[hiperParams[2]]), labelLoc = "right") %>% # left
   dyLimit(as.numeric(hcIntervalo[hiperParams[3]]), color = "red",
           label = as.character(hcIntervalo[hiperParams[3]])) %>%
   dyShading(from = as.numeric(hcIntervalo[hiperParams[1]]),
             to = as.numeric(hcIntervalo[hiperParams[3]]), axis = "y") %>%
   dyLegend(width = 500) %>% dyCrosshair()
#
#
gSerieCC
#
#
#**********************************************************************
#* [28/07/2022 17:30:00] FIN Prueba Maestro->Detalle
#* Hipercarta estacion E1 San Miguel --> Detalle medido por parametro.
#*
# *********************************************************************
#