1. CARGA DE LIBRERÍAS Y DATOS

# Librerías utilizadas para tablas, transformación y gráficas.
library(gt)
library(tidyr)
library(ggplot2)
library(knitr)
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
# Cargar el archivo de datos.
datos <- read.csv("dataset_geologico_limpio_80....csv",
                  header = TRUE, sep = ",", dec = ".",
                  stringsAsFactors = FALSE)

# Extraer el mes de recolección y conservar valores válidos de 1 a 12.
mes <- round(as.numeric(datos$MONTH_COLL))
mes <- na.omit(mes)
mes <- mes[mes >= 1 & mes <= 12]

cat("Número de observaciones:", length(mes), "\n")
## Número de observaciones: 27784
cat("Mes mínimo:", min(mes), "\n")
## Mes mínimo: 1
cat("Mes máximo:", max(mes), "\n")
## Mes máximo: 12

2. TABLA Y GRÁFICA DE DISTRIBUCIÓN DE FRECUENCIAS

MONTH_COLL identifica el mes calendario en el que fue recolectada cada muestra geológica. Como existen doce resultados posibles, puede evaluarse si las recolecciones se distribuyen uniformemente durante el año.

# Definir los meses en su orden calendario.
valores <- 1:12
categorias <- c("Enero", "Febrero", "Marzo", "Abril", "Mayo", "Junio",
                "Julio", "Agosto", "Septiembre", "Octubre", "Noviembre", "Diciembre")
ni <- table(factor(mes, levels = valores))

# Construir la distribución de frecuencias.
TDF <- data.frame(Mes = valores, Categoria = categorias,
                  ni = as.numeric(ni)) %>%
  mutate(hi = ni / sum(ni) * 100,
         Ni_asc = cumsum(ni), Ni_dsc = rev(cumsum(rev(ni))),
         Hi_asc = cumsum(hi), Hi_dsc = rev(cumsum(rev(hi))))

# Incorporar la fila total para comprobar ni y hi.
tabla <- TDF %>% mutate(Mes = as.character(Mes)) %>%
  rbind(data.frame(Mes = "TOTAL", Categoria = "", ni = sum(TDF$ni), hi = 100,
                   Ni_asc = NA, Ni_dsc = NA, Hi_asc = NA, Hi_dsc = NA))

tabla %>% gt() %>%
  tab_header(title = md("**Tabla N.° 1**"),
             subtitle = "Distribución mensual de las muestras recolectadas") %>%
  fmt_number(columns = c(hi, Hi_asc, Hi_dsc), decimals = 6) %>%
  sub_missing(columns = everything(), missing_text = "")
Tabla N.° 1
Distribución mensual de las muestras recolectadas
Mes Categoria ni hi Ni_asc Ni_dsc Hi_asc Hi_dsc
1 Enero 2340 8.422113 2340 27784 8.422113 100.000000
2 Febrero 2239 8.058595 4579 25444 16.480708 91.577887
3 Marzo 2288 8.234955 6867 23205 24.715664 83.519292
4 Abril 2262 8.141376 9129 20917 32.857040 75.284336
5 Mayo 2292 8.249352 11421 18655 41.106392 67.142960
6 Junio 2373 8.540887 13794 16363 49.647279 58.893608
7 Julio 2362 8.501296 16156 13990 58.148575 50.352721
8 Agosto 2449 8.814426 18605 11628 66.963000 41.851425
9 Septiembre 2357 8.483300 20962 9179 75.446300 33.037000
10 Octubre 2318 8.342931 23280 6822 83.789231 24.553700
11 Noviembre 2254 8.112583 25534 4504 91.901814 16.210769
12 Diciembre 2250 8.098186 27784 2250 100.000000 8.098186
TOTAL 27784 100.000000 



# Gráfica descriptiva con los meses en orden calendario.
par(mar = c(10, 5, 4, 2))
barplot(TDF$ni, names.arg = TDF$Categoria, col = "gray75", border = "gray30",
        main = "Gráfica N.° 1\nDistribución mensual de la recolección de muestras",
        xlab = "", ylab = "Frecuencia absoluta", las = 2, cex.names = 0.80)
mtext("Mes de recolección", side = 1, line = 7)

par(mar = c(5.1, 4.1, 4.1, 2.1))

3. CONJETURA DEL MODELO

# En una uniforme discreta de doce meses, cada mes tiene probabilidad 1/12.
N <- length(mes)
probabilidad <- 1 / 12
P_esperada <- rep(probabilidad, 12)
Fe <- N * P_esperada

# Construir la tabla observada-esperada.
comparativa <- TDF %>%
  mutate(Frecuencia_Esperada = Fe,
         Diferencia = ni - Frecuencia_Esperada,
         Error_Porcentual = abs(Diferencia) / Frecuencia_Esperada * 100)

comparativa %>% gt() %>%
  tab_header(title = md("**Tabla N.° 2**"),
             subtitle = "Frecuencias observadas y esperadas del modelo uniforme") %>%
  fmt_number(columns = c(Frecuencia_Esperada, Diferencia, Error_Porcentual), decimals = 6)
Tabla N.° 2
Frecuencias observadas y esperadas del modelo uniforme
Mes Categoria ni hi Ni_asc Ni_dsc Hi_asc Hi_dsc Frecuencia_Esperada Diferencia Error_Porcentual
1 Enero 2340 8.422113 2340 27784 8.422113 100.000000 2,315.333333 24.666667 1.065361
2 Febrero 2239 8.058595 4579 25444 16.480708 91.577887 2,315.333333 −76.333333 3.296862
3 Marzo 2288 8.234955 6867 23205 24.715664 83.519292 2,315.333333 −27.333333 1.180536
4 Abril 2262 8.141376 9129 20917 32.857040 75.284336 2,315.333333 −53.333333 2.303484
5 Mayo 2292 8.249352 11421 18655 41.106392 67.142960 2,315.333333 −23.333333 1.007774
6 Junio 2373 8.540887 13794 16363 49.647279 58.893608 2,315.333333 57.666667 2.490642
7 Julio 2362 8.501296 16156 13990 58.148575 50.352721 2,315.333333 46.666667 2.015549
8 Agosto 2449 8.814426 18605 11628 66.963000 41.851425 2,315.333333 133.666667 5.773107
9 Septiembre 2357 8.483300 20962 9179 75.446300 33.037000 2,315.333333 41.666667 1.799597
10 Octubre 2318 8.342931 23280 6822 83.789231 24.553700 2,315.333333 2.666667 0.115174
11 Noviembre 2254 8.112583 25534 4504 91.901814 16.210769 2,315.333333 −61.333333 2.649007
12 Diciembre 2250 8.098186 27784 2250 100.000000 8.098186 2,315.333333 −65.333333 2.821768
 
# Preparar la gráfica comparativa respetando el orden de los meses.
grafico <- comparativa %>% select(Categoria, ni, Frecuencia_Esperada) %>%
  pivot_longer(cols = c(ni, Frecuencia_Esperada),
               names_to = "Distribucion", values_to = "Frecuencia")
grafico$Categoria <- factor(grafico$Categoria, levels = categorias, ordered = TRUE)
grafico$Distribucion <- factor(grafico$Distribucion,
                               levels = c("ni", "Frecuencia_Esperada"))

ggplot(grafico, aes(Categoria, Frecuencia, fill = Distribucion)) +
  geom_col(position = "dodge") +
  scale_fill_manual(values = c("ni" = "darkred", "Frecuencia_Esperada" = "darkblue"),
                    labels = c("Observada", "Esperada")) +
  labs(title = "Gráfica N.° 2\nComparación entre frecuencias observadas y esperadas",
       subtitle = "Modelo uniforme discreto: P(X = mes) = 1/12",
       x = "Mes de recolección", y = "Frecuencia absoluta", fill = "Distribución") +
  theme_classic() +
  theme(axis.text.x = element_text(angle = 40, hjust = 1),
        legend.position = "bottom")

4. TEST DE APROBACIÓN

En este modelo no se calcula la correlación de Pearson entre las frecuencias, porque todas las frecuencias esperadas son iguales. Al no existir variación en el vector esperado, la correlación queda indefinida. La prueba apropiada es chi-cuadrado de bondad de ajuste.

# Calcular las frecuencias relativas observadas y esperadas en porcentaje.
Fo_uniforme <- TDF$hi
Fe_uniforme <- rep(100 / 12, 12)

# Construir la gráfica de comparación del modelo uniforme.
plot(
  Fo_uniforme,
  Fe_uniforme,
  xlim = c(0, max(Fo_uniforme) + 1),
  ylim = c(0, max(Fe_uniforme) + 2),
  main = "Gráfica N.° 3\nComparación de frecuencias en el modelo uniforme\ndel mes de recolección",
  xlab = "Frecuencia observada (%)",
  ylab = "Frecuencia esperada (%)",
  col = "blue3",
  pch = 19,
  cex = 1.25
)

# Dibujar la frecuencia teórica constante del modelo uniforme.
abline(
  h = 100 / 12,
  col = "red",
  lwd = 2,
  lty = 2
)

# Identificar cada punto con la abreviatura del mes correspondiente.
text(
  Fo_uniforme,
  Fe_uniforme,
  labels = substr(categorias, 1, 3),
  pos = 3,
  offset = 0.55,
  cex = 0.75,
  col = "gray20"
)

box(which = "outer", col = "black")

# Calcular chi-cuadrado para doce categorías y ningún parámetro estimado.
Chi2 <- sum((comparativa$ni - Fe)^2 / Fe)
gl <- length(valores) - 1
valor_critico <- qchisq(0.95, gl)
p_valor <- 1 - pchisq(Chi2, gl)

cat("Estadístico chi-cuadrado:", round(Chi2, 6), "\n")
## Estadístico chi-cuadrado: 18.88051
cat("Grados de libertad:", gl, "\n")
## Grados de libertad: 11
cat("Valor crítico:", round(valor_critico, 6), "\n")
## Valor crítico: 19.67514
cat("P-valor:", round(p_valor, 6), "\n")
## P-valor: 0.063272
if (p_valor > 0.05) {
  cat("No se rechaza H0: la distribución mensual es compatible con el modelo uniforme.\n")
} else {
  cat("Se rechaza H0: la distribución mensual no es uniforme.\n")
}
## No se rechaza H0: la distribución mensual es compatible con el modelo uniforme.

5. CÁLCULO DE PROBABILIDADES

5.1 PROBABILIDAD PUNTUAL

# Seleccionar junio como mes de referencia.
x <- 6
categoria_x <- categorias[x]
prob_puntual <- 1 / 12
cat("P(X =", categoria_x, ") =", round(prob_puntual, 6), "\n")
## P(X = Junio ) = 0.083333

5.2 PROBABILIDAD ACUMULADA

# Probabilidad de una recolección entre enero y junio.
prob_acumulada <- x / 12
cat("P(X <= Junio) =", round(prob_acumulada, 6), "\n")
## P(X <= Junio) = 0.5

5.3 PROBABILIDAD COMPLEMENTARIA

# Probabilidad de una recolección entre julio y diciembre.
prob_complementaria <- 1 - prob_acumulada
cat("P(X > Junio) =", round(prob_complementaria, 6), "\n")
## P(X > Junio) = 0.5

5.4 TABLA RESUMEN

tabla_probabilidades <- data.frame(
  Tipo = c("Puntual", "Acumulada", "Complementaria"),
  Evento = c("Recolección en junio", "Recolección entre enero y junio",
             "Recolección entre julio y diciembre"),
  Probabilidad = c(prob_puntual, prob_acumulada, prob_complementaria))
tabla_probabilidades %>% gt() %>% fmt_number(columns = Probabilidad, decimals = 6)
Tipo Evento Probabilidad
Puntual Recolección en junio 0.083333
Acumulada Recolección entre enero y junio 0.500000
Complementaria Recolección entre julio y diciembre 0.500000

6. INTERVALOS DE CONFIANZA

# Intervalo del 95 % para la proporción mensual de referencia.
proporcion_junio <- TDF$ni[x] / N
error <- sqrt(proporcion_junio * (1 - proporcion_junio) / N)
LI95 <- max(0, proporcion_junio - 1.96 * error)
LS95 <- min(1, proporcion_junio + 1.96 * error)
data.frame(Nivel = "95%", Limite_Inferior = LI95,
           Limite_Superior = LS95) %>%
  gt() %>% fmt_number(columns = 2:3, decimals = 6)
Nivel Limite_Inferior Limite_Superior
95% 0.082122 0.088695

7. CONCLUSIÓN

La variable mes de recolección (MONTH_COLL) se explica mediante un modelo uniforme discreto, con un límite inferior correspondiente a enero (1), un límite superior correspondiente a diciembre (12) y una probabilidad teórica de 8.33 % para cada mes.

De esta manera se calcularon probabilidades como, por ejemplo, que al seleccionar aleatoriamente una muestra geológica, la probabilidad de que haya sido recolectada en junio es de 8.33 %, mientras que la probabilidad de que haya sido recolectada entre enero y junio es de 50 %.

El intervalo de confianza del 95 % estima que la proporción poblacional de muestras recolectadas en junio se encuentra entre 8.21 % y 8.87 %. La prueba chi-cuadrado obtuvo un p-valor de 0.0633; al ser superior a 0.05, no se rechaza la hipótesis nula y la distribución mensual se considera compatible con el modelo uniforme discreto.