REGRESIÓN POLINÓMICA
Valeska Araujo
2026-06-15
1 Configuración y Carga de Datos
Se carga el conjunto de datos de arrendamientos de hidrocarburos del estado de Kansas, EE.UU., registrados por el Kansas Geological Survey.
ruta_archivo <- "C:/Users/thann/OneDrive/Escritorio/ESTADISTICA.LOL/datos_vale.csv"
datos_vale <- read_delim(
ruta_archivo,
delim = ";",
show_col_types = FALSE
)
cat("Base de datos cargada correctamente.\n")## Base de datos cargada correctamente.str(datos_vale)## spc_tbl_ [104,173 × 95] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ CODE : chr [1:104173] NA NA "28-JUL-2000 OPERATOR_NAME=COLT ENERGY INCO\"" NA ...
## $ DEPT_WATER_RESOURCES_CODE : chr [1:104173] NA NA "Whitlow Energy, Inc." NA ...
## $ DEPT_MOTOR_VEHICLES_ABBREV : chr [1:104173] NA NA NA NA ...
## $ NAME : chr [1:104173] NA NA "800" NA ...
## $ WIZARD_BASE_REFERENCE_YEAR : chr [1:104173] NA NA "23100" NA ...
## $ WIZARD_PREDEVELOPMENT_YEAR : chr [1:104173] NA NA NA NA ...
## $ UPDATE_DATE_1 : num [1:104173] NA NA 275319 NA NA ...
## $ UPDATE_INITIALS_1 : num [1:104173] NA NA 1970 NA NA NA NA NA NA NA ...
## $ ABBREVIATED_TO_4_CHARS : num [1:104173] NA NA 2026 NA NA ...
## $ KCC_DISTRICT_NUMBER : chr [1:104173] NA NA "DATA_SOURCE" NA ...
## $ OBJECTID : chr [1:104173] "42971829" "42971830" "1001106572" "42971831" ...
## $ KID : chr [1:104173] "1001106903" "1001106572" NA "1001106590" ...
## $ LEASE_NAME : chr [1:104173] "J. G. HAVENER" "EARLY" NA "ELDEN BURKE" ...
## $ FIELD_KID : chr [1:104173] "1000147101" "1000147596" NA "1000147696" ...
## $ OPERATOR_KID : chr [1:104173] "1044772773" "1041810049" "Town Oil Company Inc." "1027997289" ...
## $ LEASE_CODE_PI_BEENE : chr [1:104173] "11322" "10661" NA "10687" ...
## $ LEASE_CODE_DOR : chr [1:104173] "100743" "100416" NA "100434" ...
## $ PRODUCES_GAS : chr [1:104173] "No" "No" "NAD27" "No" ...
## $ PRODUCES_OIL : chr [1:104173] "Yes" "Yes" NA "Yes" ...
## $ STATE_CODE : chr [1:104173] "15" "15" NA "15" ...
## $ COUNTY_CODE : num [1:104173] 125 45 NA 49 49 49 49 207 31 31 ...
## $ LATITUDE : chr [1:104173] "37.132.046" "3.876.033" NA "37.482.822" ...
## $ LATITUDE_LEO_FOOTAGES : logi [1:104173] NA NA NA NA NA NA ...
## $ LATITUDE_LEO_QUARTER_CALLS : chr [1:104173] NA NA NA NA ...
## $ LATITUDE_DIRECTION : chr [1:104173] NA NA "387.603.303" NA ...
## $ LONGITUDE : chr [1:104173] "-95.882.477" "-95.157.902" "-951.579.018" "-96.298.344" ...
## $ LONGITUDE_LEO_FOOTAGES : chr [1:104173] NA NA "387.603.378" NA ...
## $ LONGITUDE_LEO_QUARTER_CALLS : chr [1:104173] NA NA "-951.581.503" NA ...
## $ LONGITUDE_DIRECTION : chr [1:104173] NA NA "312500.22" NA ...
## $ LONGITUDE_LATITUDE_SOURCE : chr [1:104173] "CENTER_OF_SECTION" "CENTER_OF_SECTION" "4292184.41" "CENTER_OF_SECTION" ...
## $ PRINCIPAL_MERIDIAN : num [1:104173] 6 6 15 6 6 6 6 6 6 6 ...
## $ TOWNSHIP : num [1:104173] 33 15 312483 29 31 ...
## $ TOWNSHIP_DIRECTION : chr [1:104173] "S" "S" "4292393.14" "S" ...
## $ RANGE : num [1:104173] 14 20 15 10 10 10 13 16 14 16 ...
## $ RANGE_DIRECTION : chr [1:104173] "E" "E" "EARLY" "E" ...
## $ SECTION : chr [1:104173] "33" "11" "BALDWIN" "34" ...
## $ SUBDIVISION_1_LARGEST : chr [1:104173] NA NA "-105.929.576.967" NA ...
## $ SUBDIVISION_2 : chr [1:104173] NA NA "46.874.008.688" NA ...
## $ SUBDIVISION_3 : chr [1:104173] NA NA NA NA ...
## $ SUBDIVISION_4_SMALLEST : chr [1:104173] NA NA NA NA ...
## $ SPOT : chr [1:104173] NA NA NA NA ...
## $ FEET_NORTH_FROM_REFERENCE : num [1:104173] NA NA NA NA NA NA NA NA NA NA ...
## $ FEET_EAST_FROM_REFERENCE : num [1:104173] NA NA NA NA NA NA NA NA NA NA ...
## $ REFERENCE_CORNER : chr [1:104173] NA NA NA NA ...
## $ MEETS_AND_BOUNDS : logi [1:104173] NA NA NA NA NA NA ...
## $ OLD_SPOT_OR_LOCATION : chr [1:104173] NA NA NA NA ...
## $ UPDATE_INITIALS : chr [1:104173] "DOR#4" "DOR" NA "DOR" ...
## $ UPDATE_DATE : chr [1:104173] "11/23/2013 3:11:58 PM" "5/31/2011 9:48:34 AM" NA "5/31/2011 9:48:35 AM" ...
## $ SKIP_IT : chr [1:104173] NA NA NA NA ...
## $ COMMENTS : chr [1:104173] NA NA NA NA ...
## $ CORRECTIONS : chr [1:104173] "28-JUL-2000 OPERATOR_NAME=HORTON OIL COMPA" "06-FEB-1999 LEASE_NAME=EARLY S." NA "28-JUL-2000 OPERATOR_NAME=DENTON OIL COMPA" ...
## $ OPERATOR_NAME : chr [1:104173] "Horton, John" NA NA "Suerte Oil Company" ...
## $ PRODUCING_FORMATION : chr [1:104173] NA NA NA NA ...
## $ DEPTH_OF_WELL : num [1:104173] 700 NA NA 1400 NA ...
## $ FIELD_CODE_DOR : num [1:104173] 63550 NA NA 25250 10800 ...
## $ DATA_SOURCE : chr [1:104173] NA NA NA NA ...
## $ CUMULATIVE_PRODUCTION : num [1:104173] 47293 NA NA 82624 10518 ...
## $ CUMULATIVE_YEAR_STARTED : num [1:104173] 1970 NA NA 1970 1971 ...
## $ CUMULATIVE_YEAR_ENDED : num [1:104173] 2025 NA NA 2017 1983 ...
## $ FIELD_KID_SOURCE : chr [1:104173] "DATA_SOURCE" NA NA "DATA_SOURCE" ...
## $ LEASE_KID : num [1:104173] 1e+09 NA NA 1e+09 1e+09 ...
## $ LEASE_KID_SOURCE : logi [1:104173] NA NA NA NA NA NA ...
## $ PRODUCING_FORMATION_OLD : chr [1:104173] NA NA NA NA ...
## $ QUARTER_CALLS_SOURCE : chr [1:104173] NA NA NA NA ...
## $ OPERATOR_NAME_OLD : chr [1:104173] "Horton Oil Company, Inc." NA NA "Suerte Oil Company" ...
## $ PRODUCING_FORMATION_STRAT_KID: num [1:104173] NA NA NA NA NA NA NA NA NA NA ...
## $ PRODUCING_FORMATION_SOURCE : chr [1:104173] NA NA NA NA ...
## $ LONGITUDE_LATITUDE_DATUM : chr [1:104173] "NAD27" NA NA "NAD27" ...
## $ GPS_LATITUDE : logi [1:104173] NA NA NA NA NA NA ...
## $ GPS_LONGITUDE : logi [1:104173] NA NA NA NA NA NA ...
## $ GPS_DATUM : logi [1:104173] NA NA NA NA NA NA ...
## $ GPS_SOURCE : logi [1:104173] NA NA NA NA NA NA ...
## $ GPS_DATE : logi [1:104173] NA NA NA NA NA NA ...
## $ GPS_ACCURACY_COMMENTS : logi [1:104173] NA NA NA NA NA NA ...
## $ NAD27_LATITUDE : chr [1:104173] "371.320.458" NA NA "374.828.223" ...
## $ NAD27_LONGITUDE : chr [1:104173] "-95.882.477" NA NA "-962.983.435" ...
## $ NAD83_LATITUDE : chr [1:104173] "371.321.146" NA NA "374.828.544" ...
## $ NAD83_LONGITUDE : chr [1:104173] "-958.827.371" NA NA "-96.298.619" ...
## $ NAD27_UTM_X : num [1:104173] 243937 NA NA 738884 741149 ...
## $ NAD27_UTM_Y : num [1:104173] 4113207 NA NA 4151660 4132923 ...
## $ NAD27_UTM_ZONE : num [1:104173] 15 NA NA 14 14 14 15 15 15 15 ...
## $ NAD83_UTM_X : num [1:104173] 243920 NA NA 738853 741119 ...
## $ NAD83_UTM_Y : num [1:104173] 4113419 NA NA 4151867 4133131 ...
## $ NAD83_UTM_ZONE : num [1:104173] 15 NA NA 14 14 14 15 15 15 15 ...
## $ LEASE_NAME_DOR : chr [1:104173] "HAVENER,J.G." NA NA "ELDEN BURKE" ...
## $ FIELD_NAME : chr [1:104173] "WAYSIDE-HAVANA" NA NA "DUNKLEBERGER" ...
## $ x : chr [1:104173] "-106.736.183.151" NA NA "-107.199.141.514" ...
## $ y : chr [1:104173] "44.575.388.408" NA NA "45.066.267.765" ...
## $ ...89 : logi [1:104173] NA NA NA NA NA NA ...
## $ ...90 : logi [1:104173] NA NA NA NA NA NA ...
## $ ...91 : logi [1:104173] NA NA NA NA NA NA ...
## $ ...92 : logi [1:104173] NA NA NA NA NA NA ...
## $ ...93 : logi [1:104173] NA NA NA NA NA NA ...
## $ ...94 : logi [1:104173] NA NA NA NA NA NA ...
## $ ...95 : logi [1:104173] NA NA NA NA NA NA ...
## - attr(*, "spec")=
## .. cols(
## .. CODE = col_character(),
## .. DEPT_WATER_RESOURCES_CODE = col_character(),
## .. DEPT_MOTOR_VEHICLES_ABBREV = col_character(),
## .. NAME = col_character(),
## .. WIZARD_BASE_REFERENCE_YEAR = col_character(),
## .. WIZARD_PREDEVELOPMENT_YEAR = col_character(),
## .. UPDATE_DATE_1 = col_double(),
## .. UPDATE_INITIALS_1 = col_double(),
## .. ABBREVIATED_TO_4_CHARS = col_double(),
## .. KCC_DISTRICT_NUMBER = col_character(),
## .. OBJECTID = col_character(),
## .. KID = col_character(),
## .. LEASE_NAME = col_character(),
## .. FIELD_KID = col_character(),
## .. OPERATOR_KID = col_character(),
## .. LEASE_CODE_PI_BEENE = col_character(),
## .. LEASE_CODE_DOR = col_character(),
## .. PRODUCES_GAS = col_character(),
## .. PRODUCES_OIL = col_character(),
## .. STATE_CODE = col_character(),
## .. COUNTY_CODE = col_double(),
## .. LATITUDE = col_character(),
## .. LATITUDE_LEO_FOOTAGES = col_logical(),
## .. LATITUDE_LEO_QUARTER_CALLS = col_character(),
## .. LATITUDE_DIRECTION = col_character(),
## .. LONGITUDE = col_character(),
## .. LONGITUDE_LEO_FOOTAGES = col_character(),
## .. LONGITUDE_LEO_QUARTER_CALLS = col_character(),
## .. LONGITUDE_DIRECTION = col_character(),
## .. LONGITUDE_LATITUDE_SOURCE = col_character(),
## .. PRINCIPAL_MERIDIAN = col_double(),
## .. TOWNSHIP = col_double(),
## .. TOWNSHIP_DIRECTION = col_character(),
## .. RANGE = col_double(),
## .. RANGE_DIRECTION = col_character(),
## .. SECTION = col_character(),
## .. SUBDIVISION_1_LARGEST = col_character(),
## .. SUBDIVISION_2 = col_character(),
## .. SUBDIVISION_3 = col_character(),
## .. SUBDIVISION_4_SMALLEST = col_character(),
## .. SPOT = col_character(),
## .. FEET_NORTH_FROM_REFERENCE = col_double(),
## .. FEET_EAST_FROM_REFERENCE = col_double(),
## .. REFERENCE_CORNER = col_character(),
## .. MEETS_AND_BOUNDS = col_logical(),
## .. OLD_SPOT_OR_LOCATION = col_character(),
## .. UPDATE_INITIALS = col_character(),
## .. UPDATE_DATE = col_character(),
## .. SKIP_IT = col_character(),
## .. COMMENTS = col_character(),
## .. CORRECTIONS = col_character(),
## .. OPERATOR_NAME = col_character(),
## .. PRODUCING_FORMATION = col_character(),
## .. DEPTH_OF_WELL = col_double(),
## .. FIELD_CODE_DOR = col_double(),
## .. DATA_SOURCE = col_character(),
## .. CUMULATIVE_PRODUCTION = col_double(),
## .. CUMULATIVE_YEAR_STARTED = col_double(),
## .. CUMULATIVE_YEAR_ENDED = col_double(),
## .. FIELD_KID_SOURCE = col_character(),
## .. LEASE_KID = col_double(),
## .. LEASE_KID_SOURCE = col_logical(),
## .. PRODUCING_FORMATION_OLD = col_character(),
## .. QUARTER_CALLS_SOURCE = col_character(),
## .. OPERATOR_NAME_OLD = col_character(),
## .. PRODUCING_FORMATION_STRAT_KID = col_double(),
## .. PRODUCING_FORMATION_SOURCE = col_character(),
## .. LONGITUDE_LATITUDE_DATUM = col_character(),
## .. GPS_LATITUDE = col_logical(),
## .. GPS_LONGITUDE = col_logical(),
## .. GPS_DATUM = col_logical(),
## .. GPS_SOURCE = col_logical(),
## .. GPS_DATE = col_logical(),
## .. GPS_ACCURACY_COMMENTS = col_logical(),
## .. NAD27_LATITUDE = col_character(),
## .. NAD27_LONGITUDE = col_character(),
## .. NAD83_LATITUDE = col_character(),
## .. NAD83_LONGITUDE = col_character(),
## .. NAD27_UTM_X = col_double(),
## .. NAD27_UTM_Y = col_double(),
## .. NAD27_UTM_ZONE = col_double(),
## .. NAD83_UTM_X = col_double(),
## .. NAD83_UTM_Y = col_double(),
## .. NAD83_UTM_ZONE = col_double(),
## .. LEASE_NAME_DOR = col_character(),
## .. FIELD_NAME = col_character(),
## .. x = col_character(),
## .. y = col_character(),
## .. ...89 = col_logical(),
## .. ...90 = col_logical(),
## .. ...91 = col_logical(),
## .. ...92 = col_logical(),
## .. ...93 = col_logical(),
## .. ...94 = col_logical(),
## .. ...95 = col_logical()
## .. )
## - attr(*, "problems")=<pointer: 0x0000019b9a5dc7b0>2 Extracción y Depuración de Variables
Se extraen y depuran las dos variables continuas seleccionadas para el análisis:
- Variable independiente (X):
CUMULATIVE_YEAR_STARTED— Año de inicio de la producción acumulada. - Variable dependiente (Y):
CUMULATIVE_PRODUCTION— Producción acumulada de petróleo en barriles.
Se argumenta su elección: los pozos más antiguos tuvieron mayor tiempo de explotación, por lo que se espera una relación inversa (a menor año de inicio → mayor producción acumulada). Se filtran únicamente registros con año entre 1930 y 2025 y producción positiva.
datos_dep <- datos_vale %>%
mutate(
anio_inicio = suppressWarnings(as.numeric(CUMULATIVE_YEAR_STARTED)),
produccion = suppressWarnings(as.numeric(CUMULATIVE_PRODUCTION))
) %>%
filter(
!is.na(anio_inicio), !is.na(produccion),
anio_inicio >= 1930, anio_inicio <= 2025,
produccion > 0
) %>%
select(anio_inicio, produccion)
n <- nrow(datos_dep)
cat("Observaciones válidas tras depuración:", n, "\n")## Observaciones válidas tras depuración: 89022# Estadísticos descriptivos
resumen <- data.frame(
Indicador = c("n (observaciones)", "Media (X̄)", "Mediana (Me)",
"Desv. Estándar (Sd)", "Mínimo", "Máximo",
"Coef. Variación (CV%)"),
Anio_inicio = c(
n,
round(mean(datos_dep$anio_inicio), 2),
round(median(datos_dep$anio_inicio), 2),
round(sd(datos_dep$anio_inicio), 2),
min(datos_dep$anio_inicio),
max(datos_dep$anio_inicio),
round((sd(datos_dep$anio_inicio) / mean(datos_dep$anio_inicio)) * 100, 4)
),
Produccion_barriles = c(
n,
round(mean(datos_dep$produccion), 2),
round(median(datos_dep$produccion), 2),
round(sd(datos_dep$produccion), 2),
round(min(datos_dep$produccion), 2),
round(max(datos_dep$produccion), 2),
round((sd(datos_dep$produccion) / mean(datos_dep$produccion)) * 100, 4)
)
)
resumen %>%
gt() %>%
tab_header(
title = md("**Tabla N°1: Estadísticos Descriptivos tras Depuración**"),
subtitle = md("*Año de Inicio (X) — Producción Acumulada (Y)*")
) %>%
cols_label(
Indicador = md("**Indicador**"),
Anio_inicio = md("**Año Inicio Producción**"),
Produccion_barriles = md("**Producción Acumulada (barriles)**")
) %>%
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(resumen), by = 2))
) %>%
tab_source_note(source_note = md("*Autor: Araujo Valeska*")) %>%
tab_options(
table.width = pct(72),
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: Estadísticos Descriptivos tras Depuración | ||
| Año de Inicio (X) — Producción Acumulada (Y) | ||
| Indicador | Año Inicio Producción | Producción Acumulada (barriles) |
|---|---|---|
| n (observaciones) | 89022.0000 | 8.902200e+04 |
| Media (X̄) | 1984.7100 | 5.503553e+05 |
| Mediana (Me) | 1983.0000 | 4.488247e+04 |
| Desv. Estándar (Sd) | 19.5200 | 1.689028e+06 |
| Mínimo | 1930.0000 | 5.000000e-02 |
| Máximo | 2025.0000 | 3.730952e+07 |
| Coef. Variación (CV%) | 0.9836 | 3.068977e+02 |
| Autor: Araujo Valeska | ||
3 Análisis Gráfico Exploratorio
Se grafica la dispersión entre el año de inicio de la producción y la producción acumulada para identificar visualmente la forma de la relación antes de ajustar el modelo.
set.seed(42)
muestra <- datos_dep[sample(nrow(datos_dep), min(4000, n)), ]
par(mar = c(6, 6, 5, 2))
plot(
muestra$anio_inicio,
muestra$produccion,
col = rgb(0.2, 0.2, 0.2, 0.25),
pch = 16,
cex = 0.5,
xlab = "",
ylab = "",
main = ""
)
# Tendencia suavizada LOWESS
linea <- lowess(muestra$anio_inicio, muestra$produccion, f = 0.4)
lines(linea, col = "black", lwd = 2.5)
mtext("Año de Inicio de Producción", side = 1, line = 4, cex = 1)
mtext("Producción Acumulada (barriles)", side = 2, line = 4.5, cex = 1)
mtext("Gráfica N°1: Dispersión — Año de Inicio vs Producción Acumulada",
side = 3, line = 2, adj = 0.5, cex = 0.9, font = 2)
legend("topright",
legend = "Tendencia LOWESS",
col = "black", lwd = 2, bty = "n", cex = 0.85)
La tendencia LOWESS revela una relación decreciente y curvilínea: los pozos con inicio de producción más antiguo acumulan en promedio mayor producción, y la caída se acentúa en los años más recientes. Esto motiva el uso de regresión polinómica.
4 Aplicación de Binning
Se aplica binning de igual amplitud (10 intervalos) sobre el año de inicio de la producción. Para cada intervalo se calcula la producción media acumulada, permitiendo visualizar la tendencia sin el ruido de la dispersión individual.
datos_dep$bin_anio <- cut(datos_dep$anio_inicio, breaks = 10)
tabla_bins <- datos_dep %>%
group_by(bin_anio) %>%
summarise(
n_obs = n(),
media_anio = round(mean(anio_inicio), 2),
media_prod = round(mean(produccion), 2),
mediana_prod = round(median(produccion), 2),
.groups = "drop"
) %>%
mutate(bin_num = row_number())
tabla_bins %>%
select(bin_num, bin_anio, n_obs, media_anio, media_prod, mediana_prod) %>%
gt() %>%
tab_header(
title = md("**Tabla N°2: Binning — Año de Inicio vs Producción Media**"),
subtitle = md("*10 intervalos de igual amplitud sobre el año de inicio*")
) %>%
cols_label(
bin_num = md("**Bin**"),
bin_anio = md("**Intervalo (Año)**"),
n_obs = md("**n**"),
media_anio = md("**Media X (año)**"),
media_prod = md("**Media Y (barriles)**"),
mediana_prod = md("**Mediana Y (barriles)**")
) %>%
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_bins), by = 2))
) %>%
tab_source_note(source_note = md("*Autor: Araujo Valeska*")) %>%
tab_options(
table.width = pct(82),
heading.title.font.size = px(16),
heading.subtitle.font.size = px(12),
table.font.size = px(13),
data_row.padding = px(6)
)| Tabla N°2: Binning — Año de Inicio vs Producción Media | |||||
| 10 intervalos de igual amplitud sobre el año de inicio | |||||
| Bin | Intervalo (Año) | n | Media X (año) | Media Y (barriles) | Mediana Y (barriles) |
|---|---|---|---|---|---|
| 1 | (1.93e+03,1.94e+03] | 1080 | 1937.23 | 645123.65 | 340064.50 |
| 2 | (1.94e+03,1.95e+03] | 2157 | 1944.87 | 299891.90 | 147328.00 |
| 3 | (1.95e+03,1.96e+03] | 6793 | 1955.52 | 3153416.65 | 626287.00 |
| 4 | (1.96e+03,1.97e+03] | 10012 | 1965.26 | 673839.89 | 107010.32 |
| 5 | (1.97e+03,1.98e+03] | 10999 | 1973.23 | 870254.54 | 64653.46 |
| 6 | (1.98e+03,1.99e+03] | 20512 | 1982.24 | 150319.10 | 16697.78 |
| 7 | (1.99e+03,2e+03] | 10982 | 1991.68 | 365122.84 | 62017.18 |
| 8 | (2e+03,2.01e+03] | 10129 | 2002.72 | 149577.56 | 61077.00 |
| 9 | (2.01e+03,2.02e+03] | 13633 | 2010.52 | 89225.51 | 25542.35 |
| 10 | (2.02e+03,2.03e+03] | 2725 | 2019.96 | 31541.82 | 9871.75 |
| Autor: Araujo Valeska | |||||
par(mar = c(6, 6, 5, 2))
plot(
tabla_bins$media_anio,
tabla_bins$media_prod,
col = "gray20",
pch = 19,
cex = 1.5,
type = "b",
lty = 2,
lwd = 1.5,
xlab = "",
ylab = "",
main = ""
)
mtext("Punto Medio del Bin — Año de Inicio", side = 1, line = 4, cex = 1)
mtext("Producción Acumulada Media (barriles)", side = 2, line = 4.5, cex = 1)
mtext("Gráfica N°2: Producción Media por Bin de Año de Inicio",
side = 3, line = 2, adj = 0.5, cex = 0.9, font = 2)
La gráfica de bins confirma una tendencia decreciente y no lineal en la producción media a medida que avanza el año de inicio, con un pico pronunciado en los bins de mediados del siglo XX y un descenso hacia los años recientes.
5 Conjetura del Modelo de Regresión Polinómica
A partir del análisis exploratorio y el binning, se conjetura que la relación puede representarse mediante un polinomio de grado 5:
\[\hat{Y} = \beta_0 + \beta_1 X + \beta_2 X^2 + \beta_3 X^3 + \beta_4 X^4 + \beta_5 X^5\]
donde \(\hat{Y}\) = Producción acumulada estimada (barriles) y \(X\) = Año de inicio de la producción.
Se ajustan y comparan modelos del grado 1 al 5.
mod1 <- lm(produccion ~ poly(anio_inicio, 1, raw = FALSE), data = datos_dep)
mod2 <- lm(produccion ~ poly(anio_inicio, 2, raw = FALSE), data = datos_dep)
mod3 <- lm(produccion ~ poly(anio_inicio, 3, raw = FALSE), data = datos_dep)
mod4 <- lm(produccion ~ poly(anio_inicio, 4, raw = FALSE), data = datos_dep)
mod5 <- lm(produccion ~ poly(anio_inicio, 5, raw = FALSE), data = datos_dep)
get_metrics <- function(m, grado) {
s <- summary(m)
pf_val <- pf(s$fstatistic[1], s$fstatistic[2], s$fstatistic[3], lower.tail = FALSE)
data.frame(
Grado = grado,
R2_ajustado = round(s$adj.r.squared, 6),
RSE = round(s$sigma, 2),
AIC = round(AIC(m), 2),
p_valor_F = format.pval(pf_val, digits = 3, eps = 0.001)
)
}
comparacion <- bind_rows(
get_metrics(mod1, 1), get_metrics(mod2, 2), get_metrics(mod3, 3),
get_metrics(mod4, 4), get_metrics(mod5, 5)
)
mejor_idx <- which.min(comparacion$AIC)
comparacion %>%
gt() %>%
tab_header(
title = md("**Tabla N°3: Comparación de Modelos Polinómicos (Grado 1 a 5)**"),
subtitle = md("*Criterio de selección: menor AIC*")
) %>%
cols_label(
Grado = md("**Grado**"),
R2_ajustado = md("**R² Ajustado**"),
RSE = md("**RSE**"),
AIC = md("**AIC**"),
p_valor_F = md("**p-valor F**")
) %>%
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, 5, by = 2))
) %>%
tab_style(
style = list(cell_fill(color = "#D6D6D6"),
cell_text(weight = "bold")),
locations = cells_body(rows = mejor_idx, columns = everything())
) %>%
tab_source_note(source_note = md("*Autor: Araujo Valeska — Fila resaltada: mejor modelo (menor AIC)*")) %>%
tab_options(
table.width = pct(72),
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: Comparación de Modelos Polinómicos (Grado 1 a 5) | ||||
| Criterio de selección: menor AIC | ||||
| Grado | R² Ajustado | RSE | AIC | p-valor F |
|---|---|---|---|---|
| 1 | 0.073087 | 1626134 | 2798972 | <0.001 |
| 2 | 0.075387 | 1624115 | 2798752 | <0.001 |
| 3 | 0.094015 | 1607671 | 2796941 | <0.001 |
| 4 | 0.116901 | 1587236 | 2794664 | <0.001 |
| 5 | 0.118025 | 1586225 | 2794552 | <0.001 |
| Autor: Araujo Valeska — Fila resaltada: mejor modelo (menor AIC) | ||||
6 Gráfica del Modelo Polinómico (Grado 5)
Se superpone la curva del modelo de grado 5 sobre la nube de puntos (muestra de 4 000 observaciones) para evaluar visualmente su ajuste.
x_seq <- seq(min(datos_dep$anio_inicio), max(datos_dep$anio_inicio), length.out = 500)
y_pred <- predict(mod5, newdata = data.frame(anio_inicio = x_seq))
par(mar = c(6, 6, 5, 2))
plot(
muestra$anio_inicio,
muestra$produccion,
col = rgb(0.2, 0.2, 0.2, 0.2),
pch = 16,
cex = 0.45,
xlab = "",
ylab = "",
main = ""
)
lines(x_seq, y_pred, col = "black", lwd = 2.5)
mtext("Año de Inicio de Producción", side = 1, line = 4, cex = 1)
mtext("Producción Acumulada (barriles)", side = 2, line = 4.5, cex = 1)
mtext("Gráfica N°3: Ajuste del Modelo Polinómico de Grado 5",
side = 3, line = 2, adj = 0.5, cex = 0.9, font = 2)
legend("topright",
legend = paste0("Polinomio grado 5 R²aj = ",
round(summary(mod5)$adj.r.squared, 4)),
col = "black", lwd = 2.5, bty = "n", cex = 0.85)
7 Test de Bondad del Modelo
7.1 Coeficiente de Correlación
El coeficiente de correlación de Pearson (\(r\)) mide la fuerza y dirección de la relación lineal entre el año de inicio de la producción y la producción acumulada.
r <- cor(datos_dep$anio_inicio, datos_dep$produccion)
r_t <- r * sqrt((n - 2) / (1 - r^2)) # estadístico t
p_r <- 2 * pt(abs(r_t), df = n - 2, lower.tail = FALSE)
cat("Coeficiente de correlación de Pearson (r):", round(r, 6), "\n")## Coeficiente de correlación de Pearson (r): -0.270365cat("Estadístico t: ", round(r_t, 4), "\n")## Estadístico t: -83.7872cat("p-valor: ", format.pval(p_r, digits = 3), "\n")## p-valor: <2e-16interpretacion <- dplyr::case_when(
abs(r) < 0.10 ~ "muy débil o nula",
abs(r) < 0.30 ~ "débil",
abs(r) < 0.50 ~ "moderada",
abs(r) < 0.70 ~ "moderada-fuerte",
TRUE ~ "fuerte"
)
direccion <- ifelse(r < 0, "negativa", "positiva")
conclusion <- ifelse(p_r < 0.05,
"SE RECHAZA H₀ — existe correlación lineal significativa",
"NO SE RECHAZA H₀ — no hay evidencia de correlación lineal")
data.frame(
Indicador = c("r de Pearson", "Estadístico t", "p-valor",
"Magnitud", "Dirección", "Conclusión (α = 0.05)"),
Valor = c(round(r, 6), round(r_t, 4), format.pval(p_r, digits = 3),
interpretacion, direccion, conclusion)
) %>%
gt() %>%
tab_header(
title = md("**Tabla N°4: Test de Correlación de Pearson**"),
subtitle = md("*H₀: ρ = 0 vs H₁: ρ ≠ 0*")
) %>%
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, 6, by = 2))
) %>%
tab_style(
style = list(cell_fill(color = "#D6D6D6"),
cell_text(weight = "bold")),
locations = cells_body(rows = 6, columns = everything())
) %>%
tab_source_note(source_note = md("*Autor: Araujo Valeska*")) %>%
tab_options(
table.width = pct(68),
heading.title.font.size = px(16), table.font.size = px(13),
data_row.padding = px(6)
)| Tabla N°4: Test de Correlación de Pearson | |
| H₀: ρ = 0 vs H₁: ρ ≠ 0 | |
| Indicador | Valor |
|---|---|
| r de Pearson | -0.270365 |
| Estadístico t | -83.7872 |
| p-valor | <2e-16 |
| Magnitud | débil |
| Dirección | negativa |
| Conclusión (α = 0.05) | SE RECHAZA H₀ — existe correlación lineal significativa |
| Autor: Araujo Valeska | |
7.2 Coeficiente de Determinación
El coeficiente de determinación (\(R^2\)) indica la proporción de la variabilidad total de \(Y\) explicada por el modelo polinómico de grado 5.
s5 <- summary(mod5)
r2 <- s5$r.squared
r2_adj <- s5$adj.r.squared
pf_val <- pf(s5$fstatistic[1], s5$fstatistic[2], s5$fstatistic[3], lower.tail = FALSE)
concl_f <- ifelse(pf_val < 0.05,
"SE RECHAZA H₀ — el modelo es globalmente significativo",
"NO SE RECHAZA H₀ — el modelo no es globalmente significativo")
cat("R²: ", round(r2, 6), "\n")## R²: 0.118075cat("R² Ajustado: ", round(r2_adj, 6), "\n")## R² Ajustado: 0.118025cat("Variabilidad explicada:", round(r2 * 100, 4), "%\n")## Variabilidad explicada: 11.8075 %cat("p-valor (F): ", format.pval(pf_val, digits = 3), "\n")## p-valor (F): <2e-16data.frame(
Indicador = c("R² (determinación)", "R² Ajustado",
"Variabilidad explicada (%)", "Variabilidad residual (%)",
"Estadístico F", "p-valor (F)",
"Conclusión (α = 0.05)"),
Valor = c(
round(r2, 6),
round(r2_adj, 6),
paste0(round(r2 * 100, 4), " %"),
paste0(round((1-r2) * 100, 4), " %"),
round(s5$fstatistic[1], 4),
format.pval(pf_val, digits = 3),
concl_f
)
) %>%
gt() %>%
tab_header(
title = md("**Tabla N°5: Coeficiente de Determinación — Modelo Grado 5**"),
subtitle = md("*H₀: β₁ = β₂ = β₃ = β₄ = β₅ = 0 vs H₁: al menos un βᵢ ≠ 0*")
) %>%
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, 7, by = 2))
) %>%
tab_style(
style = list(cell_fill(color = "#D6D6D6"),
cell_text(weight = "bold")),
locations = cells_body(rows = c(1, 7), columns = everything())
) %>%
tab_source_note(source_note = md("*Autor: Araujo Valeska*")) %>%
tab_options(
table.width = pct(68),
heading.title.font.size = px(16), table.font.size = px(13),
data_row.padding = px(6)
)| Tabla N°5: Coeficiente de Determinación — Modelo Grado 5 | |
| H₀: β₁ = β₂ = β₃ = β₄ = β₅ = 0 vs H₁: al menos un βᵢ ≠ 0 | |
| Indicador | Valor |
|---|---|
| R² (determinación) | 0.118075 |
| R² Ajustado | 0.118025 |
| Variabilidad explicada (%) | 11.8075 % |
| Variabilidad residual (%) | 88.1925 % |
| Estadístico F | 2383.5453 |
| p-valor (F) | <2e-16 |
| Conclusión (α = 0.05) | SE RECHAZA H₀ — el modelo es globalmente significativo |
| Autor: Araujo Valeska | |
8 Ecuación del Modelo
Los coeficientes \(\beta\) del modelo polinómico de grado 5 estimados por mínimos cuadrados ordinarios son:
betas <- coef(mod5)
nombres_beta <- c("β₀ (Intercepto)", "β₁ (X)", "β₂ (X²)",
"β₃ (X³)", "β₄ (X⁴)", "β₅ (X⁵)")
betas_validos <- betas[!is.na(betas)]
nombres_beta_validos <- nombres_beta[!is.na(betas)]
beta_txt <- function(i) {
if (i <= length(betas) && !is.na(betas[i])) {
format(betas[i], scientific = TRUE, digits = 4)
} else {
"0"
}
}
data.frame(
Coeficiente = nombres_beta_validos,
Estimacion = format(betas_validos, scientific = TRUE, digits = 5)
) %>%
gt() %>%
tab_header(
title = md("**Tabla N°6: Coeficientes del Modelo Polinómico — Grado 5**"),
subtitle = md("*Ŷ = β₀ + β₁X + β₂X² + β₃X³ + β₄X⁴ + β₅X⁵*")
) %>%
cols_label(
Coeficiente = md("**Coeficiente**"),
Estimacion = md("**Estimación**")
) %>%
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: Araujo Valeska*")) %>%
tab_options(
table.width = pct(62),
heading.title.font.size = px(16), table.font.size = px(13),
data_row.padding = px(6)
)| Tabla N°6: Coeficientes del Modelo Polinómico — Grado 5 | |
| Ŷ = β₀ + β₁X + β₂X² + β₃X³ + β₄X⁴ + β₅X⁵ | |
| Coeficiente | Estimación |
|---|---|
| β₀ (Intercepto) | 5.5036e+05 |
| β₁ (X) | -1.3625e+08 |
| β₂ (X²) | 2.4225e+07 |
| β₃ (X³) | 6.8798e+07 |
| β₄ (X⁴) | -7.6253e+07 |
| β₅ (X⁵) | 1.6968e+07 |
| Autor: Araujo Valeska | |
La ecuación estimada del modelo es:
\[\hat{Y} = 5.504e+05 + -1.362e+08X + 2.423e+07X^2 + 6.88e+07X^3 + -7.625e+07X^4 + 1.697e+07X^5\]
donde \(X\) representa el año de inicio de la producción acumulada.
9 Tabla Resumen del Modelo
Se presenta el resumen completo del modelo polinómico de grado 5 con coeficientes, errores estándar, estadístico \(t\) y p-valores de cada término.
coef_tabla <- as.data.frame(s5$coefficients)
coef_tabla$Termino <- nombres_beta_validos
coef_tabla <- coef_tabla[, c("Termino", "Estimate", "Std. Error", "t value", "Pr(>|t|)")]
coef_tabla %>%
mutate(
Estimate = format(Estimate, scientific = TRUE, digits = 5),
`Std. Error` = format(`Std. Error`, scientific = TRUE, digits = 5),
`t value` = round(`t value`, 4),
`Pr(>|t|)` = format.pval(`Pr(>|t|)`, digits = 3, eps = 0.001),
Sig = case_when(
suppressWarnings(as.numeric(gsub("[<>]", "", `Pr(>|t|)`))) < 0.001 ~ "***",
suppressWarnings(as.numeric(gsub("[<>]", "", `Pr(>|t|)`))) < 0.01 ~ "**",
suppressWarnings(as.numeric(gsub("[<>]", "", `Pr(>|t|)`))) < 0.05 ~ "*",
suppressWarnings(as.numeric(gsub("[<>]", "", `Pr(>|t|)`))) < 0.10 ~ ".",
TRUE ~ ""
)
) %>%
gt() %>%
tab_header(
title = md("**Tabla N°7: Resumen del Modelo Polinómico — Grado 5**"),
subtitle = md("*Variable dependiente: Producción Acumulada (barriles)*")
) %>%
cols_label(
Termino = md("**Término**"),
Estimate = md("**Estimación (β)**"),
`Std. Error` = md("**Error Estándar**"),
`t value` = md("**Estadístico t**"),
`Pr(>|t|)` = md("**p-valor**"),
Sig = md("**Sig.**")
) %>%
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_footnote(
footnote = "Códigos de significancia: *** p<0.001 ** p<0.01 * p<0.05 . p<0.10",
locations = cells_column_labels(columns = Sig)
) %>%
tab_source_note(source_note = md(paste0(
"*R² = ", round(r2, 6),
" | R² Ajustado = ", round(r2_adj, 6),
" | RSE = ", round(s5$sigma, 2),
" | n = ", n, "*"
))) %>%
tab_options(
table.width = pct(88),
heading.title.font.size = px(16),
heading.subtitle.font.size = px(12),
table.font.size = px(13),
data_row.padding = px(6)
)| Tabla N°7: Resumen del Modelo Polinómico — Grado 5 | |||||
| Variable dependiente: Producción Acumulada (barriles) | |||||
| Término | Estimación (β) | Error Estándar | Estadístico t | p-valor | Sig.1 |
|---|---|---|---|---|---|
| β₀ (Intercepto) | 5.5036e+05 | 5.3164e+03 | 103.5207 | <0.001 | ** |
| β₁ (X) | -1.3625e+08 | 1.5862e+06 | -85.8953 | <0.001 | ** |
| β₂ (X²) | 2.4225e+07 | 1.5862e+06 | 15.2722 | <0.001 | ** |
| β₃ (X³) | 6.8798e+07 | 1.5862e+06 | 43.3719 | <0.001 | ** |
| β₄ (X⁴) | -7.6253e+07 | 1.5862e+06 | -48.0722 | <0.001 | ** |
| β₅ (X⁵) | 1.6968e+07 | 1.5862e+06 | 10.6973 | <0.001 | ** |
| 1 Códigos de significancia: *** p<0.001 ** p<0.01 * p<0.05 . p<0.10 | |||||
| R² = 0.118075 | R² Ajustado = 0.118025 | RSE = 1586225.19 | n = 89022 | |||||
10 Cálculo de Estimaciones
Se realizan estimaciones puntuales de la producción acumulada esperada para distintos años de inicio, empleando el modelo polinómico de grado 5, con intervalo de predicción al 95%.
anios_estimar <- c(1930, 1940, 1950, 1955, 1960, 1965, 1970,
1975, 1980, 1985, 1990, 1995, 2000, 2005,
2010, 2015, 2020, 2025)
y_est <- predict(mod5,
newdata = data.frame(anio_inicio = anios_estimar),
interval = "prediction",
level = 0.95)
tabla_est <- data.frame(
Anio_inicio = anios_estimar,
Produccion_estimada = round(y_est[, "fit"], 2),
LI_95 = round(y_est[, "lwr"], 2),
LS_95 = round(y_est[, "upr"], 2)
)
tabla_est %>%
gt() %>%
tab_header(
title = md("**Tabla N°8: Estimaciones del Modelo Polinómico — Grado 5**"),
subtitle = md("*Producción acumulada estimada con intervalo de predicción al 95%*")
) %>%
cols_label(
Anio_inicio = md("**Año de Inicio (X)**"),
Produccion_estimada = md("**Ŷ estimada (barriles)**"),
LI_95 = md("**LI 95%**"),
LS_95 = md("**LS 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_est), by = 2))
) %>%
tab_source_note(source_note = md("*Autor: Araujo Valeska*")) %>%
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°8: Estimaciones del Modelo Polinómico — Grado 5 | |||
| Producción acumulada estimada con intervalo de predicción al 95% | |||
| Año de Inicio (X) | Ŷ estimada (barriles) | LI 95% | LS 95% |
|---|---|---|---|
| 1930 | -3775345.08 | -6895145 | -655545.5 |
| 1940 | 723338.64 | -2386178 | 3832855.2 |
| 1950 | 1962117.70 | -1147113 | 5071348.7 |
| 1955 | 1929299.92 | -1179834 | 5038433.8 |
| 1960 | 1679977.63 | -1429096 | 4789051.7 |
| 1965 | 1331261.13 | -1777795 | 4440317.5 |
| 1970 | 967791.40 | -2141258 | 4076841.3 |
| 1975 | 645758.89 | -2463279 | 3754796.9 |
| 1980 | 396922.42 | -2712106 | 3505951.1 |
| 1985 | 232627.96 | -2876405 | 3341660.8 |
| 1990 | 147827.54 | -2961219 | 3256873.9 |
| 1995 | 125098.03 | -2983956 | 3234152.1 |
| 2000 | 138660.03 | -2970391 | 3247710.8 |
| 2005 | 158396.71 | -2950654 | 3267447.6 |
| 2010 | 153872.63 | -2955197 | 3262941.9 |
| 2015 | 98352.59 | -3010761 | 3207465.9 |
| 2020 | -27179.51 | -3136540 | 3082181.3 |
| 2025 | -230001.85 | -3340925 | 2880921.2 |
| Autor: Araujo Valeska | |||
par(mar = c(6, 6, 5, 2))
plot(
muestra$anio_inicio,
muestra$produccion,
col = rgb(0.2, 0.2, 0.2, 0.18),
pch = 16,
cex = 0.45,
xlab = "",
ylab = "",
main = ""
)
lines(x_seq, y_pred, col = "black", lwd = 2.5)
points(tabla_est$Anio_inicio,
tabla_est$Produccion_estimada,
col = "gray20", pch = 17, cex = 1.3)
mtext("Año de Inicio de Producción", side = 1, line = 4, cex = 1)
mtext("Producción Acumulada (barriles)", side = 2, line = 4.5, cex = 1)
mtext("Gráfica N°4: Modelo Polinómico Grado 5 con Puntos Estimados",
side = 3, line = 2, adj = 0.5, cex = 0.9, font = 2)
legend("topright",
legend = c("Datos (muestra)", "Curva ajustada grado 5", "Estimaciones"),
col = c(rgb(0.2, 0.2, 0.2, 0.35), "black", "gray20"),
pch = c(16, NA, 17),
lty = c(NA, 1, NA),
lwd = c(NA, 2.5, NA),
bty = "n", cex = 0.82)
11 Conclusiones
Se ajustó un modelo de regresión polinómica de grado
5 para estudiar la relación entre el año de inicio de
la producción acumulada (CUMULATIVE_YEAR_STARTED,
variable independiente \(X\)) y la
producción acumulada de petróleo
(CUMULATIVE_PRODUCTION, variable dependiente \(Y\)), con 89,022
observaciones válidas del conjunto de datos de arrendamientos de
Kansas.
Los principales resultados del análisis son:
- Test de Pearson: el coeficiente de correlación fue r = -0.2704, de magnitud débil y dirección negativa; se rechazó H₀ (p < 0.05), confirmando la existencia de correlación lineal significativa.
- Coeficiente de determinación: el modelo polinómico de grado 5 explica el 11.8075% de la variabilidad total de la producción (R²), con un R² ajustado de 11.8025%; el modelo polinómico resulta globalmente significativo (p < 0.05).
- Error Estándar Residual (RSE): 1.5862252^{6} barriles.
- La tendencia decreciente observada es coherente con la lógica del dominio: los pozos con inicio más antiguo han tenido mayor tiempo de explotación y acumulan, en promedio, mayor producción. La caída pronunciada en años recientes refleja la maduración de los campos petroleros de Kansas.
- El binning fue esencial para revelar la curvatura de la relación, justificando el uso del modelo polinómico frente a la regresión lineal simple.
Autor: Araujo Valeska