1 Carga de Datos y Librerías

library(dplyr)
library(stringr)
library(gt)

datos <- read.csv("~/Estudio/TERCER SEMESTRE/Estadistica/Dataset.csv",
                   sep = ";", stringsAsFactors = FALSE)

# Crear variable ordinal
df_fecha <- data.frame(
  anio = as.numeric(substr(trimws(as.character(datos$STAT_DATE)), 1, 4))
)
df_fecha <- df_fecha[df_fecha$anio >= 1990 & df_fecha$anio <= 2010, , drop = FALSE]

# Reclasificación ordinal en terciles balanceados
df_fecha$periodo <- case_when(
  df_fecha$anio >= 1990 & df_fecha$anio <= 2001 ~ "1990-2001",
  df_fecha$anio >= 2002 & df_fecha$anio <= 2004 ~ "2002-2004",
  df_fecha$anio >= 2005 & df_fecha$anio <= 2006 ~ "2005-2006",
  TRUE ~ NA_character_
)

# Orden lógico
orden_periodo <- c("1990-2001", "2002-2004", "2005-2006")

# Convertir a factor ordenado
df_fecha$periodo <- factor(
  df_fecha$periodo,
  levels = orden_periodo,
  ordered = TRUE
)

2 Tabla de Distribución de Probabilidad

ni <- table(df_fecha$periodo)
hi <- round(prop.table(ni), 4)
P  <- round(hi * 100, 2)

tabla_finalfecha <- data.frame(
  Periodo = names(ni),
  ni      = as.numeric(ni),
  hi      = as.numeric(hi),
  P       = as.numeric(P)
)

# Fila TOTAL
fila_total <- data.frame(
  Periodo = "TOTAL",
  ni      = sum(tabla_finalfecha$ni),
  hi      = round(sum(tabla_finalfecha$hi), 4),
  P       = round(sum(tabla_finalfecha$P), 2)
)

tabla_finalfecha <- rbind(
  tabla_finalfecha,
  fila_total
)

tabla_finalfecha

##     Periodo   ni     hi      P
## 1 1990-2001  890 0.3556  35.56
## 2 2002-2004  811 0.3240  32.40
## 3 2005-2006  802 0.3204  32.04
## 4     TOTAL 2503 1.0000 100.00

# Tabla gt
tabla_finalfecha %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla N°1**"),
    subtitle = md("Distribución ordinal del período de estatuto operativo")
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo 4 - Minas")
  ) %>%
  tab_options(
    table.border.top.color = "black",
    table.border.bottom.color = "black",
    heading.border.bottom.color = "black",
    heading.border.bottom.width = px(2),
    column_labels.border.top.color = "black",
    column_labels.border.bottom.color = "black",
    column_labels.border.bottom.width = px(2),
    table_body.hlines.color = "gray",
    table_body.border.bottom.color = "black",
    row.striping.include_table_body = TRUE
  ) %>%
  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_body(rows = Periodo == "TOTAL")
  )

Periodo	ni	hi	P
Tabla N°1
Distribución ordinal del período de estatuto operativo
1990-2001	890	0.3556	35.56
2002-2004	811	0.3240	32.40
2005-2006	802	0.3204	32.04
TOTAL	2503	1.0000	100.00
Autor: Grupo 4 - Minas

3 Tabla de Distribución de Probabilidad Agrupada

# Frecuencias acumuladas (tiene sentido en ordinal, por el orden lógico)
tabla_sin_total_agr <- tabla_finalfecha[tabla_finalfecha$Periodo != "TOTAL", ]

Ni <- cumsum(tabla_sin_total_agr$ni)
Hi <- round(cumsum(tabla_sin_total_agr$hi), 4)
Pi <- round(cumsum(tabla_sin_total_agr$P), 2)

tabla_agrupada <- data.frame(
  Periodo = tabla_sin_total_agr$Periodo,
  ni      = tabla_sin_total_agr$ni,
  hi      = tabla_sin_total_agr$hi,
  P       = tabla_sin_total_agr$P,
  Ni      = Ni,
  Hi      = Hi,
  Pi      = Pi
)

tabla_agrupada

##     Periodo  ni     hi     P   Ni     Hi     Pi
## 1 1990-2001 890 0.3556 35.56  890 0.3556  35.56
## 2 2002-2004 811 0.3240 32.40 1701 0.6796  67.96
## 3 2005-2006 802 0.3204 32.04 2503 1.0000 100.00

# Tabla agrupada gt
tabla_agrupada %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla N°2**"),
    subtitle = md("Distribución acumulada de probabilidad del período de estatuto operativo")
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo 4 - Minas")
  )

Periodo	ni	hi	P	Ni	Hi	Pi
Tabla N°2
Distribución acumulada de probabilidad del período de estatuto operativo
1990-2001	890	0.3556	35.56	890	0.3556	35.56
2002-2004	811	0.3240	32.40	1701	0.6796	67.96
2005-2006	802	0.3204	32.04	2503	1.0000	100.00
Autor: Grupo 4 - Minas

4 Gráficas de Distribución de Probabilidad

P_global <- tabla_finalfecha$P[
  tabla_finalfecha$Periodo != "TOTAL"
]

barplot(
  P_global,
  main = "Gráfica N°1: Distribución ordinal del período\nde estatuto operativo",
  xlab = "Periodo",
  ylab = "Probabilidad (%)",
  col = "blue",
  names.arg = tabla_finalfecha$Periodo[
    tabla_finalfecha$Periodo != "TOTAL"
  ],
  ylim = c(0, 100),
  las = 1
)

5 Conjetura del Modelo

Al dividir el periodo total en terciles balanceados (igual cantidad de registros por periodo), las frecuencias relativas resultan prácticamente equiprobables. Esto sugiere un modelo Uniforme Discreto, donde cada periodo tiene la misma probabilidad teórica de ocurrencia: P(X = periodo_i) = 1/k

# Tamaño muestral
n <- sum(
  tabla_finalfecha$ni[
    tabla_finalfecha$Periodo != "TOTAL"
  ]
)
n

## [1] 2503

# Frecuencias observadas
x <- tabla_finalfecha$ni[
  tabla_finalfecha$Periodo != "TOTAL"
]
x

## [1] 890 811 802

# Numero de categorias
K <- length(x)
K

## [1] 3

# Parametro del modelo uniforme discreto
p_uniforme <- 1 / K
p_uniforme

## [1] 0.3333333

# Modelo Uniforme Discreta
P_uniforme <- rep(p_uniforme, K)
P_uniforme

## [1] 0.3333333 0.3333333 0.3333333

# Frecuencias
Fo <- (x / n) * 100
Fo

## [1] 35.55733 32.40112 32.04155

Fe <- P_uniforme * 100
Fe

## [1] 33.33333 33.33333 33.33333

barplot(
  rbind(Fo, Fe),
  beside = TRUE,
  col = c("skyblue", "blue"),
  names.arg = tabla_finalfecha$Periodo[
    tabla_finalfecha$Periodo != "TOTAL"
  ],
  main = "Gráfica N°2: Comparación entre la realidad\ny el modelo uniforme discreto",
  ylab = "Probabilidad (%)",
  xlab = "Periodo",
  ylim = c(0, 100)
)
legend(
  "topright",
  legend = c("Real", "Modelo"),
  fill = c("skyblue", "blue")
)

6 Test de Aprobación

plot(
  Fo,
  Fe,
  xlim = c(0, max(Fo)),
  ylim = c(0, max(Fo)),
  main = "Gráfica N°3: Correlación de frecuencias",
  xlab = "Frecuencia observada (%)",
  ylab = "Frecuencia esperada (%)",
  pch = 19,
  col = "darkblue"
)
abline(
  a = 0,
  b = 1,
  col = "red",
  lwd = 2
)

gl <- K - 1
gl

## [1] 2

x2 <- sum((Fo - Fe)^2 / Fe)
x2

## [1] 0.2245168

vc <- qchisq(0.99, gl)
vc

## [1] 9.21034

x2 < vc

## [1] TRUE

Variable <- c("Periodo de estatuto operativo")

tabla_resumen <- data.frame(
  Variable,
  round(x2, 2),
  round(vc, 2)
)
colnames(tabla_resumen) <- c(
  "Variable",
  "Chi Cuadrado",
  "Umbral de aceptación"
)

library(knitr)
kable(
  tabla_resumen,
  format = "markdown",
  caption = "Tabla N°3: Resumen de bondad del modelo"
)

Tabla N°3: Resumen de bondad del modelo
Variable	Chi Cuadrado	Umbral de aceptación
Periodo de estatuto operativo	0.22	9.21

7 Cálculo de Probabilidades

# Eliminar fila TOTAL
tabla_sin_total <- tabla_finalfecha[
  tabla_finalfecha$Periodo != "TOTAL",
]

# Extraer probabilidad de la categoría 2005-2006
prob_reciente <- tabla_sin_total$P[
  tabla_sin_total$Periodo == "2005-2006"
]
prob_reciente

## [1] 32.04

# Gráfico explicativo
plot(
  1,
  type = "n",
  axes = FALSE,
  xlab = "",
  ylab = ""
)
text(
  x = 1,
  y = 1,
  labels = paste(
    "Cálculo de probabilidad\n(Estimación general)\n\n",
    "¿Qué probabilidad existe de que una instalación\n",
    "minera presente un estatuto operativo en el\n",
    "periodo 2005-2006?\n\n",
    "Probabilidad = ",
    prob_reciente,
    " (%)",
    sep = ""
  ),
  cex = 1.2,
  col = "black",
  font = 2
)

8 Conclusión

conclusion <- sprintf(
"La variable periodo de estatuto operativo se explica a través de un modelo Uniforme Discreto, aprobando el test de Chi-cuadrado. El valor calculado de %.4f es considerablemente menor al valor crítico de %.2f (alpha=0.01), por lo que se acepta la hipótesis de ajuste del modelo. Al dividir el rango temporal completo (1990-2006) en tres periodos balanceados con igual cantidad de registros, cada periodo presenta una probabilidad teórica equiprobable de %.2f%%, lo cual se confirma con las frecuencias observadas reales del dataset MSHA. Esto indica que, al segmentar el periodo de estatuto de forma equilibrada, no existe un periodo que concentre desproporcionadamente los registros frente a los demás. Por ejemplo, la probabilidad de que una instalación minera presente su estatuto operativo en el periodo 2005-2006 es del %.2f%%.",
x2, vc, p_uniforme*100, prob_reciente
)
print(conclusion)

## [1] "La variable periodo de estatuto operativo se explica a través de un modelo Uniforme Discreto, aprobando el test de Chi-cuadrado. El valor calculado de 0.2245 es considerablemente menor al valor crítico de 9.21 (alpha=0.01), por lo que se acepta la hipótesis de ajuste del modelo. Al dividir el rango temporal completo (1990-2006) en tres periodos balanceados con igual cantidad de registros, cada periodo presenta una probabilidad teórica equiprobable de 33.33%, lo cual se confirma con las frecuencias observadas reales del dataset MSHA. Esto indica que, al segmentar el periodo de estatuto de forma equilibrada, no existe un periodo que concentre desproporcionadamente los registros frente a los demás. Por ejemplo, la probabilidad de que una instalación minera presente su estatuto operativo en el periodo 2005-2006 es del 32.04%."

Período de Estatuto Operativo Inferencial Ordinal

Análisis de Correlación entre Actividad Minera y Emisiones de CO2, NOx y CH4

Grupo 4 - Minas

2026-07-05