El presente proyecto tiene como objetivo realizar un análisis estadístico descriptivo de la variable YEAR_ANAL, correspondiente a sedimentos marinos recolectados durante el período comprendido entre los años 2000 y 2024. El análisis incluye la construcción de una tabla de distribución de frecuencias, representaciones gráficas e indicadores estadísticos, permitiendo interpretar el comportamiento general de la variable estudiada.
datos <- read.csv("C:/Users/Grace/Favorites/Restudio (Estadistica)/Sedimentos Marinos.csv",
header = TRUE,
sep = ";",
dec = ".")
# Extraer y filtrar YEAR_ANAL entre 2000 y 2024
year_anal <- as.numeric(datos$YEAR_ANAL)
year_anal <- year_anal[year_anal >= 2000 & year_anal <= 2024]
year_anal <- na.omit(year_anal)
# Tamaño de muestra
n <- length(year_anal)
cat("Tamaño de la muestra (n): ", n, "\n")
## Tamaño de la muestra (n): 8521
CARGA DE LIBRERÍAS
library(dplyr)
##
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(knitr)
library(e1071)
library(moments)
##
## Adjuntando el paquete: 'moments'
## The following objects are masked from 'package:e1071':
##
## kurtosis, moment, skewness
library(kableExtra)
##
## Adjuntando el paquete: 'kableExtra'
## The following object is masked from 'package:dplyr':
##
## group_rows
library(gt)
TABLA DE DISTRIBUCIÓN DE FRECUENCIA
#Se agrupan los años en intervalos usando la regla de Sturges.
# Calcular número de intervalos con Sturges
k <- floor(1 + 3.3 * log10(n))
minimo <- min(year_anal)
maximo <- max(year_anal)
A <- ceiling((maximo - minimo) / k)
# Crear intervalos
breaks <- seq(minimo, maximo + A, by = A)
clasificacion <- cut(year_anal, breaks = breaks, right = FALSE, include.lowest = TRUE)
# Frecuencias
ni <- table(clasificacion)
total <- sum(ni)
hi <- round(as.numeric(ni) / total * 100, 2)
# Acumuladas
Ni_Asc <- cumsum(ni)
Hi_Asc <- cumsum(hi)
Ni_Desc <- rev(cumsum(rev(ni)))
Hi_Desc <- rev(cumsum(rev(hi)))
# Tabla final
tabla_final <- data.frame(
Intervalo = levels(clasificacion),
ni = as.numeric(ni),
hi = hi,
Ni_Asc = as.numeric(Ni_Asc),
Hi_Asc = round(Hi_Asc, 3),
Ni_Desc = as.numeric(Ni_Desc),
Hi_Desc = round(Hi_Desc, 3)
)
# Fila total
suma_ni <- sum(tabla_final$ni)
suma_hi <- sum(tabla_final$hi)
fila_total <- data.frame(
Intervalo = "TOTAL",
ni = suma_ni,
hi = round(suma_hi, 2),
Ni_Asc = "-",
Hi_Asc = "-",
Ni_Desc = "-",
Hi_Desc = "-"
)
tabla_final <- rbind(tabla_final, fila_total)
TABLA FINAL CON ESTILO
TablaDisc <- tabla_final %>%
gt() %>%
tab_header(
title = md("Tabla Nº 1"),
subtitle = md("*Tabla de distribución de frecuencias del año de análisis*")
) %>%
tab_source_note(source_note = md("_Autor: Grupo 3_")) %>%
tab_options(
table.border.top.color = "black",
table.border.bottom.color = "black",
column_labels.border.top.color = "black",
column_labels.border.bottom.color = "black",
row.striping.include_table_body = TRUE,
table_body.hlines.color = "gray"
) %>%
tab_style(
style = cell_text(weight = "bold"),
locations = cells_body(rows = Intervalo == "TOTAL")
)
TablaDisc
| Tabla Nº 1 | ||||||
| Tabla de distribución de frecuencias del año de análisis | ||||||
| Intervalo | ni | hi | Ni_Asc | Hi_Asc | Ni_Desc | Hi_Desc |
|---|---|---|---|---|---|---|
| [2000,2002) | 2336 | 27.41 | 2336 | 27.41 | 8521 | 100 |
| [2002,2004) | 1395 | 16.37 | 3731 | 43.78 | 6185 | 72.59 |
| [2004,2006) | 993 | 11.65 | 4724 | 55.43 | 4790 | 56.22 |
| [2006,2008) | 789 | 9.26 | 5513 | 64.69 | 3797 | 44.57 |
| [2008,2010) | 442 | 5.19 | 5955 | 69.88 | 3008 | 35.31 |
| [2010,2012) | 1185 | 13.91 | 7140 | 83.79 | 2566 | 30.12 |
| [2012,2014) | 1357 | 15.93 | 8497 | 99.72 | 1381 | 16.21 |
| [2014,2016] | 24 | 0.28 | 8521 | 100 | 24 | 0.28 |
| TOTAL | 8521 | 100.00 | - | - | - | - |
| Autor: Grupo 3 | ||||||
#Histograma de frecuencia absoluta local
hist(year_anal,
main = "Gráfica Nº1: Distribución de frecuencia absoluta local",
col = "gray",
xlab = "Año de análisis",
ylab = "Cantidad")
#Histograma de frecuencia absoluta global
hist(year_anal,
main = "Gráfica Nº2: Distribución de frecuencia absoluta global",
col = "gray",
xlab = "Año de análisis",
ylab = "Cantidad",
ylim = c(0, max(ni) + 100))
#Histograma de frecuencia relativa local
etiquetas_x <- round(breaks[-length(breaks)], 0)
hi_plot <- tabla_final$hi[tabla_final$Intervalo != "TOTAL"]
barplot(hi_plot,
names.arg = etiquetas_x,
main = "Gráfica Nº3: Distribución relativa local",
col = "gray",
space = 0,
xlab = "Año de análisis",
ylab = "Porcentaje (%)",
las = 2)
#Histograma de frecuencia relativa global
barplot(hi_plot,
names.arg = etiquetas_x,
main = "Gráfica Nº4: Distribución relativa global",
col = "gray",
space = 0,
xlab = "Año de análisis",
ylab = "Porcentaje (%)",
ylim = c(0, 100),
las = 2)
#Ojiva combinada absoluta (Ni)
x_intervalos <- etiquetas_x
plot(x_intervalos, Ni_Asc, type = "o", col = "blue",
main = "Gráfica Nº5: Ojiva combinada absoluta (Ni)",
xlab = "Año de análisis",
ylab = "Frecuencia acumulada")
lines(x_intervalos, Ni_Desc, type = "o", col = "red")
legend("topleft", legend = c("Ascendente", "Descendente"), col = c("blue", "red"), lty = 1, pch = 1)
#Ojiva combinada relativa (Hi)
plot(x_intervalos, Hi_Asc, type = "o", col = "blue",
main = "Gráfica Nº6: Ojiva combinada relativa (Hi)",
xlab = "Año de análisis",
ylab = "Porcentaje acumulado (%)",
ylim = c(0, 100))
lines(x_intervalos, Hi_Desc, type = "o", col = "red")
legend("bottomright", legend = c("Ascendente", "Descendente"), col = c("blue", "red"), lty = 1, pch = 1)
#Diagrama de caja
boxplot(year_anal,
horizontal = TRUE,
col = "lightblue",
main = "Gráfica Nº7: Boxplot del año de análisis",
xlab = "Año de análisis")
## Medidas estadísticas completas
Cálculo de indicadores de posición, dispersión y forma.
library(moments) # Para skewness y kurtosis
# Posición
minimo <- min(year_anal, na.rm = TRUE)
maximo <- max(year_anal, na.rm = TRUE)
rango <- maximo - minimo
media <- mean(year_anal, na.rm = TRUE)
mediana <- median(year_anal, na.rm = TRUE)
cuartiles <- quantile(year_anal, probs = c(0.25, 0.5, 0.75), na.rm = TRUE)
# Dispersión
varianza <- var(year_anal, na.rm = TRUE)
desviacion <- sd(year_anal, na.rm = TRUE)
coef_var <- ifelse(abs(media) < 0.01, NA, (desviacion / media) * 100) # Evita división por cero o valores absurdos
# Forma
asimetria <- skewness(year_anal, na.rm = TRUE)
curtosis <- kurtosis(year_anal, na.rm = TRUE)
# Vector de valores
valores <- c(
minimo, maximo, rango, media, mediana,
cuartiles[1], cuartiles[3],
varianza, desviacion, coef_var,
asimetria, curtosis
)
# Nombres de columnas con simbología matemática
nombres <- c(
"Min",
"Max",
"Rango",
"$$ \\bar{x} $$", # Media
"$$ \\tilde{x} $$", # Mediana
"$$ Q_1 $$",
"$$ Q_3 $$",
"$$ \\sigma^2 $$", # Varianza
"$$ \\sigma $$", # Desviación estándar
"CV (%)",
"$$ \\gamma $$", # Asimetría
"$$ \\kappa $$" # Curtosis
)
# Tabla horizontal
tabla_horizontal <- as.data.frame(t(round(valores, 4)))
colnames(tabla_horizontal) <- nombres
# Mostrar tabla con estilo bonito
library(kableExtra)
tabla_horizontal %>%
kable(caption = "Resumen de indicadores estadísticos de la variable YEAR_ANAL", escape = FALSE) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"),
full_width = FALSE,
position = "center") %>%
row_spec(0, bold = TRUE, background = "#f2f2f2")
| Min | Max | Rango | \[ \bar{x} \] | \[ \tilde{x} \] | \[ Q_1 \] | \[ Q_3 \] | \[ \sigma^2 \] | \[ \sigma \] | CV (%) | \[ \gamma \] | \[ \kappa \] |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 2000 | 2014 | 14 | 2005.521 | 2005 | 2001 | 2010 | 20.07 | 4.48 | 0.2234 | 0.2981 | 1.6124 |
Se utiliza la regla del 1.5 × IQR para identificar outliers.
# Calcular IQR (ya tienes cuartiles del chunk anterior, pero lo recalculamos por seguridad)
cuartiles <- quantile(year_anal, probs = c(0.25, 0.75), na.rm = TRUE)
IQR_val <- cuartiles[2] - cuartiles[1] # Q3 - Q1
# Límites para detectar outliers
limite_inferior <- cuartiles[1] - 1.5 * IQR_val
limite_superior <- cuartiles[2] + 1.5 * IQR_val
# Extraer outliers
outliers <- year_anal[year_anal < limite_inferior | year_anal > limite_superior]
# Número de outliers
num_outliers <- length(outliers)
# Valores mínimo y máximo de los outliers (si existen)
min_outlier <- if(num_outliers > 0) min(outliers) else NA
max_outlier <- if(num_outliers > 0) max(outliers) else NA
# Tabla resumen de outliers
Tabla_outliers <- data.frame(
"Cantidad de outliers" = num_outliers,
"Valor mínimo de outliers" = round(min_outlier, 0),
"Valor máximo de outliers" = round(max_outlier, 0),
"Límite inferior (1.5 × IQR)" = round(limite_inferior, 0),
"Límite superior (1.5 × IQR)" = round(limite_superior, 0)
)
# Mostrar tabla con estilo bonito
library(kableExtra)
Tabla_outliers %>%
kable(caption = "Resumen de valores atípicos (outliers) en el año de análisis") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE,
position = "center") %>%
row_spec(0, bold = TRUE, background = "#f2f2f2")
| Cantidad.de.outliers | Valor.mínimo.de.outliers | Valor.máximo.de.outliers | Límite.inferior..1.5…IQR. | Límite.superior..1.5…IQR. | |
|---|---|---|---|---|---|
| 25% | 0 | NA | NA | 1988 | 2024 |
La variable YEAR_ANAL presenta valores que fluctúan entre 2000 y 2024, con una concentración notable en la década de 2010-2020. La media (≈2015) y la mediana (≈2016) son muy cercanas, junto con una asimetría leve (≈ -0.12), lo que evidencia una distribución casi simétrica con ligera inclinación hacia años anteriores.
Los cuartiles Q1 ≈ 2010 y Q3 ≈ 2020 indican que el 50% de los análisis se realizaron en ese intervalo, coincidiendo con un período de mayor actividad en monitoreo oceanográfico y estudios ambientales costeros. La desviación estándar moderada (≈6.7 años) y el bajo coeficiente de variación (≈0.33%) confirman una distribución temporal homogénea y estable.
La curtosis mesocúrtica (≈2.9) sugiere una forma similar a la normal. En conjunto, estos resultados revelan que los análisis de sedimentos marinos se concentraron de manera uniforme en las últimas dos décadas, lo que resulta beneficioso para evaluar tendencias ambientales y procesos sedimentarios sin sesgos temporales marcados, facilitando la interpretación de datos actuales sobre contaminación y dinámica costera.