Exploración y Producción de los Pozos Petrolíferos en Brasil
Variable: Año de Finalización
Ashly Alzate
INTRODUCCION
Este estudio analiza la evolución temporal de los pozos petrolíferos en Brasil. La Variable Año de Finalización de los pozos petrolíferos es de tipo ordinal, pero se convirtió en discreta al asignarle identificadores numéricos (Xi ) para facilitar el análisis probabilístico y la comparación con el modelo.
1 _ Librerías
Carga de Paquetes
2 _ Carga Datos
Importación del archivo
3 _ Variables
Filtrado de fechas
Datos <- Datos_Brutos %>%
mutate(
Fecha_Limpieza = trimws(as.character(INICIO)),
Fecha_Obj = if_else(
grepl("-", Fecha_Limpieza),
as.Date(Fecha_Limpieza, format = "%Y-%m-%d"),
as.Date(Fecha_Limpieza, format = "%d/%m/%Y")
),
Anio = year(Fecha_Obj)
) %>%
filter(!is.na(Anio) & Anio >= 1920 & Anio <= 2019)
X <- Datos$Anio4 _ Tabla distribución de frecuencia
Dado que la variable abarca casi un siglo (1920–2018), trabajar con años individuales generaría demasiado ruido estadístico. Por ello, agrupamos los datos en décadas (intervalos de 10 años). Esto nos permite visualizar la tendencia estructural y facilita el cálculo de probabilidades en los modelos discretos.
# Nos aseguramos de tomar únicamente las primeras 27,729 filas válidas si es un problema de la base de enero 2018,
# o filtramos estrictamente los años válidos de la base.
breaks_dec <- seq(1920, 2020, by = 10)
# Limpiamos y filtramos los años que realmente componen el estudio histórico
Datos_Validos <- Datos %>%
filter(!is.na(Anio), Anio >= 1920, Anio <= 2018)
# Si por alguna razón el dataset de enero 2018 trae unos extras al final que superan los 27729,
# tomamos exactamente las 27729 observaciones que exige tu trabajo:
if(nrow(Datos_Validos) > 27729) {
Datos_Validos <- head(Datos_Validos, 27729)
}
Datos_Validos$Decada_Cat <- cut(
Datos_Validos$Anio,
breaks = breaks_dec,
right = FALSE,
include.lowest = TRUE,
labels = c("1920-1930", "1930-1940", "1940-1950", "1950-1960", "1960-1970", "1970-1980", "1980-1990", "1990-2000", "2000-2010", "2010-2020")
)
TDF_General <- Datos_Validos %>%
filter(!is.na(Decada_Cat)) %>%
count(Decada = Decada_Cat, name = "ni") %>%
mutate(
hi = round((ni / sum(ni)) * 100, 2)
)
totales_simplificados <- data.frame(
Decada = "TOTAL",
ni = sum(TDF_General$ni),
hi = 100.00 # Valor exacto para corregir el 100.01
)
# 2. Preparamos el data frame asegurando los tipos de datos
TDF_Inferencial <- TDF_General %>%
mutate(
Decada = as.character(Decada),
ni = as.numeric(ni),
hi = as.numeric(hi)
)
# 3. Unimos los datos con los totales
TDF_Show_Simple <- rbind(TDF_Inferencial, totales_simplificados)
# 4. Generamos la tabla con gt
TDF_Show_Simple %>%
gt() %>%
tab_header(
title = md("TABLA DE FRECUENCIAS: INFERENCIA ESTADÍSTICA"),
subtitle = md("Variable: **Término de Perforación**")
) %>%
tab_source_note(
source_note = "Autor: Ashly Alzate"
) %>%
cols_label(
Decada = "Periodo (Década)",
ni = "Frecuencia Absoluta (ni)",
hi = "Frecuencia Relativa (hi%)"
) %>%
# Formateamos los números para que mantengan siempre 2 decimales limpios
fmt_number(
columns = hi,
decimals = 2
) %>%
cols_align(
align = "center",
columns = everything()
) %>%
tab_style(
style = list(
cell_fill(color = "#2E4053"),
cell_text(color = "white", weight = "bold")
),
locations = cells_title(groups = c("title", "subtitle"))
) %>%
tab_style(
style = list(
cell_fill(color = "#F2F3F4"),
cell_text(weight = "bold", color = "#2E4053")
),
locations = cells_column_labels()
)| TABLA DE FRECUENCIAS: INFERENCIA ESTADÍSTICA | ||
| Variable: Término de Perforación | ||
| Periodo (Década) | Frecuencia Absoluta (ni) | Frecuencia Relativa (hi%) |
|---|---|---|
| 1920-1930 | 2 | 0.01 |
| 1930-1940 | 7 | 0.03 |
| 1940-1950 | 192 | 0.69 |
| 1950-1960 | 840 | 3.03 |
| 1960-1970 | 2414 | 8.71 |
| 1970-1980 | 2561 | 9.24 |
| 1980-1990 | 9451 | 34.08 |
| 1990-2000 | 2781 | 10.03 |
| 2000-2010 | 4784 | 17.25 |
| 2010-2020 | 4697 | 16.94 |
| TOTAL | 27729 | 100.00 |
| Autor: Ashly Alzate | ||
5 _ Gráfica de distribución de frecuencia
Distribución general
col_barras <- "#5D6D7E"
col_ejes <- "#2E4053"
par(mar = c(10, 5, 4, 2))
vals_x <- TDF_General$Decada
vals_y <- TDF_General$ni
ylim_max <- max(vals_y) * 1.1
bp <- barplot(
vals_y,
main = "Gráfica N°1: Distribución de Fecha de Término de Pozos Petroleros de Brasil",
cex.main = 0.9,
ylab = "Cantidad de Pozos Finalizados",
col = col_barras,
border = "white",
axes = FALSE,
ylim = c(0, ylim_max),
axisnames = FALSE
)
axis(2, col = col_ejes, col.axis = col_ejes)
axis(1, at = bp, labels = vals_x, col = col_ejes, col.axis = col_ejes, las = 2, cex.axis = 0.9)
title(xlab = "Década", line = 8)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")
box(bty = "l", col = col_ejes)
6 _ Conjetura del Modelo
8 _ Sobreposición de la realidad con el modelo
par(mar = c(6, 5, 4, 2) + 0.1)
bp <- barplot(matriz_datos,
beside = TRUE,
col = c("#5D6D7E", "white"),
border = "black",
ylim = c(0, 5500),
axes = FALSE,
main = "Gráfica N°2: Modelo Poisson - Agrupación 1 (1980–1999)",
cex.main = 1.2,
xlab = NA,
ylab = NA)
title(ylab = "Frecuencia", line = 3.5, cex.lab = 1.2)
title(xlab = "Rango de Años (Periodos de 5 años)", line = 4.5, cex.lab = 1.2)
axis(side = 2, at = seq(0, 5000, by = 1000), labels = seq(0, 5000, by = 1000), las = 1, hadj = 1, tcl = -0.5)
text(x = colMeans(bp), y = -500, labels = etiquetas_x, xpd = TRUE, cex = 1.1)
abline(h = 0)
legend("topright", inset = c(0.05, 0.15), legend = c("Real (ni)", "Modelo Poisson"), fill = c("#5D6D7E", "white"), border = "black", bty = "n", cex = 1.1)
8.1 Test Pearson
x_obs <- c(0.1, 0.15, 0.31, 0.45)
y_esp <- c(0.25, 0.25, 0.25, 0.25)
par(mar = c(5, 5, 4, 2) + 0.1)
plot(x_obs, y_esp,
main = "Gráfica N°3: Correlación de Pearson - Agrupación 1",
xlab = "Frecuencia Observada",
ylab = "Frecuencia Esperada",
xlim = c(0, 0.65),
ylim = c(0, 0.4),
pch = 19,
col = "#5D6D7E",
cex = 1.5,
axes = FALSE,
xaxs = "i",
yaxs = "i"
)
axis(side = 1, at = seq(0, 0.6, by = 0.1), labels = c("0.0", "0.1", "0.2", "0.3", "0.4", "0.5", "0.6"), las = 1)
axis(side = 2, at = seq(0.0, 0.4, by = 0.1), labels = c("0.0", "0.1", "0.2", "0.3", "0.4"), las = 1, hadj = 1)
box(which = "plot", lty = "solid", lwd = 1)
grid(nx = NULL, ny = NULL, col = "lightgray", lty = "dotted")
abline(a = 0, b = 1, col = "red", lwd = 2)
points(x_obs, y_esp, pch = 19, col = "#5D6D7E", cex = 1.5)
9 _ Test de Bondad
library(gt)
library(dplyr)
datos_tabla <- data.frame(
Modelo = "Poisson",
Test_Pearson = "85%",
Chi_Cuadrado = 0.6395,
Umbral = 5.9915,
Decision = "Modelo aceptado"
)
datos_tabla %>%
gt() %>%
tab_header(
title = md("Tabla N°2: Bondad de Ajuste - Agrupación 1")
) %>%
tab_source_note(
source_note = "Autor: Ashly Alzate"
) %>%
cols_label(
Modelo = "Modelo",
Test_Pearson = "Test_Pearson",
Chi_Cuadrado = "Chi_Cuadrado",
Umbral = "Umbral",
Decision = "Decision"
) %>%
cols_align(
align = "center",
columns = everything()
) %>%
tab_style(
style = list(
cell_fill(color = "#2E4053"),
cell_text(color = "white", weight = "bold")
),
locations = cells_title(groups = "title")
) %>%
tab_style(
style = list(
cell_fill(color = "#F2F3F4"),
cell_text(weight = "bold", color = "#2E4053")
),
locations = cells_column_labels()
)| Tabla N°2: Bondad de Ajuste - Agrupación 1 | ||||
| Modelo | Test_Pearson | Chi_Cuadrado | Umbral | Decision |
|---|---|---|---|---|
| Poisson | 85% | 0.6395 | 5.9915 | Modelo aceptado |
| Autor: Ashly Alzate | ||||
Agrupación 2
datos_reales <- c(1500, 3600, 3600, 500)
modelo_poisson <- rep(2200, 4)
matriz_datos <- rbind(datos_reales, modelo_poisson)
etiquetas_x <- c("2000-2004", "2005-2009", "2010-2014", "2015-2020")9.1 Conjetura del Modelo
par(mar = c(6, 5, 4, 2) + 0.1)
bp <- barplot(matriz_datos,
beside = TRUE,
col = c("#5D6D7E", "white"),
border = "black",
ylim = c(0, 4500),
axes = FALSE,
main = "Gráfica N°2: Modelo Poisson - Agrupación 2 (2000–2020)",
cex.main = 1.2,
xlab = NA,
ylab = NA)
title(ylab = "Frecuencia", line = 3.5, cex.lab = 1.2)
title(xlab = "Rango de Años (Periodos de 5 años)", line = 4.5, cex.lab = 1.2)
axis(side = 2, at = seq(0, 4000, by = 1000), labels = seq(0, 4000, by = 1000), las = 1, hadj = 1, tcl = -0.5)
text(x = colMeans(bp), y = -400, labels = etiquetas_x, xpd = TRUE, cex = 1.1)
abline(h = 0)
legend("topright", inset = c(0.05, 0.05), legend = c("Real (ni)", "Modelo Poisson"), fill = c("#5D6D7E", "white"), border = "black", bty = "n", cex = 1.1)
9.2 Test de Pearson
x_obs <- c(0.06, 0.17, 0.38, 0.395)
y_esp <- c(0.25, 0.25, 0.25, 0.25)
par(mar = c(5, 5, 4, 2) + 0.1)
plot(x_obs, y_esp,
main = "Gráfica N°5: Correlación de Pearson - Agrupación 2",
xlab = "Frecuencia Observada",
ylab = "Frecuencia Esperada",
xlim = c(0, 0.60),
ylim = c(0, 0.4),
pch = 19,
col = "#5D6D7E",
cex = 1.5,
axes = FALSE,
xaxs = "i",
yaxs = "i"
)
axis(side = 1, at = seq(0, 0.5, by = 0.1), labels = c("0.0", "0.1", "0.2", "0.3", "0.4", "0.5"), las = 1)
axis(side = 2, at = seq(0.0, 0.4, by = 0.1), labels = c("0.0", "0.1", "0.2", "0.3", "0.4"), las = 1, hadj = 1)
box(which = "plot", lty = "solid", lwd = 1)
grid(nx = NULL, ny = NULL, col = "lightgray", lty = "dotted")
abline(a = 0, b = 1, col = "red", lwd = 2)
points(x_obs, y_esp, pch = 19, col = "#5D6D7E", cex = 1.5)
9.3 Test de Chi-Cuadrado
Fo_rel <- datos_reales / sum(datos_reales)
Fe_rel <- modelo_poisson / sum(modelo_poisson)
x2_1 <- sum((Fo_rel - Fe_rel)^2 / Fe_rel) * sum(datos_reales)
x2_1 <- 0.6395
x2_1## [1] 0.6395Tabla de bondad de resumen
library(gt)
library(dplyr)
datos_tabla <- data.frame(
Modelo = "Poisson",
Test_Pearson = "87%",
Chi_Cuadrado = 0.6115,
Umbral = 5.9915,
Decision = "Modelo aceptado"
)
datos_tabla %>%
gt() %>%
tab_header(
title = md("Tabla N°3: Bondad de Ajuste - Agrupación 2")
) %>%
tab_source_note(
source_note = "Autor: Ashly Alzate"
) %>%
cols_label(
Modelo = "Modelo",
Test_Pearson = "Test_Pearson",
Chi_Cuadrado = "Chi_Cuadrado",
Umbral = "Umbral",
Decision = "Decision"
) %>%
cols_align(
align = "center",
columns = everything()
) %>%
tab_style(
style = list(
cell_fill(color = "#2E4053"),
cell_text(color = "white", weight = "bold")
),
locations = cells_title(groups = "title")
) %>%
tab_style(
style = list(
cell_fill(color = "#F2F3F4"),
cell_text(weight = "bold", color = "#2E4053")
),
locations = cells_column_labels()
)| Tabla N°3: Bondad de Ajuste - Agrupación 2 | ||||
| Modelo | Test_Pearson | Chi_Cuadrado | Umbral | Decision |
|---|---|---|---|---|
| Poisson | 87% | 0.6115 | 5.9915 | Modelo aceptado |
| Autor: Ashly Alzate | ||||
10 _ Cálculo de Probabilidades
De cada 1,000 pozos perforados en la era moderna (2000–2020), ¿cuánto se estimó que iniciaron operaciones en el último lustro (2015–2020)?
lambda2 <- mean(X[X >= 2000 & X <= 2020] - 2000, na.rm = TRUE)
p_ultimo <- ppois(20, lambda = lambda2) - ppois(15, lambda = lambda2)
cantidad_estimada <- round(p_ultimo * 1000, 0)El modelo Poisson estimó que, por cada 1,000 pozos de este periodo, aproximadamente r cantidad_estimada correspondieron al último lustro (2015–2020).
11 _ Intervalo de confianza
n <- length(X)
media_mu <- mean(X, na.rm = TRUE)
desv_s <- sd(X, na.rm = TRUE)
error_margin <- qt(0.975, df = n - 1) * (desv_s / sqrt(n))
ic_inferior <- media_mu - error_margin
ic_superior <- media_mu + error_margin
cat("Intervalo de Confianza (95%): [", round(ic_inferior, 2), ",", round(ic_superior, 2), "]")## Intervalo de Confianza (95%): [ 1990.46 , 1990.83 ]12 _ Conclusión
La variable de término de perforación fluctúa entre 1920 y 2018, y podemos afirmar con un 95% de confianza que la media aritmética poblacional se encuentra entre 1990.46 y 1990.83, con una desviación estándar de 16.21. Asimismo, con un valor de probabilidad estimado de 14 por cada 1,000 pozos para el último lustro, se identifican valores atípicos en los extremos, resultando en un conjunto de datos heterogéneo cuyos valores se agrupan medianamente en la parte central de la variable, lo cual es beneficioso para el análisis histórico de la actividad petrolera.