CARGA DE DATOS Y 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
datos <- read.csv("ESTADISTICA/dataset_geologico_limpio_80.csv")
# Variables
x <- as.numeric(datos$SAND_PCT) # % Arena (independiente)
y <- as.numeric(datos$CLAY_PCT) # % Arcilla (dependiente)
# Limpieza inicial
tabla <- data.frame(x, y)
tabla <- tabla %>%
filter(is.finite(x), is.finite(y),
x >= 0, x <= 100,
y >= 0, y <= 100)
# Eliminación de outliers (IQR)
Q1_x <- quantile(tabla$x, 0.25)
Q3_x <- quantile(tabla$x, 0.75)
Q1_y <- quantile(tabla$y, 0.25)
Q3_y <- quantile(tabla$y, 0.75)
IQR_x <- Q3_x - Q1_x
IQR_y <- Q3_y - Q1_y
tabla_limpia <- tabla %>%
filter(x >= (Q1_x - 1.5*IQR_x), x <= (Q3_x + 1.5*IQR_x),
y >= (Q1_y - 1.5*IQR_y), y <= (Q3_y + 1.5*IQR_y))
cat("Observaciones después de limpieza:", nrow(tabla_limpia), "\n")
## Observaciones después de limpieza: 25430
Tabla de pares de valores
#Paso 2 Tabla de pares de valores
datatable(tabla_limpia,
caption = htmltools::tags$caption(
style = "caption-side: top; text-align: center; font-weight: bold;",
"Tabla Nro. 3. Pares de valores limpios"
),
extensions = "Scroller",
options = list(scrollY = 400, scrollX = TRUE, pageLength = 10),
rownames = FALSE)
Diagrama de dispersión
# PASO 3: Gráfica de dispersión
plot(tabla_limpia$x, tabla_limpia$y,
pch = 16, col = "blue",
xlab = "Porcentaje de arena (%)",
ylab = "Porcentaje de arcilla (%)",
main = "Gráfica N 3: Diagrama de dispersión (datos limpios)")
Conjetura del Modelo
# PASO 4: Ajuste del modelo de regresión lineal
modelo_exp <- nls(y ~ a * exp(b * x),
data = tabla_limpia,
start = list(a = 80, b = -0.04))
# Parámetros del modelo
a_est <- round(coef(modelo_exp)["a"], 4) # Intercepto (amplitud)
b_est <- round(coef(modelo_exp)["b"], 6) # Exponente (tasa de decrecimiento)
cat("\n=== PARÁMETROS DEL MODELO EXPONENCIAL ===\n")
##
## === PARÁMETROS DEL MODELO EXPONENCIAL ===
cat("Intercepto (a) =", a_est, "\n")
## Intercepto (a) = 36.3519
cat("Exponente (b) =", b_est, "\n")
## Exponente (b) = -0.025211
cat("Ecuación: y =", a_est, "* exp(", b_est, "* x)\n")
## Ecuación: y = 36.3519 * exp( -0.025211 * x)
# PASO 5: Gráfica con la recta de regresión
plot(tabla_limpia$x, tabla_limpia$y,
pch = 16, col = "blue",
xlab = "Porcentaje de arena (%)",
ylab = "Porcentaje de arcilla (%)",
main = "Gráfica N 4: Modelo Exponencial Ajustado")
curve(a_est * exp(b_est * x), add = TRUE, col = "red", lwd = 3)
legend("topright", "Modelo exponencial", col = "red", lwd = 3, bty = "n")
# Gráfica agrupada (PROMEDIOS)
# =========================
tabla_agrupada <- tabla_limpia %>%
mutate(grupo = round(x, 0)) %>%
group_by(grupo) %>%
summarise(
x_prom = mean(x),
y_prom = mean(y),
.groups = "drop"
)
plot(
tabla_agrupada$x_prom,
tabla_agrupada$y_prom,
pch = 16,
col = "blue",
xlab = "Arena (%)",
ylab = "Arcilla (%)",
main = "Datos agrupados (promedios)"
)
curve(a_est * exp(b_est * x),
add = TRUE,
col = "red",
lwd = 3)
# PASO 6: Ecuación del modelo
# =========================================================
# Ecuación del Modelo
# =========================================================
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "",
xlim = c(0, 2), ylim = c(0, 2))
text(1, 1.8, "ECUACIÓN DEL MODELO EXPONENCIAL", cex = 1.5, col = "darkblue", font = 2)
text(1, 1.35,
paste0("Y = ", a_est, " × e^(", b_est, " × x)"),
cex = 1.5, col = "blue", font = 2)
text(1, 0.95, "Donde:", cex = 1.9, col = "black")
text(1, 0.65, "Y = Porcentaje de Arcilla (%)", cex = 1.7, col = "black")
text(1, 0.45, "x = Porcentaje de Arena (%)", cex = 1.7, col = "black")
Evaluación del modelo y Restricciones
# PASO 7:Evaluación del modelo
# =========================================================
# Evaluación del modelo
# =========================================================
r <- cor(tabla_limpia$x, tabla_limpia$y)
r2 <- r^2
cat("\nCoeficiente de correlación |r| =", round(abs(r)*100, 2), "%\n")
##
## Coeficiente de correlación |r| = 77.49 %
cat("Coeficiente de determinación (R²) =", round(r2*100, 2), "%\n")
## Coeficiente de determinación (R²) = 60.04 %
# PASO 8: Restricciones del modelo
# =========================================================
# Restricciones del modelo
# =========================================================
cat("\n=== RESTRICCIONES DEL MODELO ===\n")
##
## === RESTRICCIONES DEL MODELO ===
cat("- Dominio de x (Porcentaje de Arena): [0, 100]\n")
## - Dominio de x (Porcentaje de Arena): [0, 100]
cat("- Dominio de y (Porcentaje de Arcilla): [0, 100]\n")
## - Dominio de y (Porcentaje de Arcilla): [0, 100]
cat("- El modelo es válido dentro del rango observado de los datos.\n")
## - El modelo es válido dentro del rango observado de los datos.
cat("- No se recomienda extrapolar fuera de 0% - 100%.\n")
## - No se recomienda extrapolar fuera de 0% - 100%.
cat("- La función exponencial siempre genera valores positivos dentro del dominio.\n")
## - La función exponencial siempre genera valores positivos dentro del dominio.
Cálculo de Pronosticos
# PASO 9: cálculo de Pronósticos
cat("\n=== PRONÓSTICOS ===\n")
##
## === PRONÓSTICOS ===
arena_values <- c(20, 40, 60, 80)
for (arena in arena_values) {
arcilla_pred <- a_est * exp(b_est * arena)
cat(sprintf("Si Arena = %d%% → Arcilla esperada ≈ %.2f%%\n", arena, arcilla_pred))
}
## Si Arena = 20% → Arcilla esperada ≈ 21.96%
## Si Arena = 40% → Arcilla esperada ≈ 13.26%
## Si Arena = 60% → Arcilla esperada ≈ 8.01%
## Si Arena = 80% → Arcilla esperada ≈ 4.84%
# Pronóstico en cuadro grande
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
text(x = 1, y = 1,
labels = paste0("¿Qué porcentaje de arcilla se espera\n",
"cuando el porcentaje de arena es 60%?\n\n",
"Respuesta = ", round(a_est * exp(b_est * 60), 2), " %"),
cex = 1.8, col = "blue", font = 2)
Conclusiones
cat("\n=== CONCLUSIÓN ===\n")
##
## === CONCLUSIÓN ===
cat("Se ajustó un modelo exponencial entre el porcentaje de arena y el porcentaje de arcilla.\n")
## Se ajustó un modelo exponencial entre el porcentaje de arena y el porcentaje de arcilla.
cat("Ecuación: ŷ =", a_est, "* e^(", b_est, " * x)\n")
## Ecuación: ŷ = 36.3519 * e^( -0.025211 * x)
cat("La relación es decreciente: a mayor porcentaje de arena, menor porcentaje de arcilla.\n")
## La relación es decreciente: a mayor porcentaje de arena, menor porcentaje de arcilla.
cat("El modelo explica aproximadamente un", round(r2*100, 2), "% de la variabilidad observada.\n")
## El modelo explica aproximadamente un 60.04 % de la variabilidad observada.
cat("Esto es consistente con la sedimentología marina: los sedimentos finos (arcilla) predominan donde hay menos arena.\n")
## Esto es consistente con la sedimentología marina: los sedimentos finos (arcilla) predominan donde hay menos arena.