Años Activo — Inferencial
Leslye Quinchiguango
2026-07-27
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(YRS = suppressWarnings(as.integer(YEARS_ACTIVE))) %>%
filter(!is.na(YRS), YRS >= 1, YRS <= 89) %>%
pull(YRS)
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:", min(x_raw), "| Máximo:", max(x_raw), "\n")## Mínimo: 1 | Máximo: 894. Tabla de Distribución de Frecuencias
Se calcula la distribución de frecuencias absolutas y relativas para la variable cuantitativa discreta agrupada Años Activo, correspondiente a los arrendamientos de hidrocarburos registrados en Kansas, EE.UU.
x_min_st <- min(x_raw); x_max_st <- max(x_raw)
rango_st <- x_max_st - x_min_st
c_amp_st <- ceiling(rango_st / k_sturges)
k_st <- ceiling((rango_st + 1) / c_amp_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 + 1
mc_st <- floor((lim_inf_st + lim_sup_st) / 2)
breaks_st <- c(lim_inf_st, lim_sup_st[k_st])
intervalos_cut_st <- cut(x_raw, breaks = breaks_st, right = FALSE, include.lowest = TRUE)
freq_abs_st <- as.integer(table(intervalos_cut_st))
li_st <- lim_inf_st
ls_st <- lim_sup_st
hi_dec_st <- freq_abs_st / n_conteo
Ni_asc_st <- cumsum(freq_abs_st)
Hi_asc_st <- cumsum(hi_dec_st)
Ni_desc_st <- n_conteo - c(0, head(Ni_asc_st, -1))
Hi_desc_st <- 1 - c(0, head(Hi_asc_st, -1))
etiq_st <- paste0("[", li_st, " – ", ls_st, ")")
etiq_st[k_st] <- paste0("[", li_st[k_st], " – ", ls_st[k_st] - 1, "]")
tabla_st_df <- data.frame(
Intervalo = etiq_st,
MC = as.integer(mc_st),
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
)
total_st_row <- data.frame(
Intervalo = "TOTAL",
MC = NA_integer_,
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
)
tabla_sturges_final <- bind_rows(tabla_st_df, total_st_row)
tabla_sturges_final %>%
gt() %>%
tab_header(
title = md("**Distribución de Frecuencias — Regla de Sturges (referencial)**"),
subtitle = md(paste0(
"*Años Activo, Kansas, EE.UU. (n = ",
format(n_conteo, big.mark = ","), ", k = ", k_st, " intervalos)*"
))
) %>%
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_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_sturges_final), 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(15),
heading.subtitle.font.size = px(11),
table.font.size = px(12),
data_row.padding = px(4)
)| Distribución de Frecuencias — Regla de Sturges (referencial) | ||||||||
| Años Activo, Kansas, EE.UU. (n = 47,757, k = 15 intervalos) | ||||||||
| Intervalo [Li – Ls) | Marca de Clase | ni (FA) | hi % | hi (decimal) | Ni ↑ (FAAa) | Hi ↑ (FRAa) | Ni ↓ (FAAd) | Hi ↓ (FRAd) |
|---|---|---|---|---|---|---|---|---|
| [1 – 7) | 4 | 7357 | 15.41 | 0.1541 | 7357 | 0.1541 | 47757 | 1.0000 |
| [7 – 13) | 10 | 7495 | 15.69 | 0.1569 | 14852 | 0.3110 | 40400 | 0.8459 |
| [13 – 19) | 16 | 8724 | 18.27 | 0.1827 | 23576 | 0.4937 | 32905 | 0.6890 |
| [19 – 25) | 22 | 5473 | 11.46 | 0.1146 | 29049 | 0.6083 | 24181 | 0.5063 |
| [25 – 31) | 28 | 3505 | 7.34 | 0.0734 | 32554 | 0.6817 | 18708 | 0.3917 |
| [31 – 37) | 34 | 3409 | 7.14 | 0.0714 | 35963 | 0.7530 | 15203 | 0.3183 |
| [37 – 43) | 40 | 3274 | 6.86 | 0.0686 | 39237 | 0.8216 | 11794 | 0.2470 |
| [43 – 49) | 46 | 3054 | 6.39 | 0.0639 | 42291 | 0.8855 | 8520 | 0.1784 |
| [49 – 55) | 52 | 1286 | 2.69 | 0.0269 | 43577 | 0.9125 | 5466 | 0.1145 |
| [55 – 61) | 58 | 1880 | 3.94 | 0.0394 | 45457 | 0.9518 | 4180 | 0.0875 |
| [61 – 67) | 64 | 910 | 1.91 | 0.0191 | 46367 | 0.9709 | 2300 | 0.0482 |
| [67 – 73) | 70 | 539 | 1.13 | 0.0113 | 46906 | 0.9822 | 1390 | 0.0291 |
| [73 – 79) | 76 | 392 | 0.82 | 0.0082 | 47298 | 0.9904 | 851 | 0.0178 |
| [79 – 85) | 82 | 264 | 0.55 | 0.0055 | 47562 | 0.9959 | 459 | 0.0096 |
| [85 – 89] | 87 | 195 | 0.41 | 0.0041 | 47757 | 1.0000 | 195 | 0.0041 |
| TOTAL | — | 47757 | 100.00 | 1.0000 | 47757 | 1.0000 | 47757 | 1.0000 |
| Autor: Leslye Quinchiguango | ||||||||
Aplicando la Regla de Sturges, con 47,757 observaciones corresponderían 15 intervalos de clase. Sin embargo, un desglose tan fino dificulta la lectura visual y el ajuste de los indicadores sobre la distribución. Por ello, se simplifica el análisis a una tabla de máximo 10 intervalos de clase, criterio que conserva representatividad estadística sin sacrificar claridad interpretativa.
Justificación del agrupamiento. Años Activo es discreta, pero al presentar valores enteros en un rango de 1 a 89 años, una tabla de frecuencia simple resultaría demasiado extensa y poco legible. Por ello se agrupa en intervalos de clase, como se hace con variables continuas, únicamente como recurso para resumir la información; su naturaleza discreta se conserva en los límites e indicadores, que siguen siendo enteros.
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("[", lim_inf, " - ", lim_sup, ")")
etiq[k] <- paste0("[", lim_inf[k], " - ", lim_sup[k]-1, "]")
bind_rows(
data.frame(Intervalo=etiq, MC=as.integer(mc), 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_integer_, 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("*Variable Cuantitativa Discreta Agrupada: A\u00f1os Activo, ",
"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: Leslye Quinchiguango*")) %>%
tab_options(table.width=pct(100), table.font.size=px(13), data_row.padding=px(6))| Tabla N°1: Distribución de Frecuencias | ||||||||
| Variable Cuantitativa Discreta Agrupada: Años Activo, Kansas (n = 47,757) | ||||||||
| Intervalo | MC | ni | hi% | hi | Ni (asc) | Hi (asc) | Ni (desc) | Hi (desc) |
|---|---|---|---|---|---|---|---|---|
| [1 - 10) | 5 | 10340 | 21.65 | 0.2165 | 10340 | 0.2165 | 47757 | 1.0000 |
| [10 - 19) | 14 | 13236 | 27.72 | 0.2772 | 23576 | 0.4937 | 37417 | 0.7835 |
| [19 - 28) | 23 | 6954 | 14.56 | 0.1456 | 30530 | 0.6393 | 24181 | 0.5063 |
| [28 - 37) | 32 | 5433 | 11.38 | 0.1138 | 35963 | 0.7530 | 17227 | 0.3607 |
| [37 - 46) | 41 | 5219 | 10.93 | 0.1093 | 41182 | 0.8623 | 11794 | 0.2470 |
| [46 - 55) | 50 | 2395 | 5.01 | 0.0501 | 43577 | 0.9125 | 6575 | 0.1377 |
| [55 - 64) | 59 | 2570 | 5.38 | 0.0538 | 46147 | 0.9663 | 4180 | 0.0875 |
| [64 - 73) | 68 | 759 | 1.59 | 0.0159 | 46906 | 0.9822 | 1610 | 0.0337 |
| [73 - 82) | 77 | 508 | 1.06 | 0.0106 | 47414 | 0.9928 | 851 | 0.0178 |
| [82 - 89] | 86 | 343 | 0.72 | 0.0072 | 47757 | 1.0000 | 343 | 0.0072 |
| TOTAL | - | 47757 | 100.00 | 1.0000 | 47757 | 1.0000 | 47757 | 1.0000 |
| Autor: Leslye Quinchiguango | ||||||||
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,6,6,2))
plot(h_obj, col=grises, border="black", freq=FALSE,
main="", xlab="", ylab="", las=1, xaxt="n")
axis(1, at=breaks_vec, labels=breaks_vec, las=1, cex.axis=0.9)
mtext("Densidad de Probabilidad", side=2, line=4.5, cex=1)
mtext("A\u00f1os Activo", side=1, line=3.5, cex=1)
mtext("Histograma General \u2014 A\u00f1os Activo, arrendamientos de hidrocarburos, Kansas, EE.UU.",
side=3, line=3, cex=0.95, font=2)
6. Conjetura
El histograma de la variable Años Activo muestra un comportamiento diferenciado en tres tramos. El intervalo [1, 10) presenta densidad inferior al pico principal y no sigue el patrón de decaimiento del resto; el intervalo [46, 55) constituye un repunte aislado que rompe la tendencia descendente; ambos se omiten por no ser representativos del comportamiento general. Trabajando con los intervalos restantes se identifican dos zonas con decaimiento progresivo: en [10, 46) el descenso es más pronunciado y en [55, 90] el decaimiento es más gradual; ambos comportamientos son compatibles con una distribución Exponencial. Se trabaja con dos zonas con corte en 46, omitiendo [1,10) y [46,55), con parámetros estimados exclusivamente con los datos de cada tramo.
set.seed(42)
omitir_1_sup <- 10 # omitir [1, 10)
omitir_2_inf <- 46 # omitir [46, 55)
omitir_2_sup <- 55
corte_z <- 46
lim_z1_min <- omitir_1_sup; lim_z1_max <- corte_z
lim_z2_min <- omitir_2_sup; lim_z2_max <- x_max
x_z1 <- x[x >= omitir_1_sup & x < corte_z]
x_z2 <- x[x >= omitir_2_sup & x <= lim_z2_max]
cat("Omitido [1, 10) \u2014 n:", sum(x < omitir_1_sup), "\n")## Omitido [1, 10) — n: 10340cat("Omitido [46, 55) \u2014 n:", sum(x >= omitir_2_inf & x < omitir_2_sup), "\n")## Omitido [46, 55) — n: 2395cat("Zona 1 [10, 46) \u2014 n:", length(x_z1), "\n")## Zona 1 [10, 46) — n: 30842cat("Zona 2 [55, 90] \u2014 n:", length(x_z2), "\n")## Zona 2 [55, 90] — n: 4180# ── Zona 1: Exponencial ───────────────────────────────────────────────────────
offset_z1 <- min(x_z1) - 0.001
x_z1_pos <- x_z1 - offset_z1
fit_z1 <- fitdistr(x_z1_pos, "exponential")
rate_z1 <- fit_z1$estimate["rate"]
# ── Zona 2: Exponencial ──────────────────────────────────────────────────────
offset_z2 <- min(x_z2) - 0.001
x_z2_pos <- x_z2 - offset_z2
fit_z2 <- fitdistr(x_z2_pos, "exponential")
rate_z2 <- fit_z2$estimate["rate"]
cat("\n--- Zona 1 [10, 46): Exponencial ---\n")##
## --- Zona 1 [10, 46): Exponencial ---cat("\u03bb\u0302 (rate) :", round(rate_z1, 6), "\n")## λ̂ (rate) : 0.073764cat("Offset :", round(offset_z1, 4), "\n")## Offset : 9.999cat("\n--- Zona 2 [55, 90]: Exponencial ---\n")##
## --- Zona 2 [55, 90]: Exponencial ---cat("\u03bb\u0302 (rate) :", round(rate_z2, 6), "\n")## λ̂ (rate) : 0.105401cat("Offset :", round(offset_z2, 4), "\n")## Offset : 54.9996.1 Histograma General con Corte por Zona
h_plot <- hist(x, breaks=breaks_vec, plot=FALSE)
h_plot$density <- hi_dec
# Colorear: omitidos=blanco, zona1=gris oscuro, zona2=gris claro
colores_barras <- ifelse(breaks_vec[-length(breaks_vec)] < omitir_1_sup, "white",
ifelse(breaks_vec[-length(breaks_vec)] < corte_z, "gray35",
ifelse(breaks_vec[-length(breaks_vec)] < omitir_2_sup, "white",
"gray70")))
par(mar=c(5,6,6,2))
plot(h_plot, col=colores_barras, border="black", freq=FALSE,
main="", xlab="", ylab="", las=1, xaxt="n")
axis(1, at=breaks_vec, labels=breaks_vec, las=1, cex.axis=0.9)
abline(v=omitir_1_sup, col="black", lty=3, lwd=1.5)
abline(v=corte_z, col="black", lty=3, lwd=1.5)
abline(v=omitir_2_sup, col="black", lty=2, lwd=2)
yt <- max(hi_dec)
text(mean(c(x_min, omitir_1_sup)), yt*0.80, "Omitido\n[1\u201310)",
cex=0.75, font=3, col="gray40")
text(mean(c(omitir_1_sup, corte_z)), yt*0.80,
"Zona 1\n[10\u201346)\nExponencial", cex=0.80, font=2)
text(mean(c(corte_z, omitir_2_sup)), yt*0.80, "Omitido\n[46\u201355)",
cex=0.75, font=3, col="gray40")
text(mean(c(omitir_2_sup, lim_z2_max)), yt*0.80,
"Zona 2\n[55\u201390]\nExponencial", cex=0.80, font=2)
mtext("Densidad de Probabilidad", side=2, line=4.5, cex=1)
mtext("A\u00f1os Activo", side=1, line=3.5, cex=1)
mtext("Omitidos: [1,10) y [46,55) \u2014 Zona 1: Exponencial | Zona 2: Exponencial",
side=3, line=3, cex=0.9, font=2)
6.2 Histogramas Individuales por Zona
par(mfrow=c(2,1))
# ── Zona 1: Exponencial ───────────────────────────────────────────────────────
breaks_z1 <- seq(lim_z1_min, lim_z1_max, by=c_amp)
if (tail(breaks_z1,1) < lim_z1_max) breaks_z1 <- c(breaks_z1, lim_z1_max)
h_z1 <- hist(x_z1, breaks=breaks_z1, plot=FALSE)
hi_z1 <- h_z1$counts / length(x_z1)
dens_z1 <- hi_z1 / diff(breaks_z1)
h_z1$density <- dens_z1
k_z1 <- length(hi_z1)
grises_z1 <- gray(seq(0.20, 0.60, length.out=k_z1))
xs_z1 <- seq(lim_z1_min - 0.5, lim_z1_max + 0.5, length.out=500)
xs_z1_pos <- xs_z1 - offset_z1; xs_z1_pos[xs_z1_pos <= 0] <- 1e-9
ys_z1 <- dexp(xs_z1_pos, rate=rate_z1)
par(mar=c(5,6,6,2))
plot(h_z1, col=grises_z1, border="black", freq=FALSE,
ylim=c(0, max(c(dens_z1, ys_z1)) * 1.25),
main="", xlab="", ylab="", las=1, xaxt="n")
axis(1, at=breaks_z1, labels=breaks_z1, las=1, cex.axis=0.9)
lines(xs_z1, ys_z1, col="black", lwd=2.5)
mtext("Densidad de Probabilidad", side=2, line=4.5, cex=1)
mtext("A\u00f1os Activo", side=1, line=3.5, cex=1)
mtext(paste0("Gráfica N\u00b02: Zona 1 [10 \u2013 46) \u2014 Exponencial (\u03bb\u0302 = ",
round(rate_z1,4), ")"),
side=3, line=3, cex=0.9, font=2)
legend("topright",
legend=c("Histograma",
paste0("Exponencial(\u03bb\u0302=", round(rate_z1,4), ")")),
fill=c("gray40",NA), border=c("black",NA),
lty=c(NA,1), lwd=c(NA,2.5), bty="n", cex=0.85)
# ── Zona 2: Log-Normal ────────────────────────────────────────────────────────
breaks_z2 <- seq(lim_z2_min, lim_z2_max + 1, by=c_amp)
if (tail(breaks_z2,1) <= lim_z2_max) breaks_z2 <- c(breaks_z2, lim_z2_max + 1)
h_z2 <- hist(x_z2, breaks=breaks_z2, plot=FALSE)
hi_z2 <- h_z2$counts / length(x_z2)
dens_z2 <- hi_z2 / diff(breaks_z2)
h_z2$density <- dens_z2
k_z2 <- length(hi_z2)
grises_z2 <- gray(seq(0.40, 0.85, length.out=k_z2))
xs_z2 <- seq(lim_z2_min - 0.5, lim_z2_max + 0.5, length.out=500)
xs_z2_pos <- xs_z2 - offset_z2; xs_z2_pos[xs_z2_pos <= 0] <- 1e-9
ys_z2 <- dexp(xs_z2_pos, rate=rate_z2)
par(mar=c(5,6,6,2))
plot(h_z2, col=grises_z2, border="black", freq=FALSE,
ylim=c(0, max(c(dens_z2, ys_z2)) * 1.25),
main="", xlab="", ylab="", las=1, xaxt="n")
axis(1, at=breaks_z2, labels=breaks_z2, las=1, cex.axis=0.9)
lines(xs_z2, ys_z2, col="black", lwd=2.5)
mtext("Densidad de Probabilidad", side=2, line=4.5, cex=1)
mtext("A\u00f1os Activo", side=1, line=3.5, cex=1)
mtext(paste0("Gráfica N\u00b03: Zona 2 [55 \u2013 90] \u2014 Exponencial (\u03bb\u0302 = ",
round(rate_z2,4), ")"),
side=3, line=3, cex=0.9, font=2)
legend("topright",
legend=c("Histograma",
paste0("Exponencial(\u03bb\u0302=", round(rate_z2,4), ")")),
fill=c("gray65",NA), border=c("black",NA),
lty=c(NA,1), lwd=c(NA,2.5), bty="n", cex=0.85)
par(mfrow=c(1,1))7. Cálculo de Parámetros y Probabilidades
n_z1 <- length(x_z1); n_z2 <- length(x_z2)
media_z1 <- mean(x_z1); sd_z1_calc <- sd(x_z1)
media_z2 <- mean(x_z2); sd_z2_calc <- sd(x_z2)
media_teo_z2 <- offset_z2 + 1 / rate_z2
data.frame(
Zona = c(
rep("Zona 1 [10, 46) \u2014 Exponencial", 4),
rep("Zona 2 [55, 90] \u2014 Exponencial", 4)
),
Parametro = c(
"n (observaciones zona)",
"Media observada zona",
"\u03bb\u0302 = rate (MV sobre datos desplazados)",
"Offset (min zona \u2212 0.001)",
"n (observaciones zona)",
"Media observada zona",
"\u03bb\u0302 = rate (MV sobre datos desplazados)",
"Offset (min zona \u2212 0.001)"
),
Valor = c(
as.character(n_z1), round(media_z1, 4),
round(rate_z1, 6), round(offset_z1, 4),
as.character(n_z2), round(media_z2, 4),
round(rate_z2, 6), round(offset_z2, 4)
)
) %>%
gt() %>%
tab_header(title = md("**Tabla N\u00b02: Parámetros Estimados por Zona**"),
subtitle = md("*Zona 1: Exponencial | Zona 2: Exponencial \u2014 A\u00f1os Activo*")) %>%
cols_label(Zona=md("**Zona**"), Parametro=md("**Parámetro**"), 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,8,by=2))) %>%
tab_source_note(source_note=md("*Autor: Leslye Quinchiguango*")) %>%
tab_options(table.width=pct(92), heading.title.font.size=px(15),
heading.subtitle.font.size=px(11), table.font.size=px(13),
data_row.padding=px(6))| Tabla N°2: Parámetros Estimados por Zona | ||
| Zona 1: Exponencial | Zona 2: Exponencial — Años Activo | ||
| Zona | Parámetro | Valor |
|---|---|---|
| Zona 1 [10, 46) — Exponencial | n (observaciones zona) | 30842 |
| Zona 1 [10, 46) — Exponencial | Media observada zona | 23.5557 |
| Zona 1 [10, 46) — Exponencial | λ̂ = rate (MV sobre datos desplazados) | 0.073764 |
| Zona 1 [10, 46) — Exponencial | Offset (min zona − 0.001) | 9.999 |
| Zona 2 [55, 90] — Exponencial | n (observaciones zona) | 4180 |
| Zona 2 [55, 90] — Exponencial | Media observada zona | 64.4866 |
| Zona 2 [55, 90] — Exponencial | λ̂ = rate (MV sobre datos desplazados) | 0.105401 |
| Zona 2 [55, 90] — Exponencial | Offset (min zona − 0.001) | 54.999 |
| Autor: Leslye Quinchiguango | ||
# ── Zona 1: Exponencial ───────────────────────────────────────────────────────
p1_a <- pexp(20 - offset_z1, rate=rate_z1) # P(X < 20)
p1_b <- pexp(37 - offset_z1, rate=rate_z1) -
pexp(19 - offset_z1, rate=rate_z1) # P(19 ≤ X < 37)
p1_c <- pexp(28 - offset_z1, rate=rate_z1, lower.tail=FALSE) # P(X ≥ 28)
# ── Zona 2: Exponencial ──────────────────────────────────────────────────────
p2_a <- pexp(64 - offset_z2, rate=rate_z2) # P(X < 64)
p2_b <- pexp(73 - offset_z2, rate=rate_z2) -
pexp(55 - offset_z2, rate=rate_z2) # P(55 ≤ X < 73)
p2_c <- pexp(73 - offset_z2, rate=rate_z2, lower.tail=FALSE) # P(X ≥ 73)
data.frame(
Zona = c(rep("Zona 1 \u2014 Exponencial", 3),
rep("Zona 2 \u2014 Exponencial", 3)),
Evento = c("P(X < 20)", "P(19 \u2264 X < 37)", "P(X \u2265 28)",
"P(X < 64)", "P(55 \u2264 X < 73)", "P(X \u2265 73)"),
Descripcion = c(
"Arrendamientos activos menos de 20 años en Zona 1",
"Arrendamientos en el tramo central de la Zona 1",
"Arrendamientos activos 28 años o más en Zona 1",
"Arrendamientos activos menos de 64 años en Zona 2",
"Arrendamientos en el tramo central de la Zona 2",
"Arrendamientos activos 73 años o más en Zona 2"
),
Probabilidad = round(c(p1_a, p1_b, p1_c, p2_a, p2_b, p2_c), 4)
) %>%
gt() %>%
tab_header(title = md("**Tabla N\u00b03: Cálculo de Probabilidades por Zona**"),
subtitle = md("*La probabilidad es el área bajo la curva del modelo teórico \u2014 A\u00f1os Activo*")) %>%
cols_label(Zona=md("**Zona**"), Evento=md("**Evento**"),
Descripcion=md("**Descripción**"), Probabilidad=md("**Probabilidad**")) %>%
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,6,by=2))) %>%
tab_source_note(source_note=md("*Autor: Leslye Quinchiguango*")) %>%
tab_options(table.width=pct(95), table.font.size=px(13),
heading.title.font.size=px(15), heading.subtitle.font.size=px(11),
data_row.padding=px(6))| Tabla N°3: Cálculo de Probabilidades por Zona | |||
| La probabilidad es el área bajo la curva del modelo teórico — Años Activo | |||
| Zona | Evento | Descripción | Probabilidad |
|---|---|---|---|
| Zona 1 — Exponencial | P(X < 20) | Arrendamientos activos menos de 20 años en Zona 1 | 0.5218 |
| Zona 1 — Exponencial | P(19 ≤ X < 37) | Arrendamientos en el tramo central de la Zona 1 | 0.3784 |
| Zona 1 — Exponencial | P(X ≥ 28) | Arrendamientos activos 28 años o más en Zona 1 | 0.2651 |
| Zona 2 — Exponencial | P(X < 64) | Arrendamientos activos menos de 64 años en Zona 2 | 0.6128 |
| Zona 2 — Exponencial | P(55 ≤ X < 73) | Arrendamientos en el tramo central de la Zona 2 | 0.8499 |
| Zona 2 — Exponencial | P(X ≥ 73) | Arrendamientos activos 73 años o más en Zona 2 | 0.1500 |
| Autor: Leslye Quinchiguango | |||
set.seed(42)
# ── Pearson Zona 1 ────────────────────────────────────────────────────────────
mc_z1 <- (head(breaks_z1,-1) + tail(breaks_z1,-1)) / 2
mc_z1_pos <- mc_z1 - offset_z1; mc_z1_pos[mc_z1_pos <= 0] <- 1e-9
hi_teo_z1 <- dexp(mc_z1_pos, rate=rate_z1) * diff(breaks_z1)
hi_teo_z1 <- hi_teo_z1 / sum(hi_teo_z1)
hi_obs_z1 <- h_z1$counts / n_z1
pearson_z1 <- round(cor(hi_obs_z1, hi_teo_z1) * 100, 2)
# ── Pearson Zona 2 ────────────────────────────────────────────────────────────
mc_z2 <- (head(breaks_z2,-1) + tail(breaks_z2,-1)) / 2
mc_z2_pos <- mc_z2 - offset_z2; mc_z2_pos[mc_z2_pos <= 0] <- 1e-9
hi_teo_z2 <- dexp(mc_z2_pos, rate=rate_z2) * diff(breaks_z2)
hi_teo_z2 <- hi_teo_z2 / sum(hi_teo_z2)
hi_obs_z2 <- h_z2$counts / n_z2
pearson_z2 <- round(cor(hi_obs_z2, hi_teo_z2) * 100, 2)
# ── KS Zona 1 ────────────────────────────────────────────────────────────────
samp_z1 <- sample(x_z1, size=min(400, n_z1), replace=FALSE)
samp_z1_pos <- samp_z1 - offset_z1
ks_z1 <- ks.test(samp_z1_pos, "pexp", rate=rate_z1)
# ── KS Zona 2 ────────────────────────────────────────────────────────────────
samp_z2 <- sample(x_z2, size=min(400, n_z2), replace=FALSE)
samp_z2_pos <- samp_z2 - offset_z2
ks_z2 <- ks.test(samp_z2_pos, "pexp", rate=rate_z2)
val_z1 <- ifelse(pearson_z1 > 70, "APROBADO", "RECHAZADO")
val_z2 <- ifelse(pearson_z2 > 70, "APROBADO", "RECHAZADO")
data.frame(
Zona = c("Zona 1 [10 \u2013 46) \u2014 Exponencial",
"Zona 2 [55 \u2013 90] \u2014 Exponencial"),
Pearson_R = c(pearson_z1, pearson_z2),
KS_pvalor = c(round(ks_z1$p.value,4), round(ks_z2$p.value,4)),
Validacion = c(val_z1, val_z2)
) %>%
gt() %>%
tab_header(title = md("**Tabla N\u00b04: Resumen de Validación por Zona**"),
subtitle = md("*Pearson (R%) y Kolmogorov-Smirnov (p-valor) \u2014 A\u00f1os Activo*")) %>%
cols_label(Zona=md("**Zona**"), Pearson_R=md("**Pearson (R %)**"),
KS_pvalor=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_fill(color="#F5F5F5"), locations=cells_body(rows=1)) %>%
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_R, KS_pvalor, Validacion)) %>%
cols_align(align="left", columns=Zona) %>%
fmt_number(columns=Pearson_R, decimals=2) %>%
fmt_number(columns=KS_pvalor, decimals=4) %>%
tab_source_note(source_note=md("*Autor: Leslye Quinchiguango*")) %>%
tab_options(table.width=pct(92), table.font.size=px(13),
heading.title.font.size=px(15), heading.subtitle.font.size=px(11),
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°4: Resumen de Validación por Zona | |||
| Pearson (R%) y Kolmogorov-Smirnov (p-valor) — Años Activo | |||
| Zona | Pearson (R %) | K-S (p-valor) | Validación |
|---|---|---|---|
| Zona 1 [10 – 46) — Exponencial | 95.02 | 0.0044 | APROBADO |
| Zona 2 [55 – 90] — Exponencial | 98.73 | 0.0000 | APROBADO |
| Autor: Leslye Quinchiguango | |||
8. Intervalo de Confianza
El Intervalo de Confianza estima el rango dentro del cual se encuentra la verdadera media poblacional de Años Activo con un nivel de confianza del 95%, calculado con la totalidad de los registros válidos.
\[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 = "A\u00f1os Activo Promedio Kansas",
Lim_Inferior = round(lim_inf_ic, 4),
Media_Muestral = round(media_muestral, 4),
Lim_Superior = round(lim_sup_ic, 4),
Error_Estandar = paste0("+/- ", round(margen, 4)),
Confianza = "95% (Z = 1.96)",
stringsAsFactors = FALSE
) %>%
gt() %>%
tab_header(title = md("**TABLA N\u00b0 5: ESTIMACIÓN DE LA MEDIA POBLACIONAL**"),
subtitle = md("*Inferencia Estadística para la Variable A\u00f1os Activo*")) %>%
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: Leslye Quinchiguango*")) %>%
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° 5: ESTIMACIÓN DE LA MEDIA POBLACIONAL | |||||
| Inferencia Estadística para la Variable Años Activo | |||||
| Parámetro | Lim_Inferior | Media_Muestral | Lim_Superior | Error_Estándar | Confianza |
|---|---|---|---|---|---|
| Años Activo Promedio Kansas | 24.1322 | 24.2974 | 24.4625 | +/- 0.1652 | 95% (Z = 1.96) |
| Autor: Leslye Quinchiguango | |||||
9. Conclusiones
El comportamiento de Años Activo se explica con un modelo Exponencial (λ̂ = 0.0738) en la Zona 1 [10, 46) y un modelo Exponencial (λ̂ = 0.1054) en la Zona 2 [55, 90]. Podemos afirmar con un 95% de confianza que la media aritmética real de Años Activo se encuentra entre 24.1322 y 24.4625, con una desviación estándar de 18.4168.
Autor: Leslye Quinchiguango — Análisis Estadístico, Kansas Hydrocarbon Leases Dataset