Se analiza la relación entre la longitud perforada y la profundidad vertical. Se utiliza la técnica de Binning para reducir el ruido y comparar dos enfoques de modelado: Logarítmico vs Lineal.
# 1. Limpieza Inicial
datos_raw <- datos %>%
select(PROFUNDIDADE_SONDADOR_M, PROFUNDIDADE_VERTICAL_M) %>%
mutate(
x_raw = abs(as.numeric(str_replace(as.character(PROFUNDIDADE_SONDADOR_M), ",", "."))),
y_raw = abs(as.numeric(str_replace(as.character(PROFUNDIDADE_VERTICAL_M), ",", ".")))
) %>%
filter(!is.na(x_raw) & !is.na(y_raw) & x_raw > 0 & y_raw > 0)
# 2. BINNING (Agrupamiento)
datos_model <- datos_raw %>%
mutate(x_bin = round(x_raw / 100) * 100) %>%
group_by(x_bin) %>%
summarise(
y = mean(y_raw, na.rm = TRUE),
conteo = n()
) %>%
rename(x = x_bin) %>%
filter(conteo >= 3)
# 3. Limpieza de Outliers
lim_y <- quantile(datos_model$y, c(0.02, 0.98))
datos_model <- datos_model %>%
filter(y >= lim_y[1] & y <= lim_y[2])
x <- datos_model$x
y <- datos_model$ypar(mar = c(5, 5, 4, 2))
plot(x, y,
main = "Gráfica N°1: Tendencia de Perforación (Agrupada)",
xlab = "Profundidad Sondador (m)",
ylab = "Profundidad Vertical Promedio (m)",
col = "#3498DB", pch = 16, cex = 1.2, frame.plot = FALSE)
grid(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")
axis(1); axis(2)Se plantea el modelo: \[y = a + b \cdot \ln(x)\]
par(mar = c(5, 5, 4, 2))
plot(x, y,
main = "Gráfica N°2: Ajuste Logarítmico",
xlab = "Profundidad Sondador (m)",
ylab = "Profundidad Vertical Promedio (m)",
col = "#3498DB", pch = 16, cex = 1.0, frame.plot = FALSE)
grid(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")
x_seq <- seq(min(x), max(x), length.out = 500)
y_pred_log <- predict(modelo_log, list(x = x_seq))
lines(x_seq, y_pred_log, col = "#E74C3C", lwd = 3)
legend("topleft", legend = "Modelo Logarítmico", col = "#E74C3C", lwd = 3, bty = "n")[Image of linear regression plot]
Se propone un modelo lineal simple para eliminar las restricciones matemáticas del logaritmo: \[y = m \cdot x + b\]
par(mar = c(5, 5, 4, 2))
plot(x, y,
main = "Gráfica N°3: Ajuste Lineal (Sin Restricciones)",
xlab = "Profundidad Sondador (m)",
ylab = "Profundidad Vertical Promedio (m)",
col = "#3498DB", pch = 16, cex = 1.0, frame.plot = FALSE)
grid(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")
y_pred_lin <- predict(modelo_lin, list(x = x_seq))
lines(x_seq, y_pred_lin, col = "#27AE60", lwd = 3) # Verde para el lineal
legend("topleft", legend = "Modelo Lineal", col = "#27AE60", lwd = 3, bty = "n")tabla_comp <- data.frame(
Modelo = c("Logarítmico", "Lineal"),
Pearson_R = c(paste0(round(r_log*100,2), "%"), paste0(round(r_lin*100,2), "%")),
R2 = c(paste0(round(r2_log*100,2), "%"), paste0(round(r2_lin*100,2), "%")),
Ecuacion = c(ecuacion_log, ecuacion_lin),
Restriccion = c(paste0("x > ", round(x_restriccion, 2), " m"), "Ninguna")
)
tabla_comp %>%
gt() %>%
tab_header(
title = md("**COMPARACIÓN: LOGARÍTMICO vs LINEAL**"),
subtitle = "Evaluación de Ajuste y Restricciones"
) %>%
cols_align(align = "center", columns = everything()) %>%
tab_style(
style = list(cell_fill(color = "#2C3E50"), cell_text(color = "white", weight = "bold")),
locations = cells_title()
) %>%
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",
data_row.padding = px(8)
)| COMPARACIÓN: LOGARÍTMICO vs LINEAL | ||||
| Evaluación de Ajuste y Restricciones | ||||
| Modelo | Pearson_R | R2 | Ecuacion | Restriccion |
|---|---|---|---|---|
| Logarítmico | 88.54% | 78.39% | y = -11340.5778 + 1822.8145 * ln(x) | x > 503.44 m |
| Lineal | 97.9% | 95.85% | y = 123.6245 + 0.8428x | Ninguna |
texto_conclusion <- paste0(
"Se compararon dos modelos matemáticos para explicar la relación entre la Profundidad del Sondador y la Vertical:<br><br>",
"**1. Modelo Logarítmico:** Presenta un ajuste del **", round(r2_log*100, 2), "%**, pero posee una **restricción matemática significativa**: ",
"solo es válido para profundidades de sondador mayores a **", round(x_restriccion, 2), " m** (x > ", round(x_restriccion, 2), ").<br><br>",
"**2. Modelo Lineal:** Al cambiar la perspectiva a una relación lineal simple, obtenemos un ajuste del **", round(r2_lin*100, 2), "%**, ",
"con la ventaja operativa de **eliminar las restricciones matemáticas**, permitiendo estimaciones en todo el rango operativo.<br><br>",
"La ecuación lineal recomendada es **", ecuacion_lin, "**, donde no existen restricciones de dominio."
)
cat(texto_conclusion)Se compararon dos modelos matemáticos para explicar la relación entre
la Profundidad del Sondador y la Vertical:
1. Modelo
Logarítmico: Presenta un ajuste del 78.39%,
pero posee una restricción matemática significativa:
solo es válido para profundidades de sondador mayores a 503.44
m (x > 503.44).
2. Modelo Lineal: Al
cambiar la perspectiva a una relación lineal simple, obtenemos un ajuste
del 95.85%, con la ventaja operativa de
eliminar las restricciones matemáticas, permitiendo
estimaciones en todo el rango operativo.
La ecuación lineal
recomendada es y = 123.6245 + 0.8428x, donde no existen
restricciones de dominio.