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 analiza la relación estructural de la cuenca aplicando Binning para obtener una tendencia clara. Se opta por un modelo cuadrático (Grado 2) por ser más robusto y parsimonioso.

  • Variable Independiente (X): Lámina de Agua (Agrupada en rangos de 50m).
  • Variable Dependiente (Y): Profundidad Vertical Promedio (m).
# 1. Limpieza Inicial
datos_raw <- datos %>%
  select(LAMINA_D_AGUA_M, PROFUNDIDADE_VERTICAL_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_VERTICAL_M), ",", ".")))
  ) %>%
  filter(!is.na(x_raw) & !is.na(y_raw) & x_raw > 0 & y_raw > 0)

# 2. BINNING (Agrupamiento por Rangos)
datos_model <- datos_raw %>%
  mutate(x_bin = round(x_raw / 50) * 50) %>% # Agrupamos cada 50m
  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 en los promedios
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 Cuadrática)

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 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)

4 Modelo Polinómico (Grado 2)

Se ajusta un polinomio de segundo grado (Parábola): \[y = \beta_0 + \beta_1 x + \beta_2 x^2\]

# Ajuste Polinómico Grado 2
modelo_poli <- lm(y ~ poly(x, 2, raw = TRUE))

5 Gráfica del Modelo Ajustado

par(mar = c(5, 5, 4, 2))
plot(x, y,
     main = "Gráfica N°2: Ajuste Polinómico (Grado 2)",
     xlab = "Lámina de Agua Agrupada (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")

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

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

legend("topleft", legend = "Modelo Cuadrático (Grado 2)", 
       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): 86.0259%

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

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

6.2 Ecuación Matemática

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

La ecuación resultante es: y = 0.000617x² - 0.88057x + 3597.4931

7 Tabla Resumen del Modelo

tabla_resumen <- data.frame(
  Variable = c("Lámina de Agua (Binning)", "Prof. Vertical (Promedio)", ""),
  Tipo = c("Independiente (X)", "Dependiente (Y)", ""),
  Pearson = c(paste0(round(r*100,2), "%"), "", ""),
  R2 = c(paste0(round(r2*100,2), "%"), "", ""),
  Parametros = c(
    paste0("a (x²) = ", sprintf("%.6f", a)),
    paste0("b (x) = ", sprintf("%.5f", b)),
    paste0("c (Int) = ", sprintf("%.4f", c))
  ),
  Ecuacion = c(ecuacion_txt, "", "")
)

tabla_resumen %>%
  gt() %>%
  tab_header(
    title = md("**RESUMEN MODELO CUADRÁTICO**"),
    subtitle = "Tendencia Regional (Agrupada)"
  ) %>%
  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_options(
    table.border.top.color = "#2C3E50",
    data_row.padding = px(8)
  )
RESUMEN MODELO CUADRÁTICO
Tendencia Regional (Agrupada)
Variable Tipo Pearson R2 Parametros Ecuacion
Lámina de Agua (Binning) Independiente (X) 86.03% 74% a (x²) = 0.000617 y = 0.000617x² - 0.88057x + 3597.4931
Prof. Vertical (Promedio) Dependiente (Y) b (x) = -0.88057
c (Int) = 3597.4931
Fuente: Cálculos Grupo 3

8 Conclusiones

texto_conclusion <- paste0(
  "Se ajustó un modelo polinómico de segundo grado (cuadrático) sobre los datos agrupados, ",
  "identificando una tendencia clara gobernada por la ecuación **", ecuacion_txt, "**.<br><br>",
  "Para una lámina de agua de **", round(x_ejemplo, 2), " m**, ",
  "se estima una profundidad vertical promedio de **", round(y_est, 2), " m**."
)

cat(texto_conclusion)

Se ajustó un modelo polinómico de segundo grado (cuadrático) sobre los datos agrupados, identificando una tendencia clara gobernada por la ecuación y = 0.000617x² - 0.88057x + 3597.4931.

Para una lámina de agua de 1402.94 m, se estima una profundidad vertical promedio de 3577.4 m.