\(Variable\) \(de\) \(Estudio\): Fecha de Audiencia (Hearing Date).
Muy Antiguas (29/ago/2002 – 18/sep/2004): Audiencias del inicio del periodo registrado. Corresponden a procesos ya resueltos hace más de una década, con menor relevancia para la gestión administrativa actual.
Antiguas (18/sep/2004 – 10/oct/2006): Audiencias de un periodo posterior temprano, aún distante del presente, asociadas a procesos consolidados en el histórico del bloque.
Medias (10/oct/2006 – 30/oct/2008): Audiencias del punto central del periodo estudiado, donde se concentra buena parte de la actividad regulatoria del bloque.
Recientes (30/oct/2008 – 21/nov/2010): Audiencias correspondientes a los años más próximos al presente, reflejo de trámites relativamente actuales.
Muy Recientes (21/nov/2010 – 12/dic/2012): Audiencias del tramo final del registro, las más cercanas en el tiempo y de mayor interés para la gestión vigente del campo.
##### UNIVERSIDAD CENTRAL DEL ECUADOR #####
#### AUTORES: DALLYANA LOZANO ####
### CARRERA: INGENIERÍA EN PETRÓLEOS #####
#### VARIABLE: FECHA DE AUDIENCIA ####
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 Well Status, omitimos las celdas en blanco y verificamos el tamaño muestral.
suppressPackageStartupMessages({
library(lubridate)
library(dplyr)
})
fechas_raw <- Datos$`Hearing Date`
fechas_validas <- fechas_raw[!is.na(fechas_raw) & fechas_raw != ""]
Fechas_limpias <- mdy(fechas_validas)
Fechas_limpias <- Fechas_limpias[!is.na(Fechas_limpias)]
Fecha_Au <- cut(as.numeric(Fechas_limpias),
breaks = 5,
labels = c("Muy Antiguas",
"Antiguas",
"Medias",
"Recientes",
"Muy Recientes"),
ordered_result = TRUE)
conteo_raw <- table(Fecha_Au)
ni_val <- as.numeric(conteo_raw)
hi_val <- (ni_val / sum(ni_val)) * 100Se extrajo la variable de fecha de audiencia para determinar su frecuencia absoluta (\(n_i\) y el porcentaje relativo (\(hi\)) respecto al total, agrupando los registros en cinco rangos de igual amplitud: Muy Antiguas, Antiguas, Medias, Recientes y Muy Recientes.
# FRECUENCIAS ACUMULADAS
Ni_asc <- cumsum(ni_val)
Ni_desc <- rev(cumsum(rev(ni_val)))
Hi_asc <- cumsum(hi_val)
Hi_desc <- rev(cumsum(rev(hi_val)))
# DATA FRAME PRINCIPAL
df_fecha_final <- data.frame(
Tipo = names(conteo_raw),
ni = as.character(ni_val),
hi = as.character(round(hi_val, 2)),
Ni_asc = as.character(Ni_asc),
Ni_desc = as.character(Ni_desc),
Hi_asc = as.character(round(Hi_asc, 2)),
Hi_desc = as.character(round(Hi_desc, 2))
)
# FILA DE TOTALES
fila_total <- data.frame(
Tipo = "TOTAL",
ni = as.character(sum(ni_val)),
hi = as.character(round(sum(hi_val), 2)),
Ni_asc = "-",
Ni_desc = "-",
Hi_asc = "-",
Hi_desc = "-"
)
df_show_1 <- bind_rows(df_fecha_final, fila_total)
# TABLA 1
df_show_1 %>%
gt() %>%
tab_header(
title = md("**TABLA Nº 1: DISTRIBUCIÓN DE FRECUENCIAS DE FECHA DE AUDIENCIA**")
) %>%
cols_label(
Tipo = "Fecha de Audiencia",
ni = "ni",
hi = "hi (%)",
Ni_asc = "Ni (Asc)",
Ni_desc = "Ni (Desc)",
Hi_asc = "Hi (%) (Asc)",
Hi_desc = "Hi (%) (Desc)"
) %>%
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 AUDIENCIA | ||||||
| Fecha de Audiencia | ni | hi (%) | Ni (Asc) | Ni (Desc) | Hi (%) (Asc) | Hi (%) (Desc) |
|---|---|---|---|---|---|---|
| Muy Antiguas | 1 | 0.44 | 1 | 228 | 0.44 | 100 |
| Antiguas | 44 | 19.3 | 45 | 227 | 19.74 | 99.56 |
| Medias | 83 | 36.4 | 128 | 183 | 56.14 | 80.26 |
| Recientes | 83 | 36.4 | 211 | 100 | 92.54 | 43.86 |
| Muy Recientes | 17 | 7.46 | 228 | 17 | 100 | 7.46 |
| TOTAL | 228 | 100 | - | - | - | - |
Posteriormente, 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_Au
conteo_fecha <- table(Fecha_Au)
ni_fecha <- as.numeric(conteo_fecha)
hi_fecha <- (ni_fecha / sum(ni_fecha)) * 100
# (Muy Antiguas = 1 ... Muy Recientes = 5)
df_fecha_jerarquia <- data.frame(
Asignacion = as.character(1:length(conteo_fecha)),
Tipo = names(conteo_fecha),
ni = as.character(ni_fecha),
hi = as.character(round(hi_fecha, 2))
)
# FILA DE TOTALES
fila_total_jerarquia <- data.frame(
Asignacion = "TOTAL",
Tipo = "",
ni = as.character(sum(ni_fecha)),
hi = as.character(round(sum(hi_fecha), 2))
)
df_show_2 <- bind_rows(df_fecha_jerarquia, fila_total_jerarquia)
df_show_2 %>%
gt() %>%
tab_header(
title = md("**TABLA Nº 2: ASIGNACIÓN JERÁRQUICA DE FECHA DE AUDIENCIA**")
) %>%
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 AUDIENCIA | |||
| Asignación | Rango de Fechas | ni | hi (%) |
|---|---|---|---|
| 1 | Muy Antiguas | 1 | 0.44 |
| 2 | Antiguas | 44 | 19.3 |
| 3 | Medias | 83 | 36.4 |
| 4 | Recientes | 83 | 36.4 |
| 5 | Muy Recientes | 17 | 7.46 |
| TOTAL | 228 | 100 | |
par(mar = c(5, 4, 4, 2))
barplot(as.numeric(df_fecha_final$ni),
main = "GRÁFICO Nº 1: DISTRIBUCIÓN DE LA FECHA DE AUDIENCIA",
ylab = "Cantidad de Pozos",
col = "#B0C4DE",
names.arg = df_fecha_final$Tipo,
las = 1,
cex.names = 1.0,
cex.axis = 0.8,
cex.main = 1.1,
ylim = c(0, max(as.numeric(df_fecha_final$ni), na.rm = TRUE) + max(as.numeric(df_fecha_final$ni), na.rm = TRUE) * 0.1))
mtext("Rango de Fecha de Audiencia", side = 1, line = 3)par(mar = c(5, 4, 4, 2))
barplot(as.numeric(df_fecha_jerarquia$hi),
main = "GRÁFICO Nº 2: DISTRIBUCIÓN DE PORCENTAJE DE LA FECHA DE AUDIENCIA",
ylab = "Porcentaje (%)",
col = "#B0C4DE",
names.arg = df_fecha_jerarquia$Asignacion,
las = 1,
cex.names = 1.0,
cex.axis = 0.8,
cex.main = 1.1,
ylim = c(0, max(as.numeric(df_fecha_jerarquia$hi), na.rm = TRUE) + 10))
mtext("Asignación", side = 1, line = 3)Se validó la fecha de audiencia de los pozos mediante una Distribución Binomial \(B(4, p)\), ajustada a la variable ordinal de cinco categorías. La alta similitud entre las distribuciones observada y teórica confirma un comportamiento probabilístico coherente, validando el análisis temporal de las audiencias.
n_total_Fecha <- sum(as.numeric(df_fecha_jerarquia$ni))
size_binom <- 4
X_indices <- 0:4
media_obs <- sum(X_indices * as.numeric(df_fecha_jerarquia$ni)) / n_total_Fecha
prob_p <- media_obs / size_binom
P_Binomial <- dbinom(X_indices, size = size_binom, prob = prob_p) * 100
par(mar = c(9, 4, 4, 2))
max_y <- max(max(as.numeric(df_fecha_jerarquia$hi)), max(P_Binomial))
barplot(rbind(as.numeric(df_fecha_jerarquia$hi), P_Binomial),
beside = TRUE,
main = "GRÁFICO Nº 3: Comparado de lo Observado frente a lo Esperado de la Fecha de Audiencia",
ylab = "Porcentaje (%)",
names.arg = df_fecha_jerarquia$Asignacion,
col = c("#B0C4DE", "#AED6F1"),
ylim = c(0, max_y + 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 Audiencia", side = 1, line = 6)Fo_F <- as.numeric(df_fecha_jerarquia$hi)
Fe_F <- P_Binomial
test_correlacion <- cor.test(Fo_F, Fe_F)
r_valor <- round(test_correlacion$estimate, 4)
par(mar = c(5, 5, 4, 2))
plot(Fo_F, Fe_F,
main = "GRÁFICO Nº 4: CORRELACIÓN DEL MODELO BINOMIAL - FECHA DE AUDIENCIA",
cex.main = 0.85,
xlab = "Frecuencia Observada (%)",
ylab = "Frecuencia Esperada (%)",
pch = 19,
col = "#2E4053",
cex = 1.5)
abline(lm(Fe_F ~ Fo_F), col = "red", lwd = 2)
text(x = min(Fo_F), y = max(Fe_F),
labels = paste("r =", r_valor),
pos = 4, font = 2, col = "#2E4053")## [1] 99.20626
x2_F <- sum(((Fo_F - Fe_F)^2) / Fe_F)
gl_F <- length(Fo_F) - 1
vc_F <- qchisq(0.99, gl_F)
cat("Estadístico Chi-cuadrado (Calculado):", round(x2_F, 4), "\n")## Estadístico Chi-cuadrado (Calculado): 4.2489
## Valor Crítico (Tabla): 13.2767
## ¿Se acepta el modelo? (Calculado < Crítico): TRUE
tabla_resumen_F <- data.frame(
Variable = "Fecha de Audiencia",
Pearson = round(Correlacion_F, 2),
Chi2 = round(x2_F, 4),
Umbral = round(vc_F, 2),
Resultado = ifelse(x2_F < vc_F, "Modelo Aceptado", "Modelo Rechazado")
)
tabla_resumen_F %>%
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 Audiencia | 99.21 | 4.2489 | 13.28 | Modelo Aceptado |
| Autor: Dallyana Lozano | ||||
# Para la probabilidad alta (última categoría de tu tabla)
prob_alta <- df_fecha_final$hi[nrow(df_fecha_final)]
prob_alta## [1] "7.46"
La probabilidad de que la fecha de audiencia de un pozo seleccionado al azar se ubique en el rango Muy Recientes es de 7.46%, lo que ayuda a dimensionar la actividad regulatoria reciente sobre los pozos del bloque.
## [1] "0.44"
La probabilidad de encontrar pozos con audiencias del rango Muy Antiguas es de 0.44%, lo que permite evaluar posibles rezagos o pendientes de larga data en el trámite de audiencias.
El modelo binomial validado confirma que las probabilidades más bajas se concentran en los extremos de la distribución, 0.44% en Muy Antiguas y 7.46% en Muy Recientes, lo que indica que la mayor parte de las audiencias se agrupa en los rangos intermedios, lo que refleja una gestión administrativa relativamente al día.