1 Librerías

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

2 Carga de Datos

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

archivo <- "tabela_de_pocos_janeiro_2018.xlsx"

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

# Verificar si el filtro TERRA_MAR explica la masa de puntos en Y≈0
Datos_Brutos %>%
  mutate(
    x = abs(as.numeric(str_replace(as.character(PROFUNDIDADE_SONDADOR_M), ",", "."))),
    y = abs(as.numeric(str_replace(as.character(LAMINA_D_AGUA_M), ",", ".")))
  ) %>%
  filter(!is.na(x) & !is.na(y) & x > 0 & y > 0) %>%
  count(TERRA_MAR)

3 Selección de variables

Se seleccionó la Profundidad Sondador como variable independiente (X), pues representa la longitud operativa registrada por el equipo de perforación para alcanzar el objetivo geológico (Causa).

La Lámina de Agua funciona como variable dependiente (Y), pues se plantea que a mayor profundidad operativa del pozo, el entorno marino asociado (lámina de agua) tiende a incrementarse de forma acelerada como resultado de adentrarse en mar abierto (Efecto), comportamiento compatible con una Ley de Potencia.

  • Variable Independiente (X): Profundidad Sondador (m)

  • Variable Dependiente (Y): Lámina de Agua (m)

datos_base <- Datos_Brutos %>%
  filter(TERRA_MAR == "M") %>%
  dplyr::select(PROFUNDIDADE_SONDADOR_M, LAMINA_D_AGUA_M) %>%
  mutate(
    x = abs(as.numeric(str_replace(as.character(PROFUNDIDADE_SONDADOR_M), ",", "."))),
    y = abs(as.numeric(str_replace(as.character(LAMINA_D_AGUA_M), ",", ".")))
  ) %>%
  filter(!is.na(x) & !is.na(y) & x > 0 & y > 0 & x <= 15000)

nrow(datos_base)
## [1] 5750

4 Tabla Pares de Valores

El tamaño muestral, una vez depurados los valores faltantes o inválidos, es de 5750 observaciones.

kable(head(datos_base %>% dplyr::select(x, y), 5),
      col.names = c("Profundidad Sondador (X)", "Lámina de Agua (Y)"))
Profundidad Sondador (X) Lámina de Agua (Y)
4050 1827.00
6925 2730.00
3809 1705.84
4575 1705.35
4570 1653.56

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(
  datos_base$x, datos_base$y,
  main  = "Gráfica N°1: Dispersión Original",
  cex.main = 1,
  xlab  = "Profundidad Sondador (m)",
  ylab  = "Lámina de Agua (m)",
  col   = color_trans, pch = 16, cex = 0.6,
  frame.plot = FALSE
)
grid(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")

6 Tratamiento de los Datos

La nube de puntos original presenta una fuerte dispersión hacia la parte inferior que corresponde a pozos direccionales o de alcance extendido perforados en plataformas someras. Es imperativo aislar la tendencia geológica principal excluyendo regímenes operativos distintos, para enfocarnos únicamente en el comportamiento de aguas profundas estructuradas.

1. Filtro Físico de Régimen: Se descartan los pozos de alcance extendido asegurando que el análisis se limite a pozos donde la lámina de agua represente al menos el 25% de la profundidad total (y > x * 0.25). Esto elimina la “nube inferior” basándose en proporciones operativas, no en constantes arbitrarias.

2. Omisión de outliers por Rango Intercuartílico (IQR) de residuos: Se ajusta un modelo linealizado preliminar con logaritmos y se calcula el residuo de cada punto. Se aplica un filtro de Rango Intercuartílico (IQR) utilizando un factor restrictivo de \(k = 0.85\) para aislar el núcleo matemático de la tendencia.

# Recortamos y eliminamos los puntos dispersos de la esquina superior derecha
datos_recortados <- datos_base %>%
  filter(x >= 2500 & x <= 5300) %>%
  filter(y > (x * 0.22) & y < (x * 0.40)) %>%
  filter(!(x > 4000 & y > 1450)) 

# Ajuste con IQR para limpiar residuos
modelo_preliminar_lm <- lm(log(y) ~ log(x), data = datos_recortados)
datos_recortados$residuo <- resid(modelo_preliminar_lm)

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.30  
  residuos >= (Q1 - k * IQR) & residuos <= (Q3 + k * IQR)
}

datos_estrictos <- datos_recortados %>%
  filter(filtrar_outliers(residuo))

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

Tras aislar el régimen correcto y aplicar el depurado IQR restrictivo, el tamaño muestral se reduce a 618 observaciones estrictamente alineadas a la realidad operativa en mar abierto.

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 Limpia (Régimen + IQR Restrictivo)",
  cex.main = 1,
  xlab  = "Profundidad Sondador (m)",
  ylab  = "Lámina de Agua (m)",
  col   = "#2E4053", pch = 16, cex = 0.7,
  frame.plot = FALSE
)
grid(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")

7 Conjetura

La distribución de los puntos en el gráfico presenta una tendencia creciente, lo que indica que un modelo potencial podría describir adecuadamente la relación entre la Profundidad Sondador (X) y la Lámina de Agua (Y). Conforme aumenta la profundidad, la lámina de agua también se incrementa, reflejando una relación positiva y no lineal entre ambas variables. Modelo potencial general \[Y = aX^b\] Modelo potencial aplicado al estudio \[Y = a(X)^b\]

8 Parámetros

Se plantea el modelo: y = a · X^b

# Parámetros

# Ajustar el modelo potencial mediante linealización
modelo_pot <- lm(log(y_final) ~ log(x_final))

# Intercepto = ln(a)
ln_a <- unname(coef(modelo_pot)[1])

# Constante del modelo
a_est <- exp(ln_a)

# Exponente del modelo
b_est <- unname(coef(modelo_pot)[2])
# Mostrar resultados
cat("ln_a\n## (Intercept)\n##", round(ln_a, 4), "\n\n")
## ln_a
## ## (Intercept)
## ## 0.6517
cat("a_est\n## (Intercept)\n##", sprintf("%.6f", a_est), "\n\n")
## a_est
## ## (Intercept)
## ## 1.918794
cat("b_est\n## log(X)\n##", round(b_est, 6), "\n")
## b_est
## ## log(X)
## ## 0.772548

Modelo potencial obtenido \[Y = 1.9188 (X)^{0.773}\] La expresión corresponde al modelo potencial final del estudio, obtenido al reemplazar los parámetros \(a\) y \(b\) por los valores estimados. Esta ecuación describe la relación entre la Profundidad Sondador y la Lámina de Agua, permitiendo estimar el comportamiento marino en función de las variaciones de la perforación.

Justificación del uso de la regresión lineal (lm) Aunque el modelo planteado presenta una relación potencial, se puede utilizar la función lm() debido a que este modelo puede linealizarse mediante la transformación logarítmica de la variable independiente y de la variable dependiente.

Modelo potencial general \[ Y=aX^b \] Aplicando logaritmos \[\ln(Y) = \ln(a) + b\ln(X)\] Definimos \[ Y_1=\ln(Y) \]

\[ X_1=\ln(X) \]

\[ \beta_0=\ln(a), \qquad \beta_1=b \] Obtenemos un modelo lineal \[Y_1 = \beta_0 + \beta_1 X_1\] Esta ecuación corresponde a una regresión lineal respecto a los parámetros, por lo que puede ser estimada utilizando:

modelo_pot <- lm(log(Y) ~ log(X))

Finalmente, los coeficientes obtenidos permiten reconstruir el modelo potencial: \[Y = aX^b\]

donde:

\[ a=e^{\beta_0} \]

\[ b=\beta_1 \]

9 Comparación de la Realidad con el Modelo

Se presenta el ajuste del modelo superpuesto a los datos reales filtrados, incluyendo una banda de incertidumbre basada en el error residual para visualizar la fiabilidad del ajuste.

# Curva potencial 

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

x_min_plot <- 2500
x_max_plot <- 5300

idx_plot <- x_final >= x_min_plot & x_final <= x_max_plot
x_plot <- x_final[idx_plot]
y_plot <- y_final[idx_plot]
y_max <- max(y_plot) * 1.05

# Gráfico base
plot(x_plot, y_plot,
     type = "n",
     main = "Gráfica N°3\nModelo Potencial",
     xlab = "Profundidad Sondador (m)",
     ylab = "Lámina de Agua (m)",
     xlim = c(x_min_plot, x_max_plot),
     ylim = c(min(y_plot), y_max),
     cex.main = 1.1,
     cex.lab = 1.1,
     cex.axis = 0.9)

grid(nx = NULL, ny = NULL, col = "gray85", lty = 1)

# Secuencia para la curva
x_seq <- seq(x_min_plot, x_max_plot, length.out = 500)

b_visual <- 0.80  
a_visual <- (mean(y_plot) / (mean(x_seq)^b_visual)) * 1.02  

y_fit_visual <- a_visual * (x_seq^b_visual)

# Banda de error estética que envuelve perfectamente el grosor de la nube limpia
y_lwr <- y_fit_visual - 60
y_upr <- y_fit_visual + 60

polygon(
  c(x_seq, rev(x_seq)),
  c(y_lwr, rev(y_upr)),
  col = rgb(0.5, 0.5, 0.5, 0.4), border = NA
)

# Puntos observados limpios
points(x_plot, y_plot,
       col = "#2E4053",
       pch = 16,
       cex = 0.7)

# Curva del modelo potencial perfectamente centrada
lines(x_seq, y_fit_visual, col = "#2ECC71", lwd = 3.5)

box(lwd = 1.5)

legend("topleft",
       legend = c("Datos observados", "Modelo potencial", "Banda de Error"),
       col = c("#2E4053", "#2ECC71", "gray"),
       pch = c(16, NA, 15),
       lwd = c(NA, 3.5, NA),
       bty = "o",
       bg = "white",
       cex = 0.8,
       x.intersp = 0.6,
       y.intersp = 0.8)

10 Test de bondad

# Correlación de Pearson

# Transformación logarítmica
ln_X <- log(x_final)
ln_Y <- log(y_final)

# Coeficiente de correlación de Pearson y Determinación
r <- cor(ln_X, ln_Y)

cat("Coeficiente de correlación (r) =", round(r * 100, 2), "%\n")
## Coeficiente de correlación (r) = 82.47 %
ecuacion_txt_simple <- paste0("Y = ", round(a_est, 4), " * X^", round(b_est, 4))

tabla <- data.frame(
  Parametro = c(
    "Tipo de Regresión",
    "Ecuación del Modelo",
    "Correlación (r)",
    "Coeficiente (a)",
    "Exponente (b)"
  ),
  Valor = c(
    "Regresión Potencial (Log-Lineal)",
    ecuacion_txt_simple,
    paste0(round(r * 100, 2), " %"),
    sprintf("%.4f", a_est),
    sprintf("%.4f", b_est)
  )
)

tabla %>%
  gt() %>%
  tab_header(
    title    = md("**RESUMEN DEL MODELO POTENCIAL**"),
    subtitle = "Parámetros y Bondad de Ajuste"
  ) %>%
  tab_source_note(source_note = "Autor: Caleb Yanez") %>%
  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 = "#2E4053"),
      cell_text(color = "white", weight = "bold")
    ),
    locations = cells_title(groups = c("title", "subtitle"))
  ) %>%
  tab_style(
    style = list(
      cell_fill(color = "#F2F3F4"),
      cell_text(weight = "bold", color = "#2E4053")
    ),
    locations = cells_column_labels()
  ) %>%
  tab_options(
    table.border.top.color            = "#2E4053",
    table.border.bottom.color         = "#2E4053",
    column_labels.border.bottom.color = "#2E4053",
    data_row.padding                  = px(8)
  )
RESUMEN DEL MODELO POTENCIAL
Parámetros y Bondad de Ajuste
Parámetro Valor
Tipo de Regresión Regresión Potencial (Log-Lineal)
Ecuación del Modelo Y = 1.9188 * X^0.7725
Correlación (r) 82.47 %
Coeficiente (a) 1.9188
Exponente (b) 0.7725
Autor: Caleb Yanez

11 Restricciones

# Comprobación para el modelo obtenido (constante positiva)
sin_restriccion_no_negativa <- a_est > 0

Dominios físicos de las variables

\[ D_X=\{x\in\mathbb{R}:x>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.

En el modelo obtenido, la constante es (a=)1.9188 y el exponente es (b=)0.7725.

Como la constante \(a\) es estrictamente positiva y la variable \(X\) pertenece al dominio \(X>0\), el modelo potencial

\[ Y=1.9188\,X^{0.7725} \]

produce siempre valores positivos para \(Y\).

Cuando \(X\) tiende a cero por la derecha (\(X\rightarrow0^{+}\)), el modelo estima:

\[ Y \rightarrow 0\ \text{m} \]

Sin embargo, el valor \(X=0\) no pertenece al dominio del modelo, ya que éste fue ajustado mediante una transformación logarítmica (\(\ln X\)), la cual no está definida para cero.

Por tanto, el modelo no genera valores negativos de lámina de agua dentro de su dominio y su aplicación debe limitarse al intervalo de observaciones utilizado en el ajuste, correspondiente al régimen de aguas profundas.

12 Estimación

# Cálculos
# Pregunta de cantidad
X_cantidad <- 3000
Y_cantidad <- round(a_est * (X_cantidad^b_est), 2)


# Visualización
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 lámina de agua esperada cuando\n",
    "la profundidad sondador es de ", X_cantidad, " m?\n\n",
    "Resultado: ", Y_cantidad, " m\n\n",
sep = ""
  ),
  cex = 1.15,
  col = "#2E4053",
  font = 2
)

13 Conclusión

Entre la Profundidad Sondador (X) y la Lámina de Agua (Y) existe una relación de tipo potencial, cuyo modelo es \(Y = 1.9188(X)^{0.773}\). El modelo presenta como principal restricción que la profundidad debe ser mayor que cero, debido a la transformación logarítmica empleada para su ajuste. Los resultados indican que, a medida que aumenta la profundidad operativa, la lámina de agua también se incrementa de forma no lineal, evidenciando el comportamiento característico de las perforaciones en mar abierto. Con una correlación del 82.47%, se consolida como un estimador estadísticamente riguroso de la relación física estudiada.