# =============================================================================
# MODELO DE REGRESIÓN EXPONENCIAL DECRECIENTE
# Usando datos REALES del dataset geológico
# Variable dependiente: SAND_PCT (% Arena)
# Variable independiente: DEPTH_M (Profundidad en metros)
# =============================================================================
# Cargar datos
datos <- read.csv("ESTADISTICA/dataset_geologico_limpio_80.csv")
# Librerías
library(DT)
## Warning: package 'DT' was built under R version 4.5.3
library(dplyr)
## Warning: package 'dplyr' was built under R version 4.5.3
##
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(nls2) # Para mayor estabilidad en nls
## Warning: package 'nls2' was built under R version 4.5.3
## Cargando paquete requerido: proto
## Warning: package 'proto' was built under R version 4.5.3
# =============================================================================
# PASO 1: Selección y limpieza de variables
# =============================================================================
# Variable independiente (x): Profundidad del agua (m)
# Variable dependiente (y): Porcentaje de arena (%)
datos_modelo <- datos %>%
select(DEPTH_M, SAND_PCT) %>%
na.omit() %>% # Eliminar filas con NA
filter(DEPTH_M >= 0, # Profundidad no negativa
SAND_PCT >= 0, SAND_PCT <= 100) # % Arena entre 0 y 100
x <- datos_modelo$DEPTH_M
y <- datos_modelo$SAND_PCT
cat("Número de observaciones utilizadas:", nrow(datos_modelo), "\n")
## Número de observaciones utilizadas: 26359
# =============================================================================
# PASO 2: Tabla de pares de valores (datos reales)
# =============================================================================
tabla_real <- data.frame(
Profundidad_m = x,
Porcentaje_Arena = y
)
datatable(tabla_real,
caption = htmltools::tags$caption(
style = "caption-side: top; text-align: center; font-weight: bold;",
"Tabla 1. Pares de valores reales: Profundidad vs Porcentaje de arena"
),
extensions = c("Scroller"),
options = list(scrollY = 400, scrollX = TRUE, pageLength = 10),
rownames = FALSE
)
# =============================================================================
# PASO 3: Gráfica de dispersión (datos reales)
# =============================================================================
plot(x, y,
main = "Gráfica 1: Dispersión entre Profundidad y % de Arena (datos reales)",
xlab = "Profundidad del agua (metros)",
ylab = "Porcentaje de arena (%)",
pch = 16,
col = rgb(0, 0.4, 0.8, 0.6),
cex = 0.7)
# =============================================================================
# PASO 4: Ajuste del modelo exponencial decreciente
# =============================================================================
# Modelo: y = a + c * exp(-b * x)
modelo <- nls(y ~ a + c * exp(-b * x),
data = datos_modelo,
start = list(a = 5, c = 80, b = 0.002), # valores iniciales razonables
control = nls.control(maxiter = 100))
## Warning in min(x): ningún argumento finito para min; retornando Inf
## Warning in max(x): ningun argumento finito para max; retornando -Inf
# Extraer parámetros
param <- coef(modelo)
a_est <- round(param["a"], 4)
c_est <- round(param["c"], 4)
b_est <- round(param["b"], 6)
cat("\n=== PARÁMETROS DEL MODELO ===\n")
##
## === PARÁMETROS DEL MODELO ===
cat("a =", a_est, "\n")
## a = 8.462
cat("c =", c_est, "\n")
## c = 56.7963
cat("b =", b_est, "\n")
## b = 0.000598
cat("Ecuación ajustada: ŷ =", a_est, "+", c_est, "* exp(-", b_est, "* x)\n")
## Ecuación ajustada: ŷ = 8.462 + 56.7963 * exp(- 0.000598 * x)
# =============================================================================
# PASO 5: Gráfica con curva del modelo ajustado
# =============================================================================
plot(x, y,
main = "Gráfica 2: Modelo Exponencial Decreciente Ajustado\n% Arena vs Profundidad",
xlab = "Profundidad del agua (m)",
ylab = "Porcentaje de arena (%)",
pch = 16,
col = rgb(0, 0.4, 0.8, 0.6),
cex = 0.7)
curve(a_est + c_est * exp(-b_est * x),
from = min(x), to = max(x),
add = TRUE, col = "red", lwd = 3)
legend("topright", legend = "Modelo exponencial ajustado",
col = "red", lwd = 3, bty = "n")
# =============================================================================
# PASO 6: Evaluación del modelo (Correlación y determinación)
# =============================================================================
# Correlación de Pearson (lineal)
r <- cor(x, y)
r_porcentaje <- round(abs(r) * 100, 2)
# Coeficiente de determinación aproximado (para modelo no lineal se usa con precaución)
r2 <- round(r^2 * 100, 2)
cat("\nCoeficiente de correlación lineal (r):", r_porcentaje, "%\n")
##
## Coeficiente de correlación lineal (r): 28.08 %
cat("Coeficiente de determinación aproximado (r²):", r2, "%\n")
## Coeficiente de determinación aproximado (r²): 7.88 %
# =============================================================================
# PASO 7: Pronóstico (ejemplo)
# =============================================================================
profundidades_prueba <- c(10, 50, 100, 500, 2000)
pronostico <- a_est + c_est * exp(-b_est * profundidades_prueba)
cat("\n=== PRONÓSTICOS ===\n")
##
## === PRONÓSTICOS ===
for(i in 1:length(profundidades_prueba)){
cat("A", profundidades_prueba[i], "m de profundidad → Arena esperada:",
round(pronostico[i], 2), "%\n")
}
## A 10 m de profundidad → Arena esperada: 64.92 %
## A 50 m de profundidad → Arena esperada: 63.59 %
## A 100 m de profundidad → Arena esperada: 61.96 %
## A 500 m de profundidad → Arena esperada: 50.58 %
## A 2000 m de profundidad → Arena esperada: 25.64 %
# =============================================================================
# PASO 8: Conclusión (actualiza con tus resultados)
# =============================================================================
cat("\n=== CONCLUSIÓN ===\n")
##
## === CONCLUSIÓN ===
cat("Se ajustó un modelo exponencial decreciente entre la profundidad del agua y el porcentaje de arena.\n")
## Se ajustó un modelo exponencial decreciente entre la profundidad del agua y el porcentaje de arena.
cat("Ecuación: ŷ =", a_est, "+", c_est, "· e^(-", b_est, "· x)\n")
## Ecuación: ŷ = 8.462 + 56.7963 · e^(- 0.000598 · x)
cat("Esto confirma que a mayor profundidad, el contenido de arena tiende a disminuir exponencialmente,\n")
## Esto confirma que a mayor profundidad, el contenido de arena tiende a disminuir exponencialmente,
cat("lo cual es consistente con los procesos sedimentológicos (sedimentos gruesos se depositan en aguas someras).\n")
## lo cual es consistente con los procesos sedimentológicos (sedimentos gruesos se depositan en aguas someras).
cat("El modelo explica aproximadamente un", r2, "% de la variabilidad en los datos.\n")
## El modelo explica aproximadamente un 7.88 % de la variabilidad en los datos.