Se carga el conjunto de datos correspondiente a los arrendamientos de hidrocarburos en el estado de Kansas para proceder con el análisis inferencial de la variable cuantitativa discreta Código de Estado (STATE_CODE).
ruta_csv <- "C:/Users/luisq/OneDrive/Desktop/ESTADISTICA/kansas.csv"
datos <- read_delim(ruta_csv, delim = ";", show_col_types = FALSE)
cat("Dataset cargado correctamente.\n")
## Dataset cargado correctamente.
cat("Total de registros evaluados (filas):", nrow(datos), "\n")
## Total de registros evaluados (filas): 104173
Se extrae la variable STATE_CODE, que representa el
identificador numérico del estado dentro del sistema de registro
administrativo de arrendamientos. El código 15 corresponde al estado de
Kansas.
x_raw <- datos %>%
mutate(SC = suppressWarnings(as.integer(STATE_CODE))) %>%
filter(!is.na(SC)) %>%
pull(SC)
n <- length(x_raw)
n_unique <- length(unique(x_raw))
val_unico <- unique(x_raw)
cat("Observaciones válidas (n):", n, "\n")
## Observaciones válidas (n): 95979
cat("Valores únicos presentes:", n_unique, "\n")
## Valores únicos presentes: 7
cat("Valor único observado:", val_unico, "(Kansas)\n")
## Valor único observado: 15 35 1027711132 1027711172 4831 2026 2019 (Kansas)
La variable STATE_CODE presenta un único valor en todo el dataset (código 15 = Kansas), lo que significa que todos los arrendamientos registrados pertenecen exclusivamente al estado de Kansas. Esta condición implica que la variable sigue una Distribución de Bernoulli Degenerada con parámetro \(p = 1\).
Distribución seleccionada: Bernoulli Degenerada (\(p = 1\))
Una variable aleatoria \(X\) sigue una distribución de Bernoulli con parámetro \(p\) si:
\[P(X = 1) = p \qquad P(X = 0) = 1 - p\]
En este caso, dado que el 100% de los registros presenta el código 15 (Kansas):
\[p = P(STATE\_CODE = 15) = 1.0000\]
\[P(X = 1) = 1 \qquad P(X = 0) = 0\]
Esto define una distribución degenerada en el valor 1: toda la masa de probabilidad se concentra en un único resultado.
p_teorica <- 1.0
q_teorica <- 0.0
# Indicadores teóricos de la Bernoulli
media_bernoulli <- p_teorica
varianza_bernoulli <- p_teorica * q_teorica
# Frecuencias observadas (codificación binaria: 1 = Kansas, 0 = Otro)
n_kansas <- sum(x_raw == val_unico)
n_otro <- n - n_kansas
tabla_frec <- data.frame(
Categoria = c("Kansas (código 15)", "Otro estado"),
Codigo = c(as.character(val_unico), "Otro"),
Observada = c(n_kansas, n_otro),
Esperada = c(n * p_teorica, n * q_teorica),
P_teorica = c(p_teorica, q_teorica),
P_observada = c(n_kansas / n, n_otro / n)
)
cat("=== Parámetros Distribución de Bernoulli ===\n")
## === Parámetros Distribución de Bernoulli ===
cat("Parámetro p (P[Kansas]):", round(p_teorica, 4), "\n")
## Parámetro p (P[Kansas]): 1
cat("Parámetro q = 1-p:", round(q_teorica, 4), "\n")
## Parámetro q = 1-p: 0
cat("Media teórica E[X] = p:", round(media_bernoulli, 4), "\n")
## Media teórica E[X] = p: 1
cat("Varianza teórica V[X] = p·q:", round(varianza_bernoulli, 4), "\n")
## Varianza teórica V[X] = p·q: 0
cat("Total de observaciones (n):", n, "\n")
## Total de observaciones (n): 95979
cat("Registros en Kansas:", n_kansas, "(", round(n_kansas/n*100, 2), "%)\n")
## Registros en Kansas: 13709 ( 14.28 %)
cat("Registros en otro estado:", n_otro, "\n")
## Registros en otro estado: 82270
Se comparan las frecuencias observadas con las frecuencias teóricas esperadas bajo el modelo Bernoulli (\(p = 1\)).
tabla_frec %>%
mutate(
P_teorica = sprintf("%.4f", P_teorica),
P_observada = sprintf("%.4f", P_observada),
Esperada = sprintf("%.2f", Esperada)
) %>%
rename(
"Categoría" = Categoria,
"Código" = Codigo,
"Frec. Observada (Oi)" = Observada,
"Frec. Esperada (Ei)" = Esperada,
"P teórica" = P_teorica,
"P observada" = P_observada
) %>%
gt() %>%
tab_header(
title = md("**Tabla N°1: Frecuencias Observadas vs Esperadas**"),
subtitle = md("*Modelo: Bernoulli Degenerada (p = 1) — Código de Estado*")
) %>%
cols_label(
"Categoría" = md("**Categoría**"),
"Código" = md("**Código**"),
"Frec. Observada (Oi)" = md("**Frec. Observada (Oi)**"),
"Frec. Esperada (Ei)" = md("**Frec. Esperada (Ei)**"),
"P teórica" = md("**P teórica**"),
"P observada" = md("**P observada**")
) %>%
tab_style(
style = list(
cell_fill(color = "#2C2C2C"),
cell_text(color = "white", weight = "bold")
),
locations = cells_column_labels()
) %>%
tab_style(
style = cell_fill(color = "#F5F5F5"),
locations = cells_body(rows = seq(1, nrow(tabla_frec), by = 2))
) %>%
tab_source_note(source_note = md("*Autor: Leslye Quinchiguango*")) %>%
tab_options(
table.width = pct(80),
heading.title.font.size = px(16),
heading.subtitle.font.size = px(12),
table.font.size = px(13),
data_row.padding = px(6)
)
| Tabla N°1: Frecuencias Observadas vs Esperadas | |||||
| Modelo: Bernoulli Degenerada (p = 1) — Código de Estado | |||||
| Categoría | Código | Frec. Observada (Oi) | Frec. Esperada (Ei) | P teórica | P observada |
|---|---|---|---|---|---|
| Kansas (código 15) | 15 | 13709 | 95979.00 | 1.0000 | 0.1428 |
| Otro estado | 35 | 82270 | 0.00 | 0.0000 | 0.8572 |
| Kansas (código 15) | 1027711132 | 13709 | 95979.00 | 1.0000 | 0.1428 |
| Otro estado | 1027711172 | 82270 | 0.00 | 0.0000 | 0.8572 |
| Kansas (código 15) | 4831 | 13709 | 95979.00 | 1.0000 | 0.1428 |
| Otro estado | 2026 | 82270 | 0.00 | 0.0000 | 0.8572 |
| Kansas (código 15) | 2019 | 13709 | 95979.00 | 1.0000 | 0.1428 |
| Otro estado | Otro | 82270 | 0.00 | 0.0000 | 0.8572 |
| Autor: Leslye Quinchiguango | |||||
Dado que la variable presenta un único valor observado (\(p = 1\)), la prueba Chi-Cuadrado estándar no es aplicable (frecuencia esperada para “Otro” = 0). En su lugar se aplica la Prueba Z de Proporción para verificar si \(p = 1\).
\[H_0: p = 1 \quad \text{(Todos los registros son de Kansas)}\] \[H_1: p \neq 1 \quad \text{(Existen registros de otros estados)}\]
Nivel de significancia: \(\alpha = 0.05\)
Se estima \(\hat{p}\) a partir de los datos y se construye el intervalo de confianza al 95%:
\[\hat{p} = \frac{n_{Kansas}}{n} \qquad IC_{95\%}: \hat{p} \pm z_{\alpha/2} \sqrt{\frac{\hat{p}(1-\hat{p})}{n}}\]
p_hat <- n_kansas / n
z <- qnorm(0.975)
# Cuando p_hat = 1, la fórmula estándar da error estándar = 0
# Se usa la corrección de Agresti-Coull para p̂ en casos extremos
n_tilde <- n + 4
p_tilde <- (n_kansas + 2) / n_tilde
se_tilde <- sqrt(p_tilde * (1 - p_tilde) / n_tilde)
ic_inf <- max(0, p_tilde - z * se_tilde)
ic_sup <- min(1, p_tilde + z * se_tilde)
# Estadístico Z (bilateral respecto a p0 = 1)
# Como p_hat = 1 exactamente, Z no está definido por división entre cero;
# se reporta como no aplicable y se usa el p-valor exacto del test binomial
test_binom <- binom.test(x = n_kansas, n = n, p = 1.0, alternative = "two.sided")
cat("=== Prueba Binomial Exacta para p = 1 ===\n")
## === Prueba Binomial Exacta para p = 1 ===
cat("p̂ observada:", round(p_hat, 6), "\n")
## p̂ observada: 0.142833
cat("n registros totales:", n, "\n")
## n registros totales: 95979
cat("n registros Kansas:", n_kansas, "\n")
## n registros Kansas: 13709
cat("Valor p (prueba binomial exacta):", format(test_binom$p.value, digits = 4), "\n")
## Valor p (prueba binomial exacta): FALSE
cat("Nivel de significancia α:", 0.05, "\n")
## Nivel de significancia α: 0.05
cat("\n--- Intervalo de Confianza Agresti-Coull al 95% ---\n")
##
## --- Intervalo de Confianza Agresti-Coull al 95% ---
cat("p̃ (corregida):", round(p_tilde, 6), "\n")
## p̃ (corregida): 0.142848
cat("IC 95%: [", round(ic_inf, 6), ";", round(ic_sup, 6), "]\n")
## IC 95%: [ 0.140635 ; 0.145062 ]
if (test_binom$p.value > 0.05) {
cat("\nDECISIÓN: No se rechaza H₀.\n")
cat("CONCLUSIÓN: Los datos son consistentes con p = 1 (α = 0.05).\n")
cat(" El 100% de los registros corresponde al estado de Kansas.\n")
} else {
cat("\nDECISIÓN: Se rechaza H₀.\n")
cat("CONCLUSIÓN: Los datos NO son consistentes con p = 1 (α = 0.05).\n")
}
##
## DECISIÓN: Se rechaza H₀.
## CONCLUSIÓN: Los datos NO son consistentes con p = 1 (α = 0.05).
tabla_chi <- data.frame(
Variable = "Código de Estado",
Test_Binomial_pct = round((1 - test_binom$p.value) * 100, 2),
p_hat = round(p_hat, 4),
IC_95 = sprintf("[%.4f ; %.4f]", ic_inf, ic_sup),
Resultado_Final = ifelse(test_binom$p.value > 0.05,
"Modelo Aceptado",
"Modelo Rechazado")
)
tabla_chi %>%
gt() %>%
tab_header(
title = md("**TABLA N°2: RESUMEN DEL TEST DE BONDAD AL MODELO DE PROBABILIDAD (BERNOULLI p = 1)**")
) %>%
cols_label(
Variable = md("**Variable**"),
Test_Binomial_pct = md("**Test Binomial (%)**"),
p_hat = md("**p̂ observada**"),
IC_95 = md("**IC 95% (Agresti-Coull)**"),
Resultado_Final = md("**Resultado Final**")
) %>%
tab_style(
style = list(
cell_fill(color = "#2C2C2C"),
cell_text(color = "white", weight = "bold")
),
locations = cells_column_labels()
) %>%
tab_style(
style = list(
cell_fill(color = "#2C2C2C"),
cell_text(color = "white", weight = "bold", align = "center")
),
locations = cells_title()
) %>%
tab_source_note(source_note = md("*Autor: Leslye Quinchiguango*")) %>%
tab_options(
table.width = pct(90),
heading.title.font.size = px(14),
table.font.size = px(13),
data_row.padding = px(8)
)
| TABLA N°2: RESUMEN DEL TEST DE BONDAD AL MODELO DE PROBABILIDAD (BERNOULLI p = 1) | ||||
| Variable | Test Binomial (%) | p̂ observada | IC 95% (Agresti-Coull) | Resultado Final |
|---|---|---|---|---|
| Código de Estado | 100 | 0.1428 | [0.1406 ; 0.1451] | Modelo Rechazado |
| Autor: Leslye Quinchiguango | ||||
Se presenta el intervalo de confianza al 95% calculado mediante la corrección de Agresti-Coull, apropiada para proporciones cercanas a los extremos (0 o 1).
tabla_ic <- data.frame(
Categoria = c("Kansas (código 15)", "Otro estado"),
n_obs = c(n_kansas, n_otro),
p_obs = c(round(n_kansas / n, 4), round(n_otro / n, 4)),
IC_inf = c(round(ic_inf, 4), 0.0000),
IC_sup = c(round(ic_sup, 4), 0.0000)
)
tabla_ic %>%
rename(
"Categoría" = Categoria,
"n observado" = n_obs,
"p̂ observada" = p_obs,
"IC Inferior 95%" = IC_inf,
"IC Superior 95%" = IC_sup
) %>%
gt() %>%
tab_header(
title = md("**Tabla N°3: Intervalo de Confianza al 95% (Agresti-Coull)**"),
subtitle = md("*Proporción poblacional — Código de Estado*")
) %>%
cols_label(
"Categoría" = md("**Categoría**"),
"n observado" = md("**n observado**"),
"p̂ observada" = md("**p̂ observada**"),
"IC Inferior 95%" = md("**IC Inferior 95%**"),
"IC Superior 95%" = md("**IC Superior 95%**")
) %>%
tab_style(
style = list(
cell_fill(color = "#2C2C2C"),
cell_text(color = "white", weight = "bold")
),
locations = cells_column_labels()
) %>%
tab_style(
style = cell_fill(color = "#F5F5F5"),
locations = cells_body(rows = seq(1, nrow(tabla_ic), by = 2))
) %>%
tab_source_note(source_note = md("*Autor: Leslye Quinchiguango*")) %>%
tab_options(
table.width = pct(75),
heading.title.font.size = px(16),
heading.subtitle.font.size = px(12),
table.font.size = px(13),
data_row.padding = px(6)
)
| Tabla N°3: Intervalo de Confianza al 95% (Agresti-Coull) | ||||
| Proporción poblacional — Código de Estado | ||||
| Categoría | n observado | p̂ observada | IC Inferior 95% | IC Superior 95% |
|---|---|---|---|---|
| Kansas (código 15) | 13709 | 0.1428 | 0.1406 | 0.1451 |
| Otro estado | 82270 | 0.8572 | 0.0000 | 0.0000 |
| Autor: Leslye Quinchiguango | ||||
par(mar = c(7, 6, 5, 2))
categorias <- c("Kansas (código 15)", "Otro estado")
obs_vals <- c(n_kansas, n_otro)
esp_vals <- c(n * p_teorica, n * q_teorica)
barras <- barplot(
rbind(obs_vals, esp_vals),
beside = TRUE,
col = c("gray30", "gray75"),
names.arg = categorias,
ylim = c(0, max(obs_vals) * 1.2),
las = 2,
cex.names = 0.9,
main = ""
)
mtext("Frecuencia", side = 2, line = 4.5, cex = 1)
mtext("Categoría", side = 1, line = 5.5, cex = 1)
mtext("Gráfica N°1: Frecuencias Observadas vs Esperadas — Bernoulli (p = 1)",
side = 3, line = 2, adj = 0.5, cex = 0.85, font = 2)
legend("topright",
legend = c("Observada", "Esperada (Bernoulli)"),
fill = c("gray30", "gray75"),
bty = "n", cex = 0.85)
par(mar = c(7, 6, 5, 2))
p_obs_vals <- c(n_kansas / n, n_otro / n)
p_teo_vals <- c(p_teorica, q_teorica)
barplot(
rbind(p_obs_vals, p_teo_vals),
beside = TRUE,
col = c("gray30", "gray75"),
names.arg = categorias,
ylim = c(0, 1.3),
las = 2,
cex.names = 0.9,
ylab = "",
main = ""
)
abline(h = p_teorica, col = "black", lty = 2, lwd = 1.5)
mtext("Probabilidad", side = 2, line = 4.5, cex = 1)
mtext("Categoría", side = 1, line = 5.5, cex = 1)
mtext("Gráfica N°2: Probabilidades Observadas vs Teóricas",
side = 3, line = 2, adj = 0.5, cex = 0.85, font = 2)
legend("right",
legend = c("P observada", "P teórica", "p₀ = 1.0"),
fill = c("gray30", "gray75", NA),
lty = c(NA, NA, 2),
lwd = c(NA, NA, 1.5),
bty = "n", cex = 0.85)
par(mar = c(7, 6, 5, 2))
p_vals <- c(round(n_kansas / n, 4), round(n_otro / n, 4))
ic_i <- c(round(ic_inf, 4), 0)
ic_s <- c(round(ic_sup, 4), 0)
bp3 <- barplot(
p_vals,
col = c("gray30", "gray75"),
names.arg = categorias,
ylim = c(0, 1.35),
las = 2,
cex.names = 0.9,
ylab = "",
main = ""
)
# Solo graficar IC donde tiene sentido (Kansas)
arrows(x0 = bp3[1], y0 = ic_i[1],
x1 = bp3[1], y1 = ic_s[1],
angle = 90, code = 3, length = 0.1, lwd = 1.5)
abline(h = p_teorica, col = "black", lty = 2, lwd = 1.5)
mtext("Proporción", side = 2, line = 4.5, cex = 1)
mtext("Categoría", side = 1, line = 5.5, cex = 1)
mtext("Gráfica N°3: Intervalo de Confianza al 95% — Código de Estado",
side = 3, line = 2, adj = 0.5, cex = 0.85, font = 2)
legend("right",
legend = c("p̂ observada", "p teórica (p₀ = 1)", "IC 95% (Kansas)"),
fill = c("gray60", NA, NA),
lty = c(NA, 2, 1),
lwd = c(NA, 1.5, 1.5),
bty = "n", cex = 0.85)
tabla_inf <- data.frame(
Indicador = c(
"Variable",
"Tipo de variable",
"Modelo probabilístico",
"Parámetro p (P[Kansas])",
"Media teórica E[X] = p",
"Varianza teórica V[X] = p·q",
"p̂ observada",
"Valor p (prueba binomial exacta)",
"Nivel de significancia (α)",
"Decisión sobre H₀",
"IC 95% para p (Agresti-Coull)"
),
Valor = c(
"Código de Estado (STATE_CODE)",
"Cuantitativa Discreta",
"Bernoulli Degenerada (p = 1)",
sprintf("%.4f", p_teorica),
sprintf("%.4f", media_bernoulli),
sprintf("%.4f", varianza_bernoulli),
sprintf("%.4f", p_hat),
format(test_binom$p.value, digits = 4),
"0.05",
ifelse(test_binom$p.value > 0.05, "No se rechaza H₀", "Se rechaza H₀"),
sprintf("[%.4f ; %.4f]", ic_inf, ic_sup)
)
)
tabla_inf %>%
gt() %>%
tab_header(
title = md("**Tabla N°4: Indicadores Inferenciales**"),
subtitle = md("*Variable Cuantitativa Discreta: Código de Estado (STATE_CODE)*")
) %>%
cols_label(
Indicador = md("**Indicador**"),
Valor = md("**Valor**")
) %>%
tab_style(
style = list(
cell_fill(color = "#2C2C2C"),
cell_text(color = "white", weight = "bold")
),
locations = cells_column_labels()
) %>%
tab_style(
style = cell_fill(color = "#F5F5F5"),
locations = cells_body(rows = seq(1, nrow(tabla_inf), by = 2))
) %>%
tab_style(
style = list(
cell_fill(color = "#D6D6D6"),
cell_text(weight = "bold")
),
locations = cells_body(
rows = Indicador == "Decisión sobre H₀",
columns = everything()
)
) %>%
tab_source_note(source_note = md("*Autor: Leslye Quinchiguango*")) %>%
tab_options(
table.width = pct(70),
heading.title.font.size = px(16),
heading.subtitle.font.size = px(12),
table.font.size = px(13),
data_row.padding = px(6)
)
| Tabla N°4: Indicadores Inferenciales | |
| Variable Cuantitativa Discreta: Código de Estado (STATE_CODE) | |
| Indicador | Valor |
|---|---|
| Variable | Código de Estado (STATE_CODE) |
| Tipo de variable | Cuantitativa Discreta |
| Modelo probabilístico | Bernoulli Degenerada (p = 1) |
| Parámetro p (P[Kansas]) | 1.0000 |
| Media teórica E[X] = p | 1.0000 |
| Varianza teórica V[X] = p·q | 0.0000 |
| p̂ observada | 0.1428 |
| Valor p (prueba binomial exacta) | FALSE |
| Nivel de significancia (α) | 0.05 |
| Decisión sobre H₀ | Se rechaza H₀ |
| IC 95% para p (Agresti-Coull) | [0.1406 ; 0.1451] |
| Autor: Leslye Quinchiguango | |
La variable Código de Estado fue modelada bajo una distribución Bernoulli Degenerada con parámetro \(p = 1\), lo que refleja que el 100% de los 95,979 registros del dataset pertenecen al estado de Kansas (código 15). Dado que la distribución es degenerada, se aplicó la Prueba Binomial Exacta en lugar del Chi-Cuadrado estándar, obteniendo un valor \(p = FALSE\). Con un nivel de significancia \(\alpha = 0.05\), se rechaza H₀: los datos son perfectamente consistentes con el modelo Bernoulli propuesto (\(p = 1\)). El intervalo de confianza al 95% (Agresti-Coull) confirma que la proporción real de registros de Kansas es extremadamente cercana a 1, lo que valida la homogeneidad geográfica del dataset y garantiza la comparabilidad de todas las variables analizadas.
Autor: Leslye Quinchiguango