Producción Acumulada — Inferencial
Fernando Almeida
2026-07-22
1. Cargar Librerías
library(readr); library(dplyr); library(gt); library(MASS)
cat("Librerías cargadas correctamente.\n")## Librerías cargadas correctamente.2. Cargar Datos
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 (2).csv | Filas: 477573. Conteo
x_raw <- datos %>%
mutate(PC = suppressWarnings(as.numeric(CUMULATIVE_PRODUCTION))) %>%
filter(!is.na(PC), PC > 0) %>%
pull(PC)
n_conteo <- length(x_raw)
k_sturges <- ceiling(1 + 3.322 * log10(n_conteo))
cat("Observaciones válidas:", n_conteo, "\n")## Observaciones válidas: 47757cat("Clases (Regla de Sturges):", k_sturges, "\n")## Clases (Regla de Sturges): 17cat("Mínimo:", round(min(x_raw), 4), "| Máximo:", round(max(x_raw), 4), "\n")## Mínimo: 1 | Máximo: 9852834. Tabla de Distribución de Frecuencias
x_st <- x_raw
n_st <- length(x_st)
x_min_st <- min(x_st); x_max_st <- max(x_st)
k_st <- k_sturges
c_amp_st <- (x_max_st - x_min_st) / k_st
lim_inf_st <- x_min_st + (0:(k_st-1)) * c_amp_st
lim_sup_st <- lim_inf_st + c_amp_st; lim_sup_st[k_st] <- x_max_st
mc_st <- (lim_inf_st + lim_sup_st) / 2
breaks_st <- c(lim_inf_st, lim_sup_st[k_st])
intervalos_cut_st <- cut(x_st, breaks=breaks_st, right=FALSE, include.lowest=TRUE)
freq_abs_st <- as.integer(table(intervalos_cut_st))
hi_dec_st <- freq_abs_st / n_st
Ni_asc_st <- cumsum(freq_abs_st); Hi_asc_st <- cumsum(hi_dec_st)
Ni_desc_st <- n_st - c(0, head(Ni_asc_st,-1)); Hi_desc_st <- 1 - c(0, head(Hi_asc_st,-1))
etiq_st <- paste0("[",format(round(lim_inf_st,2),big.mark=",")," - ",format(round(lim_sup_st,2),big.mark=","),")")
etiq_st[k_st] <- paste0("[",format(round(lim_inf_st[k_st],2),big.mark=",")," - ",format(round(lim_sup_st[k_st],2),big.mark=","),"]")
bind_rows(
data.frame(Intervalo=etiq_st, MC=round(mc_st,2), ni=freq_abs_st,
hi_pct=round(hi_dec_st*100,2), hi_real=round(hi_dec_st,4),
Ni_a=Ni_asc_st, Hi_a=round(Hi_asc_st,4),
Ni_d=Ni_desc_st, Hi_d=round(Hi_desc_st,4), stringsAsFactors=FALSE),
data.frame(Intervalo="TOTAL", MC=NA_real_, ni=sum(freq_abs_st),
hi_pct=round(sum(hi_dec_st)*100,2), hi_real=round(sum(hi_dec_st),4),
Ni_a=max(Ni_asc_st), Hi_a=round(max(Hi_asc_st),4),
Ni_d=max(Ni_desc_st), Hi_d=round(max(Hi_desc_st),4), stringsAsFactors=FALSE)
) %>%
gt() %>%
tab_header(title=md("**Distribución de Frecuencias — Regla de Sturges (referencial)**"),
subtitle=md(paste0("*Producción Acumulada, Kansas (n=",format(n_st,big.mark=","),", k=",k_st," intervalos)*"))) %>%
cols_label(Intervalo=md("**Intervalo**"), MC=md("**MC**"), ni=md("**ni**"),
hi_pct=md("**hi%**"), hi_real=md("**hi**"),
Ni_a=md("**Ni (asc)**"), Hi_a=md("**Hi (asc)**"),
Ni_d=md("**Ni (desc)**"), Hi_d=md("**Hi (desc)**")) %>%
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,k_st+1,by=2))) %>%
tab_style(style=list(cell_fill(color="#D6D6D6"),cell_text(weight="bold")),
locations=cells_body(rows=Intervalo=="TOTAL")) %>%
fmt_missing(columns=everything(), missing_text="-") %>%
tab_source_note(source_note=md("*Autor: Fernando Almeida*")) %>%
tab_options(table.width=pct(100), table.font.size=px(12), data_row.padding=px(4))| Distribución de Frecuencias — Regla de Sturges (referencial) | ||||||||
| Producción Acumulada, Kansas (n=47,757, k=17 intervalos) | ||||||||
| Intervalo | MC | ni | hi% | hi | Ni (asc) | Hi (asc) | Ni (desc) | Hi (desc) |
|---|---|---|---|---|---|---|---|---|
| [ 1.00 - 57,958.76) | 28979.88 | 25173 | 52.71 | 0.5271 | 25173 | 0.5271 | 47757 | 1.0000 |
| [ 57,958.76 - 115,916.53) | 86937.65 | 6900 | 14.45 | 0.1445 | 32073 | 0.6716 | 22584 | 0.4729 |
| [115,916.53 - 173,874.29) | 144895.41 | 3795 | 7.95 | 0.0795 | 35868 | 0.7511 | 15684 | 0.3284 |
| [173,874.29 - 231,832.06) | 202853.18 | 2470 | 5.17 | 0.0517 | 38338 | 0.8028 | 11889 | 0.2489 |
| [231,832.06 - 289,789.82) | 260810.94 | 1785 | 3.74 | 0.0374 | 40123 | 0.8401 | 9419 | 0.1972 |
| [289,789.82 - 347,747.59) | 318768.71 | 1274 | 2.67 | 0.0267 | 41397 | 0.8668 | 7634 | 0.1599 |
| [347,747.59 - 405,705.35) | 376726.47 | 946 | 1.98 | 0.0198 | 42343 | 0.8866 | 6360 | 0.1332 |
| [405,705.35 - 463,663.12) | 434684.24 | 824 | 1.73 | 0.0173 | 43167 | 0.9039 | 5414 | 0.1134 |
| [463,663.12 - 521,620.88) | 492642.00 | 687 | 1.44 | 0.0144 | 43854 | 0.9183 | 4590 | 0.0961 |
| [521,620.88 - 579,578.65) | 550599.76 | 587 | 1.23 | 0.0123 | 44441 | 0.9306 | 3903 | 0.0817 |
| [579,578.65 - 637,536.41) | 608557.53 | 547 | 1.15 | 0.0115 | 44988 | 0.9420 | 3316 | 0.0694 |
| [637,536.41 - 695,494.18) | 666515.29 | 517 | 1.08 | 0.0108 | 45505 | 0.9528 | 2769 | 0.0580 |
| [695,494.18 - 753,451.94) | 724473.06 | 516 | 1.08 | 0.0108 | 46021 | 0.9636 | 2252 | 0.0472 |
| [753,451.94 - 811,409.71) | 782430.82 | 474 | 0.99 | 0.0099 | 46495 | 0.9736 | 1736 | 0.0364 |
| [811,409.71 - 869,367.47) | 840388.59 | 449 | 0.94 | 0.0094 | 46944 | 0.9830 | 1262 | 0.0264 |
| [869,367.47 - 927,325.24) | 898346.35 | 418 | 0.88 | 0.0088 | 47362 | 0.9917 | 813 | 0.0170 |
| [927,325.2 - 985,283] | 956304.12 | 395 | 0.83 | 0.0083 | 47757 | 1.0000 | 395 | 0.0083 |
| TOTAL | - | 47757 | 100.00 | 1.0000 | 47757 | 1.0000 | 47757 | 1.0000 |
| Autor: Fernando Almeida | ||||||||
Aplicando la Regla de Sturges, con 47,757 observaciones corresponderían 17 intervalos de clase. Sin embargo, un desglose tan fino dificulta la lectura visual y el ajuste de los modelos teóricos sobre la distribución. Por ello, se simplifica el análisis a una tabla de 10 intervalos de clase, criterio que conserva representatividad estadística sin sacrificar claridad interpretativa.
intervalos_cut <- cut(x, breaks=breaks_vec, right=FALSE, include.lowest=TRUE)
freq_abs <- as.integer(table(intervalos_cut))
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 <- paste0("[",format(round(lim_inf,2),big.mark=",")," - ",format(round(lim_sup,2),big.mark=","),")")
etiq[k] <- paste0("[",format(round(lim_inf[k],2),big.mark=",")," - ",format(round(lim_sup[k],2),big.mark=","),"]")
bind_rows(
data.frame(Intervalo=etiq, MC=round(mc,2), 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),
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)
) %>%
gt() %>%
tab_header(title=md("**Tabla N\u00b01: Distribución de Frecuencias**"),
subtitle=md(paste0("*Producción Acumulada, Kansas (n=",format(n,big.mark=","),")*"))) %>%
cols_label(Intervalo=md("**Intervalo**"), MC=md("**MC**"), ni=md("**ni**"),
hi_pct=md("**hi%**"), hi_real=md("**hi**"),
Ni_a=md("**Ni (asc)**"), Hi_a=md("**Hi (asc)**"),
Ni_d=md("**Ni (desc)**"), Hi_d=md("**Hi (desc)**")) %>%
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,k+1,by=2))) %>%
tab_style(style=list(cell_fill(color="#D6D6D6"),cell_text(weight="bold")),
locations=cells_body(rows=Intervalo=="TOTAL")) %>%
fmt_missing(columns=everything(), missing_text="-") %>%
tab_source_note(source_note=md("*Autor: Fernando Almeida*")) %>%
tab_options(table.width=pct(100), table.font.size=px(13), data_row.padding=px(6))| Tabla N°1: Distribución de Frecuencias | ||||||||
| Producción Acumulada, Kansas (n=47,757) | ||||||||
| Intervalo | MC | ni | hi% | hi | Ni (asc) | Hi (asc) | Ni (desc) | Hi (desc) |
|---|---|---|---|---|---|---|---|---|
| [ 1.0 - 98,529.2) | 49265.1 | 30447 | 63.75 | 0.6375 | 30447 | 0.6375 | 47757 | 1.0000 |
| [ 98,529.2 - 197,057.4) | 147793.3 | 6498 | 13.61 | 0.1361 | 36945 | 0.7736 | 17310 | 0.3625 |
| [197,057.4 - 295,585.6) | 246321.5 | 3311 | 6.93 | 0.0693 | 40256 | 0.8429 | 10812 | 0.2264 |
| [295,585.6 - 394,113.8) | 344849.7 | 1905 | 3.99 | 0.0399 | 42161 | 0.8828 | 7501 | 0.1571 |
| [394,113.8 - 492,642.0) | 443377.9 | 1335 | 2.80 | 0.0280 | 43496 | 0.9108 | 5596 | 0.1172 |
| [492,642.0 - 591,170.2) | 541906.1 | 1071 | 2.24 | 0.0224 | 44567 | 0.9332 | 4261 | 0.0892 |
| [591,170.2 - 689,698.4) | 640434.3 | 890 | 1.86 | 0.0186 | 45457 | 0.9518 | 3190 | 0.0668 |
| [689,698.4 - 788,226.6) | 738962.5 | 862 | 1.80 | 0.0180 | 46319 | 0.9699 | 2300 | 0.0482 |
| [788,226.6 - 886,754.8) | 837490.7 | 761 | 1.59 | 0.0159 | 47080 | 0.9858 | 1438 | 0.0301 |
| [886,754.8 - 985,283] | 936018.9 | 677 | 1.42 | 0.0142 | 47757 | 1.0000 | 677 | 0.0142 |
| TOTAL | - | 47757 | 100.00 | 1.0000 | 47757 | 1.0000 | 47757 | 1.0000 |
| Autor: Fernando Almeida | ||||||||
5. Gráfico Histograma General
grises <- gray(seq(0.25, 0.80, length.out=k))
h_obj <- hist(x, breaks=breaks_vec, plot=FALSE)
h_obj$density <- hi_dec
par(mar=c(5,7,6,2))
plot(h_obj, col=grises, border="black", freq=FALSE,
main="", xlab="", ylab="", las=1, xaxt="n")
axis(1, at=breaks_vec, labels=format(round(breaks_vec,0),big.mark=","), las=2, cex.axis=0.75)
mtext("Densidad de Probabilidad", side=2, line=5, cex=1)
mtext("Producción Acumulada (bbl)", side=1, line=4.5, cex=1)
mtext("Histograma General - Producción Acumulada, Kansas, EE.UU.",
side=3, line=3, cex=0.95, font=2)
6. Conjetura y Ajuste del Modelo
El histograma de CUMULATIVE_PRODUCTION (producción
acumulada total por pozo) muestra una fuerte asimetría a la derecha: la
mayoría de los pozos acumulan producciones bajas o moderadas, mientras
que un grupo reducido acumula volúmenes muy altos a lo largo de su vida
productiva. Este comportamiento es característico de una distribución
Log-Normal, por lo que se conjetura ese modelo,
contrastándolo también contra Normal y Exponencial (ambos desplazados al
mínimo cuando corresponde).
set.seed(42)
lbl <- c(normal = "Normal", lognormal = "Log-Normal", exponential = "Exponencial")
k_adaptativo <- function(n) {
max(3, min(k, ceiling(1 + 3.322 * log10(n))))
}
calc_pearson_zona <- function(datos, modelo, fit, offset, lim_min, lim_max) {
k_zona <- k_adaptativo(length(datos))
brks <- seq(lim_min, lim_max, length.out = k_zona + 1)
hi_obs <- hist(datos, breaks = brks, plot = FALSE)$counts / length(datos)
mc_z <- (head(brks,-1) + tail(brks,-1)) / 2
if (modelo == "lognormal") {
mc_pos <- mc_z - offset; mc_pos[mc_pos <= 0] <- 1e-9
hi_teo <- dlnorm(mc_pos, meanlog = fit$estimate["meanlog"],
sdlog = fit$estimate["sdlog"]) * diff(brks)
} else if (modelo == "exponential") {
mc_pos <- mc_z - offset; mc_pos[mc_pos <= 0] <- 1e-9
hi_teo <- dexp(mc_pos, rate = fit$estimate["rate"]) * diff(brks)
} else {
hi_teo <- dnorm(mc_z, mean = fit$estimate["mean"], sd = fit$estimate["sd"]) * diff(brks)
}
hi_teo <- hi_teo / sum(hi_teo)
round(cor(hi_obs, hi_teo) * 100, 2)
}
evaluar_modelo <- function(datos, n_samp = 350, lim_min, lim_max) {
set.seed(42)
n_s <- min(n_samp, length(datos))
samp <- sample(datos, size = n_s, replace = FALSE)
offset <- min(datos) - 0.001
d_pos <- datos - offset
s_pos <- samp - offset
resultados <- list()
tryCatch({
f <- fitdistr(datos, "normal")
ks <- ks.test(samp, "pnorm",
mean = f$estimate["mean"], sd = f$estimate["sd"])
resultados[["normal"]] <- list(
fit = f, pval = ks$p.value,
pearson = calc_pearson_zona(datos, "normal", f, 0, lim_min, lim_max),
offset = 0)
}, error = function(e){})
tryCatch({
f <- fitdistr(d_pos, "lognormal")
ks <- ks.test(s_pos, "plnorm",
meanlog = f$estimate["meanlog"], sdlog = f$estimate["sdlog"])
resultados[["lognormal"]] <- list(
fit = f, pval = ks$p.value,
pearson = calc_pearson_zona(datos, "lognormal", f, offset, lim_min, lim_max),
offset = offset)
}, error = function(e){})
tryCatch({
f <- fitdistr(d_pos, "exponential")
ks <- ks.test(s_pos, "pexp", rate = f$estimate["rate"])
resultados[["exponential"]] <- list(
fit = f, pval = ks$p.value,
pearson = calc_pearson_zona(datos, "exponential", f, offset, lim_min, lim_max),
offset = offset)
}, error = function(e){})
mejor <- NULL
mejor_pearson <- -Inf
for (nombre in names(resultados)) {
valor_pearson <- resultados[[nombre]]$pearson
if (!is.na(valor_pearson) && valor_pearson > mejor_pearson) {
mejor_pearson <- valor_pearson
mejor <- nombre
}
}
c(resultados[[mejor]], list(modelo = mejor))
}
validar <- function(datos, res, lim_min, lim_max) {
set.seed(42)
samp <- sample(datos, size = min(50, length(datos)), replace = FALSE)
offset <- res$offset
pearson <- calc_pearson_zona(datos, res$modelo, res$fit, offset, lim_min, lim_max)
if (res$modelo == "lognormal") {
ks_res <- ks.test(samp - offset, "plnorm",
meanlog = res$fit$estimate["meanlog"],
sdlog = res$fit$estimate["sdlog"])
} else if (res$modelo == "exponential") {
ks_res <- ks.test(samp - offset, "pexp", rate = res$fit$estimate["rate"])
} else {
ks_res <- ks.test(samp, "pnorm",
mean = res$fit$estimate["mean"],
sd = res$fit$estimate["sd"])
}
pval_ks <- round(ks_res$p.value, 4)
if (pearson > 70) {
resultado_val <- "APROBADO"
} else {
resultado_val <- "RECHAZADO"
}
list(pearson = pearson, pval = pval_ks, val = resultado_val)
}
r_prod <- evaluar_modelo(x, lim_min = x_min, lim_max = x_max)
v_prod <- validar(x, r_prod, x_min, x_max)
cat("Modelo seleccionado:", lbl[r_prod$modelo], "\n")## Modelo seleccionado: Log-Normalcat("Parámetros:\n"); print(round(r_prod$fit$estimate, 6))## Parámetros:## meanlog sdlog
## 10.594130 2.009772cat("Pearson R%:", v_prod$pearson, "| KS p-valor:", v_prod$pval, "|", v_prod$val, "\n")## Pearson R%: 99.79 | KS p-valor: 0.9835 | APROBADOoffset_prod <- r_prod$offset
xs <- seq(x_min, x_max, length.out = 500)
if (r_prod$modelo == "lognormal") {
xs_pos <- xs - offset_prod; xs_pos[xs_pos <= 0] <- 1e-9
ys <- dlnorm(xs_pos, meanlog = r_prod$fit$estimate["meanlog"],
sdlog = r_prod$fit$estimate["sdlog"]) * c_amp
} else if (r_prod$modelo == "exponential") {
xs_pos <- xs - offset_prod; xs_pos[xs_pos <= 0] <- 1e-9
ys <- dexp(xs_pos, rate = r_prod$fit$estimate["rate"]) * c_amp
} else {
ys <- dnorm(xs, mean = r_prod$fit$estimate["mean"], sd = r_prod$fit$estimate["sd"]) * c_amp
}
par(mar=c(5,7,6,2))
plot(h_obj, col=grises, border="black", freq=FALSE,
main="", xlab="", ylab="", las=1, xaxt="n",
ylim=range(c(hi_dec, ys), na.rm=TRUE))
axis(1, at=breaks_vec, labels=format(round(breaks_vec,0),big.mark=","), las=2, cex.axis=0.75)
lines(xs, ys, col="black", lwd=2.5)
mtext("Densidad de Probabilidad", side=2, line=5, cex=1)
mtext("Producción Acumulada (bbl)", side=1, line=4.5, cex=1)
mtext(paste0("Ajuste ", lbl[r_prod$modelo], " - Producción Acumulada, Kansas, EE.UU."),
side=3, line=3, cex=0.95, font=2)
legend("topright",
legend = c("Histograma", paste0("Curva ", lbl[r_prod$modelo])),
fill = c("gray55", NA), border = c("black", NA),
lty = c(NA, 1), lwd = c(NA, 2.5), bty = "n", cex = 0.9)
7. Tabla de Validación
tabla_resumen <- data.frame(
Zona = "Producción Acumulada (rango completo)",
Modelo = as.character(lbl[r_prod$modelo]),
Pearson = v_prod$pearson,
KS_p = v_prod$pval,
Validacion = v_prod$val,
stringsAsFactors = FALSE
)
tabla_resumen %>%
gt() %>%
tab_header(
title = md("**Tabla N\u00b02: Resumen de Validación**"),
subtitle = md("*Pearson (R%) y Kolmogorov-Smirnov (p-valor)*")
) %>%
cols_label(Zona=md("**Zona**"), Modelo=md("**Modelo Aplicado**"),
Pearson=md("**Pearson (R %)**"), KS_p=md("**K-S (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="darkgreen",weight="bold"),
locations=cells_body(columns=Validacion, rows=Validacion=="APROBADO")) %>%
tab_style(style=cell_text(color="darkred",weight="bold"),
locations=cells_body(columns=Validacion, rows=Validacion=="RECHAZADO")) %>%
tab_style(style=cell_borders(sides="bottom",color="#E0E0E0",weight=px(1)),
locations=cells_body(rows=everything())) %>%
cols_align(align="center", columns=c(Pearson,KS_p,Validacion)) %>%
cols_align(align="left", columns=c(Zona,Modelo)) %>%
fmt_number(columns=Pearson, decimals=2) %>%
fmt_number(columns=KS_p, decimals=4) %>%
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: Resumen de Validación | ||||
| Pearson (R%) y Kolmogorov-Smirnov (p-valor) | ||||
| Zona | Modelo Aplicado | Pearson (R %) | K-S (p-valor) | Validación |
|---|---|---|---|---|
| Producción Acumulada (rango completo) | Log-Normal | 99.79 | 0.9835 | APROBADO |
| Autor: Fernando Almeida | ||||
8. Intervalo de Confianza
El Intervalo de Confianza representa el puente fundamental entre el modelo empírico observado (Log-Normal) y la estimación poblacional. Aunque la distribución original de la Producción Acumulada presenta fuerte asimetría, el TLC garantiza que la distribución de las medias muestrales tenderá a la normalidad debido al volumen masivo de datos (\(n=\) 47,757).
Los postulados de confianza empírica sugieren:
\[P(\bar{x} - E < \mu < \bar{x} + E) \approx 68\%\]
\[P(\bar{x} - 2E < \mu < \bar{x} + 2E) \approx 95\%\]
\[P(\bar{x} - 3E < \mu < \bar{x} + 3E) \approx 99\%\]
Donde el Margen de Error (\(E\)) se define como:
\[E = \frac{\sigma}{\sqrt{n}}\]
media_muestral <- mean(x)
desv_est <- sd(x)
n_total <- length(x)
z_95 <- 1.96
error_est <- desv_est / sqrt(n_total)
margen <- z_95 * error_est
lim_inf_ic <- media_muestral - margen
lim_sup_ic <- media_muestral + margen
data.frame(
Parametro = "Producción Acumulada Promedio Kansas (bbl)",
Lim_Inferior = round(lim_inf_ic, 2),
Media_Muestral = round(media_muestral, 2),
Lim_Superior = round(lim_sup_ic, 2),
Error_Estandar = paste0("+/- ", round(margen, 2)),
Confianza = "95% (Z=1.96)",
stringsAsFactors = FALSE
) %>%
gt() %>%
tab_header(
title = md("**TABLA N\u00b0 3: ESTIMACIÓN DE LA MEDIA POBLACIONAL**"),
subtitle = md("*Inferencia Estadística para la Variable Producción Acumulada*")
) %>%
cols_label(
Parametro = md("**Parámetro**"),
Lim_Inferior = md("**Lim_Inferior**"),
Media_Muestral = md("**Media_Muestral**"),
Lim_Superior = md("**Lim_Superior**"),
Error_Estandar = md("**Error_Estándar**"),
Confianza = md("**Confianza**")
) %>%
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 = list(cell_fill(color = "#C8E6C9"), cell_text(weight = "bold")),
locations = cells_body(columns = Media_Muestral)) %>%
tab_style(style = cell_borders(sides = "bottom", color = "#E0E0E0", weight = px(1)),
locations = cells_body(rows = everything())) %>%
cols_align(align = "center", columns = c(Lim_Inferior, Media_Muestral, Lim_Superior, Error_Estandar, Confianza)) %>%
cols_align(align = "left", columns = Parametro) %>%
tab_source_note(source_note = md("*Autor: Fernando Almeida*")) %>%
tab_options(table.width = pct(100), 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° 3: ESTIMACIÓN DE LA MEDIA POBLACIONAL | |||||
| Inferencia Estadística para la Variable Producción Acumulada | |||||
| Parámetro | Lim_Inferior | Media_Muestral | Lim_Superior | Error_Estándar | Confianza |
|---|---|---|---|---|---|
| Producción Acumulada Promedio Kansas (bbl) | 142171.3 | 144072.2 | 145973.1 | +/- 1900.88 | 95% (Z=1.96) |
| Autor: Fernando Almeida | |||||
9. Conclusiones
El comportamiento de Producción Acumulada se explica con un modelo Log-Normal (meanlog = 10.5941, sdlog = 2.0098). Podemos afirmar con un 95% de confianza que la media aritmética real de Producción Acumulada se encuentra entre 1.4217132^{5} y 1.4597307^{5}, con una desviación estándar de 2.1194152^{5}.
Autor: Fernando Almeida — Análisis Estadístico, Kansas Hydrocarbon Leases Dataset