PERMIT ISSUED DATE

Modelo Binormal

1 IDENTIFICACIÓN Y JUSTIFICACIÓN DE LA VARIABLE

\(Variable\) \(de\) \(Estudio\): Fecha de Emisión de Permiso (Permit Issued Date).

1. Antiguas (1953 – 1979): periodo con menor cantidad de registros.

2. Medias (1980 – 1999): mayor concentración de permisos emitidos en el histórico.

3. Recientes (2000 – 2026): segunda mayor representación, con emisiones vigentes o recientes.

2 CARGA DE DATOS

##### UNIVERSIDAD CENTRAL DEL ECUADOR #####
#### AUTORES: DALLYANA LOZANO ####
### CARRERA: INGENIERÍA EN PETRÓLEOS #####
#### VARIABLE: FECHA DE EMISIÓN DEL PERMISO ####
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 Permit Issued Date, omitimos las celdas en blanco y verificamos el tamaño muestral.

### EXTRAER VARIABLE
suppressPackageStartupMessages({
  library(lubridate)
  library(dplyr)
})

fechas_raw_emitido <- Datos$`Permit Issued Date`
fechas_validas_emitido <- fechas_raw_emitido[!is.na(fechas_raw_emitido) & fechas_raw_emitido != ""]
Fechas_limpias_emitido <- mdy(fechas_validas_emitido)
Fechas_limpias_emitido <- Fechas_limpias_emitido[!is.na(Fechas_limpias_emitido)]

Fecha_Emitido <- cut(year(Fechas_limpias_emitido),
                breaks = c(1953, 1980, 2000, 2027),
                labels = c("Antiguas",
                           "Medias",
                           "Recientes"),
                right = FALSE,
                include.lowest = TRUE,
                ordered_result = TRUE)

conteo_emitido <- table(Fecha_Emitido)
ni_emitido <- as.numeric(conteo_emitido)
hi_emitido <- (ni_emitido / sum(ni_emitido)) * 100

4 TABLAS DE DISTRIBUCIÓN DE FRECUENCIA

4.1 DISTRIBUCIÓN DE FRECUENCIAS DE LA FECHA DE SOLICITUD DE PERMISO

Se extrajo la variable de fecha de emisión de permiso para determinar su frecuencia absoluta (\(n_i\)) y el porcentaje relativo (\(hi\)) respecto al total, agrupando los registros en tres rangos definidos según la misma lógica temporal usada en la fecha de solicitud de permiso: Antiguas (1953-1979), Medias (1980-1999) y Recientes (2000-2026).

df_emitido_final <- data.frame(
  Tipo = names(conteo_emitido),
  ni = as.character(ni_emitido),
  hi = as.character(round(hi_emitido, 2))
)

fila_total_emitido <- data.frame(
  Tipo = "TOTAL",
  ni = as.character(sum(ni_emitido)),
  hi = as.character(round(sum(hi_emitido), 2))
)

df_show_emitido_1 <- bind_rows(df_emitido_final, fila_total_emitido)

df_show_emitido_1 %>%
  gt() %>%
  tab_header(
    title = md("**TABLA Nº 1: DISTRIBUCIÓN DE FRECUENCIAS DE FECHA DE EMISIÓN DE PERMISO**")
  ) %>%
  cols_label(
    Tipo = "Fecha de Emisión de Permiso", 
    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 EMISIÓN DE PERMISO
Fecha de Emisión de Permiso	ni	hi (%)
Antiguas	4624	25.3
Medias	7780	42.56
Recientes	5876	32.14
TOTAL	18280	100

4.2 ASIGNACIÓN JERÁRQUICA

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_Emitido
conteo_emitido_j <- table(Fecha_Emitido)
ni_emitido_j <- as.numeric(conteo_emitido_j)
hi_emitido_j <- (ni_emitido_j / sum(ni_emitido_j)) * 100

df_emitido_jerarquia <- data.frame(
  Asignacion = as.character(1:length(conteo_emitido_j)),
  Tipo = names(conteo_emitido_j),
  ni = as.character(ni_emitido_j),
  hi = as.character(round(hi_emitido_j, 2))
)

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

df_show_emitido_2 <- bind_rows(df_emitido_jerarquia, fila_total_emitido_j)

df_show_emitido_2 %>%
  gt() %>%
  tab_header(
    title = md("**TABLA Nº 2: ASIGNACI\u00d3N JERÁRQUICA DE FECHA DE EMISI\u00d3N DE PERMISO**")
  ) %>%
  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 EMISIÓN DE PERMISO
Asignación	Rango de Fechas	ni	hi (%)
1	Antiguas	4624	25.3
2	Medias	7780	42.56
3	Recientes	5876	32.14
TOTAL		18280	100

5 REPRESENTACIÓN GRÁFICA

5.1 DIAGRAMA DE BARRAS - FRECUENCIA ABSOLUTA

par(mar = c(5, 4, 4, 2))
barplot(as.numeric(df_emitido_final$ni),
        main = "GRÁFICO Nº 1: DISTRIBUCI\u00d3N DE FECHA DE EMISI\u00d3N DE PERMISO",
        ylab = "Cantidad de Pozos",
        col = "#B0C4DE",      
        names.arg = df_emitido_final$Tipo, 
        las = 1,            
        cex.names = 1.0,      
        cex.axis = 0.8,      
        cex.main = 1.1,        
        ylim = c(0, max(as.numeric(df_emitido_final$ni), na.rm = TRUE) + max(as.numeric(df_emitido_final$ni), na.rm = TRUE) * 0.1)) 
mtext("Rango de Fechas de Emisión de Permiso", side = 1, line = 3)

5.2 DIAGRAMA DE BARRAS - FRECUENCIA RELATIVA

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

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

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

6 CONJETURA DEL MODELO

Se validó la fecha de emisión de permiso (Permit Issued 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 de la emisión de permisos.

n_total_Emitido <- sum(as.numeric(df_emitido_jerarquia$ni))
size_binom_emitido <- 2   
X_indices_emitido <- 0:2  
media_obs_emitido <- sum(X_indices_emitido * as.numeric(df_emitido_jerarquia$ni)) / n_total_Emitido
prob_p_emitido <- media_obs_emitido / size_binom_emitido
P_Binomial_Emitido <- dbinom(X_indices_emitido, size = size_binom_emitido, prob = prob_p_emitido) * 100

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

7 TEST DE PEARSON

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

Correlacion_E <- cor(Fo_E, Fe_E) * 100
Correlacion_E

## [1] 98.58774

8 TEST DE CHI-CUADRADO

x2_E <- sum(((Fo_E - Fe_E)^2) / Fe_E)
gl_E <- length(Fo_E) - 1
vc_E <- qchisq(0.99, gl_E)
cat("Estad\u00edstico Chi-cuadrado (Calculado):", round(x2_E, 4), "\n")

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

cat("Valor Cr\u00edtico (Tabla):", round(vc_E, 4), "\n")

## Valor Crítico (Tabla): 9.2103

cat("¿Se acepta el modelo? (Calculado < Cr\u00edtico):", x2_E < vc_E, "\n")

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

9 TABLA RESUMEN DE BONDAD DEL AJUSTE

tabla_resumen_E <- data.frame(
  Variable = "Fecha de Emisión de Permiso",
  Pearson = round(Correlacion_E, 2),
  Chi2    = round(x2_E, 4),
  Umbral  = round(vc_E, 2),
  Resultado = ifelse(x2_E < vc_E, "Modelo Aceptado", "Modelo Rechazado")
)
tabla_resumen_E %>% 
  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 Emisión de Permiso	98.59	2.0967	9.21	Modelo Aceptado
Autor: Dallyana Lozano

10 CÁLCULO DE PROBABILIDADES

1. ¿Cuál es la probabilidad de que la fecha de emisión de permiso de un pozo seleccionado al azar corresponda al rango “Recientes”? r

prob_alta_emitido <- df_emitido_final$hi[nrow(df_emitido_final)]
prob_alta_emitido

## [1] "32.14"

La probabilidad de que un pozo tenga su permiso emitido en el rango Recientes (2000-2026) es de aproximadamente 32.1%.

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

prob_baja_emitido <- df_emitido_final$hi[1]
prob_baja_emitido

## [1] "25.3"

La probabilidad de encontrar pozos en el rango Antiguas (1953-1979) es de 25.3%.

11 CONCLUSIÓN

El modelo binomial se ajusta bien (Pearson ≈ 98.6%, Chi² ≈ 2.10 < 9.21, modelo aceptado). Los permisos emitidos se concentran en Medias 1980-1999 (42.6%), seguido de Recientes 2000-2026 (32.1%) y Antiguas 1953-1979 (25.3%).