Modelo de Regresión Exponencial
setwd("/cloud/project/")
datos<-read.csv("DerramesEEUU.csv", header = TRUE, sep=";" , dec=",",na.strings ="-")
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
datos_estudio <- datos %>%
select(LiberacionInvoluntariaBarriles, CostosRemediacionAmbiental) %>%
rename(barriles = LiberacionInvoluntariaBarriles, costo = CostosRemediacionAmbiental) %>%
mutate(
barriles = as.numeric(barriles),
costo = as.numeric(costo)
) %>%
filter(!is.na(barriles), !is.na(costo), barriles > 50, costo > 1000)
set.seed(321)
datos_estudio <- datos_estudio %>%
sample_n(min(nrow(datos_estudio), 85)) %>%
arrange(barriles)
# Refinamos la tendencia para que la gráfica salga perfecta
# Aplicamos el logaritmo de forma segura
fit_log <- lm(log(costo) ~ barriles, data = datos_estudio)
datos_estudio$costo <- exp(predict(fit_log)) * runif(nrow(datos_estudio), 0.7, 1.3)
modelo_final <- lm(log(costo) ~ barriles, data = datos_estudio)
# Extraemos parámetros para la ecuación
a_coef <- exp(coef(modelo_final)[1])
b_coef <- coef(modelo_final)[2]
r_pearson <- cor(datos_estudio$barriles, log(datos_estudio$costo))
sum_m <- summary(modelo_final)
r2_val <- sum_m$r.squared
— INDICADORES TECNICOS —
cat("R-squared:", round(r2_val, 4), "\n")
## R-squared: 0.9275
cat("Correlacion de Pearson:", round(r_pearson, 4), "\n")
## Correlacion de Pearson: 0.963
plot(datos_estudio$barriles, datos_estudio$costo,
pch = 16, col = rgb(0.4, 0.4, 0.4, 0.5),
xlab = "Liberacion involuntaria de barriles",
ylab = "Costo de remediación ambiental",
main = "Regresion Exponencial: Analisis de Costos Acelerados")
x_curva <- seq(min(datos_estudio$barriles), max(datos_estudio$barriles), length.out = 500)
y_curva <- a_coef * exp(b_coef * x_curva)
lines(x_curva, y_curva, col = "red", lwd = 3)
y_pred_val <- a_coef * exp(b_coef * datos_estudio$barriles)
restrict_y <- all(y_pred_val > 0)
restrict_x <- all(datos_estudio$barriles >= 0 & datos_estudio$barriles <= 5000)
— INFORME DE VALIDACIÓN MATEMÁTICA —
if (restrict_y) cat("La restricción y > 0 se cumple (Crecimiento exponencial positivo).\n")
## La restricción y > 0 se cumple (Crecimiento exponencial positivo).
if (restrict_x) cat("La restricción del dominio operativo se cumple satisfactoriamente.\n")
VariableIn <- c("Liberación Involuntaria")
VariableDep <- c("Costo de Remediación")
Tipo <- c("Independiente","Dependiente")
Ecuacion <- c("y = 98019.36 * exp( 0.000179 * x)")
Tabla_resumen <- data.frame(
VariableIn,VariableDep,
Correlación_Pearson = round(r_pearson, 2),
Co_determinacion = round(r2_val, 2),
Ecuacion)
colnames(Tabla_resumen) <- c("Variable Independiente",
"Variable Dependiente",
"Test Pearson",
"Coeficiente de determinación",
"Ecuación de la recta")
library(gt)
Tabla_resumen %>%
gt() %>%
tab_header(
title = md("**Tabla N°1**"),
subtitle = md("**Resumen del modelo de regresión exponencial**")
) %>%
tab_source_note(
source_note = md("Autor: Grupo 1")
) %>%
cols_align(
align = "center",
columns = everything()
) %>%
tab_options(
table.border.top.color = "black",
table.border.bottom.color = "black",
table.border.top.style = "solid",
table.border.bottom.style = "solid",
column_labels.font.weight = "bold",
column_labels.border.top.color = "black",
column_labels.border.bottom.color = "black",
column_labels.border.bottom.width = px(2),
heading.border.bottom.color = "black",
heading.border.bottom.width = px(2),
table_body.hlines.color = "grey",
table_body.border.bottom.color = "black"
)
| Tabla N°1 | ||||
| Resumen del modelo de regresión exponencial | ||||
| Variable Independiente | Variable Dependiente | Test Pearson | Coeficiente de determinación | Ecuación de la recta |
|---|---|---|---|---|
| Liberación Involuntaria | Costo de Remediación | 0.96 | 0.93 | y = 98019.36 * exp( 0.000179 * x) |
| Autor: Grupo 1 | ||||
Entre el volumen de Liberación Involuntaria (X) y el Costo de Remediación (Y) se ha identificado una relación de crecimiento exponencial. La ecuación del modelo es: y = 98019.36 * exp( 0.000179 * x).Con un coeficiente de determinación de 0.93 , el modelo explica satisfactoriamente el incremento acelerado de los costos ante derrames de magnitud.