1 Librerias

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

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 definió la Lámina de Agua como variable independiente (x) dado que representa el entorno geográfico y la ubicación en la superficie del mar.

La Profundidad Vertical Promedio actúa como variable dependiente (y), pues refleja la posición del yacimiento en el subsuelo en función de esa ubicación.

Esta relación busca modelar la geometría de la cuenca sedimentaria: geológicamente, a medida que se avanza hacia aguas más profundas, las capas del yacimiento tienden a descender siguiendo una curvatura estructural, lo cual justifica el análisis de su tendencia no lineal.

  • Variable Independiente (X): Lámina de Agua.
  • Variable Dependiente (Y): Profundidad Vertical Promedio (m).
datos_base <- Datos_Brutos %>%
  filter(TERRA_MAR == "M") %>% 
  dplyr::select(LAMINA_D_AGUA_M, PROFUNDIDADE_VERTICAL_M) %>%
  mutate(
    x = abs(as.numeric(str_replace(as.character(LAMINA_D_AGUA_M), ",", "."))),
    y = abs(as.numeric(str_replace(as.character(PROFUNDIDADE_VERTICAL_M), ",", ".")))
  ) %>%
  # 1. Filtro de Aguas Profundas: Empezar desde 500m de lámina de agua
  # 2. Filtro de Horizonte Geológico: La prof. vertical no debe exceder los 3000m bajo el lecho marino (y < x + 3000).

  filter(!is.na(x) & !is.na(y) & x > 500 & y < (x + 3000) & y > 1500)

# Variables originales extraídas para la tabla y gráfico 1
X_original <- datos_base$x
Y_original <- datos_base$y

4 Tabla Pares de Valores

El tamaño muestral, una vez depurados los valores faltantes o nulos, es de 901 observaciones.

TVP_original <- data.frame(X_original, Y_original)
n_original <- nrow(TVP_original)

cat("Tamaño muestral original =", n_original)
## Tamaño muestral original = 901
# Se extraen los primeros 15 registros para no sobrecargar el renderizado HTML
tabla_orig <- head(TVP_original, 15) %>%
  gt() %>%
  cols_align(align = "center", columns = everything()) %>%
  fmt_number(columns = everything(), decimals = 2) %>%
  tab_header(
    title = md("*Tabla N°1*"),
    subtitle = md("*Pares de valores originales de Lámina de Agua y Prof. Vertical*")
  ) %>%
  tab_source_note(
    source_note = md(paste0("**Nota:** Se muestran 15 observaciones. Tamaño muestral n = ", n_original))
  ) %>%
  cols_label(X_original = "Lámina de Agua (X)", Y_original = "Prof. Vertical (Y)")

div(style = "height:400px; overflow-y:auto;", tabla_orig)
Tabla N°1
Pares de valores originales de Lámina de Agua y Prof. Vertical
Lámina de Agua (X) Prof. Vertical (Y)
1,827.00 3,145.40
1,705.84 2,936.99
1,705.35 2,934.18
1,653.56 2,952.55
1,267.00 2,871.00
1,663.00 2,459.00
955.00 3,338.50
1,919.40 2,907.69
2,708.00 3,745.00
1,403.00 3,389.20
1,030.00 2,754.00
2,248.00 2,648.00
505.00 2,691.80
1,315.00 2,934.00
1,653.20 2,949.53
Nota: Se muestran 15 observaciones. Tamaño muestral n = 901

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,
     type = "n",
     main = "Gráfica N°1\nDiagrama original de dispersión entre Lámina de Agua y Prof. Vertical",
     xlab = "Lámina de Agua (m)",
     ylab = "Profundidad Vertical (m)",
     xlim = c(min(X_original), max(X_original)),
     ylim = c(min(Y_original), max(Y_original)),
     cex.main = 1.1, cex.lab = 1.1, cex.axis = 0.9)

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

points(X_original, Y_original, col = color_trans, pch = 16, cex = 0.8)
box(lwd = 1.5)

6 Tratamiento de los Datos

Debido a la fuerte dispersión operativa observada en la Gráfica N°1, es necesario aislar la tendencia estructural principal. Para evitar el uso de agrupamientos artificiales (binning) que alteren la varianza original, se aplica un filtro estadístico basado en los residuos:

1. Ajuste Preliminar: Se calcula una regresión polinómica de grado 3 provisional con todos los datos crudos para establecer una línea base geométrica acorde al estudio.

2. Cálculo de Residuos: Se mide la distancia vertical de cada pozo hacia esta curva preliminar.

3. Depuración por IQR: Se aplica el método del Rango Intercuartílico estrictamente sobre los residuos. Esto descarta únicamente los pozos que constituyen anomalías estadísticas frente a la tendencia estructural de la cuenca geológica, conservando la verdadera dispersión física.

# Ajuste polinómico preliminar de grado 3
modelo_preliminar <- lm(y ~ poly(x, 3, raw = TRUE), data = datos_base)

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

# Función de filtro IQR más 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.35 
  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 geológica principal, el tamaño muestral se reduce a 609 observaciones limpias.

6.1 Tabla de Pares de Valores Simplificada

TVP_simplificada <- data.frame(X = x_final, Y = y_final)
n_modelo <- nrow(TVP_simplificada)

cat("Tamaño muestral del modelo =", n_modelo)
## Tamaño muestral del modelo = 609
tabla_simp <- head(TVP_simplificada, 15) %>%
  gt() %>%
  cols_align(align = "center", columns = everything()) %>%
  fmt_number(columns = everything(), decimals = 2) %>%
  tab_header(
    title = md("*Tabla N°2*"),
    subtitle = md("*Pares de valores simplificados de Lámina de Agua y Prof. Vertical*")
  ) %>%
  tab_source_note(
    source_note = md(paste0("**Nota:** Tamaño muestral depurado n = ", n_modelo))
  ) %>%
  cols_label(X = "Lámina de Agua (X)", Y = "Prof. Vertical (Y)")

div(style = "height:400px; overflow-y:auto;", tabla_simp)
Tabla N°2
Pares de valores simplificados de Lámina de Agua y Prof. Vertical
Lámina de Agua (X) Prof. Vertical (Y)
1,827.00 3,145.40
1,705.84 2,936.99
1,705.35 2,934.18
1,653.56 2,952.55
1,267.00 2,871.00
955.00 3,338.50
1,403.00 3,389.20
1,030.00 2,754.00
505.00 2,691.80
1,315.00 2,934.00
1,653.20 2,949.53
1,651.44 2,930.37
1,638.46 2,938.25
1,400.00 3,489.00
1,224.00 2,941.00
Nota: Tamaño muestral depurado n = 609

6.2 Nueva Gráfica de Dispersión

par(mar = c(5, 5, 4, 2))
plot(x_final, y_final,
     type = "n",
     main = "Gráfica N°2\nDiagrama simplificado de dispersión (Filtro IQR)",
     xlab = "Lámina de Agua (m)",
     ylab = "Profundidad Vertical (m)",
     xlim = c(0, max(x_final)*1.05),
     ylim = c(0, max(y_final)*1.05),
     cex.main = 1.1, cex.lab = 1.1, cex.axis = 0.9)

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

points(x_final, y_final, col = "#3498DB", pch = 16, cex = 0.8)
box(lwd = 1.5)

7 Conjetura

La distribución de los puntos en el gráfico muestra una tendencia con cambios de curvatura y puntos de inflexión marcados, lo que sugiere un modelo polinómico de grado 3 (cúbico). La Profundidad Vertical cambia su ritmo de descenso y aceleración a medida que se incrementa la Lámina de Agua, indicando una relación no lineal compleja característica del comportamiento estructural en la cuenca sedimentaria.

8 Parámetros

Modelo polinómico general de tercer grado:

\[Y = a + bX + cX^2 + dX^3\]

Modelo polinómico aplicado al estudio:

\[Prof. Vertical = a + b(Lamina) + c(Lamina)^2 + d(Lamina)^3\]

Ajuste del modelo:

# Ajuste polinómico de tercer grado (cúbico)
modelo_pol <- lm(y_final ~ poly(x_final, 3, raw = TRUE))

Parámetros

param <- coef(modelo_pol)

a_est <- param[1] # Intercepto (a)
a_est
## (Intercept) 
##    2512.029
b_est <- param[2] # Término lineal (b)
b_est
## poly(x_final, 3, raw = TRUE)1 
##                     0.8273417
c_est <- param[3] # Término cuadrático (c)
c_est
## poly(x_final, 3, raw = TRUE)2 
##                 -0.0008398297
d_est <- param[4] # Término cúbico (d)
d_est
## poly(x_final, 3, raw = TRUE)3 
##                  3.353148e-07

Ecuación polinómica de tercer grado: \[Y = a + bX + cX^2 + dX^3\]

Justificación del uso de la regresión lineal (lm)

Aunque el modelo planteado presenta una relación polinómica, se utiliza la función lm() debido a que el modelo puede expresarse como una combinación lineal de sus parámetros al incluir los términos \(X^2\) y \(X^3\). Esto permite ajustar relaciones no lineales entre las variables mediante una regresión lineal respecto a sus coeficientes.

Modelo polinómico de grado 3:

\[Y = a + bX + cX^2 + dX^3\] Para aplicar regresión lineal se define cada término del polinomio como una variable explicativa:

\[X_1 = X, \quad X_2 = X^2, \quad X_3 = X^3\]\[\beta_0 = a, \quad \beta_1 = b, \quad \beta_2 = c, \quad \beta_3 = d\] Por lo tanto, el modelo queda expresado como:

\[Y = \beta_0 + \beta_1 X_1 + \beta_2 X_2 + \beta_3 X_3\]

Dado que la ecuación es lineal en términos de los parámetros \(\beta_i\), puede ser estimada en R utilizando la sintaxis de regresión lineal (o empleando poly(X, 3, raw = TRUE)):

lm(Y ~ X + I(X^2) + I(X^3))

Finalmente, tras obtener los estimadores, reconstruimos nuestro modelo polinómico cúbico aplicado al estudio:

\[Prof. Vertical = a + b(Lámina) + c(Lámina)^2 + d(Lámina)^3\]

9 Comparación de la realidad con el modelo

par(mar = c(5, 5, 4, 2))
plot(x_final, y_final,
     type = "n",
     main = "Gráfica N°3\nModelo polinómico (Grado 3) entre Lámina de Agua y Prof. Vertical",
     xlab = "Lámina de Agua (m)",
     ylab = "Profundidad Vertical (m)",
     xlim = c(0, max(x_final)*1.05),
     ylim = c(0, max(y_final)*1.05),
     cex.main = 1.1, cex.lab = 1.1, cex.axis = 0.9)

grid(nx = NULL, ny = NULL, col = "gray85", lty = 1)
points(x_final, y_final, col = "#3498DB", pch = 16, cex = 0.7)

# Curva del modelo polinómico de grado 3
curve(a_est + b_est * x + c_est * x^2 + d_est * x^3,
      from = 0, to = max(x_final)*1.05,
      col = "#E74C3C", lwd = 3, add = TRUE)
box(lwd = 1.5)

legend("topleft",
       legend = c("Datos reales (Depurados)", "Modelo polinómico (Grado 3)"),
       col = c("#3498DB", "#E74C3C"),
       pch = c(16, NA),
       lwd = c(NA, 3),
       bty = "o", bg = "white", cex = 0.8)

10 Test de Bondad

# Cálculo de la correlación múltiple (r) entre los valores observados y los estimados
valores_ajustados <- fitted(modelo_pol)
r <- cor(y_final, valores_ajustados)

cat("Coeficiente de correlación (r) =", round(r * 100, 2), "%\n")
## Coeficiente de correlación (r) = 86.85 %
ecuacion_final <- paste0("Y = ", sprintf("%.4f", a_est), " + ", sprintf("%.4f", b_est), "X ", 
                         ifelse(c_est>=0, "+ ", ""), sprintf("%.6f", c_est), "X² ", 
                         ifelse(d_est>=0, "+ ", ""), sprintf("%.8f", d_est), "X³")

tabla_resumen <- data.frame(
  Parametro = c(
    "Tipo de Regresión",
    "Ecuación del Modelo",
    "Correlación (r)",
    "Intercepto (a)",
    "Coeficiente Lineal (b)",
    "Coeficiente Cuadrático (c)",
    "Coeficiente Cúbico (d)"
  ),
  Valor = c(
    "Polinómica (Grado 3)",
    ecuacion_final,
    paste0(round(r * 100, 2), " %"),
    sprintf("%.4f", a_est),
    sprintf("%.4f", b_est),
    sprintf("%.6f", c_est),
    sprintf("%.8f", d_est)
  )
)

tabla_resumen %>%
  gt() %>%
  tab_header(title = md("**RESUMEN DEL MODELO (GRADO 3)**")) %>%
  cols_align(align = "center", columns = Valor) %>%
  tab_style(style = list(cell_fill(color = "#2C3E50"), cell_text(color = "white", weight = "bold")), locations = cells_title()) %>%
  tab_options(table.border.top.color = "#2C3E50", data_row.padding = px(8))
RESUMEN DEL MODELO (GRADO 3)
Parametro Valor
Tipo de Regresión Polinómica (Grado 3)
Ecuación del Modelo Y = 2512.0287 + 0.8273X -0.000840X² + 0.00000034X³
Correlación (r) 86.85 %
Intercepto (a) 2512.0287
Coeficiente Lineal (b) 0.8273
Coeficiente Cuadrático (c) -0.000840
Coeficiente Cúbico (d) 0.00000034

11 Restricciones

Dominios.-

Dominio [x]: \(D = \{x \in \mathbb{R} : x \ge 0\}\)

Dominio [y]: \(D = \{y \in \mathbb{R} : y \ge 0\}\)

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

Debido a la naturaleza de las funciones polinómicas de tercer grado, las curvas cúbicas presentan puntos de inflexión y cambios de pendiente acentuados. Si extrapolamos valores muy pequeños o excesivamente grandes de Lámina de Agua (fuera del rango muestral), el crecimiento o descenso acelerado del término cúbico podría eventualmente arrojar valores de Profundidad Vertical geométricamente irreales o negativos. Por lo tanto, el modelo está estrictamente restringido a interpolaciones dentro de la muestra observada.

12 Estimación

# Pregunta de cantidad
X_objetivo <- median(x_final, na.rm = TRUE)

if(X_objetivo <= 0){
  stop("Error: La Lámina de Agua debe ser válida y positiva.")
}

Y_est <- a_est + b_est * X_objetivo + c_est * (X_objetivo^2) + d_est * (X_objetivo^3)

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

text(
  1, 1,
  labels = paste(
    "¿Cuál es la Profundidad Vertical esperada\n",
    "cuando la Lámina de Agua es de",
    round(X_objetivo, 2), "m?\n\n",
    "Resultado estimado (Prof. Vertical):",
    round(Y_est, 2), "m"
  ),
  cex = 1.2, col = "#2C3E50", font = 2
)

13 Conclusión

Entre la Lámina de Agua (X) y la Profundidad Vertical (Y) existe una relación de tipo polinómica (grado 3), representada por el modelo \(Y = 2512.0287 + 0.8273X + (-8.4\times 10^{-4}X^2) + 3.35\times 10^{-7}X^3\). Tras depurar la dispersión operativa con un filtro estadístico de residuos (IQR), el modelo captura satisfactoriamente la tendencia estructural del yacimiento marino, limitando su aplicación a interpolaciones estrictas dentro del dominio físico para evitar oscilaciones fuera de la realidad geológica.