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.")
})

3 Selección de Variables

Se seleccionó la Profundidad Vertical como variable independiente (X) debido a que representa el objetivo geológico fijo (la ubicación conocida del yacimiento).

Por consiguiente, la Profundidad de Perforación funciona como la variable dependiente (Y), pues representa la longitud operativa necesaria para alcanzar dicho objetivo.

  • Variable Independiente (X): Profundidad Vertical (m)
  • Variable Dependiente (Y): Profundidad de Perforación (m)
datos_base <- Datos_Brutos %>%
  dplyr::select(PROFUNDIDADE_VERTICAL_M, PROFUNDIDADE_SONDADOR_M) %>%
  mutate(
    x = abs(as.numeric(str_replace(as.character(PROFUNDIDADE_VERTICAL_M), ",", "."))),
    y = abs(as.numeric(str_replace(as.character(PROFUNDIDADE_SONDADOR_M), ",", ".")))
  ) %>%
  filter(!is.na(x) & !is.na(y) & x > 0 & y > 0 & x <= 15000)

4 Tabla de Pares de Valores

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

kable(head(datos_base %>% dplyr::select(x, y), 5),
      col.names = c("Profundidad Vertical (X)", "Profundidad de Perforación (Y)"))
Profundidad Vertical (X) Profundidad de Perforación (Y)
3145.40 4050
6900.00 6925
2936.99 3809
2934.18 4575
2952.55 4570

5 Gráfica de Dispersión

par(mar = c(5, 5, 4, 2))
plot(
  datos_base$x, datos_base$y,
  main = "Gráfica N°1: Dispersión de Prof. de Perforación en función de Prof. Vertical",
  cex.main = 1,
  xlab = "Profundidad Vertical (m)",
  ylab = "Profundidad de Perforación (m)",
  col  = "#2E4053", pch = 16, cex = 0.7,
  frame.plot = FALSE
)
grid(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")

6 Conjetura

La nube de puntos observada en la Gráfica N°1 no se ajusta a una tendencia lineal limpia: se aprecia un núcleo de puntos alineado a lo largo de una diagonal, pero también un grupo considerable de observaciones muy por encima de esa tendencia. Esto indica una nube compleja/caótica, por lo que es necesario un tratamiento previo de los datos antes de continuar.

6.1 Tratamiento de los Datos

Se aplican los siguientes pasos:

  1. Único X, único Y: se trabaja exclusivamente con el par de variables ya definido (Profundidad Vertical → X, Profundidad de Perforación → Y), sin mezclar otras columnas del dataset.
  2. Ajuste de un modelo preliminar: se calcula una regresión lineal provisional con todos los datos depurados, únicamente para obtener los residuos de cada observación.
  3. Omisión de outliers por residuo: en lugar de evaluar X e Y por separado, se calcula el residuo de cada punto respecto al modelo preliminar y se aplica el criterio de rango intercuartílico (IQR) sobre esos residuos. Así se eliminan los puntos que se desvían de la tendencia general, conservando los que sí siguen el patrón lineal.
# Función para detectar outliers por rango intercuartílico (IQR)
filtrar_outliers <- function(x) {
  Q1  <- quantile(x, 0.25, na.rm = TRUE)
  Q3  <- quantile(x, 0.75, na.rm = TRUE)
  IQR <- Q3 - Q1
  x >= (Q1 - 1.5 * IQR) & x <= (Q3 + 1.5 * IQR)
}

# Modelo preliminar (solo para calcular residuos)
modelo_preliminar <- lm(y ~ x, data = datos_base)
datos_base$residuo <- resid(modelo_preliminar)

# Se descartan los puntos cuyo residuo es atípico
datos_model <- datos_base %>%
  filter(filtrar_outliers(residuo)) %>%
  dplyr::select(x, y)

Tras este tratamiento, el tamaño muestral se reduce de 5510 a 4714 observaciones.

6.2 Nueva Gráfica de Dispersión

par(mar = c(5, 5, 4, 2))
plot(
  datos_model$x, datos_model$y,
  main = "Gráfica N°2: Dispersión sin valores atípicos",
  cex.main = 1,
  xlab = "Profundidad Vertical (m)",
  ylab = "Profundidad de Perforación (m)",
  col  = "#2E4053", pch = 16, cex = 0.7,
  frame.plot = FALSE
)
grid(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")

6.3 Nueva Conjetura

Tras eliminar los valores atípicos, la nube de puntos muestra ahora una tendencia lineal clara y consistente, sin dispersión desproporcionada. Esto permite proceder con el ajuste del modelo de regresión lineal simple.

7 Cálculo de Parámetros

Se plantea el modelo matemático: y = mx + b

# Ajuste del modelo de regresión lineal
regresion_lineal <- lm(y ~ x, data = datos_model)

# Extracción de parámetros
beta0 <- unname(coef(regresion_lineal)[1])
beta1 <- unname(coef(regresion_lineal)[2])

# Extracción de métricas para más adelante
r  <- cor(datos_model$x, datos_model$y)
r2 <- summary(regresion_lineal)$r.squared

# Elementos para escribir la ecuación correctamente
signo_beta1 <- ifelse(beta1 >= 0, "+", "-")
beta1_abs <- abs(beta1)

cat("Intercepto beta0 =", round(beta0, 4), "\n")
## Intercepto beta0 = 64.3148
cat("Pendiente beta1 =", round(beta1, 4), "\n")
## Pendiente beta1 = 1.0048
cat(
  "Modelo: Y =",
  round(beta0, 4),
  signo_beta1,
  round(beta1_abs, 4),
  "* X\n"
)
## Modelo: Y = 64.3148 + 1.0048 * X

Modelo lineal obtenido:

\[ Y = 64.3148 + 1.0048\,X \]

El intercepto \(\beta_0\) representa la profundidad teórica de perforación cuando la profundidad vertical es igual a cero. La pendiente \(\beta_1\) indica cuántos metros cambia, en promedio, la profundidad de perforación estimada cuando la profundidad vertical aumenta en 1 m.

Justificación matemática del uso de la regresión lineal

El modelo propuesto tiene la forma: \[ Y = \beta_0 + \beta_1 X \] La función lm(y ~ x) estima los parámetros mediante el método de mínimos cuadrados ordinarios. Este método busca la recta que minimiza la suma de los cuadrados de las diferencias entre los valores observados \(Y_i\) y los valores estimados \(\hat{Y}_i\):

\[ \sum_{i=1}^{n}(Y_i - \hat{Y}_i)^2 \] La pendiente y el intercepto pueden expresarse matemáticamente como: \[ \beta_1 = \frac{\sum_{i=1}^{n}(X_i - \bar{X})(Y_i - \bar{Y})}{\sum_{i=1}^{n}(X_i - \bar{X})^2} \]\[ \beta_0 = \bar{Y} - \beta_1\bar{X} \] Por ello, el comando lm() permite obtener directamente los parámetros que definen la recta de mejor ajuste entre la Profundidad Vertical y la Profundidad de Perforación.

8 Realidad y Modelo

Se presenta el ajuste lineal incluyendo la banda de incertidumbre estadística (Intervalo de Confianza del 95%), superpuesto a los datos reales.

par(mar = c(5, 5, 4, 2))
plot(
  datos_model$x, datos_model$y,
  main = "Gráfica N°3: Modelo Lineal: Prof. de Perforación en función de Prof. Vertical",
  cex.main = 1,
  xlab = "Profundidad Vertical (m)",
  ylab = "Profundidad de Perforación (m)",
  col  = "#2E4053", pch = 16, cex = 0.6,
  frame.plot = FALSE
)
grid(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")

x_seq       <- seq(min(datos_model$x), max(datos_model$x), length.out = 500)
predicciones <- predict(regresion_lineal,
                        newdata  = data.frame(x = x_seq),
                        interval = "confidence",
                        level    = 0.95)

# Banda de intervalo de confianza
polygon(
  c(x_seq, rev(x_seq)),
  c(predicciones[, "lwr"], rev(predicciones[, "upr"])),
  col = rgb(0.5, 0.5, 0.5, 0.2), border = NA
)

# Línea del modelo
lines(x_seq, predicciones[, "fit"], col = "#C0392B", lwd = 3)

legend(
  "topleft",
  legend = c("Datos Reales", "Modelo Lineal", "I.C. 95%"),
  col    = c("#2E4053", "#C0392B", "gray"),
  pch    = c(16, NA, 15),
  lwd    = c(NA, 3, NA),
  pt.cex = c(0.7, NA, 2),
  bty    = "n"
)

9 Test de Bondad

ecuacion_txt <- paste0("y = ", round(beta0, 4), " + ", round(beta1, 4), "x")

tabla_resumen <- data.frame(
  Parametro = c(
    "Tipo de Regresión",
    "Ecuación del Modelo",
    "Coeficiente de Pearson (r)",
    "Coeficiente de Determinación (R²)",
    "Intercepto (beta0)",
    "Pendiente (beta1)"
  ),
  Valor = c(
    "Regresión Lineal Simple",
    ecuacion_txt,
    paste0(round(r * 100, 2), " %"),
    paste0(round(r2 * 100, 2), " %"),
    sprintf("%.4f", beta0),
    sprintf("%.4f", beta1)
  )
)
tabla_resumen %>%
  gt() %>%
  tab_header(
    title    = md("**RESUMEN DEL MODELO DE REGRESIÓN LINEAL**"),
    subtitle = "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 = "#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 DE REGRESIÓN LINEAL
Parámetros y Bondad de Ajuste
Parámetro Valor
Tipo de Regresión Regresión Lineal Simple
Ecuación del Modelo y = 64.3148 + 1.0048x
Coeficiente de Pearson (r) 99.88 %
Coeficiente de Determinación (R²) 99.76 %
Intercepto (beta0) 64.3148
Pendiente (beta1) 1.0048
Autor: Anahi Macias

10 Restricciones

# Valor estimado de Y cuando X = 0
Y_en_cero <- beta0

# Comprobación para el modelo obtenido
sin_restriccion_no_negativa <- beta0 >= 0 && beta1 >= 0

Dominios físicos de las variables

\[ D_X = {x \in \mathbb{R} : x \ge 0} \] \[ D_Y = {y \in \mathbb{R} : y \ge 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, el intercepto es \(\beta_0 = 64.3148\) y la pendiente es \(\beta_1 = 1.0048\). Como ambos parámetros son positivos, cualquier profundidad vertical mayor o igual a cero genera una profundidad de perforación estimada positiva.

Cuando \(X = 0\), el modelo estima:
\[ Y = 64.3148\ \text{m} \] Por tanto, el modelo no produce distancias operativas negativas dentro del dominio físico de las variables. Sin embargo, para evitar extrapolaciones poco confiables, su aplicación práctica debe realizarse preferentemente dentro del intervalo de observaciones de la base de datos.

11 Estimación

# ------------------------------------------------------------
# Pregunta de cantidad
# ------------------------------------------------------------

X_cantidad <- 3000

Y_cantidad <- beta0 + beta1 * X_cantidad

cat(
  "Prof. de perforación estimada cuando Prof. Vertical =",
  X_cantidad,
  "m:",
  round(Y_cantidad, 4),
  "m\n"
)
## Prof. de perforación estimada cuando Prof. Vertical = 3000 m: 3078.604 m
# ------------------------------------------------------------
# Presentación visual de las preguntas y respuestas
# ------------------------------------------------------------

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.50,
  labels = paste(
    "Pregunta de cantidad\n\n",
    "¿Cuál es la profundidad de perforación esperada cuando\n",
    "la profundidad vertical es de ", X_cantidad, " m?\n\n",
    "Resultado: ", round(Y_cantidad, 2), " m\n\n",
    sep = ""
  ),
  cex = 1.05,
  col = "#2E4053",
  font = 2
)

12 Conclusión

\[ Y = 64.3148 + 1.0048X \]

En esta ecuación, la Profundidad Vertical (X) corresponde a la variable independiente y la Profundidad de Perforación (Y) a la variable dependiente. El coeficiente de correlación de Pearson de 99.88% evidencia una asociación lineal fuerte, mientras que el coeficiente de determinación de 99.76% indica la proporción de variabilidad de la profundidad de perforación explicada por el modelo.