El presente documento tiene como objetivo realizar un análisis estadístico descriptivo de la variable YEAR_COLL (año de recolección de las muestras), 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 agrupadas, representaciones gráficas e indicadores estadísticos, permitiendo interpretar el comportamiento temporal de la recolección de muestras.
CARGA DE DATOS
# Ruta completa al archivo
datos <- read.csv("C:/Users/Grace/Favorites/Restudio (Estadistica)/Sedimentos Marinos.csv",
header = TRUE,
sep = ";",
dec = ".")
# Extraer y filtrar YEAR_COLL entre 2000 y 2024
year_coll <- as.numeric(datos$YEAR_COLL)
year_coll <- year_coll[year_coll >= 2000 & year_coll <= 2024]
year_coll <- na.omit(year_coll)
# Tamaño de muestra
n <- length(year_coll)
cat("Tamaño de la muestra (n): ", n, "\n")
## Tamaño de la muestra (n): 7018
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
# Calcular número de intervalos con Sturges
k <- floor(1 + 3.3 * log10(n))
minimo <- min(year_coll)
maximo <- max(year_coll)
A <- ceiling((maximo - minimo) / k)
# Crear intervalos
breaks <- seq(minimo, maximo + A, by = A)
clasificacion <- cut(year_coll, 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)
TablaDisc <- tabla_final %>%
gt() %>%
tab_header(
title = md("**Tabla Nº 1**"),
subtitle = md("**Tabla de distribución de frecuencias del año de recolección de las muestras de sedimentos marinos**")
) %>%
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 recolección de las muestras de sedimentos marinos | ||||||
| Intervalo | ni | hi | Ni_Asc | Hi_Asc | Ni_Desc | Hi_Desc |
|---|---|---|---|---|---|---|
| [2000,2002) | 1244 | 17.73 | 1244 | 17.73 | 7018 | 100 |
| [2002,2004) | 1232 | 17.55 | 2476 | 35.28 | 5774 | 82.27 |
| [2004,2006) | 1059 | 15.09 | 3535 | 50.37 | 4542 | 64.72 |
| [2006,2008) | 656 | 9.35 | 4191 | 59.72 | 3483 | 49.63 |
| [2008,2010) | 391 | 5.57 | 4582 | 65.29 | 2827 | 40.28 |
| [2010,2012) | 1386 | 19.75 | 5968 | 85.04 | 2436 | 34.71 |
| [2012,2014) | 1026 | 14.62 | 6994 | 99.66 | 1050 | 14.96 |
| [2014,2016] | 24 | 0.34 | 7018 | 100 | 24 | 0.34 |
| TOTAL | 7018 | 100.00 | - | - | - | - |
| Autor: Grupo 3 | ||||||
#Histograma de frecuencia absoluta local
hist(year_coll,
main = "Gráfica Nº1: Distribución de frecuencia absoluta local del año de recolección",
col = "gray",
xlab = "Año de recolección",
ylab = "Cantidad")
#Histograma de frecuencia absoluta global
hist(year_coll,
main = "Gráfica Nº2: Distribución de frecuencia absoluta global del año de recolección",
col = "gray",
xlab = "Año de recolección",
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 del año de recolección",
col = "gray",
space = 0,
xlab = "Año de recolección",
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 del año de recolección",
col = "gray",
space = 0,
xlab = "Año de recolección",
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 recolección",
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 recolección",
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_coll,
horizontal = TRUE,
col = "lightblue",
main = "Gráfica Nº7: Boxplot del año de recolección de las muestras",
xlab = "Año de recolección")
## 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_coll, na.rm = TRUE)
maximo <- max(year_coll, na.rm = TRUE)
rango <- maximo - minimo
media <- mean(year_coll, na.rm = TRUE)
mediana <- median(year_coll, na.rm = TRUE)
cuartiles <- quantile(year_coll, probs = c(0.25, 0.5, 0.75), na.rm = TRUE)
# Dispersión
varianza <- var(year_coll, na.rm = TRUE)
desviacion <- sd(year_coll, na.rm = TRUE)
coef_var <- ifelse(abs(media) < 0.01, NA, (desviacion / media) * 100)
# Forma
asimetria <- skewness(year_coll, na.rm = TRUE)
curtosis <- kurtosis(year_coll, na.rm = TRUE)
# Vector de valores
valores <- c(
minimo, maximo, rango, media, mediana,
cuartiles[1], cuartiles[3],
varianza, desviacion, coef_var,
asimetria, curtosis
)
# Nombres con simbología
nombres <- c(
"Min", "Max", "Rango",
"$$ \\bar{x} $$", "$$ \\tilde{x} $$", "$$ Q_1 $$", "$$ Q_3 $$",
"$$ \\sigma^2 $$", "$$ \\sigma $$", "CV (%)",
"$$ \\gamma $$", "$$ \\kappa $$"
)
# Tabla horizontal
tabla_horizontal <- as.data.frame(t(round(valores, 4)))
colnames(tabla_horizontal) <- nombres
library(kableExtra)
tabla_horizontal %>%
kable(caption = "Resumen de indicadores estadísticos de la variable YEAR_COLL", 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 | 2006.11 | 2005 | 2002 | 2010 | 18.9022 | 4.3477 | 0.2167 | 0.106 | 1.54 |
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_coll, probs = c(0.25, 0.75), na.rm = TRUE)
IQR_val <- cuartiles[2] - cuartiles[1]
limite_inferior <- cuartiles[1] - 1.5 * IQR_val
limite_superior <- cuartiles[2] + 1.5 * IQR_val
outliers <- year_coll[year_coll < limite_inferior | year_coll > limite_superior]
num_outliers <- length(outliers)
min_outlier <- if(num_outliers > 0) min(outliers) else NA
max_outlier <- if(num_outliers > 0) max(outliers) else NA
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)
)
library(kableExtra)
Tabla_outliers %>%
kable(caption = "Resumen de valores atípicos (outliers) en el año de recolección") %>%
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 | 1990 | 2022 |
La variable YEAR_COLL (año de recolección) presenta valores que fluctúan entre 1995 y 2017, con una concentración en torno a la mediana de 2011. La desviación estándar de aproximadamente 4 años indica que se trata de un conjunto relativamente homogéneo, con poca influencia de valores atípicos extremos. La acumulación de valores se encuentra en la parte central-alta de la variable, lo que evidencia que la mayoría de las recolecciones se realizaron en periodos recientes (década de 2010).