##### UNIVERSIDAD CENTRAL DEL ECUADOR #####
### CARRERA: INGENIERÍA EN PETRÓLEOS #####
#### REGRESIÓN LINEAL ####
## Librerias
library(dplyr)
library(ggplot2)
library(gt)
library(stringr)
## DATASET ##
# Selecciona el archivo CSV manualmente
Datos <- read.csv(file.choose(), 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" ...
Se seleccionó la Producción Acumulada como variable independiente (x), ya que representa el volumen total producido por un pozo a lo largo del tiempo.
Por consiguiente, la Producción Promedio se considera la variable dependiente (y), debido a que refleja el rendimiento medio asociado al nivel de producción acumulada.
Esta relación permite analizar cómo varía la producción promedio en función del volumen total producido, identificando patrones de comportamiento y eficiencia productiva.
# 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$y
# Agrupación de datos (se calcula aquí; se usará más adelante para la tabla y el modelo)
datos_agrupados <- datos_model %>%
mutate(
grupo = ntile(x, 15)
) %>%
group_by(grupo) %>%
summarise(
x = mean(x, na.rm = TRUE),
y = mean(y, na.rm = TRUE),
.groups = "drop"
)
tabla_variables <- datos_agrupados %>%
mutate(
x = round(x, 2),
y = round(y, 2)
) %>%
select(x, y)
tabla_variables %>%
rename(
"Producción Acumulada (x)" = x,
"Producción Promedio (y)" = y
) %>%
gt() %>%
tab_header(
title = md("**Tabla N°1: Comparación de Valores Numéricos de las Variables**"),
subtitle = md("*Pares de valores (x, y) del dataset depurado*")
) %>%
cols_label(
"Producción Acumulada (x)" = md("**Producción Acumulada (x)**"),
"Producción Promedio (y)" = md("**Producción Promedio (y)**")
) %>%
cols_align(
align = "center",
everything()
) %>%
fmt_number(
columns = c("Producción Acumulada (x)", "Producción Promedio (y)"),
decimals = 2,
use_seps = TRUE
) %>%
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_variables), by = 2))
) %>%
tab_source_note(source_note = md("*Valores promedio calculados a partir del dataset depurado. Autor: Fernando Almeida*")) %>%
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°1: Comparación de Valores Numéricos de las Variables | |
| Pares de valores (x, y) del dataset depurado | |
| Producción Acumulada (x) | Producción Promedio (y) |
|---|---|
| 2,424.52 | 784.25 |
| 5,882.30 | 1,103.54 |
| 9,958.28 | 1,455.80 |
| 14,887.26 | 1,722.60 |
| 20,992.01 | 2,080.06 |
| 28,288.47 | 2,224.52 |
| 38,118.98 | 2,670.62 |
| 50,691.20 | 3,138.37 |
| 66,678.00 | 3,754.95 |
| 87,657.60 | 4,372.78 |
| 116,252.11 | 5,336.29 |
| 156,348.75 | 6,727.73 |
| 214,935.47 | 8,742.07 |
| 311,370.92 | 10,611.90 |
| 516,140.93 | 13,961.74 |
| Valores promedio calculados a partir del dataset depurado. Autor: Fernando Almeida | |
La Gráfica N°1 muestra una alta dispersión de los datos originales, lo que dificulta identificar una tendencia clara entre la Producción Acumulada y la Producción Promedio. No obstante, se observa una posible relación creciente, lo que justifica la aplicación de técnicas de suavización mediante agrupación de datos.
par(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()
Se escogió el modelo de regresión lineal debido a que las variables seleccionadas resultan directamente proporcionales por lo tanto la ecuación general del modelo es \(y = mx + b\).
Se presenta el ajuste lineal incluyendo la banda de incertidumbre estadística (Intervalo de Confianza del 95%).
# Se usan los valores agrupados para ajustar el modelo
x <- datos_agrupados$x
y <- datos_agrupados$y
modelo_lineal <- lm(y ~ x, data = datos_agrupados)
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 Agrupados", "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 determinación (R²) es: 0.96
Se evalúa la hipótesis de correlación lineal mediante el test de Pearson, contrastando el valor p obtenido contra un nivel de significancia (α) de 0.05 para determinar si la hipótesis de correlación significativa es aceptada o rechazada.
test_pearson <- cor.test(x, y)
p_valor <- test_pearson$p.value
alpha <- 0.05
decision <- ifelse(p_valor < alpha, "Aceptado", "Rechazado")
tabla_pearson <- data.frame(
Estadistico = c(
"Coeficiente de Correlación (r)",
"Coeficiente de Determinación (R²)",
"Estadístico t",
"Grados de Libertad",
"Valor p",
"Nivel de Significancia (α)",
"Decisión de la Hipótesis"
),
Valor = c(
round(r, 4),
round(r2, 4),
round(unname(test_pearson$statistic), 4),
unname(test_pearson$parameter),
format.pval(p_valor, digits = 4, eps = 0.0001),
alpha,
decision
)
)
tabla_pearson %>%
rename(
"Estadístico" = Estadistico,
"Valor" = Valor
) %>%
gt() %>%
tab_header(
title = md("**Tabla N°1.1: Resultados del Test de Pearson**"),
subtitle = md("*Prueba de Hipótesis de Correlación Lineal*")
) %>%
cols_align(
align = "center",
everything()
) %>%
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_pearson), by = 2))
) %>%
tab_style(
style = list(
cell_fill(color = "#D6D6D6"),
cell_text(weight = "bold")
),
locations = cells_body(
rows = Estadístico == "Decisión de la Hipótesis",
columns = everything()
)
) %>%
tab_source_note(source_note = md("*H₀: No existe correlación lineal (r = 0) — H₁: Existe correlación lineal (r ≠ 0). Autor: Fernando Almeida*")) %>%
tab_options(
table.width = pct(70),
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.1: Resultados del Test de Pearson | |
| Prueba de Hipótesis de Correlación Lineal | |
| Estadístico | Valor |
|---|---|
| Coeficiente de Correlación (r) | 0.9818 |
| Coeficiente de Determinación (R²) | 0.9639 |
| Estadístico t | 18.6409 |
| Grados de Libertad | 13 |
| Valor p | < 0.0001 |
| Nivel de Significancia (α) | 0.05 |
| Decisión de la Hipótesis | Aceptado |
| H₀: No existe correlación lineal (r = 0) — H₁: Existe correlación lineal (r ≠ 0). Autor: Fernando Almeida | |
La ecuación estimada del modelo es:
y = 0.0266 x + 1671.356
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°2 del Resumen del Modelo de Regresión Lineal**")
) %>%
tab_source_note(
source_note = "Autor: Fernando Almeida"
) %>%
cols_align(
align = "center",
everything()
) %>%
tab_options(
heading.title.font.size = px(16),
column_labels.background.color = "#F0F0F0"
)
| Tabla N°2 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 | 1671.36 | 0.0266 | y = 0.0266x + 1671.3559 |
| Autor: Fernando Almeida | ||||||
¿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: 9647.01
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.0266x + 1671.3559\), siendo ‘x’ la Producción Acumulada y ‘y’ la Producción Promedio.
La gráfica no inicia en el origen, ya que el modelo se ajusta al rango real de los datos observados, los cuales fueron previamente depurados y agrupados, excluyendo valores extremos.
El coeficiente de determinación R² ≈ 96%. indica un excelente nivel de explicación de los datos.