suppressMessages(suppressWarnings({
library(readr)
library(dplyr)
library(gt)
}))
cat("Librerías cargadas correctamente.\n")
## Librerías cargadas correctamente.
ruta_csv <- file.choose()
datos <- read_csv(ruta_csv, show_col_types = FALSE)
cat("Archivo:", basename(ruta_csv), "| Filas:", nrow(datos), "\n")
## Archivo: oil_and_gas_leases_data.csv.csv | Filas: 47757
Es una variable cualitativa nominal: sus categorías (Sí produce / No produce) no tienen ningún orden natural entre sí. Se les asigna un código arbitrario (0/1) únicamente para poder calcular el modelo, no porque exista jerarquía entre ellas.
niveles_orden <- c("0", "1")
niveles_es <- c("No produce", "Sí produce") # etiquetas en español para mostrar
x_raw <- datos %>%
mutate(ESTADO = factor(as.character(PRODUCES_GAS), levels = niveles_orden)) %>%
filter(!is.na(ESTADO)) %>%
pull(ESTADO)
n_conteo <- length(x_raw)
k_niveles <- length(niveles_orden)
cat("Observaciones válidas:", n_conteo, "\n")
## Observaciones válidas: 47757
cat("Categorías (sin orden):", k_niveles, "\n")
## Categorías (sin orden): 2
cat("Niveles:", paste(niveles_es, collapse = " / "), "\n")
## Niveles: No produce / Sí produce
x <- x_raw
n <- length(x)
freq_abs <- as.integer(table(x))
hi_dec <- freq_abs / n
prob_pct <- round(hi_dec * 100, 2)
asignacion <- seq_along(niveles_orden) - 1 # 0 y 1
data.frame(Categoria = niveles_es, Asignacion = asignacion,
ni = freq_abs, hi = round(hi_dec, 4), Probabilidad = prob_pct,
stringsAsFactors = FALSE) %>%
gt() %>%
tab_header(title = md("**Tabla N\u00b0 1: Distribuci\u00f3n de Frecuencias de Produce Petr\u00f3leo**")) %>%
cols_label(Categoria = md("**Produce Gas**"), Asignacion = md("**Valor asignado**"),
ni = md("**Frecuencia absoluta (ni)**"), hi = md("**Frecuencia relativa (hi)**"),
Probabilidad = md("**Probabilidad (%)**")) %>%
tab_style(style = cell_borders(sides = "bottom", color = "#333333", weight = px(2)),
locations = cells_column_labels()) %>%
tab_style(style = cell_borders(sides = "bottom", color = "#eeeeee", weight = px(1)),
locations = cells_body(rows = everything())) %>%
tab_style(style = cell_text(color = "#555555"),
locations = cells_body(columns = Asignacion)) %>%
cols_align(align = "center", columns = c(Asignacion, ni, hi, Probabilidad)) %>%
cols_align(align = "left", columns = Categoria) %>%
tab_source_note(source_note = md("*Autor: Fernando Almeida*")) %>%
tab_options(table.width = pct(100), table.font.size = px(13), data_row.padding = px(9),
table.border.top.style = "hidden", table.border.bottom.style = "hidden",
column_labels.border.top.style = "hidden")
| Tabla N° 1: Distribución de Frecuencias de Produce Petróleo | ||||
| Produce Gas | Valor asignado | Frecuencia absoluta (ni) | Frecuencia relativa (hi) | Probabilidad (%) |
|---|---|---|---|---|
| No produce | 0 | 32640 | 0.6835 | 68.35 |
| Sí produce | 1 | 15117 | 0.3165 | 31.65 |
| Autor: Fernando Almeida | ||||
grises <- gray(seq(0.30, 0.75, length.out = k_niveles))
par(mar = c(5, 6, 6, 2))
bp <- barplot(prob_pct, names.arg = niveles_es, col = grises, border = "black",
las = 1, ylim = c(0, max(prob_pct) * 1.2), ylab = "", xlab = "")
mtext("Probabilidad (%)", side = 2, line = 4.2, cex = 1)
mtext("Produce Gas", side = 1, line = 3, cex = 1)
mtext("Distribución de Produce Gas", side = 3, line = 1.5, cex = 1, font = 2)
text(bp, prob_pct, labels = paste0(round(prob_pct, 2), "%"), pos = 3, cex = 0.9)
Basado en el gráfico se conjetura un modelo Uniforme (Bernoulli, p=0.5): si la variable fuera puramente al azar, se esperaría una división 50/50 entre “Sí produce” y “No produce”. El gráfico muestra que la barra de “Sí produce” es notablemente más alta, lo que sugiere que la variable no se reparte al azar.
cat("p teórico (Uniforme/Bernoulli, 0.5):", 0.5, "\n")
## p teórico (Uniforme/Bernoulli, 0.5): 0.5
data.frame(Categoria = niveles_es,
p_H0 = round(p_uniforme, 4),
p_observada = round(hi_dec, 4))
## Categoria p_H0 p_observada
## 0 No produce 0.5 0.6835
## 1 Sí produce 0.5 0.3165
comparacion <- rbind(Observado = prob_pct, `Modelo Uniforme` = p_uniforme_pct)
par(mar = c(5, 6, 6, 2))
bp2 <- barplot(comparacion, beside = TRUE,
col = c(gray(0.35), gray(0.75)),
border = "black", las = 1,
names.arg = niveles_es,
ylim = c(0, max(comparacion) * 1.25),
ylab = "", xlab = "")
mtext("Probabilidad (%)", side = 2, line = 4.2, cex = 1)
mtext("Produce Gas", side = 1, line = 3, cex = 1)
mtext("Frecuencia Observada en función del Modelo Uniforme Teórico (p=0.5)", side = 3, line = 1.5, cex = 1, font = 2)
text(bp2, comparacion, labels = paste0(round(comparacion, 1), "%"), pos = 3, cex = 0.8)
legend("topright", legend = c("Observado", "Modelo Uniforme (p=0.5)"),
fill = c(gray(0.35), gray(0.75)), bty = "n", cex = 0.9)
Nota: en el segundo gráfico, barras grises oscuras = frecuencia real observada; barras grises claras = probabilidad teórica del modelo Uniforme (50/50). Entre más distintas las alturas de cada par, más evidencia de que la variable no se reparte al azar.
Se valida el modelo con dos criterios: la correlación de Pearson entre las frecuencias observadas y las teóricas, y una prueba Chi-Cuadrado de Bondad de Ajuste.
La prueba Chi-Cuadrado se calcula sobre el tamaño muestral completo (n = 47757), ya que aquí precisamente se espera que el test detecte la desviación real frente al 50/50 teórico; no hay riesgo de “sobre-rechazar” un modelo que ya se conjetura desbalanceado.
# Correlación de Pearson entre hi observado y p teórico (modelo Uniforme p=0.5).
pearson_r <- cor(cumsum(hi_dec), cumsum(p_uniforme)) * 100
prueba_chi <- chisq.test(x = freq_abs, p = p_uniforme)
chi_stat <- unname(prueba_chi$statistic)
chi_gl <- unname(prueba_chi$parameter)
chi_pval <- prueba_chi$p.value
val_pearson <- ifelse(pearson_r > 70, "APROBADO", "RECHAZADO")
val_chi <- ifelse(chi_pval > 0.05, "APROBADO", "RECHAZADO")
bind_rows(
data.frame(Prueba = "Correlación de Pearson (hi vs. p teórico)",
Estadistico = round(pearson_r, 2), GL = NA_integer_,
p_valor = NA_real_, Validacion = val_pearson, stringsAsFactors = FALSE),
data.frame(Prueba = paste0("Chi-Cuadrado (muestra completa n=", n, ")"),
Estadistico = round(chi_stat, 4), GL = chi_gl,
p_valor = round(chi_pval, 4), Validacion = val_chi, stringsAsFactors = FALSE)
) %>%
gt() %>%
tab_header(
title = md("**Tabla N\u00b0 2: Validación de la Conjetura (Modelo Uniforme p=0.5)**"),
subtitle = md("*Produce Gas*")
) %>%
cols_label(Prueba = md("**Prueba**"), Estadistico = md("**Estadístico**"),
GL = md("**G.L.**"), p_valor = md("**p-valor**"), Validacion = md("**Validación**")) %>%
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")),
locations = cells_title(groups = "title")) %>%
tab_style(style = cell_text(color = "#000000", weight = "bold"),
locations = cells_body(columns = Validacion, rows = Validacion == "APROBADO")) %>%
tab_style(style = cell_text(color = "#8A8A8A", weight = "bold"),
locations = cells_body(columns = Validacion, rows = Validacion == "RECHAZADO")) %>%
cols_align(align = "center", columns = c(Estadistico, GL, p_valor, Validacion)) %>%
cols_align(align = "left", columns = Prueba) %>%
fmt_missing(columns = everything(), missing_text = "-") %>%
tab_source_note(source_note = md("*Autor: Fernando Almeida*")) %>%
tab_options(table.width = pct(90), table.font.size = px(13),
heading.title.font.size = px(16), heading.subtitle.font.size = px(12),
data_row.padding = px(6),
column_labels.border.top.width = px(2),
column_labels.border.bottom.width = px(2),
table_body.border.bottom.width = px(2),
table.border.top.style = "hidden", table.border.bottom.style = "hidden")
| Tabla N° 2: Validación de la Conjetura (Modelo Uniforme p=0.5) | ||||
| Produce Gas | ||||
| Prueba | Estadístico | G.L. | p-valor | Validación |
|---|---|---|---|---|
| Correlación de Pearson (hi vs. p teórico) | 100.00 | - | - | APROBADO |
| Chi-Cuadrado (muestra completa n=47757) | 6429.54 | 1 | 0 | RECHAZADO |
| Autor: Fernando Almeida | ||||
Se trabajó con la variable cualitativa nominal Produce
Gas (PRODUCES_GAS), sin orden natural entre sus
categorías (Sí produce / No produce). Se conjeturó un modelo
Uniforme (p=0.5); al realizar una prueba de Pearson se
obtuvo 100% y la prueba Chi-Cuadrado sobre la muestra completa (n=47757)
obtuvo un valor estadístico de 6429.5397 con 1 grado(s) de libertad y un
p-valor de 0, lo que demuestra que la variable no se
reparte al azar entre sus dos categorías (está sesgada hacia una de
ellas).
Autor: Fernando Almeida — Análisis Estadístico, Kansas Hydrocarbon Leases Dataset