Maestría en Biodiversidad y Cambio Climático
Resumen
# Librerías y directorio de trabajo:
library(tidyverse)
library(DT)
library(highcharter)
library(psych)
library(gridExtra)
library(glue)
library(e1071)
library(reshape2)
library(factoextra)
library(FactoMineR)
library(corrplot)
library(knitr)
library(kableExtra)
library(RColorBrewer) # Librería para la paleta de colores
knitr::opts_knit$set(root.dir = "D:/DATA_SCIENCE_ENDI/ACP/")Iniciaremos realizando un análisis gráfico mediante una técnica gráfica muy popular como lo es el Boxplot (Walpole et al. 2012) (Diagrama de caja y bigotes) comparativo, para visualizar si existen valores atípicos y como se distribuyen las variables en los años 1995 y 2021 según las escalas de medición originales en cada variable:
Cuantiles: Un cuantil de una muestra, q(f), es un valor para el que una fracción específica f de los valores de los datos es menor o igual a q(f).
Un cuantil representa una estimación de una característica de una población o, más bien, la distribución teórica. La mediana de la muestra es q(0.5). El percentil 75 (cuartil superior) es q(0.75) y el cuantil inferior es q(0.25). Una gráfica de cuantiles simplemente son los valores de los datos en el eje vertical contra una evaluación empírica de la fracción de observaciones excedidas por los valores de los datos (Walpole et al. 2012).
# Carga del DataSet y transformaciones -----------------------------------------
indices_fq <- readxl::read_excel("DATASETS/DatosMacroinvertebrados.xlsx") %>%
mutate_if(is.numeric, ~ round(., 2))
cols <- c("RIOS","ANIO")
df_largo <- indices_fq %>%
pivot_longer(cols = -RIOS,
names_to = c(".value", "ANIO"),
names_pattern = "(.*)_(\\d{4})") %>%
mutate_at(.vars = cols, .funs = factor)
indices_fq_ddc <- df_largo %>%
mutate(ID = glue("{RIOS}_{ANIO}")) %>%
column_to_rownames(var = "ID") %>%
select(-RIOS,
-ANIO)
var_scale <- as.data.frame(lapply(indices_fq_ddc, function(x) if(is.numeric(x)) scale(x) else x))
df_fq_1995 <- pivot_longer(df_largo,
cols = c(ANCHO,
PROFUNDIDAD,
VELOCIDAD,
DESCARGA,
PH,
TEMPERATURA,
OXIGENO_DISUELTO,
CONDUCTIVIDAD,
RIQUEZA,
ABUNDANCIA,
DIVERSIDAD,
ABI,
BMWP,
IBF),
names_to = "VARIABLE",
values_to = "VALOR") %>%
filter(ANIO=="1995")
df_fq_2021 <- pivot_longer(df_largo,
cols = c(ANCHO,
PROFUNDIDAD,
VELOCIDAD,
DESCARGA,
PH,
TEMPERATURA,
OXIGENO_DISUELTO,
CONDUCTIVIDAD,
RIQUEZA,
ABUNDANCIA,
DIVERSIDAD,
ABI,
BMWP,
IBF),
names_to = "VARIABLE",
values_to = "VALOR") %>%
filter(ANIO=="2021")
# Data para BoxPlot:
df_bx_95 <- data_to_boxplot(
df_fq_1995,
variable = VALOR,
group_var = VARIABLE,
# group_var2 = codigo,
add_outliers = T
)
df_bx_21 <- data_to_boxplot(
df_fq_2021,
variable = VALOR,
group_var = VARIABLE,
# group_var2 = codigo,
add_outliers = T
)
# Visualización del Dataset
DT::datatable(df_largo,
class = 'cell-border stripe',
# filter = 'top',
caption = htmltools::tags$caption(
style = 'caption-side: bottom; text-align: left;',
'Tabla: ', htmltools::em('Indicadores Físico-Químicos y Ecológicos para los años 1995 y 2021')),
extensions = c('Buttons','Scroller'),
options = list(scrollX = TRUE,
initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#003566', 'color': '#fff'});",
"}"),
dom = 'Bfrtip',
buttons = c('excel'),
deferRender = TRUE,
scrollY = 500,
scroller = TRUE))Para el gráfico de los Boxplot se obtiene de la siguiente estructura de datos:
estadisticos_boxplot <- function(df, year) {
df <- subset(df, ANIO == year)
df <- df[sapply(df, is.numeric)]
cuartiles <- as.data.frame(apply(df, 2, quantile, probs = c(0.25, 0.5, 0.75)))
rownames(cuartiles) <- c("Q1", "Q2", "Q3")
minimos <- as.data.frame(t(apply(df, 2, min)))
rownames(minimos) <- "Mínimo"
maximos <- as.data.frame(t(apply(df, 2, max)))
rownames(maximos) <- "Máximo"
estadisticos <- rbind(cuartiles,
minimos,
maximos)
# Redondear los valores
estadisticos <- round(estadisticos, 2)
# Añadir los nombres de las estadísticas como una columna
estadisticos$ESTADISTICOS <- rownames(estadisticos)
# Reorganizar las columnas
estadisticos <- estadisticos %>%
select(ESTADISTICOS, everything())
rownames(estadisticos) <- NULL
return(estadisticos)
}
# Ejemplo de uso
cuartiles_95 <- estadisticos_boxplot(df_largo, "1995")
DT::datatable(cuartiles_95,
class = 'cell-border stripe',
# filter = 'top',
caption = htmltools::tags$caption(
style = 'caption-side: bottom; text-align: left;',
'Tabla: ', htmltools::em('Estadísticos del Boxplot - Año 1995')),
extensions = c('Buttons','Scroller'),
options = list(scrollX = FALSE,
initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#003566', 'color': '#fff'});",
"}"),
dom = 'Bfrtip',
buttons = c('excel')))highchart() %>%
hc_xAxis(type = "category",
labels = list(
rotation = 270
)) %>%
hc_add_series_list(df_bx_95) %>%
hc_xAxis(title = list(text = "VARIABLES")) %>%
hc_yAxis(title = list(text = "VALORES")) %>%
hc_title(text = "BOXPLOT COMPARATIVO ENTRE VARIABLES FÍSICO QUÍMICAS y ECOLÓGICAS - AÑO 1995") %>%
hc_subtitle(text = "AÑO 1995", align="left") %>%
hc_caption(text = "ELABORADO POR: Marcelo Chávez") %>%
hc_legend(enabled = F, title = list(text = "<b>ESTACIONES DE MONITOREO:</b>")) %>%
hc_tooltip(formatter = JS("function() {
var tooltip = '';
if (this.point.low && this.point.q1 && this.point.median && this.point.q3 && this.point.high) {
tooltip += '<b>Variable: </b>' + this.point.name + '<br/>' +
'<b>Mínimo: </b>' + this.point.low.toFixed(2) + '</b><br/>' +
'<b>Q1: </b>' + this.point.q1.toFixed(2) + '</b><br/>' +
'<b>Mediana: </b>' + this.point.median.toFixed(2) + '</b><br/>' +
'<b>Q3: </b>' + this.point.q3.toFixed(2) + '</b><br/>' +
'<b>Máximo: </b>' + this.point.high.toFixed(2) + '</b><br/>';
}
if (this.point.y && !(this.point.low && this.point.q1 && this.point.median && this.point.q3 && this.point.high)) {
tooltip += '<b>Valor Atípico: </b>' + this.point.y.toFixed(2) + '<br/>';
}
return tooltip;}")) %>%
hc_add_theme(hc_theme_gridlight())La descarga de agua en el río presenta la siguiente distribución:
El primer cuartil (Q1) de la descarga es de 39 metros cúbicos por segundo, lo que indica que el 25% de las mediciones de descarga son iguales o inferiores a este valor.
La mediana (Q2) de la descarga es de 87 metros cúbicos por segundo, lo que significa que el 50% de las mediciones son iguales o inferiores a este valor.
El tercer cuartil (Q3) de la descarga es de 183.5 metros cúbicos por segundo, lo que indica que el 75% de las mediciones son iguales o inferiores a este valor.
El mínimo de la descarga es de 5 metros cúbicos por segundo, mientras que el máximo es de 298 metros cúbicos por segundo.
El pH del agua en el río muestra la siguiente distribución:
El primer cuartil (Q1) del pH es de 7.47, lo que indica que el 25% de las mediciones de pH son iguales o inferiores a este valor.
La mediana (Q2) del pH es de 7.63, lo que significa que el 50% de las mediciones son iguales o inferiores a este valor.
El tercer cuartil (Q3) del pH es de 8.03, lo que indica que el 75% de las mediciones son iguales o inferiores a este valor.
El mínimo del pH es de 6.18, mientras que el máximo es de 8.25.
La temperatura del agua en el río presenta la siguiente distribución:
El primer cuartil (Q1) de la temperatura es de 6.4 grados Celsius, lo que indica que el 25% de las mediciones de temperatura son iguales o inferiores a este valor.
La mediana (Q2) de la temperatura es de 10.6 grados Celsius, lo que significa que el 50% de las mediciones son iguales o inferiores a este valor.
El tercer cuartil (Q3) de la temperatura es de 11.85 grados Celsius, lo que indica que el 75% de las mediciones son iguales o inferiores a este valor.
El mínimo de la temperatura es de 6.3 grados Celsius, mientras que el máximo es de 14.8 grados Celsius.
El oxígeno disuelto en el agua del río muestra la siguiente distribución:
El primer cuartil (Q1) del oxígeno disuelto es de 6.7 mg/L, lo que indica que el 25% de las mediciones de oxígeno disuelto son iguales o inferiores a este valor.
La mediana (Q2) del oxígeno disuelto es de 7.1 mg/L, lo que significa que el 50% de las mediciones son iguales o inferiores a este valor.
El tercer cuartil (Q3) del oxígeno disuelto es de 7.45 mg/L, lo que indica que el 75% de las mediciones son iguales o inferiores a este valor.
El mínimo del oxígeno disuelto es de 6.3 mg/L, mientras que el máximo es de 7.7 mg/L.
La conductividad del agua en el río exhibe la siguiente distribución:
El primer cuartil (Q1) de la conductividad es de 38.5 μS/cm, lo que indica que el 25% de las mediciones de conductividad son iguales o inferiores a este valor.
La mediana (Q2) de la conductividad es de 48 μS/cm, lo que significa que el 50% de las mediciones son iguales o inferiores a este valor.
El tercer cuartil (Q3) de la conductividad es de 63 μS/cm, lo que indica que el 75% de las mediciones son iguales o inferiores a este valor.
El mínimo de la conductividad es de 19 μS/cm, mientras que el máximo es de 119 μS/cm.
La riqueza de especies de macroinvertebrados en el río muestra la siguiente distribución:
El primer cuartil (Q1) de la riqueza es de 11 especies, lo que indica que el 25% de las mediciones de riqueza son iguales o inferiores a este valor.
La mediana (Q2) de la riqueza es de 13 especies, lo que significa que el 50% de las mediciones son iguales o inferiores a este valor.
El tercer cuartil (Q3) de la riqueza es de 15 especies, lo que indica que el 75% de las mediciones son iguales o inferiores a este valor.
El mínimo de la riqueza es de 8 especies, mientras que el máximo es de 20 especies.
La abundancia de macroinvertebrados en el río muestra la siguiente distribución:
El primer cuartil (Q1) de la abundancia es de 500.5 individuos, lo que indica que el 25% de las mediciones de abundancia son iguales o inferiores a este valor.
La mediana (Q2) de la abundancia es de 598 individuos, lo que significa que el 50% de las mediciones son iguales o inferiores a este valor.
El tercer cuartil (Q3) de la abundancia es de 1557 individuos, lo que indica que el 75% de las mediciones son iguales o inferiores a este valor.
El mínimo de la abundancia es de 335 individuos, mientras que el máximo es de 2926 individuos.
La diversidad de especies de macroinvertebrados en el río exhibe la siguiente distribución:
El primer cuartil (Q1) de la diversidad es de 1.44, lo que indica que el 25% de las mediciones de diversidad son iguales o inferiores a este valor.
La mediana (Q2) de la diversidad es de 1.6, lo que significa que el 50% de las mediciones son iguales o inferiores a este valor.
El tercer cuartil (Q3) de la diversidad es de 1.72, lo que indica que el 75% de las mediciones son iguales o inferiores a este valor.
El mínimo de la diversidad es de 0.85, mientras que el máximo es de 2.05.
El Índice de Bioticidad del Agua (ABI) en el río muestra la siguiente distribución:
El primer cuartil (Q1) del ABI es de 39, lo que indica que el 25% de las mediciones de ABI son iguales o inferiores a este valor.
La mediana (Q2) del ABI es de 61, lo que significa que el 50% de las mediciones son iguales o inferiores a este valor.
El tercer cuartil (Q3) del ABI es de 71.5, lo que indica que el 75% de las mediciones son iguales o inferiores a este valor.
El mínimo del ABI es de 17, mientras que el máximo es de 102.
El Índice de Calidad del Agua del Macroinvertebrados Bentónicos (BMWP) en el río muestra la siguiente distribución:
El primer cuartil (Q1) del BMWP es de 38, lo que indica que el 25% de las mediciones de BMWP son iguales o inferiores a este valor.
La mediana (Q2) del BMWP es de 49, lo que significa que el 50% de las mediciones son iguales o inferiores a este valor.
El tercer cuartil (Q3) del BMWP es de 67, lo que indica que el 75% de las mediciones son iguales o inferiores a este valor.
El mínimo del BMWP es de 17, mientras que el máximo es de 86.
El Índice Biótico de Familias (IBF) en el río muestra la siguiente distribución:
El primer cuartil (Q1) del IBF es de 3.57, lo que indica que el 25% de las mediciones de IBF son iguales o inferiores a este valor.
La mediana (Q2) del IBF es de 4.44, lo que significa que el 50% de las mediciones son iguales o inferiores a este valor.
El tercer cuartil (Q3) del IBF es de 4.86, lo que indica que el 75% de las mediciones son iguales o inferiores a este valor.
El mínimo del IBF es de 2, mientras que el máximo es de 6.22.
El ancho de los ríos muestra la siguiente distribución:
El primer cuartil (Q1) del ancho del río es de 1.78 metros, lo que indica que el 25% de los datos de ancho del río son iguales o inferiores a este valor.
La mediana (Q2) del ancho del río es de 1.93 metros, lo que significa que el 50% de los datos son iguales o inferiores a este valor.
El tercer cuartil (Q3) del ancho del río es de 2.7 metros, lo que indica que el 75% de los datos son iguales o inferiores a este valor.
El mínimo del ancho del río es de 1.23 metros, mientras que el máximo es de 6 metros.
La profundidad en los ríos muestra la siguiente distribución:
El primer cuartil (Q1) de la profundidad del río es de 0.16 metros, lo que indica que el 25% de los datos de profundidad del río son iguales o inferiores a este valor.
La mediana (Q2) de la profundidad del río es de 0.17 metros, lo que significa que el 50% de los datos son iguales o inferiores a este valor.
El tercer cuartil (Q3) de la profundidad del río es de 0.18 metros, lo que indica que el 75% de los datos son iguales o inferiores a este valor.
El mínimo de la profundidad del río es de 0.07 metros, mientras que el máximo es de 0.27 metros.
La velocidad en los ríos muestra la siguiente distribución:
El primer cuartil (Q1) de la velocidad del agua en el río es de 0.14 metros por segundo, lo que indica que el 25% de los datos de velocidad del agua en el río son iguales o inferiores a este valor.
La mediana (Q2) de la velocidad del agua en el río es de 0.2 metros por segundo, lo que significa que el 50% de los datos son iguales o inferiores a este valor.
El tercer cuartil (Q3) de la velocidad del agua en el río es de 0.32 metros por segundo, lo que indica que el 75% de los datos son iguales o inferiores a este valor.
El mínimo de la velocidad del agua en el río es de 0.05 metros por segundo, mientras que el máximo es de 0.53 metros por segundo.
Para el gráfico de los Boxplot se obtiene de la siguiente estructura de datos:
# Calcula los estadísticos para graficar un boxplot
cuartiles_21 <- estadisticos_boxplot(df_largo, "2021")
DT::datatable(cuartiles_21,
class = 'cell-border stripe',
# filter = 'top',
caption = htmltools::tags$caption(
style = 'caption-side: bottom; text-align: left;',
'Tabla: ', htmltools::em('Estadísticos del Boxplot - Año 2021')),
extensions = c('Buttons','Scroller'),
options = list(scrollX = FALSE,
initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#003566', 'color': '#fff'});",
"}"),
dom = 'Bfrtip',
buttons = c('excel')))highchart() %>%
hc_xAxis(type = "category",
labels = list(
rotation = 270
)) %>%
hc_add_series_list(df_bx_21) %>%
hc_xAxis(title = list(text = "VARIABLES")) %>%
hc_yAxis(title = list(text = "VALORES")) %>%
hc_title(text = "BOXPLOT COMPARATIVO ENTRE ÍNDICES FÍSICO QUÍMICOS y ECOLÓGICOS - AÑO 2021") %>%
hc_subtitle(text = "AÑO 2021", align="left") %>%
hc_caption(text = "ELABORADO POR: Marcelo Chávez") %>%
hc_legend(enabled = F, title = list(text = "<b>ESTACIONES DE MONITOREO:</b>")) %>%
hc_tooltip(formatter = JS("function() {
var tooltip = '';
if (this.point.low && this.point.q1 && this.point.median && this.point.q3 && this.point.high) {
tooltip += '<b>Variable: </b>' + this.point.name + '<br/>' +
'<b>Mínimo: </b>' + this.point.low.toFixed(2) + '</b><br/>' +
'<b>Q1: </b>' + this.point.q1.toFixed(2) + '</b><br/>' +
'<b>Mediana: </b>' + this.point.median.toFixed(2) + '</b><br/>' +
'<b>Q3: </b>' + this.point.q3.toFixed(2) + '</b><br/>' +
'<b>Máximo: </b>' + this.point.high.toFixed(2) + '</b><br/>';
}
if (this.point.y && !(this.point.low && this.point.q1 && this.point.median && this.point.q3 && this.point.high)) {
tooltip += '<b>Valor Atípico: </b>' + this.point.y.toFixed(2) + '<br/>';
}
return tooltip;}")) %>%
hc_add_theme(hc_theme_gridlight())El ancho del río muestra la siguiente distribución:
La profundidad del río muestra la siguiente distribución:
La velocidad del agua en el río muestra la siguiente distribución:
La descarga de agua en el río muestra la siguiente distribución:
El pH del agua en el río muestra la siguiente distribución:
La temperatura del agua en el río muestra la siguiente distribución:
El oxígeno disuelto en el agua del río muestra la siguiente distribución:
La conductividad del agua en el río muestra la siguiente distribución:
La riqueza de especies de macroinvertebrados en el río muestra la siguiente distribución:
La abundancia de macroinvertebrados en el río muestra la siguiente distribución:
La diversidad de especies de macroinvertebrados en el río muestra la siguiente distribución:
El Índice de Bioticidad (ABI) en el río muestra la siguiente distribución:
El índice de BMWP (Biological Monitoring Working Party) en el río muestra la siguiente distribución:
El Índice Biótico de Familias (IBF) en el río muestra la siguiente distribución:
El Análisis Exploratorio de los datos es relevante para determinar el comportamiento y naturaleza de las variables, podemos observar su distribución a través de medidas de localización y variabilidad (Walpole et al. 2012)
exploratorio <- function(df) {
tipos <- sapply(df, class)
valores_min <- sapply(df, function(x) ifelse(is.numeric(x), min(x[complete.cases(x)]), NA))
valores_max <- sapply(df, function(x) ifelse(is.numeric(x), max(x[complete.cases(x)]), NA))
coeficientes_asimetria <- sapply(df, function(x) ifelse(is.numeric(x), round(e1071::skewness(x[complete.cases(x)]), 2), NA))
curtosis <- sapply(df, function(x) ifelse(is.numeric(x), round(kurtosis(x[complete.cases(x)]), 2), NA))
promedio <- sapply(df, function(x) ifelse(is.numeric(x), round(mean(x[complete.cases(x)]), 2), NA))
medianas <- sapply(df, function(x) ifelse(is.numeric(x), round(median(x[complete.cases(x)]), 2), NA))
modas <- sapply(df, function(x) ifelse(is.numeric(x), {
tab <- table(x[complete.cases(x)])
as.numeric(names(tab)[tab == max(tab)])}, NA))
rangos <- sapply(df, function(x) ifelse(is.numeric(x), round(max(x[complete.cases(x)]) - min(x[complete.cases(x)]), 2), NA))
varianzas <- sapply(df, function(x) ifelse(is.numeric(x), round(var(x[complete.cases(x)]), 2), NA))
desviaciones <- sapply(df, function(x) ifelse(is.numeric(x), round(sd(x[complete.cases(x)]), 2), NA))
coeficientes_variacion <- sapply(df, function(x) ifelse(is.numeric(x), round(sd(x[complete.cases(x)]) / mean(x[complete.cases(x)]), 2), NA))
resumen <- data.frame(Variable = names(df),
Tipo = tipos,
Minimo = valores_min,
Maximo = valores_max,
Rango = rangos,
Promedio = promedio,
Mediana = medianas,
Desviacion_Estandar = desviaciones,
Coeficiente_Variacion = coeficientes_variacion,
Moda = modas,
Varianza = varianzas,
Coeficiente_Asimetria = coeficientes_asimetria,
Curtosis = curtosis,
stringsAsFactors = FALSE)
resumen$Tipo <- ifelse(resumen$Tipo == "factor", "Categórica", resumen$Tipo)
resumen$Tipo <- ifelse(resumen$Tipo == "POSIXct", "Fecha", resumen$Tipo)
resumen$Tipo <- ifelse(resumen$Tipo == "logical", "Booleana", resumen$Tipo)
resumen$Tipo <- ifelse(resumen$Tipo == "numeric", "Numérica", resumen$Tipo)
# Elimina los nombres de las etiquetas de las filas
rownames(resumen) <- NULL
return(resumen)
}
DT::datatable(exploratorio(df_largo),
class = 'cell-border stripe',
# filter = 'top',
caption = htmltools::tags$caption(
style = 'caption-side: bottom; text-align: left;',
'Tabla: ', htmltools::em('Estimadores de Tendencia Central, Dispersión y Forma')),
extensions = c('Buttons','Scroller'),
options = list(scrollX = TRUE,
initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#003566', 'color': '#fff'});",
"}"),
dom = 'Bfrtip',
buttons = c('excel'),
deferRender = TRUE,
scrollY = 500,
scroller = TRUE))La variable de ancho presenta la siguiente información:
La variable de profundidad presenta la siguiente información:
La variable de velocidad presenta la siguiente información:
La variable de descarga presenta la siguiente información:
La variable de pH presenta la siguiente información:
La variable de temperatura presenta la siguiente información:
La variable de oxígeno disuelto presenta la siguiente información:
La variable de conductividad presenta la siguiente información:
La variable de riqueza presenta la siguiente información:
La variable de abundancia presenta la siguiente información:
La variable de diversidad presenta la siguiente información:
La variable de ABI presenta la siguiente información:
La variable de BMWP presenta la siguiente información:
La variable de IBF presenta la siguiente información:
El Coeficiente de Variación elimina las unidades de medida desde la desviación estándar del número de series dividiendo para el promedio de las mismas series de números (Abdi 2010)
Las variables que presentan mayor variabilidad son Abundancia y Descarga con Coeficientes de Variación por encima del 100%, esto lo puede corroborar la desviación estándar en comparación con el promedio de cada variable respectivamente.
El Coeficiente de Asimetría en la variable Temperatura es cercano a 0 lo que podría sugerir que la variable se acerca a una Distribución Normal Estándar
Respecto a la Curtosis (Mayor a 3) en las variables Velocidad yDiversidad son distribuciones con colas más largas, lo que puede sugerir la presencia de datos atípicos.
Finalmente, en un contexto de modelización estadística de datos previo a la aplicación de cualquier técnica estadística, y una vez revisado los estimadores en conjunto con los Boxplot podemos confirmar que es necesario realizar un normalización a la matriz de datos, para evitar los sesgos que pueden causar los valores atípicos o las unidades de medida.
A acontinuación, nos enfocaremos en revisar el comportamiento o naturaleza de los datos. Y asumiendo que obedecen a una Distribución Normal, es importante aplicar un Test Estadístico para realizar la verificación correspondiente.
Consideremos una muestra aleatoria de datos x_{1},x_{2},...,x_{n} que provienen de cierta distribución desconocida denotada por F(x). Se quiere verificar si dichos datos fueron generados por un proceso normal, mediante las hipótesis estadísticas.
H_{0}: F(x) es normal H_{0}: F(x) No es normal
Los pasos para la prueba de Shapiro-Wilks son:
Se han calculado para todos los datos de los años 1995 y 2021 en 11 estaciones de monitoreo (Ríos de Ecuador).
En cada variable se aplica el Test de Normalidad y su signicancia estadística para determinar si obedece o no a muestra proveniente de una Distribución Normal Estándar N\approx (\bar{x}=0,\sigma^{2}=constante).
El Test de Shapiro-Wilk (W) (Gutiérrez Pulido y Vara Salazar 2004), es uno de las pruebas estadísticas más robustas, y se obtiene de la siguiente forma:
W = \frac{{\left(\sum_{i=1}^{n} a_i x_{(i)}\right)^2}}{{\sum_{i=1}^{n} (x_{(i)} - \bar{x})^2}}
Donde:
Los coeficientes a_{i} y los estadísticos auxiliares m_{i} y x_{j} se calculan a partir de las observaciones de la muestra y se utilizan en la fórmula del estadístico de Shapiro-Wilk. Estos coeficientes y estadísticos se definen matemáticamente de la siguiente manera:
Donde:
Nota técnica: El valor del estadístico de Shapiro-Wilk (W) se compara con los valores críticos de la distribución para determinar si la muestra sigue una distribución normal. Si el valor de W es significativamente menor que el valor crítico correspondiente, entonces hay evidencia para rechazar la hipótesis nula de normalidad.
numeric_vars <- indices_fq_ddc[sapply(indices_fq_ddc, is.numeric)]
# Convertir el dataframe en formato largo (long format) para usar facet_wrap
df_long <- tidyr::pivot_longer(numeric_vars, cols = everything())
# Crear el Q-Q plot con facet_wrap
ggplot(df_long, aes(sample = value)) +
geom_qq(color = "#003049") +
stat_qq_line(color = "#fcbf49") +
labs(
title = "Gráfico de los Cuantiles (Q-Q Plot) para los Índices Físico-Químicos y Ecológicos",
subtitle = "Estaciones de Monitoreo (Ríos) para los años 1995 y 2021",
x = "Cuantiles teóricos",
y = "Cuantiles observados",
caption = "Elaborado por: Marcelo Chávez"
) +
facet_wrap(~ name, scales = "free") +
theme_minimal() +
theme(
panel.grid = element_line(color = "#e9ecef", size = 0.5), # Añadir grid
panel.border = element_rect(color = "black", fill = NA), # Añadir recuadro
axis.ticks = element_line(color = "black"), # Añadir ticks en los ejes
axis.line = element_blank(), # Eliminar líneas de ejes interiores
plot.title = element_text(hjust = 0.5), # Centrar el título
plot.caption = element_text(hjust = 0), # Alinear el footnote a la izquierda
axis.ticks.length = unit(-0.1, "cm") # Ajustar longitud de los ticks hacia adentro
)
# Definir una función para aplicar el test de Shapiro-Wilk a todas las variables numéricas
shapiro_test_all <- function(df) {
# Filtrar solo las variables numéricas
numeric_vars <- df[sapply(df, is.numeric)]
# Crear una lista para almacenar los resultados del test
test_results <- list()
# Iterar sobre cada variable numérica y aplicar el test de Shapiro-Wilk
for (var_name in names(numeric_vars)) {
result <- shapiro.test(numeric_vars[[var_name]])
# Redondear el estadístico W y el valor p a dos decimales
result$statistic <- round(result$statistic, 2)
result$p.value <- round(result$p.value, 2)
test_results[[var_name]] <- result
}
# Retornar los resultados como una lista
return(test_results)
}
# Aplicar la función al dataframe indices_fq_ddc
shapiro_results <- shapiro_test_all(indices_fq_ddc)
# Convertir los resultados en un tibble
results_df <- tibble::enframe(shapiro_results,
name = "Variable",
value = "Resultados")
# Extraer los estadísticos W y los valores p en columnas separadas
results_df <- results_df %>%
mutate(W = sapply(Resultados,
"[[",
"statistic"),
p_value = sapply(Resultados,
"[[",
"p.value"))
# Seleccionar las columnas relevantes
results_df <- results_df %>%
select(Variable, W, p_value)
# Definir los niveles de significancia
significance_levels <- c(0.05, 0.01, 0.10)
# Función para determinar si el valor p es mayor o menor que un nivel de significancia dado
check_significance <- function(p_value,
significance_level) {
if (p_value < significance_level) {
return("Menor al $\\alpha$")
} else {
return("Mayor o igual $\\alpha$")
}
}
# Aplicar la función a cada valor p y nivel de significancia
for (level in significance_levels) {
results_df <- results_df %>%
mutate(
!!paste0("Nivel de Significancia al ",
level) := sapply(p_value,
check_significance,
significance_level = level),
!!paste0("Rechazas H0 al ",
level) := ifelse(p_value < level,
"Sí",
"No")
)
}
# Mostrar la tabla actualizada
knitr::kable(results_df, format = "markdown")| Variable | W | p_value | Nivel de Significancia al 0.05 | Rechazas H0 al 0.05 | Nivel de Significancia al 0.01 | Rechazas H0 al 0.01 | Nivel de Significancia al 0.1 | Rechazas H0 al 0.1 |
|---|---|---|---|---|---|---|---|---|
| ANCHO | 0.83 | 0.00 | Menor al \alpha | Sí | Menor al \alpha | Sí | Menor al \alpha | Sí |
| PROFUNDIDAD | 0.90 | 0.03 | Menor al \alpha | Sí | Mayor o igual \alpha | No | Menor al \alpha | Sí |
| VELOCIDAD | 0.75 | 0.00 | Menor al \alpha | Sí | Menor al \alpha | Sí | Menor al \alpha | Sí |
| DESCARGA | 0.83 | 0.00 | Menor al \alpha | Sí | Menor al \alpha | Sí | Menor al \alpha | Sí |
| PH | 0.88 | 0.01 | Menor al \alpha | Sí | Mayor o igual \alpha | No | Menor al \alpha | Sí |
| TEMPERATURA | 0.98 | 0.84 | Mayor o igual \alpha | No | Mayor o igual \alpha | No | Mayor o igual \alpha | No |
| OXIGENO_DISUELTO | 0.88 | 0.01 | Menor al \alpha | Sí | Mayor o igual \alpha | No | Menor al \alpha | Sí |
| CONDUCTIVIDAD | 0.92 | 0.07 | Mayor o igual \alpha | No | Mayor o igual \alpha | No | Menor al \alpha | Sí |
| RIQUEZA | 0.95 | 0.33 | Mayor o igual \alpha | No | Mayor o igual \alpha | No | Mayor o igual \alpha | No |
| ABUNDANCIA | 0.71 | 0.00 | Menor al \alpha | Sí | Menor al \alpha | Sí | Menor al \alpha | Sí |
| DIVERSIDAD | 0.92 | 0.07 | Mayor o igual \alpha | No | Mayor o igual \alpha | No | Menor al \alpha | Sí |
| ABI | 0.91 | 0.04 | Menor al \alpha | Sí | Mayor o igual \alpha | No | Menor al \alpha | Sí |
| BMWP | 0.94 | 0.16 | Mayor o igual \alpha | No | Mayor o igual \alpha | No | Mayor o igual \alpha | No |
| IBF | 0.96 | 0.60 | Mayor o igual \alpha | No | Mayor o igual \alpha | No | Mayor o igual \alpha | No |
Para la comprobaciónd de normalidad se ha planteado la siguiente prueba de hipótesis:
H_{0}: Las variables provienen de una Distribución Normal
H_{1}: Las variables NO provienen de una Distribución Normal
Análisis: De igual forma en un contexto general los indicadores físico-químicos y ecológicos, con un nivel de significancia del 5%. De las 14 variables, 5 presentan normalidad y el resto de variables no lo son. Este resultado nos conduce a generalizar que para todo el conjunto de datos es necesario reducir la dimensionalidad y/o aplicar un método No Paramétrico para descubrir clústers o taxonomías entre las unidades de estudio.
Para la Modelización Factorial emplearemos los siguientes pasos:
graph TD;
A(Matriz de correlaciones y su significancia estadística) -->
B(Determinante de la matriz de correlaciones);
B --> C(Prueba de esfericidad de Bartlett);
C --> D(Comprobación de hipótesis para el análisis factorial por componentes principales);
D --> E(Gráfico de Sedimentación);
E --> F(Proporción de Varianza Acumulada);
F --> G(Componentes Principales);
G --> H(Autovalores y Varianzas);
H --> I(Círculo de las Correlaciones);
I --> J(Variables versus Dimensiones);
J --> K(Biplot);
graph TD;
A(Matriz de correlaciones y su significancia estadística) -->
B(Determinante de la matriz de correlaciones);
B --> C(Prueba de esfericidad de Bartlett);
C --> D(Comprobación de hipótesis para el análisis factorial por componentes principales);
D --> E(Gráfico de Sedimentación);
E --> F(Proporción de Varianza Acumulada);
F --> G(Componentes Principales);
G --> H(Autovalores y Varianzas);
H --> I(Círculo de las Correlaciones);
I --> J(Variables versus Dimensiones);
J --> K(Biplot);
Se ha tomado como referencia los pasos indicados en el libro (Hair et al. 1999).
# Calcular correlaciones y p-values
correlation_matrix <- cor(indices_fq_ddc)
p_values <- cor.mtest(indices_fq_ddc)$p
# Convertir p-values en asteriscos de acuerdo con el nivel de significancia
significant_level <- ifelse(p_values < 0.001, "***",
ifelse(p_values < 0.01, "**",
ifelse(p_values < 0.05, "*", "")))
# Crear gráfico
ggplot(data = melt(round(correlation_matrix, 2)), aes(x = Var1, y = Var2, fill = value)) +
geom_tile() +
geom_text(aes(label = paste(round(value, 2), significant_level)), color = "black", size = 4) +
labs(
title = "Mapa de calor de correlaciones",
x = "",
y = "",
fill = "Nivel de Correlación",
caption = "Elaborado por: Marcelo Chávez"
) +
scale_fill_gradient(low = "#caf0f8", high = "#2a9d8f") +
theme_minimal() +
theme(
axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1),
axis.title.x = element_text(angle = 90),
axis.title.y = element_text(angle = 0),
panel.grid = element_line(color = "#e9ecef", linewidth = 0.5), # Cambio a linewidth
panel.border = element_rect(color = "black", fill = NA),
axis.ticks = element_line(color = "black"),
axis.line = element_blank(),
plot.title = element_text(hjust = 0.5),
plot.caption = element_text(hjust = 0),
axis.ticks.length = unit(-0.1, "cm")
)
Es importante conocer que el nivel de significancia de la matriz de correlaciones para definir variables que a más de tener un buen nivel de correlación, es significativo estadísticamente.
\\p-value < 0.001 (***): Es significativa la correlación al 99% \\p-value < 0.05 (**): Es significativa la correlación al 95% \\p-value < 0.01 (*): Es significativa la correlación al 90%
Si están correlacionadas, el determinantes de la matriz de correlaciones será próximo a cero. De lo contrario el Análisis Factorial no es viable.
Kaiser-Meyer-Olkin factor adequacy
Call: KMO(r = indices_fq_ddc)
Overall MSA = 0.44
MSA for each item =
ANCHO PROFUNDIDAD VELOCIDAD DESCARGA
0.17 0.73 0.32 0.37
PH TEMPERATURA OXIGENO_DISUELTO CONDUCTIVIDAD
0.47 0.28 0.15 0.51
RIQUEZA ABUNDANCIA DIVERSIDAD ABI
0.63 0.40 0.64 0.49
BMWP IBF
0.62 0.48 $chisq
[1] 1454.851
$p.value
[1] 1.621989e-244
$df
[1] 91Un KMO de 0.44 es considerado bajo y podría sugerir que un análisis factorial puede no ser adecuado para estos datos. Sin embargo, la prueba de Bartlett tiene un p-valor menor al nivel de significancia del 5%, lo que indica que las variables están correlacionadas y que, por lo tanto, podría justificarse aplicar un método multivariante para reducción de dimensionalidad.
La hipótesis nula es que la matriz de correlaciones es una matriz identidad, lo que significa que no existirían correlaciones significativas, por lo que el modelo factorial no sería pertinente.
H_{0}: Existe esfericidad
H_{1}: No existe esfericidad
La esfericidad implica que todas las variables tienen la misma varianza y que no hay correlaciones entre ellas.
De aquí que el valor del KMO de 0.44 y su p-valor es menor al 95% de confianza. Por lo tanto: Rechazamos H_{0}, y concluimos que es factible estadísticamente realizar la reducción de dimensiones a través de un Análisis Factorial por Componentes Principales
# Cálculo de los autovalores y autovectores:
value_pro<-eigen(cor(indices_fq_ddc))
Acumulado <- cumsum(value_pro$values)
Prop.acumulado <- Acumulado/sum(value_pro$values)
val.prop.porce <- data.frame(value_pro$values,
Acumulado,
Prop.acumulado)
row.names(val.prop.porce) = c(expression(lambda[1]),
expression(lambda[2]),
expression(lambda[3]),
expression(lambda[4]),
expression(lambda[5]),
expression(lambda[6]),
expression(lambda[7]),
expression(lambda[8]),
expression(lambda[9]),
expression(lambda[10]),
expression(lambda[11]),
expression(lambda[12]),
expression(lambda[13]),
expression(lambda[14]))
colnames(val.prop.porce) <- c("Valor Propio",
"Acumulado",
"Prop. Acumulado")
kable(val.prop.porce,
caption = "Valores propios desde la matriz de correlaciones",
digits = 2,
format.args = list(decimal.mark =",")) %>%
row_spec(row = 5,
background="#a7c957",
bold=T)| Valor Propio | Acumulado | Prop. Acumulado | |
|---|---|---|---|
| lambda[1] | 5,05 | 5,05 | 0,36 |
| lambda[2] | 2,19 | 7,25 | 0,52 |
| lambda[3] | 1,75 | 9,00 | 0,64 |
| lambda[4] | 1,70 | 10,69 | 0,76 |
| lambda[5] | 1,13 | 11,83 | 0,84 |
| lambda[6] | 0,70 | 12,53 | 0,89 |
| lambda[7] | 0,58 | 13,11 | 0,94 |
| lambda[8] | 0,28 | 13,38 | 0,96 |
| lambda[9] | 0,22 | 13,60 | 0,97 |
| lambda[10] | 0,16 | 13,76 | 0,98 |
| lambda[11] | 0,14 | 13,90 | 0,99 |
| lambda[12] | 0,07 | 13,98 | 1,00 |
| lambda[13] | 0,02 | 13,99 | 1,00 |
| lambda[14] | 0,01 | 14,00 | 1,00 |
El Valor Propio de la matriz de correlaciones cuando desciende hasta 1 sugiere que el número de componentes o factores que pueden explicar la variabilidad de todo el conjunto de datos está en un \lambda=5 y lo corrobora el Gráfico de Sedimentación
En la ejecución de las componentes principales emplearemos un método de estandarización de variables respecto a su media (\bar{x}) y desviación estándar (\sigma) (Wang, Sun, y Luan 2024)
Importance of components:
PC1 PC2 PC3 PC4 PC5 PC6 PC7
Standard deviation 2.248 1.4804 1.3231 1.3023 1.06484 0.83589 0.76202
Proportion of Variance 0.361 0.1565 0.1250 0.1211 0.08099 0.04991 0.04148
Cumulative Proportion 0.361 0.5176 0.6426 0.7638 0.84475 0.89466 0.93614
PC8 PC9 PC10 PC11 PC12 PC13 PC14
Standard deviation 0.5252 0.4688 0.40051 0.37373 0.27113 0.13661 0.07873
Proportion of Variance 0.0197 0.0157 0.01146 0.00998 0.00525 0.00133 0.00044
Cumulative Proportion 0.9558 0.9715 0.98300 0.99297 0.99822 0.99956 1.00000 eigenvalue variance.percent cumulative.variance.percent
Dim.1 5.054291459 36.10208185 36.10208
Dim.2 2.191655745 15.65468390 51.75677
Dim.3 1.750665400 12.50475286 64.26152
Dim.4 1.696074162 12.11481544 76.37633
Dim.5 1.133880767 8.09914834 84.47548
Dim.6 0.698704553 4.99074681 89.46623
Dim.7 0.580677202 4.14769430 93.61392
Dim.8 0.275814651 1.97010465 95.58403
Dim.9 0.219778973 1.56984981 97.15388
Dim.10 0.160411780 1.14579843 98.29968
Dim.11 0.139674537 0.99767527 99.29735
Dim.12 0.073509242 0.52506601 99.82242
Dim.13 0.018663566 0.13331119 99.95573
Dim.14 0.006197963 0.04427116 100.00000Al analizar los componentes principales podemos observar que en el Componente 5 se explica el 84% de la varianza de todas las dimensiones
En el círculo de las correlaciones es una representación gráfica de las correlaciones entre las variables originales y los componentes principales extraídos durante el análisis factorial. Cada variable original se representa como un vector en el espacio de los componentes principales, donde la longitud del vector indica la correlación entre esa variable y el componente principal correspondiente, y la dirección del vector indica la dirección en la que esa variable contribuye al componente principal. Por ejemplo, al examinar el círculo de correlaciones, podemos observar que las variables ABI, BMWP y RIQUEZA están inversamente correlacionadas con la Dimensión 2. Por otro lado, las variables ANCHO y PROFUNDIDAD muestran una correlación más fuerte con la Dimensión 1. En resumen, el círculo de correlaciones proporciona una representación visual que ayuda a entender cómo las variables originales están relacionadas y contribuyen a la estructura de los componentes principales identificados durante el análisis factorial
fviz_screeplot(pca,
ncp = 5,
barfill = "#3fc1c0",
barcolor = "#3fc1c0",
addlabels = TRUE,
ylab = "Porcentaje de varianza explicada",
xlab = "Dimensiones",
main = "Porcentaje de varianza explicada por componente (Scree plot)",
hjust = -0.3) +
theme(plot.title = element_text(size = 14, face = "bold"),
plot.caption = element_text(size = 8, face = "italic")) +
labs(caption = "Elaborado por: Marcelo Chávez") +
theme_minimal() +
theme(
axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1),
axis.title.x = element_text(angle = 90),
axis.title.y = element_text(angle = 0),
panel.grid = element_line(color = "#e9ecef", linewidth = 0.5), # Cambio a linewidth
panel.border = element_rect(color = "black", fill = NA),
axis.ticks = element_line(color = "black"),
axis.line = element_blank(),
plot.title = element_text(hjust = 0.5),
plot.caption = element_text(hjust = 0),
axis.ticks.length = unit(-0.1, "cm")
)
Es fundamental examinar el nivel de contribución de las variables a cada uno de los componentes principales. En este sentido, observamos que variables como ABI, BMWP y RIQUEZA destacan por su significativa contribución a la Dimensión 2. Sin embargo, al considerar OXÍGENO y PH, a pesar de ubicarse en los mismos componentes, la longitud de sus vectores indica una contribución mínima al modelo factorial en construcción.
Variables ecológicas como ABI, BMWP y RIQUEZA exhiben una alta similitud en la estación de monitoreo 8 durante el año 1995. De manera similar: CONDUCTIVIDAD, DIVERSIDAD e IBF comparten características destacadas en las estaciones de monitoreo 7 y 11, también en el año 1995. Por otro lado, un conjunto distinto de variables como: ANCHO, PROFUNDIDAD y DESCARGA para el año 2021, evidencian patrones similares en las estaciones de monitoreo 1, 7, 8 y 9. Sin embargo, variables como: ABUNDANCIA, TEMPERATURA y VELOCIDAD, a pesar de su comportamiento de no similaridad entre ellas, aportan de forma significativa al modelo factorial individualmente
Para la construcción de un Índice Multivariante utilizando el método factorial por componentes principales, vamos a basarnos en la utilización de las cargas factoriales o loadings que son los vectores propios resulantes de la rotación de máxima varianza en las 5 componentes donde se explica el 84% de variabilidad de los datos, considerando dos directrices técnicas importantes:
PC1 PC2 PC3 PC4 PC5
ANCHO 0.11 0.32 0.00 0.18 0.33
PROFUNDIDAD 0.18 0.43 0.00 0.06 0.00
VELOCIDAD 0.28 0.00 0.00 0.08 0.00
DESCARGA 0.31 0.11 0.00 0.14 0.00
PH 0.00 0.01 0.00 0.00 0.02
TEMPERATURA 0.12 0.00 0.00 0.34 0.11
OXIGENO_DISUELTO 0.09 0.02 0.11 0.00 0.08
CONDUCTIVIDAD 0.00 0.26 0.00 0.00 0.30
RIQUEZA 0.00 0.00 0.00 0.02 0.00
ABUNDANCIA 0.00 0.00 0.00 0.03 0.30
DIVERSIDAD 0.00 0.08 0.04 0.04 0.00
ABI 0.00 0.01 0.00 0.09 0.00
BMWP 0.00 0.07 0.07 0.03 0.00
IBF 0.00 0.45 0.01 0.34 0.07Por consiguiente, la ecuación de las combinaciones lineales para la matriz de variables físico-químicos y ecológicos es la siguiente:
X_{1} = a_{11}F_{1} + a_{12}F2 + ... + a_{1q}F_{q} + d_{1}U_{1} X_{2} = a_{21}F_{1} + a_{22}F2 + ... + a_{2q}F_{q} + d_{2}U_{2} ............................................................... X_{2} = a_{p1}F_{1} + a_{p2}F2 + ... + a_{pq}F_{q} + d_{p}U_{p}
Donde:
I_{mcm} = ANCHO_{\text{PC}2} +\\ PROFUNDIDAD_{\text{PC}2} +\\ VELOCIDAD_{\text{PC}1} +\\ DESCARGA_{\text{PC}1} +\\ PH_{\text{PC}2} +\\ TEMPERATURA_{\text{PC}4} +\\ OXIGENO\_DISUELTO_{\text{PC}5} +\\ CONDUCTIVIDAD_{\text{PC}2} +\\ RIQUEZA_{\text{PC}2} +\\ ABUNDANCIA_{\text{PC}5} +\\ DIVERSIDAD_{\text{PC}2} +\\ ABI_{\text{PC}3} +\\ BMWP_{\text{PC}2} +\\ IBF_{\text{PC}2}
I_{mcm} = 0.32 \times ANCHO_{\text{PC}2} +\\ 0.43 \times PROFUNDIDAD_{\text{PC}2} +\\ 0.28 \times VELOCIDAD_{\text{PC}1} +\\ 0.31 \times DESCARGA_{\text{PC}1} +\\ 0.02 \times PH_{\text{PC}5} +\\ 0.34 \times TEMPERATURA_{\text{PC}4} +\\ 0.11 \times OXIGENO\_DISUELTO_{\text{PC}3} +\\ 0.30 \times CONDUCTIVIDAD_{\text{PC}5} +\\ 0.02 \times RIQUEZA_{\text{PC}2} +\\ 0.30 \times ABUNDANCIA_{\text{PC}5} +\\ 0.08 \times DIVERSIDAD_{\text{PC}2} +\\ 0.09 \times ABI_{\text{PC}4} +\\ 0.07 \times BMWP_{\text{PC}2} +\\ 0.45 \times IBF_{\text{PC}2}
# Función de escalamiento entre 0 y 1
scale_values <- function(x) {
round((x - min(x)) / (max(x) - min(x)),2)
}
indices_mcm <- indices_fq_ddc %>%
mutate(
INDICE = round(
0.32 * ANCHO +
0.43 * PROFUNDIDAD +
0.28 * VELOCIDAD +
0.31 * DESCARGA +
0.02 * PH +
0.34 * TEMPERATURA +
0.11 * OXIGENO_DISUELTO +
0.30 * CONDUCTIVIDAD +
0.02 * RIQUEZA +
0.30 * ABUNDANCIA +
0.08 * DIVERSIDAD +
0.09 * ABI +
0.07 * BMWP +
0.45 * IBF, 2),
IMCM = scale_values(INDICE),
RIOS = row.names(indices_fq_ddc)) %>%
arrange(desc(IMCM))
# Categorización del I_MCM con etiquetas personalizadas
indices_mcm$IMCM_CATEGORIA <- cut(indices_mcm$IMCM,
breaks = c(-Inf,
0.29,
0.30,
0.49,
0.62,
Inf), # Definición de intervalos
labels = c("IMCM Bajo",
"IMCM Bajo",
"IMCM Medio",
"IMCM Medio",
"IMCM Alto"),
right = FALSE)
# Filtrar IMCM del año 1995 en los rownames
indices_mcm_95 <- indices_mcm[grep("95", rownames(indices_mcm)),]
# Filtrar IMCM del año 2021 en los rownames
indices_mcm_21 <- indices_mcm[grep("21", rownames(indices_mcm)),]
DT::datatable(indices_mcm,
class = 'cell-border stripe',
# filter = 'top',
caption = htmltools::tags$caption(
style = 'caption-side: bottom; text-align: left;',
'Tabla: ', htmltools::em('Variables Físico-Químicas y Ecológicas de los años 1995 y 2021 con el cálculo del Índice Multidimensional de las Comunidades de Macroinvertebrados (IMCM)')),
extensions = c('Buttons','Scroller'),
options = list(scrollX = TRUE,
initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#003566', 'color': '#fff'});",
"}"),
dom = 'Bfrtip',
buttons = c('excel'),
deferRender = TRUE,
scrollY = 500,
scroller = TRUE))highchart() %>%
hc_chart(type = "column",
options3d = list(enabled = TRUE,
beta = 15,
alpha = 15)) %>% # Tipo de gráfico: columnas
hc_xAxis(categories = indices_mcm$RIOS) %>% # Especificar las categorías en el eje X
hc_add_series(data = indices_mcm$IMCM,
color = "#6096ba") %>%
hc_xAxis(labels = list(rotation = -45,
align = "right"),
margin = 100) %>%
hc_title(text = "Índice Multidimensional de las Comunidades de Macroinvertebrados por Estaciones de Monitoreo en los años 1995 y 2021") %>%
hc_caption(text = "Elaborado por: Marcelo Chávez") %>%
hc_legend(enabled = FALSE) %>%
hc_tooltip(formatter = JS("function() {
return '<b>RÍO: </b>' + this.x + '<br/>' +
'<b>IMCM: </b>' + this.y.toFixed(2);}")) %>%
hc_add_theme(hc_theme_google())highchart() %>%
hc_chart(type = "column",
options3d = list(enabled = TRUE,
beta = 15,
alpha = 15)) %>% # Tipo de gráfico: columnas
hc_xAxis(categories = indices_mcm_95$RIOS) %>% # Especificar las categorías en el eje X
hc_add_series(data = indices_mcm_95$IMCM,
color = "#6096ba") %>%
hc_xAxis(labels = list(rotation = -45,
align = "right"),
margin = 100) %>%
hc_title(text = "Índice Multidimensional de las Comunidades de Macroinvertebrados por Estaciones de Monitoreo en el año 1995") %>%
hc_caption(text = "Elaborado por: Marcelo Chávez") %>%
hc_legend(enabled = FALSE) %>%
hc_tooltip(formatter = JS("function() {
return '<b>RÍO: </b>' + this.x + '<br/>' +
'<b>IMCM: </b>' + this.y.toFixed(2);}")) %>%
hc_add_theme(hc_theme_google())highchart() %>%
hc_chart(type = "column",
options3d = list(enabled = TRUE,
beta = 15,
alpha = 15)) %>% # Tipo de gráfico: columnas
hc_xAxis(categories = indices_mcm_21$RIOS) %>% # Especificar las categorías en el eje X
hc_add_series(data = indices_mcm_21$IMCM,
color = "#6096ba") %>%
hc_xAxis(labels = list(rotation = -45,
align = "right"),
margin = 100) %>%
hc_title(text = "Índice Multidimensional de las Comunidades de Macroinvertebrados por Estaciones de Monitoreo en el año 2021") %>%
hc_caption(text = "Elaborado por: Marcelo Chávez") %>%
hc_legend(enabled = FALSE) %>%
hc_tooltip(formatter = JS("function() {
return '<b>RÍO: </b>' + this.x + '<br/>' +
'<b>IMCM: </b>' + this.y.toFixed(2);}")) %>%
hc_add_theme(hc_theme_google())Para los clusterización de las estaciones de monitoreo se empleará un método No Paramétrico que se encuentra dentro de los métodos de Aprendizaje No Supervisado, esto dado porque no se está utilizando una variable en específico que nos permita clasificar para entrenar un modelo factorial.
En el proceso de cluster para las estaciones de monitoreo, se utiliza la misma estructura matricial de los índices físico-químicos y ecológicos. Por consiguiente se utiliza el siguiente proceso algorítmico:
fviz_cluster(algoritmo,
data = var_scale) +
theme_minimal() +
labs(
title = "Clústers de las Estaciones de Monitoreo",
caption = "Elaborado por: Marcelo Chávez") +
theme_minimal() +
theme(
axis.text.x = element_text(angle = 0,
vjust = 0.5,
hjust = 0.5),
axis.title.x = element_text(angle = 0),
axis.title.y = element_text(angle = 0),
panel.grid = element_line(color = "#e9ecef", linewidth = 0.5), # Cambio a linewidth
panel.border = element_rect(color = "black", fill = NA),
axis.ticks = element_line(color = "black"),
axis.line = element_blank(),
plot.title = element_text(hjust = 0.5),
plot.caption = element_text(hjust = 0),
axis.ticks.length = unit(-0.1, "cm"))
indices_mcm <- indices_mcm %>%
mutate(CLUSTER = as.factor(algoritmo$cluster))
DT::datatable(indices_mcm,
class = 'cell-border stripe',
# filter = 'top',
caption = htmltools::tags$caption(
style = 'caption-side: bottom; text-align: left;',
'Tabla 3: ', htmltools::em('Indicadores Físico-Químicos y Ecológicos para los años 1995 y 2021 con el cálculo del Índice Multidimensional de las Comunidades de Macroinvertebrados (IMCM) y el número de clúster que corresponde')),
extensions = c('Buttons','Scroller'),
options = list(scrollX = TRUE,
initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#003566', 'color': '#fff'});",
"}"),
dom = 'Bfrtip',
buttons = c('excel'),
deferRender = TRUE,
scrollY = 500,
scroller = TRUE))A Notebook de R by Marcelo Chávez Reinoso
marcelo_chavez_ec@outlook.com