1. Configuración y Carga de Datos

Para iniciar el procesamiento estadístico, se verifica la estructura global del conjunto de datos correspondientes a los bloques contractuales y arrendamientos de hidrocarburos en el estado de Kansas.

ruta_csv <- "C:/Users/luisq/OneDrive/Desktop/ESTADISTICA/kansas.csv"
datos <- read_delim(ruta_csv, delim = ";", show_col_types = FALSE)
cat("Dataset cargada correctamente.\n")
## Dataset cargada correctamente.
cat("Total de registros (filas):", nrow(datos), "\n")
## Total de registros (filas): 104173

2. Extraer Variable

Se realiza el aislamiento de la variable cuantitativa continua CUMULATIVE_PRODUCTION, que representa el volumen total de hidrocarburos extraídos durante la vida productiva del pozo, expresado en barriles. Sus valores pertenecen a los reales positivos. Se filtran únicamente los valores válidos mayores a cero.

x_raw <- datos %>%
  mutate(CP = suppressWarnings(as.numeric(CUMULATIVE_PRODUCTION))) %>%
  filter(!is.na(CP), CP > 0) %>%
  pull(CP)

cat("Observaciones válidas:", length(x_raw), "\n")
## Observaciones válidas: 89034

3. Determinación de los Intervalos

Para la variable cuantitativa continua Producción Acumulada, se aplica el criterio de máximo 10 intervalos de clase. La amplitud se calcula como \(c = \left\lceil \dfrac{\max - \min}{k} \right\rceil\), y los intervalos se construyen con notación \([L_i, L_s)\) —cerrado a la izquierda, abierto a la derecha—, excepto el último que se cierra en ambos extremos.

\[k = 10 \quad \text{(máximo permitido)} \qquad c = \left\lceil \frac{\max - \min}{k} \right\rceil\]

x         <- x_raw
n         <- length(x)
x_min     <- min(x)
x_max     <- max(x)
rango_val <- x_max - x_min

k      <- 10
c_amp  <- ceiling(rango_val / k)

cat("n =", n, "| k =", k, "| Rango =", rango_val, "| Amplitud c =", c_amp, "\n")
## n = 89034 | k = 10 | Rango = 37309517 | Amplitud c = 3730952
lim_inf    <- x_min + (0:(k - 1)) * c_amp
lim_sup    <- lim_inf + c_amp
lim_sup[k] <- x_max
mc         <- (lim_inf + lim_sup) / 2
breaks_vec <- c(lim_inf, lim_sup[k])

4. Tabla de Distribución de Frecuencias

Se calcula la distribución de frecuencias absolutas y relativas para la variable cuantitativa continua Producción Acumulada, correspondiente a los pozos de hidrocarburos registrados en Kansas, EE.UU.

intervalos_cut <- cut(x, breaks = breaks_vec, right = FALSE, include.lowest = TRUE)
freq_abs       <- as.integer(table(intervalos_cut))

li <- lim_inf
ls <- lim_sup

hi_dec  <- freq_abs / n
Ni_asc  <- cumsum(freq_abs)
Hi_asc  <- cumsum(hi_dec)
Ni_desc <- n - c(0, head(Ni_asc, -1))
Hi_desc <- 1 - c(0, head(Hi_asc, -1))

etiq_intervalo    <- paste0("[", format(li, big.mark=",", scientific=FALSE), " – ", format(ls, big.mark=",", scientific=FALSE), ")")
etiq_intervalo[k] <- paste0("[", format(li[k], big.mark=",", scientific=FALSE), " – ", format(ls[k], big.mark=",", scientific=FALSE), "]")

tabla_df <- data.frame(
  Intervalo = etiq_intervalo,
  MC        = round(mc, 0),
  ni        = freq_abs,
  hi_pct    = round(hi_dec * 100, 2),
  hi_real   = round(hi_dec, 4),
  Ni_a      = Ni_asc,
  Hi_a      = round(Hi_asc, 4),
  Ni_d      = Ni_desc,
  Hi_d      = round(Hi_desc, 4),
  stringsAsFactors = FALSE
)

total_row <- data.frame(
  Intervalo = "TOTAL",
  MC        = NA_real_,
  ni        = sum(freq_abs),
  hi_pct    = round(sum(hi_dec) * 100, 2),
  hi_real   = round(sum(hi_dec), 4),
  Ni_a      = max(Ni_asc),
  Hi_a      = round(max(Hi_asc), 4),
  Ni_d      = max(Ni_desc),
  Hi_d      = round(max(Hi_desc), 4),
  stringsAsFactors = FALSE
)

tabla_final_freq <- bind_rows(tabla_df, total_row)

tabla_final_freq %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla N°1: Distribución de Frecuencias**"),
    subtitle = md(paste0(
      "*Variable Cuantitativa Continua: Producción Acumulada, ",
      "pozos de hidrocarburos, Kansas, EE.UU. (n = ",
      format(n, big.mark = ","), " registros válidos)*"
    ))
  ) %>%
  cols_label(
    Intervalo = md("**Intervalo [Li – Ls)**"),
    MC        = md("**Marca de Clase**"),
    ni        = md("**ni (FA)**"),
    hi_pct    = md("**hi %**"),
    hi_real   = md("**hi (decimal)**"),
    Ni_a      = md("**Ni ↑ (FAAa)**"),
    Hi_a      = md("**Hi ↑ (FRAa)**"),
    Ni_d      = md("**Ni ↓ (FAAd)**"),
    Hi_d      = md("**Hi ↓ (FRAd)**")
  ) %>%
  tab_spanner(label = md("**Frecuencia Relativa**"), columns = c(hi_pct, hi_real)) %>%
  tab_spanner(label = md("**Acumulada ↑**"),         columns = c(Ni_a, Hi_a)) %>%
  tab_spanner(label = md("**Acumulada ↓**"),         columns = c(Ni_d, Hi_d)) %>%
  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_column_spanners()
  ) %>%
  tab_style(
    style = cell_fill(color = "#F5F5F5"),
    locations = cells_body(rows = seq(1, nrow(tabla_final_freq), by = 2))
  ) %>%
  tab_style(
    style = list(cell_fill(color = "#D6D6D6"), cell_text(weight = "bold")),
    locations = cells_body(rows = Intervalo == "TOTAL", columns = everything())
  ) %>%
  fmt_missing(columns = everything(), missing_text = "—") %>%
  tab_source_note(source_note = md("*Autor: Leslye Quinchiguango*")) %>%
  tab_options(
    table.width = pct(100), 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: Distribución de Frecuencias
Variable Cuantitativa Continua: Producción Acumulada, pozos de hidrocarburos, Kansas, EE.UU. (n = 89,034 registros válidos)
Intervalo [Li – Ls) Marca de Clase ni (FA)
Frecuencia Relativa
Acumulada ↑
Acumulada ↓
hi % hi (decimal) Ni ↑ (FAAa) Hi ↑ (FRAa) Ni ↓ (FAAd) Hi ↓ (FRAd)
[ 0.05 – 3,730,952) 1865476 85659 96.21 0.9621 85659 0.9621 89034 1.0000
[ 3,730,952.05 – 7,461,904) 5596428 1831 2.06 0.0206 87490 0.9827 3375 0.0379
[ 7,461,904.05 – 11,192,856) 9327380 1042 1.17 0.0117 88532 0.9944 1544 0.0173
[11,192,856.05 – 14,923,808) 13058332 376 0.42 0.0042 88908 0.9986 502 0.0056
[14,923,808.05 – 18,654,760) 16789284 87 0.10 0.0010 88995 0.9996 126 0.0014
[18,654,760.05 – 22,385,712) 20520236 22 0.02 0.0002 89017 0.9998 39 0.0004
[22,385,712.05 – 26,116,664) 24251188 10 0.01 0.0001 89027 0.9999 17 0.0002
[26,116,664.05 – 29,847,616) 27982140 4 0.00 0.0000 89031 1.0000 7 0.0001
[29,847,616.05 – 33,578,568) 31713092 1 0.00 0.0000 89032 1.0000 3 0.0000
[33,578,568 – 37,309,517] 35444043 2 0.00 0.0000 89034 1.0000 2 0.0000
TOTAL 89034 100.00 1.0000 89034 1.0000 89034 1.0000
Autor: Leslye Quinchiguango

5. Representación Gráfica

Se presentan cuatro gráficas en escala de grises que permiten analizar visualmente la distribución de la variable cuantitativa continua Producción Acumulada.

5.1 Histograma de Frecuencias Absolutas

grises <- gray(seq(0.25, 0.80, length.out = k))
h_obj  <- hist(x, breaks = breaks_vec, plot = FALSE)

par(mar = c(5, 6, 6, 2))
plot(h_obj, col = grises, border = "black", freq = TRUE,
     main = "", xlab = "", ylab = "", las = 1, xaxt = "n")
axis(1, at = breaks_vec, labels = format(breaks_vec, big.mark=",", scientific=FALSE), las = 2, cex.axis = 0.75)
mtext("Frecuencia Absoluta (ni)",       side = 2, line = 4.5, cex = 1)
mtext("Producción acumulada (barriles)", side = 1, line = 4.5, cex = 1)
mtext("Producción Acumulada,\npozos de hidrocarburos, Kansas, EE.UU.",
      side = 3, line = 3, cex = 0.9, font = 2)

5.2 Polígono de Frecuencias

mc_ext <- c(mc[1] - c_amp, mc, mc[k] + c_amp)
ni_ext <- c(0, freq_abs, 0)
grises <- gray(seq(0.25, 0.80, length.out = k))
h_obj  <- hist(x, breaks = breaks_vec, plot = FALSE)

par(mar = c(5, 6, 6, 2))
plot(h_obj, col = grises, border = "black", freq = TRUE,
     main = "", xlab = "", ylab = "", las = 1, xaxt = "n",
     ylim = c(0, max(freq_abs) * 1.20))
axis(1, at = breaks_vec, labels = format(breaks_vec, big.mark=",", scientific=FALSE), las = 2, cex.axis = 0.75)
lines(mc_ext, ni_ext, col = "black", lwd = 2, lty = 1)
points(mc_ext, ni_ext, pch = 16, col = "black", cex = 0.9)
mtext("Frecuencia Absoluta (ni)",       side = 2, line = 4.5, cex = 1)
mtext("Producción acumulada (barriles)", side = 1, line = 4.5, cex = 1)
mtext("Producción Acumulada,\npozos de hidrocarburos, Kansas, EE.UU.",
      side = 3, line = 3, cex = 0.9, font = 2)
legend("topright",
       legend = c("Histograma", "Polígono de frecuencias"),
       fill = c("gray60", NA), border = c("black", NA),
       lty = c(NA, 1), pch = c(NA, 16), lwd = c(NA, 2), col = c(NA, "black"),
       bty = "n", cex = 0.85)

5.3 Boxplot

media    <- mean(x)
mediana  <- median(x)
desv_std <- sd(x)
q1       <- as.numeric(quantile(x, 0.25))
q3       <- as.numeric(quantile(x, 0.75))

par(mar = c(5, 4, 6, 2))
boxplot(x, col = "gray75", border = "black",
        horizontal = TRUE, outline = TRUE, pch = 16, cex = 0.5,
        main = "", xlab = "", ylab = "")
mtext("Producción acumulada (barriles)", side = 1, line = 3.5, cex = 1)
mtext("Producción Acumulada,\npozos de hidrocarburos, Kansas, EE.UU.",
      side = 3, line = 3, cex = 0.9, font = 2)
text(q1,      1.38, labels = paste0("Q1=", format(round(q1), big.mark=",")), cex = 0.8)
text(mediana, 0.62, labels = paste0("Me=", format(round(mediana), big.mark=",")), cex = 0.8)
text(q3,      1.38, labels = paste0("Q3=", format(round(q3), big.mark=",")), cex = 0.8)

5.4 Ojivas Creciente y Decreciente

x_asc  <- c(li[1], ls)
y_asc  <- c(0, Ni_asc)
x_desc <- c(li[1], ls)
y_desc <- c(n, Ni_desc)

par(mar = c(6, 7, 6, 2))
plot(x_asc, y_asc, type = "b", pch = 16, lwd = 2, col = "black",
     ylim = c(0, n * 1.10), xlim = c(min(x_asc), max(x_asc)),
     xlab = "", ylab = "", main = "", las = 1, xaxt = "n")
axis(1, at = breaks_vec, labels = format(breaks_vec, big.mark=",", scientific=FALSE), las = 2, cex.axis = 0.75)
lines(x_desc, y_desc, type = "b", pch = 17, lwd = 2, col = "gray40", lty = 2)
grid(col = "gray85", lty = "dotted")
y_cruce <- n / 2
abline(h = y_cruce, col = "gray50", lty = 3, lwd = 1.2)
abline(v = mediana,  col = "gray50", lty = 3, lwd = 1.2)
text(mediana + c_amp * 0.3, y_cruce + (n * 0.04),
     labels = paste0("Cruce \u2248 Me = ", format(round(mediana), big.mark=",")),
     cex = 0.82, col = "black", font = 3)
legend("right",
       legend = c("Ojiva Creciente (Ni \u2191)", "Ojiva Decreciente (Ni \u2193)"),
       col = c("black", "gray40"), lty = c(1, 2), pch = c(16, 17),
       lwd = 2, bty = "n", cex = 0.9)
mtext("Frecuencia Absoluta Acumulada (Ni)", side = 2, line = 5,   cex = 1)
mtext("Producción acumulada (barriles)",    side = 1, line = 5,   cex = 1)
mtext("Producción Acumulada,\npozos de hidrocarburos, Kansas, EE.UU.",
      side = 3, line = 3, cex = 0.9, font = 2)

6. Indicadores Estadísticos

Para la variable cuantitativa continua Producción Acumulada, se calculan todos los indicadores de tendencia central, dispersión y forma.

moda_int     <- etiq_intervalo[which.max(freq_abs)]
cv           <- (desv_std / media) * 100
iqr_val      <- IQR(x)
asimetria    <- (3 * (media - mediana)) / desv_std
curtosis_val <- (sum((x - media)^4) / length(x)) / (desv_std^4)
lim_inf_out  <- q1 - 1.5 * iqr_val
lim_sup_out  <- q3 + 1.5 * iqr_val
n_outliers   <- sum(x < lim_inf_out | x > lim_sup_out)
outliers_str <- if (n_outliers == 0) "Sin valores atípicos" else paste0(format(n_outliers, big.mark=","), " valores atípicos detectados")

data.frame(
  Indicador = c("Tamaño muestral (n)", "Mínimo", "Máximo", "Rango",
                "Media", "Mediana", "Moda (intervalo modal)",
                "Varianza (s²)", "Desviación estándar (s)",
                "Coef. de variación (CV%)", "Cuartil 1 (Q1)", "Cuartil 3 (Q3)",
                "Rango intercuartílico (IQR)", "Asimetría de Pearson",
                "Curtosis", "Valores atípicos (Outliers)"),
  Valor = c(format(n, big.mark = ","),
            paste0(format(round(x_min, 2), big.mark=","), " bbl"),
            paste0(format(round(x_max, 2), big.mark=","), " bbl"),
            paste0(format(round(rango_val, 2), big.mark=","), " bbl"),
            paste0(format(round(media, 2), big.mark=","), " bbl"),
            paste0(format(round(mediana, 2), big.mark=","), " bbl"),
            moda_int,
            as.character(format(round(desv_std^2, 2), big.mark=",")),
            paste0(format(round(desv_std, 2), big.mark=","), " bbl"),
            paste0(round(cv, 2), "%"),
            paste0(format(round(q1, 2), big.mark=","), " bbl"),
            paste0(format(round(q3, 2), big.mark=","), " bbl"),
            paste0(format(round(iqr_val, 2), big.mark=","), " bbl"),
            as.character(round(asimetria, 4)),
            as.character(round(curtosis_val, 4)),
            outliers_str),
  stringsAsFactors = FALSE
) %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla N°2: Indicadores Estadísticos**"),
    subtitle = md("*Variable Cuantitativa Continua: Producción Acumulada (barriles)*")
  ) %>%
  cols_label(Indicador = md("**Indicador**"), Valor = md("**Valor**")) %>%
  cols_align(align = "left",  columns = Indicador) %>%
  cols_align(align = "right", columns = Valor) %>%
  tab_style(
    style = list(cell_fill(color = "#2C2C2C"), cell_text(color = "white", weight = "bold")),
    locations = cells_column_labels()
  ) %>%
  tab_style(
    style = cell_borders(sides = "bottom", color = "#E0E0E0", weight = px(1)),
    locations = cells_body(rows = everything())
  ) %>%
  tab_source_note(source_note = md("*Autor: Leslye Quinchiguango*")) %>%
  tab_options(
    table.width = pct(55), heading.title.font.size = px(15),
    heading.subtitle.font.size = px(11), table.font.size = px(12),
    data_row.padding = px(4),
    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: Indicadores Estadísticos
Variable Cuantitativa Continua: Producción Acumulada (barriles)
Indicador Valor
Tamaño muestral (n) 89,034
Mínimo 0.05 bbl
Máximo 37,309,517 bbl
Rango 37,309,517 bbl
Media 550,281.3 bbl
Mediana 44,870.18 bbl
Moda (intervalo modal) [ 0.05 – 3,730,952)
Varianza (s²) 2.852471e+12
Desviación estándar (s) 1,688,926 bbl
Coef. de variación (CV%) 306.92%
Cuartil 1 (Q1) 6,827.16 bbl
Cuartil 3 (Q3) 254,724.3 bbl
Rango intercuartílico (IQR) 247,897.2 bbl
Asimetría de Pearson 0.8978
Curtosis 46.9757
Valores atípicos (Outliers) 14,433 valores atípicos detectados
Autor: Leslye Quinchiguango

7. Conclusiones

La variable Producción Acumulada fluctúa entre 0.05 y 37,309,517 barriles (rango = 37,309,517 bbl) y sus valores varían en torno a 44,870.18 bbl, con una desviación estándar de 1,688,926 bbl, siendo un grupo de valores heterogéneo (CV = 306.92%), con 14,433 valores atípicos detectados. El conjunto de valores se concentra a la derecha (As = 0.9), con mayor concentración de pozos de baja producción acumulada y una cola hacia pozos de muy alta producción. Por lo tanto, el comportamiento es medianamente favorable, dado que la alta variabilidad en la producción acumulada refleja una cartera de pozos muy heterogénea, con pozos de bajo y alto rendimiento que requieren estrategias de gestión diferenciadas.


Autor: Leslye Quinchiguango — Análisis Estadístico, Kansas Hydrocarbon Leases Dataset