DATE WELL CONFIDENTIALY ENDS

Modelo Binormal

1 IDENTIFICACIÓN Y JUSTIFICACIÓN DE LA VARIABLE

\(Variable\) \(de\) \(Estudio\): Fecha de Fin de Confidencialidad (Date Well Confidentiality Ends).

1. Muy Antiguas (1916 – 1944): periodo con muy pocos registros.

2. Antiguas (1944 – 1971): escasa representación en el histórico.

3. Recientes (1971 – 1999): comienza a concentrarse buena parte de los registros.

4. Muy Recientes (1999 – 2026): concentra la mayoría de los pozos, con confidencialidad vigente o recién vencida.

2 CARGA DE DATOS

##### UNIVERSIDAD CENTRAL DEL ECUADOR #####
#### AUTORES: DALLYANA LOZANO ####
### CARRERA: INGENIERÍA EN PETRÓLEOS #####
#### VARIABLE: FECHA DE FIN DE CONFIDENCIALIDAD ####
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)

3 EXTRAER VARIABLE

Extraemos la variable Date Well Confidentiality Ends, omitimos las celdas en blanco y verificamos el tamaño muestral.

suppressPackageStartupMessages({
  library(lubridate)
  library(dplyr)
})

fechas_raw_conf <- Datos$`Date Well Confidentiality Ends`
fechas_validas_conf <- fechas_raw_conf[!is.na(fechas_raw_conf) & fechas_raw_conf != ""]
Fechas_limpias_conf <- mdy(fechas_validas_conf)
Fechas_limpias_conf <- Fechas_limpias_conf[!is.na(Fechas_limpias_conf)]

Fecha_Conf <- cut(as.numeric(Fechas_limpias_conf),
                breaks = 4,
                labels = c("Muy Antiguas",
                           "Antiguas",
                           "Recientes",
                           "Muy Recientes"),
                ordered_result = TRUE)

conteo_conf <- table(Fecha_Conf)
ni_conf <- as.numeric(conteo_conf)
hi_conf <- (ni_conf / sum(ni_conf)) * 100

4 TABLAS DE DISTRIBUCIÓN DE FRECUENCIA

4.1 DISTRIBUCIÓN DE FRECUENCIAS DE LA FECHA DE FIN DE CONFIDENCIALIDAD

Se extrajo la variable de fecha de fin de confidencialidad para determinar su frecuencia absoluta (\(n_i\))y el porcentaje relativo (\(hi\)) respecto al total, agrupando los registros en cuatro rangos de igual amplitud: Muy Antiguas, Antiguas, Recientes y Muy Recientes.

# DATA FRAME PRINCIPAL
df_conf_final <- data.frame(
  Tipo = names(conteo_conf),
  ni = as.character(ni_conf),
  hi = as.character(round(hi_conf, 2))
)

# FILA DE TOTALES
fila_total_conf <- data.frame(
  Tipo = "TOTAL",
  ni = as.character(sum(ni_conf)),
  hi = as.character(round(sum(hi_conf), 2))
)

df_show_conf_1 <- bind_rows(df_conf_final, fila_total_conf)

# TABLA 1
df_show_conf_1 %>%
  gt() %>%
  tab_header(
    title = md("**TABLA Nº 1: DISTRIBUCIÓN DE FRECUENCIAS DE FECHA DE FIN DE CONFIDENCIALIDAD**")
  ) %>%
  cols_label(
    Tipo = "Fecha de Fin de Confidencialidad", 
    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 FIN DE CONFIDENCIALIDAD
Fecha de Fin de Confidencialidad	ni	hi (%)
Muy Antiguas	1	0.01
Antiguas	2	0.03
Recientes	2742	36.24
Muy Recientes	4821	63.72
TOTAL	7566	100

4.2 ASIGNACIÓN JERÁRQUICA

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_Conf
conteo_conf_j <- table(Fecha_Conf)
ni_conf_j <- as.numeric(conteo_conf_j)
hi_conf_j <- (ni_conf_j / sum(ni_conf_j)) * 100

# (Muy Antiguas = 1 ... Muy Recientes = 4)
df_conf_jerarquia <- data.frame(
  Asignacion = as.character(1:length(conteo_conf_j)),
  Tipo = names(conteo_conf_j),
  ni = as.character(ni_conf_j),
  hi = as.character(round(hi_conf_j, 2))
)

# FILA DE TOTALES
fila_total_conf_j <- data.frame(
  Asignacion = "TOTAL",
  Tipo = "",
  ni = as.character(sum(ni_conf_j)),
  hi = as.character(round(sum(hi_conf_j), 2))
)

df_show_conf_2 <- bind_rows(df_conf_jerarquia, fila_total_conf_j)

df_show_conf_2 %>%
  gt() %>%
  tab_header(
    title = md("**TABLA Nº 2: ASIGNACIÓN JERÁRQUICA DE FECHA DE FIN DE CONFIDENCIALIDAD**")
  ) %>%
  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 FIN DE CONFIDENCIALIDAD
Asignación	Rango de Fechas	ni	hi (%)
1	Muy Antiguas	1	0.01
2	Antiguas	2	0.03
3	Recientes	2742	36.24
4	Muy Recientes	4821	63.72
TOTAL		7566	100

5 REPRESENTACIÓN GRÁFICA

5.1 DIAGRAMA DE BARRAS - FRECUENCIA ABSOLUTA

par(mar = c(5, 4, 4, 2))
barplot(as.numeric(df_conf_final$ni),
        main = "GRÁFICO Nº 1: DISTRIBUCIÓN DE LA FECHA DE FIN DE CONFIDENCIALIDAD",
        ylab = "Cantidad de Pozos",
        col = "#B0C4DE",      
        names.arg = df_conf_final$Tipo, 
        las = 1,            
        cex.names = 1.0,      
        cex.axis = 0.8,      
        cex.main = 1.1,        
        ylim = c(0, max(as.numeric(df_conf_final$ni), na.rm = TRUE) + max(as.numeric(df_conf_final$ni), na.rm = TRUE) * 0.1)) 
mtext("Rango de Fecha de Fin de Confidencialidad", side = 1, line = 3)

5.2 DIAGRAMA DE BARRAS - FRECUENCIA RELATIVA

par(mar = c(5, 4, 4, 2))

barplot(as.numeric(df_conf_jerarquia$hi),
        main = "GRÁFICO Nº 2: DISTRIBUCIÓN DE PORCENTAJE DE FIN DE CONFIDENCIALIDAD",
        ylab = "Porcentaje (%)",
        col = "#B0C4DE",      
        names.arg = df_conf_jerarquia$Asignacion, 
        las = 1,            
        cex.names = 1.0,      
        cex.axis = 0.8,      
        cex.main = 1.1,        
        ylim = c(0, max(as.numeric(df_conf_jerarquia$hi), na.rm = TRUE) + 10)) 

mtext("Asignación", side = 1, line = 3)

6 CONJETURA DEL MODELO

Se validó la fecha de fin de confidencialidad de los pozos mediante una Distribución Binomial \(B(3, p)\), ajustada a la variable ordinal de cuatro 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 de la confidencialidad.

n_total_Conf <- sum(as.numeric(df_conf_jerarquia$ni))
size_binom_conf <- 3   
X_indices_conf <- 0:3  
media_obs_conf <- sum(X_indices_conf * as.numeric(df_conf_jerarquia$ni)) / n_total_Conf
prob_p_conf <- media_obs_conf / size_binom_conf
P_Binomial_Conf <- dbinom(X_indices_conf, size = size_binom_conf, prob = prob_p_conf) * 100

par(mar = c(9, 4, 4, 2))
max_y_conf <- max(max(as.numeric(df_conf_jerarquia$hi)), max(P_Binomial_Conf))
barplot(rbind(as.numeric(df_conf_jerarquia$hi), P_Binomial_Conf), 
        beside = TRUE,
        main = "GRÁFICO Nº 3: Comparado de lo Observado frente a lo Esperado de la Fecha de Fin de Confidencialidad",
        ylab = "Porcentaje (%)",
        names.arg = df_conf_jerarquia$Asignacion, 
        col = c("#B0C4DE", "#AED6F1"), 
        ylim = c(0, max_y_conf + 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 Fin de Confidencialidad", side = 1, line = 6)

7 TEST DE PEARSON

Fo_C <- as.numeric(df_conf_jerarquia$hi)
Fe_C <- P_Binomial_Conf 
test_correlacion_conf <- cor.test(Fo_C, Fe_C)
r_valor_conf <- round(test_correlacion_conf$estimate, 4)
par(mar = c(5, 5, 4, 2)) 
plot(Fo_C, Fe_C, 
     main = "GRÁFICO Nº 4: CORRELACIÓN DEL MODELO BINOMIAL - FECHA DE FIN DE CONFIDENCIALIDAD",
     cex.main = 0.85,
     xlab = "Frecuencia Observada (%)", 
     ylab = "Frecuencia Esperada (%)", 
     pch = 19,            
     col = "#2E4053",    
     cex = 1.5)         
abline(lm(Fe_C ~ Fo_C), col = "red", lwd = 2)
text(x = min(Fo_C), y = max(Fe_C), 
     labels = paste("r =", r_valor_conf), 
     pos = 4, font = 2, col = "#2E4053")

Correlacion_C <- cor(Fo_C, Fe_C) * 100
Correlacion_C

## [1] 98.29162

8 TEST DE CHI-CUADRADO

x2_C <- sum(((Fo_C - Fe_C)^2) / Fe_C)
gl_C <- length(Fo_C) - 1
vc_C <- qchisq(0.99, gl_C)
cat("Estadístico Chi-cuadrado (Calculado):", round(x2_C, 4), "\n")

## Estadístico Chi-cuadrado (Calculado): 6.6028

cat("Valor Crítico (Tabla):", round(vc_C, 4), "\n")

## Valor Crítico (Tabla): 11.3449

cat("¿Se acepta el modelo? (Calculado < Crítico):", x2_C < vc_C, "\n")

## ¿Se acepta el modelo? (Calculado < Crítico): TRUE

9 TABLA RESUMEN DE BONDAD DEL AJUSTE

tabla_resumen_C <- data.frame(
  Variable = "Fecha de Fin de Confidencialidad",
  Pearson = round(Correlacion_C, 2),
  Chi2    = round(x2_C, 4),
  Umbral  = round(vc_C, 2),
  Resultado = ifelse(x2_C < vc_C, "Modelo Aceptado", "Modelo Rechazado")
)
tabla_resumen_C %>% 
  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 Fin de Confidencialidad	98.29	6.6028	11.34	Modelo Aceptado
Autor: Dallyana Lozano

10 CÁLCULO DE PROBABILIDADES

1. ¿Cuál es la probabilidad de que la fecha de fin de confidencialidad de un pozo seleccionado al azar corresponda al rango “Muy Recientes”?

prob_alta_conf <- df_conf_final$hi[nrow(df_conf_final)]
prob_alta_conf

## [1] "63.72"

La probabilidad de que un pozo se ubique en el rango Muy Recientes es de 63.72%, lo que indica que la mayoría de los pozos tiene periodos de confidencialidad vigentes o recién vencidos.

2. ¿Cuál es la probabilidad de que corresponda al rango “Muy Antiguas”?

prob_baja_conf <- df_conf_final$hi[1]
prob_baja_conf

## [1] "0.01"

La probabilidad de encontrar pozos en el rango Muy Antiguas es de apenas 0.01%, prácticamente inexistente en el bloque.

11 CONCLUSIÓN

La fecha de fin de confidencialidad se concentra fuertemente en el rango Muy Recientes (63.72%) frente a un 0.01% en Muy Antiguas, mostrando una distribución mucho más sesgada que la de Fecha de Audiencia.