\(Variable\) \(de\) \(Estudio\): Fecha de Estado (Status Date).
Antiguas (1884 – 1931): periodo con muy pocos registros.
Medias (1931 – 1979): representación intermedia en el histórico.
Recientes (1979 – 2027): concentra la mayoría de los pozos, con cambios de estado vigentes o recientes.
##### UNIVERSIDAD CENTRAL DEL ECUADOR #####
#### AUTORES: DALLYANA LOZANO ####
### CARRERA: INGENIERÍA EN PETRÓLEOS #####
#### VARIABLE: FECHA DE ESTADO ####
suppressPackageStartupMessages({
library(tidyverse)
library(readxl)
library(gt)
library(dplyr)
library(readr)
library(lubridate)
})
Datos <- read_delim("Dataset.csv", delim = ";", escape_double = FALSE, trim_ws = TRUE, show_col_types = FALSE)Extraemos la variable Status Date, omitimos las celdas en blanco y verificamos el tamaño muestral.
suppressPackageStartupMessages({
library(lubridate)
library(dplyr)
})
fechas_raw_status <- Datos$`Status Date`
fechas_validas_status <- fechas_raw_status[!is.na(fechas_raw_status) & fechas_raw_status != ""]
Fechas_limpias_status <- mdy(fechas_validas_status)
Fechas_limpias_status <- Fechas_limpias_status[!is.na(Fechas_limpias_status)]
Fecha_Status <- cut(as.numeric(Fechas_limpias_status),
breaks = 3,
labels = c("Antiguas",
"Medias",
"Recientes"),
ordered_result = TRUE)
conteo_status <- table(Fecha_Status)
ni_status <- as.numeric(conteo_status)
hi_status <- (ni_status / sum(ni_status)) * 100Se extrajo la variable de fecha de estado para determinar su frecuencia absoluta (\(n_i\))y el porcentaje relativo (\(hi\)) respecto al total, agrupando los registros en tres rangos de igual amplitud: Antiguas, Medias y Recientes.
df_status_final <- data.frame(
Tipo = names(conteo_status),
ni = as.character(ni_status),
hi = as.character(round(hi_status, 2))
)
fila_total_status <- data.frame(
Tipo = "TOTAL",
ni = as.character(sum(ni_status)),
hi = as.character(round(sum(hi_status), 2))
)
df_show_status_1 <- bind_rows(df_status_final, fila_total_status)
df_show_status_1 %>%
gt() %>%
tab_header(
title = md("**TABLA Nº 1: DISTRIBUCIÓN DE FRECUENCIAS DE FECHA DE ESTADO**")
) %>%
cols_label(
Tipo = "Fecha de Estado",
ni = "ni",
hi = "hi (%)"
) %>%
cols_align(align = "center", columns = everything()) %>%
tab_style(
style = list(cell_fill(color = "#F2F3F4"), cell_text(weight = "bold", color = "#2E4053")),
locations = cells_column_labels()
) %>%
tab_style(
style = list(cell_fill(color = "#D0ECE7"), cell_text(weight = "bold")),
locations = cells_body(rows = Tipo == "TOTAL")
) %>%
tab_options(
table.width = pct(90),
data_row.padding = px(12),
column_labels.padding = px(15),
table.border.top.style = "solid",
table.border.top.color = "#2E4053",
table.border.bottom.style = "solid",
table.border.bottom.color = "#2E4053"
)| TABLA Nº 1: DISTRIBUCIÓN DE FRECUENCIAS DE FECHA DE ESTADO | ||
| Fecha de Estado | ni | hi (%) |
|---|---|---|
| Antiguas | 333 | 1.24 |
| Medias | 6606 | 24.57 |
| Recientes | 19952 | 74.2 |
| TOTAL | 26891 | 100 |
Se incorporó una asignación jerárquica ordinal y se consolidó la información en un data frame estructurado para su presentación formal.
# FRECUENCIAS CALCULADAS DIRECTO DESDE Fecha_Status
conteo_status_j <- table(Fecha_Status)
ni_status_j <- as.numeric(conteo_status_j)
hi_status_j <- (ni_status_j / sum(ni_status_j)) * 100
# (Antiguas = 1 ... Recientes = 3)
df_status_jerarquia <- data.frame(
Asignacion = as.character(1:length(conteo_status_j)),
Tipo = names(conteo_status_j),
ni = as.character(ni_status_j),
hi = as.character(round(hi_status_j, 2))
)
# FILA DE TOTALES
fila_total_status_j <- data.frame(
Asignacion = "TOTAL",
Tipo = "",
ni = as.character(sum(ni_status_j)),
hi = as.character(round(sum(hi_status_j), 2))
)
df_show_status_2 <- bind_rows(df_status_jerarquia, fila_total_status_j)
df_show_status_2 %>%
gt() %>%
tab_header(
title = md("**TABLA Nº 2: ASIGNACI\u00d3N JERÁRQUICA DE FECHA DE ESTADO**")
) %>%
cols_label(
Asignacion = "Asignación",
Tipo = "Rango de Fechas",
ni = "ni",
hi = "hi (%)"
) %>%
cols_align(align = "center", columns = everything()) %>%
tab_style(
style = list(cell_fill(color = "#F2F3F4"), cell_text(weight = "bold", color = "#2E4053")),
locations = cells_column_labels()
) %>%
tab_style(
style = list(cell_fill(color = "#D0ECE7"), cell_text(weight = "bold")),
locations = cells_body(rows = Asignacion == "TOTAL")
) %>%
tab_options(
table.width = pct(90),
data_row.padding = px(12),
column_labels.padding = px(15),
table.border.top.style = "solid",
table.border.top.color = "#2E4053",
table.border.bottom.style = "solid",
table.border.bottom.color = "#2E4053"
)| TABLA Nº 2: ASIGNACIÓN JERÁRQUICA DE FECHA DE ESTADO | |||
| Asignación | Rango de Fechas | ni | hi (%) |
|---|---|---|---|
| 1 | Antiguas | 333 | 1.24 |
| 2 | Medias | 6606 | 24.57 |
| 3 | Recientes | 19952 | 74.2 |
| TOTAL | 26891 | 100 | |
par(mar = c(5, 4, 4, 2))
barplot(as.numeric(df_status_final$ni),
main = "GRÁFICO Nº 1: DISTRIBUCI\u00d3N DE FECHA DE ESTADO",
ylab = "Cantidad de Pozos",
col = "#B0C4DE",
names.arg = df_status_final$Tipo,
las = 1,
cex.names = 1.0,
cex.axis = 0.8,
cex.main = 1.1,
ylim = c(0, max(as.numeric(df_status_final$ni), na.rm = TRUE) + max(as.numeric(df_status_final$ni), na.rm = TRUE) * 0.1))
mtext("Rango de Fecha de Estado", side = 1, line = 3)par(mar = c(5, 4, 4, 2))
barplot(as.numeric(df_status_jerarquia$hi),
main = "GRÁFICO Nº 2: DISTRIBUCI\u00d3N DE PORCENTAJE DE FECHA DE ESTADO",
ylab = "Porcentaje (%)",
col = "#B0C4DE",
names.arg = df_status_jerarquia$Asignacion,
las = 1,
cex.names = 1.0,
cex.axis = 0.8,
cex.main = 1.1,
ylim = c(0, max(as.numeric(df_status_jerarquia$hi), na.rm = TRUE) + 10))
mtext("Asignación", side = 1, line = 3)Se validó la fecha de estado (Status Date) de los pozos mediante una Distribución Binomial \(B(2, p)\), ajustada a la variable ordinal de tres categorías. La similitud entre las distribuciones observada y teórica permite evaluar si el comportamiento probabilístico es coherente, validando el análisis temporal del estado.
n_total_Status <- sum(as.numeric(df_status_jerarquia$ni))
size_binom_status <- 2
X_indices_status <- 0:2
media_obs_status <- sum(X_indices_status * as.numeric(df_status_jerarquia$ni)) / n_total_Status
prob_p_status <- media_obs_status / size_binom_status
P_Binomial_Status <- dbinom(X_indices_status, size = size_binom_status, prob = prob_p_status) * 100
par(mar = c(9, 4, 4, 2))
max_y_status <- max(max(as.numeric(df_status_jerarquia$hi)), max(P_Binomial_Status))
barplot(rbind(as.numeric(df_status_jerarquia$hi), P_Binomial_Status),
beside = TRUE,
main = "GRÁFICO Nº 3: Comparado de lo Observado frente a lo Esperado de Fecha de Estado",
ylab = "Porcentaje (%)",
names.arg = df_status_jerarquia$Asignacion,
col = c("#B0C4DE", "#AED6F1"),
ylim = c(0, max_y_status + 25),
las = 1,
cex.names = 0.9,
cex.main = 0.85)
legend("topright",
legend = c("Realidad", "Modelo"),
fill = c("#B0C4DE", "#AED6F1"),
bty = "n", cex = 0.8)
mtext("Rango de Fecha de Estado", side = 1, line = 6)Fo_S <- as.numeric(df_status_jerarquia$hi)
Fe_S <- P_Binomial_Status
test_correlacion_status <- cor.test(Fo_S, Fe_S)
r_valor_status <- round(test_correlacion_status$estimate, 4)
par(mar = c(5, 5, 4, 2))
plot(Fo_S, Fe_S,
main = "GRÁFICO Nº 4: CORRELACIÓN DEL MODELO BINOMIAL - FECHA DE ESTADO",
cex.main = 0.85,
xlab = "Frecuencia Observada (%)",
ylab = "Frecuencia Esperada (%)",
pch = 19,
col = "#2E4053",
cex = 1.5)
abline(lm(Fe_S ~ Fo_S), col = "red", lwd = 2)
text(x = min(Fo_S), y = max(Fe_S),
labels = paste("r =", r_valor_status),
pos = 4, font = 2, col = "#2E4053")## [1] 99.96431
x2_S <- sum(((Fo_S - Fe_S)^2) / Fe_S)
gl_S <- length(Fo_S) - 1
vc_S <- qchisq(0.99, gl_S)
cat("Estad\u00edstico Chi-cuadrado (Calculado):", round(x2_S, 4), "\n")## Estadístico Chi-cuadrado (Calculado): 0.2538
## Valor Crítico (Tabla): 9.2103
## ¿Se acepta el modelo? (Calculado < Crítico): TRUE
tabla_resumen_S <- data.frame(
Variable = "Fecha de Estado",
Pearson = round(Correlacion_S, 2),
Chi2 = round(x2_S, 4),
Umbral = round(vc_S, 2),
Resultado = ifelse(x2_S < vc_S, "Modelo Aceptado", "Modelo Rechazado")
)
tabla_resumen_S %>%
gt() %>%
tab_header(
title = md("**TABLA Nº 3: RESUMEN DEL TEST DE BONDAD AL MODELO DE PROBABILIDAD**")
) %>%
cols_label(
Variable = "Variable",
Pearson = "Test Pearson (%)",
Chi2 = "Chi Cuadrado",
Umbral = "Umbral de Aceptación",
Resultado = "Resultado Final"
) %>%
tab_source_note(
source_note = "Autor: Dallyana Lozano"
) %>%
cols_align(align = "center", columns = everything()) %>%
tab_style(
style = list(cell_fill(color = "#2E4053"), cell_text(color = "white", weight = "bold")),
locations = cells_title()
) %>%
tab_style(
style = list(cell_fill(color = "#F2F3F4"), cell_text(weight = "bold", color = "#2E4053")),
locations = cells_column_labels()
) %>%
tab_options(
table.width = pct(95),
table.border.top.color = "#2E4053",
table.border.bottom.color = "#2E4053",
column_labels.border.bottom.color = "#2E4053",
data_row.padding = px(10)
)| TABLA Nº 3: RESUMEN DEL TEST DE BONDAD AL MODELO DE PROBABILIDAD | ||||
| Variable | Test Pearson (%) | Chi Cuadrado | Umbral de Aceptación | Resultado Final |
|---|---|---|---|---|
| Fecha de Estado | 99.96 | 0.2538 | 9.21 | Modelo Aceptado |
| Autor: Dallyana Lozano | ||||
## [1] "74.2"
La probabilidad de que un pozo se ubique en el rango Recientes es de 74.2%, lo que indica que la mayoría de los pozos tuvo su último cambio de estado registrado en años cercanos al presente.
## [1] "1.24"
La probabilidad de encontrar pozos en el rango Antiguas es de apenas 1.24%, reflejando muy pocos registros con cambios de estado muy antiguos.
El modelo binomial validado para Status Date muestra un buen ajuste, con la mayoría de los registros concentrados en el rango Recientes (74.2%) frente a solo 1.24% en Antiguas, evidenciando que la actualización del estado de los pozos es, en general, un proceso reciente y activo dentro del bloque.