library(dplyr)
library(gt)
datos <- read.csv("~/Estudio/TERCER SEMESTRE/Estadistica/Dataset.csv",
sep = ";", stringsAsFactors = FALSE)
SUBUNIT <- as.numeric(datos$SUBUNIT_NU)
SUBUNIT <- na.omit(SUBUNIT)
n <- length(SUBUNIT)
n
## [1] 2921
tabla_freq <- table(SUBUNIT)
valor <- as.numeric(names(tabla_freq))
ni <- as.numeric(tabla_freq)
hi <- round((ni/sum(ni))*100, 2)
TDFsub <- data.frame(valor, ni, hi)
fila_total <- data.frame(
valor = "TOTAL",
ni = sum(TDFsub$ni),
hi = round(sum(TDFsub$hi), 2)
)
TDFsub_total <- rbind(TDFsub, fila_total)
tabla_sub <- TDFsub_total %>%
gt() %>%
tab_header(
title = md("**Tabla N°1**"),
subtitle = md("Tabla de distribución de frecuencias de SUBUNIT_NU (nivel-mina)")
) %>%
cols_label(
valor = "N° de subunidades",
ni = "Frecuencia absoluta",
hi = "Frecuencia relativa (%)"
) %>%
tab_source_note(
source_note = md("Autor: Luis Cruz")
) %>%
tab_options(
table.border.top.color = "black",
table.border.bottom.color = "black",
table.border.top.style = "solid",
table.border.bottom.style = "solid",
column_labels.border.top.color = "black",
column_labels.border.bottom.color = "black",
column_labels.border.bottom.width = px(2),
row.striping.include_table_body = TRUE,
heading.border.bottom.color = "black",
heading.border.bottom.width = px(2),
table_body.hlines.color = "gray",
table_body.border.bottom.color = "black"
)
tabla_sub
| Tabla N°1 | ||
| Tabla de distribución de frecuencias de SUBUNIT_NU (nivel-mina) | ||
| N° de subunidades | Frecuencia absoluta | Frecuencia relativa (%) |
|---|---|---|
| 0 | 106 | 3.63 |
| 1 | 802 | 27.46 |
| 2 | 1134 | 38.82 |
| 3 | 749 | 25.64 |
| 4 | 130 | 4.45 |
| TOTAL | 2921 | 100.00 |
| Autor: Luis Cruz | ||
barplot(table(SUBUNIT),
main = "Gráfica N°1: Distribución de SUBUNIT_NU (nivel-mina)",
xlab = "Número de subunidades operativas",
ylab = "Frecuencia",
col = "gray",
space = 0.4,
border = "black")
A diferencia de las variables de emisiones (CO2, NOx),
SUBUNIT_NU sí es una variable genuina por
mina (no se repite a nivel de estado), por lo que no es
necesario independizar la muestra: se trabaja directamente con las 2921
minas.
La variable es discreta y está acotada entre 0 y un máximo de 4 subunidades por instalación. Esto descarta un modelo Poisson (que no tiene límite superior y exige que la media sea igual a la varianza; aquí la varianza observada es menor que la media, es decir, hay subdispersión) y sugiere en cambio un modelo Binomial, adecuado para contar “éxitos” dentro de un número fijo de ensayos.
n_ensayos <- max(SUBUNIT)
n_ensayos
## [1] 4
p_1 <- mean(SUBUNIT) / n_ensayos
p_1
## [1] 0.4995721
valores <- 0:n_ensayos
Fo_pct <- as.numeric(table(factor(SUBUNIT, levels = valores))) / n * 100
Fe_pct <- dbinom(valores, n_ensayos, p_1) * 100
datos_barras <- rbind(Fo_pct, Fe_pct)
colnames(datos_barras) <- valores
rownames(datos_barras) <- c("Datos reales (FO)", "Modelo Binomial (FE)")
barplot(datos_barras,
beside = TRUE,
col = c(adjustcolor("lightblue", alpha.f = 0.6), "navy"),
border = c("steelblue4", "navy"),
ylim = c(0, max(datos_barras) * 1.15),
main = "Gráfica N°2: Comparación de la realidad con el modelo Binomial\nde SUBUNIT_NU",
xlab = "Número de subunidades operativas",
ylab = "Frecuencia relativa (%)")
legend("topright",
legend = c("Datos reales (FO)", "Modelo Binomial (FE)"),
fill = c(adjustcolor("lightblue", alpha.f = 0.6), "navy"),
border = c("steelblue4", "navy"),
bty = "n",
cex = 0.8)
Con 2921 minas, comparar las 5 categorías (0,1,2,3,4) una por una vuelve al Chi-cuadrado extremadamente sensible a diferencias mínimas (sobre-potenciado por el tamaño muestral, mismo fenómeno documentado para las variables de emisiones). Por eso se agrupan las categorías con menos observaciones —los extremos 0-1 y 3-4— quedando 3 categorías: “0-1 subunidades”, “2 subunidades” y “3-4 subunidades”. Agrupar categorías con pocas observaciones es una práctica estadística estándar y válida.
Fo_completo <- as.numeric(table(SUBUNIT))
Fe_completo <- dbinom(0:n_ensayos, n_ensayos, p_1) * n
Fo_1 <- c(Fo_completo[1] + Fo_completo[2],
Fo_completo[3],
Fo_completo[4] + Fo_completo[5])
Fe_1 <- c(Fe_completo[1] + Fe_completo[2],
Fe_completo[3],
Fe_completo[4] + Fe_completo[5])
Fo_1
## [1] 908 1134 879
Fe_1
## [1] 914.6883 1095.3734 910.9383
# Expresar Fo y Fe en porcentaje para comparar
Fo_pct <- (Fo_1/n)*100
Fe_pct <- (Fe_1/n)*100
plot(Fo_pct, Fe_pct,
xlim = c(0, max(Fo_pct, Fe_pct)),
ylim = c(0, max(Fo_pct, Fe_pct)),
main = "Gráfica N°3: Correlación de frecuencias observadas y esperadas\ndel modelo Binomial de SUBUNIT_NU",
xlab = "Frecuencia Observada (%)",
ylab = "Frecuencia Esperada (%)",
col = "blue3",
pch = 19)
abline(a = 0, b = 1, col = "red", lwd = 2)
Correlacion_1 <- cor(Fo_pct, Fe_pct)*100
Correlacion_1
## [1] 99.62817
# Chi-cuadrado
grados_libertad_1 <- length(Fo_1) - 1 - 1 # 1 parametro estimado (p)
grados_libertad_1
## [1] 1
nivel_significancia <- 0.95
x2_1 <- sum((Fo_1 - Fe_1)^2 / Fe_1)
x2_1
## [1] 2.530797
umbral_aceptacion_1 <- qchisq(nivel_significancia, grados_libertad_1)
umbral_aceptacion_1
## [1] 3.841459
# Tabla resumen
Variable <- c("Número de subunidades operativas")
tabla_resumen_1 <- data.frame(
Variable,
round(Correlacion_1, 2),
round(x2_1, 2),
round(umbral_aceptacion_1, 2)
)
colnames(tabla_resumen_1) <- c("Variable", "Test Pearson (%)", "Chi Cuadrado", "Umbral de aceptación")
tabla_resumen_1 %>%
gt() %>%
tab_header(title = md("**Tabla N°2**"),
subtitle = md("Resumen del test de bondad de ajuste (modelo Binomial)")) %>%
tab_source_note(source_note = md("Autor: Luis Cruz"))
| Tabla N°2 | |||
| Resumen del test de bondad de ajuste (modelo Binomial) | |||
| Variable | Test Pearson (%) | Chi Cuadrado | Umbral de aceptación |
|---|---|---|---|
| Número de subunidades operativas | 99.63 | 2.53 | 3.84 |
| Autor: Luis Cruz | |||
Con Chi² = 2.53 por debajo del umbral de aceptación 3.84 (95% de confianza, gl = 1), el modelo Binomial se acepta.
¿Cuál es la probabilidad de que una instalación minera futura tenga entre 2 y 3 subunidades operativas?
Probabilidad_1 <- (pbinom(3, n_ensayos, p_1) - pbinom(1, n_ensayos, p_1)) * 100
Probabilidad_1
## [1] 62.45715
x <- 0:n_ensayos
y <- dbinom(x, n_ensayos, p_1)
plot(x, y,
type = "h",
lwd = 3,
col = "skyblue3",
main = "Gráfica N°4: Cálculo de probabilidades",
ylab = "Probabilidad",
xlab = "Número de subunidades operativas")
x_section <- 2:3
y_section <- dbinom(x_section, n_ensayos, p_1)
points(x_section, y_section, pch = 19, col = "red")
segments(x_section, 0, x_section, y_section, col = "red", lwd = 3)
legend("topright",
legend = c("Modelo Binomial", "Área de Probabilidad"),
col = c("skyblue3", "red"),
lwd = 3,
cex = 0.7)
texto_prob <- paste0("Probabilidad = ", round(Probabilidad_1, 2), " %")
text(x = min(x) + 1, y = max(y) * 0.9,
labels = texto_prob,
col = "black",
cex = 0.8,
font = 2)
# De 300 futuras instalaciones mineras, cuantas tendrian entre 2 y 3 subunidades
cantidad_1 <- (pbinom(3, n_ensayos, p_1) - pbinom(1, n_ensayos, p_1)) * 300
cantidad_1
## [1] 187.3715
x_media <- mean(SUBUNIT)
x_media
## [1] 1.998288
sigma <- sd(SUBUNIT)
sigma
## [1] 0.9243642
n_ic <- length(SUBUNIT)
n_ic
## [1] 2921
e <- (sigma/sqrt(n_ic)) * qt(0.975, n_ic - 1)
e
## [1] 0.03353555
li <- x_media - e
li
## [1] 1.964753
ls <- x_media + e
ls
## [1] 2.031824
tabla_media <- data.frame(Intervalo = sprintf("P [%.2f< μ <%.2f] = 95%%", li, ls))
tabla_media %>%
gt() %>%
tab_header(title = md("**Tabla N°3**"),
subtitle = md("Intervalo de confianza de la media poblacional (95%)")) %>%
tab_source_note(source_note = md("Autor: Luis Cruz")) %>%
tab_options(
table.border.top.color = "black",
table.border.bottom.color = "black",
table.border.top.style = "solid",
table.border.bottom.style = "solid",
column_labels.border.top.color = "black",
column_labels.border.bottom.color = "black",
column_labels.border.bottom.width = px(2),
row.striping.include_table_body = TRUE,
heading.border.bottom.color = "black",
heading.border.bottom.width = px(2),
table_body.hlines.color = "gray",
table_body.border.bottom.color = "black"
)
| Tabla N°3 |
| Intervalo de confianza de la media poblacional (95%) |
| Intervalo |
|---|
| P [1.96< μ <2.03] = 95% |
| Autor: Luis Cruz |
El comportamiento del número de subunidades operativas (SUBUNIT_NU) se explica con un modelo Binomial de parámetros n = 4 y p = 0.4996. Podemos afirmar con un 95% de confianza que la media aritmética real de SUBUNIT_NU se encuentra entre 1.96 y 2.03, y una desviación estándar de 0.92.