DATE OF TOTAL DEPTH

Modelo Binormal

1 IDENTIFICACIÓN Y JUSTIFICACIÓN DE LA VARIABLE

\(Variable\) \(de\) \(Estudio\): Fecha de Profundidad Total (Date of Total Depth).

1. Muy antiguas (1881 – 1906): periodo con muy pocos registros.

2. Antiguas (1906 – 1930): representación baja en el histórico.

3. Medias (1930 – 1954): representación baja-intermedia.

4. Media-recientes (1954 – 1978): representación intermedia.

5. Recientes (1978 – 2003): concentra la mayoría de los pozos.

6. Muy recientes (2003 – 2026): segunda mayor representación, con perforaciones vigentes o recientes.

2 CARGA DE DATOS

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

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

fechas_raw_prof <- Datos$`Date of Total Depth`
fechas_validas_prof <- fechas_raw_prof[!is.na(fechas_raw_prof) & fechas_raw_prof != ""]
Fechas_limpias_prof <- mdy(fechas_validas_prof)
Fechas_limpias_prof <- Fechas_limpias_prof[!is.na(Fechas_limpias_prof)]

Fecha_Prof <- cut(as.numeric(Fechas_limpias_prof),
                breaks = 6,
                labels = c("Muy antiguas",
                           "Antiguas",
                           "Medias",
                           "Media-recientes",
                           "Recientes",
                           "Muy recientes"),
                ordered_result = TRUE)

conteo_prof <- table(Fecha_Prof)
ni_prof <- as.numeric(conteo_prof)
hi_prof <- (ni_prof / sum(ni_prof)) * 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 profundidad total (Date of Total Depth) para determinar su frecuencia absoluta (\(n_i\)) y el porcentaje relativo (\(hi\)) respecto al total, agrupando los registros en seis rangos de igual amplitud: Muy antiguas, Antiguas, Medias, Media-recientes, Recientes y Muy recientes.

df_prof_final <- data.frame(
  Tipo = names(conteo_prof),
  ni = as.character(ni_prof),
  hi = as.character(round(hi_prof, 2))
)

fila_total_prof <- data.frame(
  Tipo = "TOTAL",
  ni = as.character(sum(ni_prof)),
  hi = as.character(round(sum(hi_prof), 2))
)

df_show_prof_1 <- bind_rows(df_prof_final, fila_total_prof)

df_show_prof_1 %>%
  gt() %>%
  tab_header(
    title = md("**TABLA Nº 1: DISTRIBUCIÓN DE FRECUENCIAS DE FECHA DE PROFUNDIDAD TOTAL**")
  ) %>%
  cols_label(
    Tipo = "Rango de Fechas de Profundidad Total", 
    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 PROFUNDIDAD TOTAL
Rango de Fechas de Profundidad Total	ni	hi (%)
Muy antiguas	31	0.18
Antiguas	335	1.99
Medias	462	2.75
Media-recientes	3572	21.23
Recientes	8046	47.82
Muy recientes	4379	26.03
TOTAL	16825	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_Prof
conteo_prof_j <- table(Fecha_Prof)
ni_prof_j <- as.numeric(conteo_prof_j)
hi_prof_j <- (ni_prof_j / sum(ni_prof_j)) * 100

df_prof_jerarquia <- data.frame(
  Asignacion = as.character(1:length(conteo_prof_j)),
  Tipo = names(conteo_prof_j),
  ni = as.character(ni_prof_j),
  hi = as.character(round(hi_prof_j, 2))
)

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

df_show_prof_2 <- bind_rows(df_prof_jerarquia, fila_total_prof_j)

df_show_prof_2 %>%
  gt() %>%
  tab_header(
    title = md("**TABLA Nº 2: ASIGNACI\u00d3N JERÁRQUICA DE FECHA DE PROFUNDIDAD TOTAL**")
  ) %>%
  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 PROFUNDIDAD TOTAL
Asignación	Rango de Fechas	ni	hi (%)
1	Muy antiguas	31	0.18
2	Antiguas	335	1.99
3	Medias	462	2.75
4	Media-recientes	3572	21.23
5	Recientes	8046	47.82
6	Muy recientes	4379	26.03
TOTAL		16825	100

5 REPRESENTACIÓN GRÁFICA

5.1 DIAGRAMA DE BARRAS - FRECUENCIA ABSOLUTA

par(mar = c(7, 4, 4, 2))
barplot(as.numeric(df_prof_final$ni),
        main = "GRÁFICO Nº 1: DISTRIBUCI\u00d3N DE FECHA DE PROFUNDIDAD TOTAL",
        ylab = "Cantidad de Pozos",
        col = "#B0C4DE",      
        names.arg = df_prof_final$Tipo, 
        las = 2,            
        cex.names = 0.7,      
        cex.axis = 0.8,      
        cex.main = 1.1,        
        ylim = c(0, max(as.numeric(df_prof_final$ni), na.rm = TRUE) + max(as.numeric(df_prof_final$ni), na.rm = TRUE) * 0.1)) 
mtext("Rango de Fecha de Profundidad Total", side = 1, line = 6)

5.2 DIAGRAMA DE BARRAS - FRECUENCIA RELATIVA

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

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

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

6 CONJETURA DEL MODELO

Se validó la fecha de profundidad total (Date of Total Depth) de los pozos mediante una Distribución Binomial \(B(5, p)\), ajustada a la variable ordinal de seis 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 profundidad total.

n_total_Prof <- sum(as.numeric(df_prof_jerarquia$ni))
size_binom_prof <- 5   
X_indices_prof <- 0:5  
media_obs_prof <- sum(X_indices_prof * as.numeric(df_prof_jerarquia$ni)) / n_total_Prof
prob_p_prof <- media_obs_prof / size_binom_prof
P_Binomial_Prof <- dbinom(X_indices_prof, size = size_binom_prof, prob = prob_p_prof) * 100

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

7 TEST DE PEARSON

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

Correlacion_Pr <- cor(Fo_Pr, Fe_Pr) * 100
Correlacion_Pr

## [1] 98.10728

8 TEST DE CHI-CUADRADO

x2_Pr <- sum(((Fo_Pr - Fe_Pr)^2) / Fe_Pr)
gl_Pr <- length(Fo_Pr) - 1
vc_Pr <- qchisq(0.99, gl_Pr)
cat("Estad\u00edstico Chi-cuadrado (Calculado):", round(x2_Pr, 4), "\n")

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

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

## Valor Crítico (Tabla): 15.0863

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

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

9 TABLA RESUMEN DE BONDAD DEL AJUSTE

tabla_resumen_Pr <- data.frame(
  Variable = "Fecha de Profundidad Total",
  Pearson = round(Correlacion_Pr, 2),
  Chi2    = round(x2_Pr, 4),
  Umbral  = round(vc_Pr, 2),
  Resultado = ifelse(x2_Pr < vc_Pr, "Modelo Aceptado", "Modelo Rechazado")
)
tabla_resumen_Pr %>% 
  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 Profundidad Total	98.11	5.5772	15.09	Modelo Aceptado
Autor: Dallyana Lozano

10 CÁLCULO DE PROBABILIDADES

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

prob_alta_prof <- df_prof_final$hi[5]
prob_alta_prof

## [1] "47.82"

La probabilidad de que un pozo tenga su fecha de profundidad total en el rango Recientes (1978-2003) es de aproximadamente 47.82%.

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

prob_baja_prof <- df_prof_final$hi[1]
prob_baja_prof

## [1] "0.18"

La probabilidad de encontrar pozos en el rango Muy antiguas (1881-1906) es de 0.18%.

11 CONCLUSIÓN

El modelo binomial muestra buen ajuste. La profundidad total se concentra en Recientes 1978-2003 (47.8%), seguido de Muy recientes 2003-2026 (25.9%), Media-recientes 1954-1978 (21.4%), y tramos históricos pequeños: Medias 1930-1954 (2.76%), Antiguas 1906-1930 (1.98%) y Muy antiguas 1881-1906 (apenas 0.18%).