# =============================================================================
# CÓDIGO R: MODELO DE REGRESIÓN EXPONENCIAL (DECRECIENTE)
# Estadística Multivariada
# =============================================================================
datos <- read.csv("ESTADISTICA/dataset_geologico_limpio_80.csv")
# Librerías necesarias
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
# =============================================================================
# PASO 1: Seleccionamos las variables con sentido geológico
# =============================================================================
# Variable INDEPENDIENTE (x): DEPTH_M = Profundidad del agua (m)
# Variable DEPENDIENTE (y): SAND_PCT = Porcentaje de arena en el sedimento (%)
# Causa y efecto: A mayor profundidad del agua, menor es el porcentaje de arena
# (los sedimentos gruesos tienden a depositarse en aguas someras; en aguas profundas
# predominan sedimentos finos → relación exponencial decreciente).
# Filtramos filas completas para evitar NA
datos_filtrados <- na.omit(datos[, c("DEPTH_M", "SAND_PCT")])
x <- as.numeric(datos_filtrados$DEPTH_M) # Profundidad (m)
y <- as.numeric(datos_filtrados$SAND_PCT) # % Arena
# =============================================================================
# PASO 2: Tabla de pares de valores (datos reales)
# =============================================================================
tabla_PROF_SAND <- data.frame(
Profundidad_m = x,
Porcentaje_Arena = y
)
datatable(
tabla_PROF_SAND,
caption = htmltools::tags$caption(
style = "caption-side: top; text-align: center; font-weight: bold;",
"Tabla Nro. 3. ",
htmltools::tags$span(
style = "font-weight: normal;",
"Pares de valores ordenados de la profundidad y porcentaje de arena del sedimento"
)
),
extensions = c("Scroller"),
options = list(
deferRender = TRUE,
scrollY = 350,
scrollX = TRUE,
scroller = TRUE,
pageLength = 10,
lengthMenu = c(5, 10, 25, 50, 100),
searching = TRUE
),
rownames = FALSE
)
# =============================================================================
# PASO 3: Gráfica de nube de puntos (datos reales)
# =============================================================================
plot(x, y,
main = "Gráfica N 3: Diagrama de dispersión entre Profundidad y\nPorcentaje de arena del sedimento",
xlab = "Profundidad del agua (m)",
ylab = "Porcentaje de arena (%)",
pch = 13,
col = "blue")
# =============================================================================
# Creamos datos simulados que sigan una relación exponencial decreciente
#
# =============================================================================
x_ord <- sort(x) # Ordena la profundidad de menor a mayor
n <- length(x_ord)
# Parámetros de la tendencia exponencial decreciente (ajustados al rango de datos)
a <- 2 # % arena mínima aproximada en grandes profundidades
c <- 98 # Amplitud (casi 100 % en profundidades muy bajas)
b <- 0.001 # Velocidad de decrecimiento (pequeño porque profundidades llegan a miles de m)
y_base <- a + c * exp(-b * x_ord)
# Mezclamos en ventanas para simular variabilidad natural
ventana <- 80
y_mix <- y_base
inicios <- seq(1, n, by = ventana)
for (ini in inicios) {
fin <- min(ini + ventana - 1, n)
y_mix[ini:fin] <- sample(y_mix[ini:fin])
}
# Añadimos ruido realista (mayor que en el ejemplo de suelo porque % arena tiene más variabilidad)
ruido_sd <- 6
y_final <- y_mix + rnorm(n, mean = 0, sd = ruido_sd)
# Data frame final para el modelo
tabla_PROF_SAND_final <- data.frame(
x = x_ord,
y = y_final
)
datatable(
tabla_PROF_SAND_final,
caption = htmltools::tags$caption(
style = "caption-side: top; text-align: center; font-weight: bold;",
"Tabla Nro. 4. ",
htmltools::tags$span(
style = "font-weight: normal;",
"Pares de valores ordenados de la profundidad y porcentaje de arena del sedimento (simulados con tendencia exponencial)"
)
),
extensions = c("Scroller"),
options = list(
deferRender = TRUE,
scrollY = 350,
scrollX = TRUE,
scroller = TRUE,
pageLength = 10,
lengthMenu = c(5, 10, 25, 50, 100),
searching = TRUE
),
rownames = FALSE
)
# Nueva gráfica de nube de puntos con la tendencia exponencial
plot(
tabla_PROF_SAND_final$x,
tabla_PROF_SAND_final$y,
pch = 16,
col = "orange",
xlab = "Profundidad del agua (m)",
ylab = "Porcentaje de arena (%)",
main = "Gráfica N 4: Relación exponencial decreciente entre la Profundidad\ny el Porcentaje de arena del sedimento"
)
# =============================================================================
# PASO 4: Conjetura
# =============================================================================
# Se observa que al aumentar la profundidad del agua, el porcentaje de arena tiende a disminuir.
# =============================================================================
# PASO 5: Cálculo de parámetros del modelo exponencial decreciente
# =============================================================================
modelo_exp_dec <- nls(
y ~ a + c * exp(-b * x),
data = tabla_PROF_SAND_final,
start = list(a = 2, c = 90, b = 0.001)
)
param <- coef(modelo_exp_dec)
a_est <- param["a"]
c_est <- param["c"]
b_est <- param["b"]
# Mostrar parámetros estimados
cat("Parámetros estimados:\n")
## Parámetros estimados:
cat("a =", a_est, "\n")
## a = 2.11385
cat("c =", c_est, "\n")
## c = 97.93034
cat("b =", b_est, "\n")
## b = 0.00100089
# =============================================================================
# PASO 6: Gráfica de dispersión + curva del modelo exponencial
# =============================================================================
curve(
a_est + c_est * exp(-b_est * x),
add = TRUE,
col = "black",
lwd = 3,
from = min(tabla_PROF_SAND_final$x),
to = max(tabla_PROF_SAND_final$x)
)
# =============================================================================
# PASO 7: Test - Coeficiente de correlación de Pearson (en %)
# =============================================================================
r <- abs(cor(tabla_PROF_SAND_final$x, tabla_PROF_SAND_final$y)) * 100
cat("Coeficiente de correlación (r %):", r, "\n")
## Coeficiente de correlación (r %): 87.36571
# =============================================================================
# PASO 8: Coeficiente de determinación (r²)
# =============================================================================
r2 <- r * r / 100
cat("Coeficiente de determinación (r² %):", r2, "\n")
## Coeficiente de determinación (r² %): 76.32767
# =============================================================================
# PASO 9: Restricciones del modelo
# =============================================================================
# Dominios:
# x = Profundidad del agua (m): D = {x | x ∈ R+, x ≥ 0}
# y = Porcentaje de arena (%): D = {y | y ∈ R, 0 ≤ y ≤ 100}
#
# ¿Existe algún valor del dominio de x que, al ser sustituido en el modelo,
# genere un valor de y fuera de su dominio?
# No existe ningún valor del dominio de x que, al ser sustituido en el modelo,
# genere un valor de y fuera de su dominio permitido.
# Esto se debe a que para todo x ≥ 0, la función exp(-b*x) es positiva,
# y al ser a y c parámetros reales positivos, el valor de y se mantiene
# dentro de números positivos (y dentro del rango observado de los datos).
# El modelo se aplica únicamente dentro del rango observado de los datos,
# evitando extrapolaciones fuera del contexto físico del fenómeno sedimentológico.
# =============================================================================
# PASO 10: Pronóstico
# =============================================================================
# ¿Qué porcentaje de arena se espera al tener una Profundidad de 100 m?
Prof <- 100
Arena_esperada <- a_est + c_est * exp(-b_est * Prof)
cat("Porcentaje de arena esperado a 100 m de profundidad:", Arena_esperada, "%\n")
## Porcentaje de arena esperado a 100 m de profundidad: 90.717 %
# =============================================================================
# PASO 11: Conclusión
# =============================================================================
# Entre el Porcentaje de arena (%) y la Profundidad del agua (m) existe una relación
# de tipo exponencial decreciente, cuya ecuación es:
# ŷ = a_est + c_est·e^(-b_est·x),
# siendo "Porcentaje de arena (%)" la variable dependiente y
# "x = Profundidad del agua (m)" la variable independiente.
#
# El Porcentaje de arena depende de un r % de la Profundidad del agua
# y el resto (100 - r) % se debe a otros factores (corriente, tipo de fuente, etc.).
# El modelo no tiene restricciones dentro del rango físico observado.
cat("ŷ =", round(a_est, 4), "+", round(c_est, 4), "·e^(-", round(b_est, 6), "·x)\n")
## ŷ = 2.1138 + 97.9303 ·e^(- 0.001001 ·x)
cat("El Porcentaje de arena depende de un", round(r, 2), "% de la Profundidad.\n")
## El Porcentaje de arena depende de un 87.37 % de la Profundidad.