##### UNIVERSIDAD CENTRAL DEL ECUADOR #####
#### AUTOR: LISS MURILLO ####
### CARRERA: INGENIERÍA EN PETRÓLEOS #####
#### REGRESIÓN LINEAL ####
## DATASET ##
setwd("~/SEBAS PROYECTO")
# Cargar dataset
Datos <- read.csv("oil_and_gas_leases_data.csv", sep = ",", fileEncoding = "latin1")
## Estructura de los datos
str(Datos)'data.frame': 47757 obs. of 24 variables:
$ KID : int 1001106903 1001106572 1001106590 1001107343 1001108234 1001106684 1001107377 1001107386 1001107740 1001106710 ...
$ DEPTH_OF_WELL : num 700 800 1400 1125 2940 ...
$ CUMULATIVE_PRODUCTION : num 47225 275063 82624 7544 681006 ...
$ AVG_PRODUCTION : num 859 5001 1758 377 24322 ...
$ LATITUDE : num 37.1 38.8 37.5 37.8 37.1 ...
$ LONGITUDE : num -95.9 -95.2 -96.3 -95.7 -101.3 ...
$ YEARS_ACTIVE : num 55 55 47 20 28 55 20 48 48 55 ...
$ SECTION : num 33 11 34 8 30 4 26 28 11 17 ...
$ COUNTY_CODE : num 125 45 49 207 189 121 49 1 31 121 ...
$ STATE_CODE : int 15 15 15 15 15 15 15 15 15 15 ...
$ TOWNSHIP : num 33 15 29 26 33 17 30 26 23 16 ...
$ RANGE : num 14 20 10 16 36 25 12 21 16 24 ...
$ PRODUCES_OIL : num 1 1 1 1 0 1 1 1 1 1 ...
$ PRODUCES_GAS : num 0 0 0 0 1 0 0 0 0 0 ...
$ OPERATOR_NAME : chr "Horton, John" "Whitlow Energy, Inc." "Suerte Oil Company" "Patterson-Blackford" ...
$ FIELD_NAME : chr "WAYSIDE-HAVANA" "BALDWIN" "DUNKLEBERGER" "ROSE EAST" ...
$ PRODUCING_FORMATION : chr "UNKNOWN" "UNKNOWN" "UNKNOWN" "UNKNOWN" ...
$ LONGITUDE_LATITUDE_SOURCE: chr "CENTER_OF_SECTION" "CENTER_OF_SECTION" "CENTER_OF_SECTION" "CENTER_OF_SECTION" ...
$ PROD_LEVEL : chr "MEDIUM" "HIGH" "MEDIUM" "LOW" ...
$ DEPTH_LEVEL : chr "SHALLOW" "SHALLOW" "SHALLOW" "SHALLOW" ...
$ LIFE_STAGE : chr "OLD" "OLD" "OLD" "MATURE" ...
$ AVG_PROD_LEVEL : chr "LOW" "MEDIUM" "MEDIUM" "LOW" ...
$ TOWNSHIP_DIRECTION : chr "S" "S" "S" "S" ...
$ RANGE_DIRECTION : chr "E" "E" "E" "E" ...
# Selección de variables
datos_model <- Datos %>%
select(CUMULATIVE_PRODUCTION, AVG_PRODUCTION) %>%
mutate(
x = abs(as.numeric(gsub(",", ".", as.character(CUMULATIVE_PRODUCTION)))),
y = abs(as.numeric(gsub(",", ".", as.character(AVG_PRODUCTION))))
) %>%
filter(
!is.na(x),
!is.na(y),
x > 0,
y > 0
)
# Omitir outliers
lim_x <- quantile(datos_model$x, probs = c(0.05, 0.95), na.rm = TRUE)
lim_y <- quantile(datos_model$y, probs = c(0.05, 0.95), na.rm = TRUE)
datos_model <- datos_model %>%
filter(
x >= lim_x[1] & x <= lim_x[2],
y >= lim_y[1] & y <= lim_y[2]
)
x <- datos_model$x
y <- datos_model$ypar(mar = c(6, 6, 4, 2))
plot(jitter(x), jitter(y),
main = "Gráfica N°1: Diagrama de Dispersión de la Producción Promedio\n en función de la Producción Acumulada",
xlab = "Producción Acumulada",
ylab = "Producción Promedio",
pch = 19,
col = rgb(46/255, 134/255, 193/255, 0.3),
cex = 0.4,
cex.main = 0.9,
axes = FALSE,
frame.plot = FALSE)
grid(col = "#D7DBDD", lty = "dotted")
# Ejes personalizados
axis(1, at = pretty(x, n = 6),
labels = format(pretty(x, n = 6)))
axis(2, at = pretty(y, n = 6),
labels = format(pretty(y, n = 6)))
box()par(mar = c(6, 6, 4, 2))
plot(x, y,
main = "Gráfica N°2: Modelo de Regresión Lineal de la Producción Promedio\n en función de la Producción Acumulada",
xlab = "Producción Acumulada",
ylab = "Producción Promedio",
pch = 19,
col = rgb(46/255, 134/255, 193/255, 0.5),
cex = 0.6,
cex.main = 0.9,
axes = FALSE,
frame.plot = FALSE)
grid(col = "#D7DBDD", lty = "dotted")
# Ejes personalizados
axis(1, at = pretty(x, n = 6),
labels = format(pretty(x, n = 6), big.mark = ","))
axis(2, at = pretty(y, n = 6),
labels = format(pretty(y, n = 6), big.mark = ","))
box()
# Secuencia de valores
x_seq <- seq(min(x), max(x), length.out = 500)
# Predicciones
predicciones <- predict(modelo_lineal,
newdata = data.frame(x = x_seq),
interval = "confidence",
level = 0.95)
# Banda de confianza
polygon(c(x_seq, rev(x_seq)),
c(predicciones[,"lwr"], rev(predicciones[,"upr"])),
col = rgb(0.5, 0.5, 0.5, 0.2),
border = NA)
# Línea del modelo
lines(x_seq, predicciones[,"fit"],
col = "red",
lwd = 3)
# Leyenda
legend("topleft",
legend = c("Datos Binned", "Modelo Lineal", "I.C. 95%"),
col = c(rgb(46/255, 134/255, 193/255, 0.5), "red", "gray"),
pch = c(16, NA, 15),
lwd = c(NA, 3, NA),
pt.cex = c(0.8, NA, 2),
bty = "n")El coeficiente de correlación de Pearson es: 0.98
El coeficiente de determinación (R²) es: 0.96
La ecuación estimada del modelo es:
y = 0.0265 x + 1685.087
tabla_resumen <- data.frame(
Variable = c("Producción Acumulada", "Producción Promedio"),
Tipo = c("Independiente (x)", "Dependiente (y)"),
Pearson = c("", round(r, 2)),
R2 = c("", round(r2, 2)),
Intercepto = c("", round(b, 2)),
Pendiente = c("", round(m, 4)),
Ecuación = c("", ecuacion)
)
tabla_resumen %>%
gt() %>%
tab_header(
title = md("**Tabla N°1 del Resumen del Modelo de Regresión Lineal**")
) %>%
tab_source_note(
source_note = "Autor: Liss Murillo"
) %>%
cols_align(
align = "center",
everything()
) %>%
tab_options(
heading.title.font.size = px(16),
column_labels.background.color = "#F0F0F0"
)| Tabla N°1 del Resumen del Modelo de Regresión Lineal | ||||||
| Variable | Tipo | Pearson | R2 | Intercepto | Pendiente | Ecuación |
|---|---|---|---|---|---|---|
| Producción Acumulada | Independiente (x) | |||||
| Producción Promedio | Dependiente (y) | 0.98 | 0.96 | 1685.09 | 0.0265 | y = 0.0265x + 1685.087 |
| Autor: Liss Murillo | ||||||
¿Cuál sería la Producción Promedio estimada para una Producción Acumulada de 300000?
Para una Producción Acumulada de 300000 , la Producción Promedio estimada es: 9623.13
Entre la Producción Acumulada y la Producción Promedio existe una relación de tipo lineal, cuya ecuación matemática está representada por \(y = 0.0265x + 1685.087\), donde ‘x’ corresponde a la Producción Acumulada y ‘y’ a la Producción Promedio.
La aplicación de binning permitió reducir la dispersión de los datos, mejorando la estabilidad del modelo y fortaleciendo la relación estadística entre las variables.
El modelo estimado indica que por cada incremento en la Producción Acumulada, la Producción Promedio aumenta aproximadamente en 0.0265 unidades.
El intercepto indica que, cuando la Producción Acumulada es cercana a cero, la Producción Promedio estimada es aproximadamente 1685.087.
El coeficiente de determinación (R² = 0.96) evidencia que el modelo explica el 96% de la variabilidad de la Producción Promedio, mostrando un ajuste estadístico muy alto y una mejora significativa respecto al modelo sin binning.