1 Configuración y Carga de Datos

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

2 Extraer y Preparar Variable

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)

3 Identificación del Modelo Probabilístico

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.

4 Parámetros del Modelo

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

5 Tabla de Frecuencias Observadas vs Esperadas

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

6 Prueba de Hipótesis — Estimación Puntual e Intervalo de Confianza para \(p\)

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\).

6.1 Planteamiento de Hipótesis

\[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\)

6.2 Estadístico de Prueba

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).

6.3 Tabla de Resultados de la Prueba

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

7 Intervalo de Confianza para la Proporción \(p\)

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

8 Representación Gráfica

8.1 Frecuencias Observadas vs Esperadas

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)

8.2 Probabilidades Observadas vs Teóricas

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)

8.3 Intervalo de Confianza al 95% (Agresti-Coull)

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)

9 Tabla de Indicadores Inferenciales

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

10 Conclusiones

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