PERMIT APPLICATION DATE

Modelo Binormal

1 IDENTIFICACIÓN Y JUSTIFICACIÓN DE LA VARIABLE

\(Variable\) \(de\) \(Estudio\): Fecha de Solicitud de Permiso (Permit Application Date).

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

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

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

2 CARGA DE DATOS

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

### EXTRAER VARIABLE

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

fechas_raw_permiso <- Datos$`Permit Application Date`
fechas_validas_permiso <- fechas_raw_permiso[!is.na(fechas_raw_permiso) & fechas_raw_permiso != ""]
Fechas_limpias_permiso <- mdy(fechas_validas_permiso)
Fechas_limpias_permiso <- Fechas_limpias_permiso[!is.na(Fechas_limpias_permiso)]

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

conteo_permiso <- table(Fecha_Permiso)
ni_permiso <- as.numeric(conteo_permiso)
hi_permiso <- (ni_permiso / sum(ni_permiso)) * 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 solicitud 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 concentración real de solicitudes por año: Antiguas (1933-1979), Medias (1980-1999) y Recientes (2000-2026).

df_permiso_final <- data.frame(
  Tipo = names(conteo_permiso),
  ni = as.character(ni_permiso),
  hi = as.character(round(hi_permiso, 2))
)

fila_total_permiso <- data.frame(
  Tipo = "TOTAL",
  ni = as.character(sum(ni_permiso)),
  hi = as.character(round(sum(hi_permiso), 2))
)

df_show_permiso_1 <- bind_rows(df_permiso_final, fila_total_permiso)

df_show_permiso_1 %>%
  gt() %>%
  tab_header(
    title = md("**TABLA Nº 1: DISTRIBUCIÓN DE FRECUENCIAS DE FECHA DE SOLICITUD DE PERMISO**")
  ) %>%
  cols_label(
    Tipo = "Fecha de Solicitud 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 SOLICITUD DE PERMISO
Fecha de Solicitud de Permiso	ni	hi (%)
Antiguas	4275	23.3
Medias	7680	41.86
Recientes	6392	34.84
TOTAL	18347	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 
conteo_permiso_j <- table(Fecha_Permiso)
ni_permiso_j <- as.numeric(conteo_permiso_j)
hi_permiso_j <- (ni_permiso_j / sum(ni_permiso_j)) * 100

df_permiso_jerarquia <- data.frame(
  Asignacion = as.character(1:length(conteo_permiso_j)),
  Tipo = names(conteo_permiso_j),
  ni = as.character(ni_permiso_j),
  hi = as.character(round(hi_permiso_j, 2))
)

# FILA
fila_total_permiso_j <- data.frame(
  Asignacion = "TOTAL",
  Tipo = "",
  ni = as.character(sum(ni_permiso_j)),
  hi = as.character(round(sum(hi_permiso_j), 2))
)

df_show_permiso_2 <- bind_rows(df_permiso_jerarquia, fila_total_permiso_j)

df_show_permiso_2 %>%
  gt() %>%
  tab_header(
    title = md("**TABLA Nº 2: ASIGNACI\u00d3N JERÁRQUICA DE FECHA DE SOLICITUD 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 SOLICITUD DE PERMISO
Asignación	Rango de Fechas	ni	hi (%)
1	Antiguas	4275	23.3
2	Medias	7680	41.86
3	Recientes	6392	34.84
TOTAL		18347	100

5 REPRESENTACIÓN GRÁFICA

5.1 DIAGRAMA DE BARRAS - FRECUENCIA ABSOLUTA

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

5.2 DIAGRAMA DE BARRAS - FRECUENCIA RELATIVA

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

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

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

6 CONJETURA DEL MODELO

Se validó la fecha de solicitud de permiso (Permit Application 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 las solicitudes de permiso.

n_total_Permiso <- sum(as.numeric(df_permiso_jerarquia$ni))
size_binom_permiso <- 2   
X_indices_permiso <- 0:2  
media_obs_permiso <- sum(X_indices_permiso * as.numeric(df_permiso_jerarquia$ni)) / n_total_Permiso
prob_p_permiso <- media_obs_permiso / size_binom_permiso
P_Binomial_Permiso <- dbinom(X_indices_permiso, size = size_binom_permiso, prob = prob_p_permiso) * 100

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

7 TEST DE PEARSON

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

Correlacion_P <- cor(Fo_P, Fe_P) * 100
Correlacion_P

## [1] 96.40971

8 TEST DE CHI-CUADRADO

x2_P <- sum(((Fo_P - Fe_P)^2) / Fe_P)
gl_P <- length(Fo_P) - 1
vc_P <- qchisq(0.99, gl_P)
cat("Estad\u00edstico Chi-cuadrado (Calculado):", round(x2_P, 4), "\n")

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

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

## Valor Crítico (Tabla): 9.2103

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

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

9 TABLA RESUMEN DE BONDAD DEL AJUSTE

tabla_resumen_P <- data.frame(
  Variable = "Fecha de Solicitud de Permiso",
  Pearson = round(Correlacion_P, 2),
  Chi2    = round(x2_P, 4),
  Umbral  = round(vc_P, 2),
  Resultado = ifelse(x2_P < vc_P, "Modelo Aceptado", "Modelo Rechazado")
)
tabla_resumen_P %>% 
  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 Solicitud de Permiso	96.41	2.2952	9.21	Modelo Aceptado
Autor: Dallyana Lozano

10 CÁLCULO DE PROBABILIDADES

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

prob_alta_permiso <- df_permiso_final$hi[nrow(df_permiso_final)]
prob_alta_permiso

## [1] "34.84"

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

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

prob_baja_permiso <- df_permiso_final$hi[1]
prob_baja_permiso

## [1] "23.3"

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

11 CONCLUSIÓN

El modelo binomial se ajusta bien (Pearson ≈ 96.4%, Chi² ≈ 2.30 < 9.21, modelo aceptado). Las solicitudes se concentran principalmente en Medias 1980-1999 (41.9%), seguido de Recientes 2000-2026 (34.8%) y Antiguas 1933-1979 (23.3%).