1 Configuración y Carga de Datos

archivo <- "tabela_de_pocos_janeiro_2018.xlsx"

tryCatch({
  datos <- read_excel(archivo)
}, error = function(e) {
  stop("Error: Verifica que el archivo .xlsx esté en la carpeta.")
})

2 Extracción y Estrategia de Binning

Se aplica un modelo de crecimiento exponencial sobre los datos agrupados para reducir el ruido y encontrar la tendencia de la cuenca.

  • Variable Independiente (X): Lámina de Agua (Agrupada cada 50m).
  • Variable Dependiente (Y): Profundidad del Sondador Promedio (m).
# 1. Limpieza Inicial
datos_raw <- datos %>%
  select(LAMINA_D_AGUA_M, PROFUNDIDADE_SONDADOR_M) %>%
  mutate(
    x_raw = abs(as.numeric(str_replace(as.character(LAMINA_D_AGUA_M), ",", "."))),
    y_raw = abs(as.numeric(str_replace(as.character(PROFUNDIDADE_SONDADOR_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 / 50) * 50) %>% 
  group_by(x_bin) %>%
  summarise(
    y = mean(y_raw, na.rm = TRUE), 
    conteo = n()
  ) %>%
  rename(x = x_bin) %>%
  filter(conteo >= 3) # Filtro de representatividad

# 3. Limpieza de Outliers
lim_y <- quantile(datos_model$y, c(0.05, 0.95))
datos_model <- datos_model %>%
  filter(y >= lim_y[1] & y <= lim_y[2])

x <- datos_model$x
y <- datos_model$y

3 Análisis Gráfico (Tendencia Agrupada)

par(mar = c(5, 5, 4, 2))
plot(x, y,
     main = "Gráfica N°1: Tendencia Promedio (Agrupada)",
     xlab = "Lámina de Agua Agrupada (m)",
     ylab = "Profundidad Sondador 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)

4 Modelo Exponencial

Se plantea un modelo exponencial: \[y = a \cdot e^{bx}\] Linealización: \(\ln(y) = \ln(a) + bx\)

# Ajuste Exponencial (Semi-log)
modelo_exp <- lm(log(y) ~ x)

5 Gráfica del Modelo Ajustado

par(mar = c(5, 5, 4, 2))
plot(x, y,
     main = "Gráfica N°2: Ajuste Exponencial Final",
     xlab = "Lámina de Agua Agrupada (m)",
     ylab = "Profundidad Sondador Promedio (m)",
     col = "#3498DB", pch = 16, cex = 1.0, frame.plot = FALSE)

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

# Generar Curva
x_seq <- seq(min(x), max(x), length.out = 500)
y_pred <- exp(predict(modelo_exp, list(x = x_seq)))

lines(x_seq, y_pred, col = "#E74C3C", lwd = 3)

legend("topleft", legend = "Modelo Exponencial", 
       col = "#E74C3C", lwd = 3, bty = "n")

6 Resultados y Ecuación

6.1 Bondad de Ajuste

cat(paste0("**Coeficiente de Correlación (R):** ", round(r * 100, 4), "%<br>"))

Coeficiente de Correlación (R): 90.8732%

cat(paste0("**Coeficiente de Determinación (R²):** ", round(r2 * 100, 4), "%"))

Coeficiente de Determinación (R²): 82.5793%

6.2 Ecuación Matemática

cat(paste0("La ecuación resultante es: **", ecuacion_txt, "**"))

La ecuación resultante es: y = 2913.1272 * e^(0.00022x)

7 Tabla Resumen del Modelo

# Tabla con el diseño solicitado (Adaptado a parámetros exponenciales)
tabla <- data.frame(
  Variable = c("Lámina de Agua", "Prof. Sondador"),
  Tipo = c("Independiente (X)", "Dependiente (Y)"),
  Pearson = c(paste0(round(r*100,2), "%"), ""),
  R2 = c(paste0(round(r2*100,2), "%"), ""),
  Intercepto = c(sprintf("%.4f", a), ""),      # Parámetro a
  Coeficiente = c(sprintf("%.5f", b), ""),     # Parámetro b
  Ecuacion = c(ecuacion_txt, "")
)

tabla %>%
  gt() %>%
  tab_header(
    title = md("**RESUMEN DEL MODELO EXPONENCIAL**"),
    subtitle = "Parámetros y Bondad de Ajuste"
  ) %>%
  tab_source_note(source_note = "Fuente: Cálculos Grupo 3") %>%
  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",
    table.border.bottom.color = "#2C3E50",
    data_row.padding = px(8)
  )
RESUMEN DEL MODELO EXPONENCIAL
Parámetros y Bondad de Ajuste
Variable Tipo Pearson R2 Intercepto Coeficiente Ecuacion
Lámina de Agua Independiente (X) 90.87% 82.58% 2913.1272 0.00022 y = 2913.1272 * e^(0.00022x)
Prof. Sondador Dependiente (Y)
Fuente: Cálculos Grupo 3

8 Conclusiones

texto_conclusion <- paste0(
  "Entre la lámina de agua y la profundidad del sondador existe una relación de tipo exponencial ",
  "cuya ecuación matemática está representada por **", ecuacion_txt, "**, ",
  "siendo ‘x’ la lámina de agua en m y ‘y’ la profundidad del sondador en m donde no existen restricciones.<br><br>",
  "Por ejemplo, para una lámina de agua de **", round(x_ejemplo, 2), " m** ",
  "se estima una profundidad del sondador de **", round(y_est, 2), " m**."
)

cat(texto_conclusion)

Entre la lámina de agua y la profundidad del sondador existe una relación de tipo exponencial cuya ecuación matemática está representada por y = 2913.1272 * e^(0.00022x), siendo ‘x’ la lámina de agua en m y ‘y’ la profundidad del sondador en m donde no existen restricciones.

Por ejemplo, para una lámina de agua de 1403.92 m se estima una profundidad del sondador de 3945.85 m.