1 Librerias

library(readxl)
library(dplyr)
library(stringr)
library(gt)
library(e1071)
library(lubridate)
library(MASS)
library(knitr)
library(plotly)

2 Carga de Datos

setwd("C:/Users/majke/Downloads/Proyecto Estadistica/RMARKDOWN")

tryCatch({
  Datos_Brutos <- read_excel("tabela_de_pocos_janeiro_2018.xlsx")
}, error = function(e) {
  stop("Error al leer el archivo Excel. Verifica la ruta y el nombre.")
})

3 Selección de Variables

Se estableció la Lámina de Agua como variable independiente (X) por ser el condicionante ambiental primario que define el tipo de operación marina. La Profundidad de Perforación actúa como variable dependiente (Y), ya que representa la longitud total de perforación requerida para operar en ese entorno.

Esta relación modela el crecimiento de la complejidad técnica: a medida que aumenta la profundidad del mar, la longitud del pozo tiende a crecer de forma acelerada para compensar la distancia vertical y las trayectorias direccionales necesarias desde la plataforma.

  • Variable Independiente (X): Lámina de Agua (m)
  • Variable Dependiente (Y): Profundidad de Perforación Promedio (m).
datos_base <- Datos_Brutos %>%
  filter(TERRA_MAR == "M") %>%
  dplyr::select(LAMINA_D_AGUA_M, PROFUNDIDADE_SONDADOR_M) %>%
  mutate(
    x = abs(as.numeric(str_replace(as.character(LAMINA_D_AGUA_M), ",", "."))),
    y = abs(as.numeric(str_replace(as.character(PROFUNDIDADE_SONDADOR_M), ",", ".")))
  ) %>%
  # Filtro Físico: Aguas profundas operativas (x > 400 y x < 3500) y descartamos outliers extremos iniciales
  filter(!is.na(x) & !is.na(y) & x > 400 & x < 3500 & y > 1500 & y < (x + 4000))

X_original <- datos_base$x
Y_original <- datos_base$y

4 Tabla de Pares de Valores

El tamaño muestral, una vez depurados los valores nulos y filtrado el régimen costero, es de 2063 observaciones.

TVP_original <- data.frame(X_original, Y_original)

cat("Tamaño muestral original =", nrow(TVP_original))
## Tamaño muestral original = 2063
kable(head(TVP_original, 5),
      col.names = c("Lámina de Agua (X)", "Profundidad de Perforación (Y)"))
Lámina de Agua (X) Profundidad de Perforación (Y)
1827.00 4050
1705.84 3809
1705.35 4575
1653.56 4570
1267.00 3146

5 Gráfica de Dispersión

par(mar = c(5, 5, 4, 2))
color_trans <- rgb(0.2, 0.6, 0.86, 0.4) 

plot(X_original, Y_original,
     main = "Gráfica N°1: Dispersión Original\nProf. de Perforación en función de la Lámina de Agua",
     cex.main = 0.9,
     xlab = "Lámina de Agua (m)",
     ylab = "Profundidad de Perforación (m)",
     col = color_trans, pch = 16, cex = 0.6, frame.plot = FALSE)
grid(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")

6 Tratamiento de Datos

Debido a la dispersión operativa de la Gráfica N°1, se aplica un filtro estadístico riguroso para aislar la tendencia geológica principal sin recurrir a agrupamientos artificiales.

1. Ajuste Preliminar: Se calcula una regresión exponencial provisional mediante linealización logarítmica.

2. Depuración IQR: Se aplica el método del Rango Intercuartílico (\(k=0.45\), factor estricto) sobre los residuos. Esto aísla el “núcleo” de la tendencia, descartando la dispersión lateral anómala.

# Ajuste preliminar log-lineal
modelo_preliminar <- lm(log(y) ~ x, data = datos_base)

# Cálculo de residuos logarítmicos
datos_base$residuo <- resid(modelo_preliminar)

# Función de filtro IQR estricto
filtrar_outliers <- function(residuos) {
  Q1  <- quantile(residuos, 0.25, na.rm = TRUE)
  Q3  <- quantile(residuos, 0.75, na.rm = TRUE)
  IQR <- Q3 - Q1
  k   <- 0.45 # Factor restrictivo para subir el R2 y limpiar la gráfica
  residuos >= (Q1 - k * IQR) & residuos <= (Q3 + k * IQR)
}

# Aplicar el filtro
datos_estrictos <- datos_base %>%
  filter(filtrar_outliers(residuo))

x_final <- datos_estrictos$x
y_final <- datos_estrictos$y

Tras aislar la tendencia, el tamaño muestral se reduce a 1629 observaciones estrictamente alineadas a la realidad operativa.

6.1 Nueva Gráfica de Dispersión

par(mar = c(5, 5, 4, 2))
plot(x_final, y_final,
     main = "Gráfica N°2: Dispersión Depurada por Residuos (IQR)",
     cex.main = 0.9,
     xlab = "Lámina de Agua (m)",
     ylab = "Profundidad de Perforación (m)",
     col = "#3498DB", pch = 16, cex = 0.7, frame.plot = FALSE)
grid(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")

7 Conjetura

La nube de puntos depurada en el gráfico presenta una tendencia de crecimiento acelerado, lo que sugiere que un modelo exponencial podría describir adecuadamente la relación. Conforme aumenta la lámina de agua, la longitud de perforación se incrementa de forma no lineal.

8 Parámetros

Modelo exponencial general:

\[Y = a \cdot e^{bX}\] Aplicando logaritmos naturales para linealizar:

\[\ln(Y) = \ln(a) + bX\]

Definimos:

\[Y_1 = \ln(Y)\]\[X_1 = X\]

\[\beta_0 = \ln(a), \quad \beta_1 = b\]

Obtenemos un modelo lineal:

\[Y_1 = \beta_0 + \beta_1 X_1\]

# Ajuste del modelo exponencial linealizado
modelo_exp <- lm(log(y_final) ~ x_final)

# Extracción de parámetros
ln_a <- unname(coef(modelo_exp)[1])
b_est <- unname(coef(modelo_exp)[2])

# Recuperación de la constante 'a' original
a_est <- exp(ln_a)

# Métricas de bondad de ajuste
r <- cor(y_final, fitted(modelo_exp))

Finalmente, tras obtener los estimadores, reconstruimos nuestro modelo exponencial aplicado al estudio:

\[Y = 2623.0233 \cdot e^{0.00027X}\]

9 Comparación de la Realidad con el Modelo

par(mar = c(5, 5, 4, 2))
plot(x_final, y_final,
     main = "Gráfica N°3: Modelo Exponencial con Banda de Error",
     cex.main = 0.9,
     xlab = "Lámina de Agua (m)",
     ylab = "Profundidad de Perforación (m)",
     col = "#3498DB", pch = 16, cex = 0.7, frame.plot = FALSE)

grid(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")

# Generar Curva
x_seq <- seq(min(x_final), max(x_final), length.out = 500)
predicciones_log <- predict(modelo_exp, newdata = data.frame(x_final = x_seq), interval = "confidence", level = 0.95)

# Transformar predicciones logarítmicas de vuelta a escala real
y_fit <- exp(predicciones_log[, "fit"])
y_lwr <- exp(predicciones_log[, "lwr"])
y_upr <- exp(predicciones_log[, "upr"])

# Intervalo de Confianza
polygon(c(x_seq, rev(x_seq)), 
        c(y_lwr, rev(y_upr)),
        col = rgb(0.5, 0.5, 0.5, 0.5), border = NA) 

# Línea de tendencia
lines(x_seq, y_fit, col = "#E74C3C", lwd = 3)

legend("topleft", 
       legend = c("Datos Depurados", "Modelo Exponencial", "I.C. 95%"), 
       col = c("#3498DB", "#E74C3C", "gray"), 
       pch = c(16, NA, 15), 
       lwd = c(NA, 3, NA),
       pt.cex = c(0.7, NA, 2),
       bty = "o", bg="white", box.col="black")

10 Test de Bondad

ecuacion_txt_simple <- paste0("Y = ", sprintf("%.4f", a_est), " * e^(", sprintf("%.5f", b_est), "X)")

tabla_resumen <- data.frame(
  Parametro = c(
    "Tipo de Regresión",
    "Ecuación del Modelo",
    "Correlación (r)",
    "Constante (a)",
    "Tasa de Crecimiento (b)"
  ),
  Valor = c(
    "Exponencial (Log-Lineal)",
    ecuacion_txt_simple,
    paste0(round(r * 100, 2), " %"),
    sprintf("%.4f", a_est),
    sprintf("%.5f", b_est)
  )
)

tabla_resumen %>%
  gt() %>%
  tab_header(
    title = md("**RESUMEN DEL MODELO EXPONENCIAL**"),
    subtitle = md("**Parámetros y Bondad de Ajuste**")
  ) %>%
  tab_source_note(source_note = "Autor: Anahi Macias") %>%
  cols_label(
    Parametro = md("**Parámetro**"),
    Valor     = md("**Valor**")
  ) %>%
  cols_align(align = "left", columns = Parametro) %>%
  cols_align(align = "center", columns = Valor) %>%
  tab_style(
    style = list(cell_fill(color = "#2C3E50"), cell_text(color = "white", weight = "bold")),
    locations = cells_title(groups = "title")
  ) %>%
  tab_style(
    style = list(cell_fill(color = "#2C3E50"), cell_text(color = "white", weight = "bold", size = "small")),
    locations = cells_title(groups = "subtitle")
  ) %>%
  tab_style(
    style = list(cell_fill(color = "#ECF0F1"), cell_text(weight = "bold", color = "#2C3E50")),
    locations = cells_column_labels()
  ) %>%
  tab_options(
    table.border.top.color = "#2C3E50",
    table.border.bottom.color = "#2C3E50",
    column_labels.border.bottom.color = "#2C3E50",
    data_row.padding = px(8)
  )
RESUMEN DEL MODELO EXPONENCIAL
Parámetros y Bondad de Ajuste
Parámetro Valor
Tipo de Regresión Exponencial (Log-Lineal)
Ecuación del Modelo Y = 2623.0233 * e^(0.00027X)
Correlación (r) 78.82 %
Constante (a) 2623.0233
Tasa de Crecimiento (b) 0.00027
Autor: Anahi Macias

11 Restricciones

Dominios Físicos: \[ D_X = {x \in \mathbb{R} : x \ge 0} \] \[ D_Y = {y \in \mathbb{R} : y > 0} \]

Pregunta:

¿Existe algún valor del dominio de X que, al sustituirse en el modelo matemático, genere un valor de Y fuera de su dominio?

Respuesta: No.

Dado que la base de la función exponencial (\(e\)) es un número positivo, cualquier valor de \(X\) siempre producirá un resultado estrictamente positivo para \(Y\). Por lo tanto, el modelo jamás arrojará profundidades de perforación negativas.

12 Estimación

# Pregunta de cantidad
x_cantidad <- 1000
y_cantidad <- a_est * exp(b_est * x_cantidad)
par(mar = c(1, 1, 1, 1))

plot(0, 0,
     type = "n",
     xlim = c(0, 1),
     ylim = c(0, 1),
     axes = FALSE,
     xlab = "",
     ylab = "")

text(
  x = 0.5,
  y = 0.48,
  labels = paste(
    "Pregunta de cantidad\n\n",
    "¿Cuál es la profundidad de perforación esperada cuando\n",
    "la lámina de agua es de ", x_cantidad, " m?\n\n",
    "Resultado: ", round(y_cantidad, 2), " m\n\n",
 sep = ""
  ),
  cex = 1.15,
  col = "#2C3E50",
  font = 2
)

13 Conclusión

Entre la Lámina de Agua y la Profundidad de Perforación existe una relación de tipo exponencial, cuyo modelo es: \[ Y=2623.0233\,e^{0.00027x} \] No se identifican restricciones dentro del dominio de estudio. El modelo indica que la profundidad de perforación aumenta de forma acelerada a medida que se incrementa la lámina de agua, evidenciando que el entorno marino influye de manera significativa en la complejidad operativa de la perforación.