Modelo de Regresión Logarítmica
Cargar los datos
setwd("D:/Data")
datos <- read.csv("derrames_globales_.csv", header = TRUE, sep = ";", dec =".")
str(datos)## 'data.frame': 3550 obs. of 23 variables:
## $ Id : int 6786 6250 8220 6241 6216 6620 6262 6229 6201 6221 ...
## $ Dia : int 19 3 21 16 19 7 10 12 18 29 ...
## $ Mes : int 1 6 4 3 12 10 2 5 3 1 ...
## $ ANo : chr "A" "1979" "2010" "1978" ...
## $ Nombre : chr "Arabian Gulf Spills; Persian Gulf, Kuwait" "IXTOC I; Bahia de Campeche, Mexico" "Deepwater Horizon; Gulf of Mexico" "Amoco Cadiz; Brittany, France" ...
## $ Ubicacion : chr "Persian Gulf, Kuwait" "Bahia de Campeche, Mexico" "Gulf of Mexico" "Brittany, France" ...
## $ Latitud : chr "29,5" "19,4083" "28,7367" "48,5833" ...
## $ Longuitud : chr "48" "-92,325" "-88,3872" "-4,71667" ...
## $ Amenaza : chr "Oil" "Oil" "Oil" "Oil" ...
## $ Etiquetas : chr "" "Collision" "" "Grounding" ...
## $ Tipo_de_crudo : chr "Kuwait crude oil" "IXTOC I crude oil" "Diesel, crude oil" "Arabian light crude, Iranian light crude, Bunker C" ...
## $ Recuperacion_en_superficie_aplicada: int NA NA 1 NA NA NA NA NA NA NA ...
## $ Recuperacion_en_costas_aplicada : int NA NA 1 NA NA NA NA NA NA NA ...
## $ Tratamiento_biologico_aplicado : int 1 NA 1 1 NA NA NA NA NA NA ...
## $ Dispersion_quimica_aplicada : int NA 1 1 1 NA NA NA 1 1 1 ...
## $ Quema_aplicada : int NA 1 1 NA NA NA NA 1 1 1 ...
## $ Maximo_liberacion_galones : int 336000009 -1 205000000 68000017 -1 -1 -1 9240000 36100000 -1 ...
## $ Barreras_de_contencion_flotantes : int 35 12 182 17 3 3 7 8 5 6 ...
## $ Causa_principal : chr "DaNo del tanque " "Incendio y explosion " "Incendio y explosion " "DaNo del tanque " ...
## $ Volumen_derramados_galones : chr "336.000.000" "365.000.000" "600.000.000" "68.000.000" ...
## $ Respuesta_actual_galones : chr "336000000" "252000000" "168000000" "68700000" ...
## $ Fuente_respuesta : chr "description and posts" "posts" "description" "posts" ...
## $ etiqueta_actualizacion : chr "RA updated" "RA newly acquired" "RA updated" "RA updated" ...1 Regresión Logarítmica
library(dplyr)##
## 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, unionlibrary(knitr)
x <- as.numeric(as.character(datos[, 20])) # Volumen## Warning: NAs introducidos por coercióny <- as.numeric(as.character(datos[, 21])) # Respuesta## Warning: NAs introducidos por coerción1.1 Limpieza y filtrado de datos
datos_filtrados <- data.frame(x = x, y = y)
datos_filtrados <- na.omit(datos_filtrados)
# Filtro de Respuesta (Y) > 2100 (Eliminando ruido base)
datos_filtrados <- subset(datos_filtrados, y > 2100)
# Filtro de Volumen (X) entre 4000 y 25000
datos_finales <- subset(datos_filtrados, x >= 4000 & x <= 25000)1.2 Modelo logarítmico
datos_finales$log_x <- log(datos_finales$x)
modelo_log <- lm(y ~ log_x, data = datos_finales)1.3 Coeficientes
a <- coef(modelo_log)[1]
b <- coef(modelo_log)[2]1.4 Test de bondad
R <- cor(datos_finales$log_x, datos_finales$y)
R2 <- summary(modelo_log)$r.squared * 100
cat("\nCoeficiente de Determinación (R²) logarítmico:", round(R2, 2), "%\n")##
## Coeficiente de Determinación (R²) logarítmico: 80.71 %1.5 Gráfica 1: Regresión Logarítmica Volumen vs Respuesta
x_seq <- seq(min(datos_finales$x), max(datos_finales$x), length.out = 200)
y_pred <- a + b * log(x_seq)
plot(datos_finales$x, datos_finales$y,
col = "blue", pch = 16, cex = 1.3,
main = "Regresión Logarítmica: Volumen vs Respuesta ",
xlab = "Volumen_derramados_galones",
ylab = "Respuesta_actual_galones")
lines(x_seq, y_pred, col = "red", lwd = 2)
legend("topleft",
legend = c(paste0("R = ", round(R, 4)),
paste0("R² = ", round(R2, 2), "%")),
col = c("red", "red"), lwd = 2, bty = "n")
## Ecuación Log
ecuacion <- paste("Respuesta = ", round(a, 4), " + ", round(b, 4), "* log(Volumen)")
cat("=== ECUACIÓN DEL MODELO LOGARÍTMICO ===\n")## === ECUACIÓN DEL MODELO LOGARÍTMICO ===cat(ecuacion, "\n")## Respuesta = -78478.5165 + 9793.0083 * log(Volumen)1.6 Predicción para un punto
nuevo_valor_rag <- 40000
prediccion_log <- a + b * log(nuevo_valor_rag)
cat("=== PREDICCIÓN MANUAL — MODELO LOGARÍTMICO ===\n")## === PREDICCIÓN MANUAL — MODELO LOGARÍTMICO ===cat("Para un valor de entrada de", nuevo_valor_rag, ", la estimación es:",
round(prediccion_log, 2), "\n") ## Para un valor de entrada de 40000 , la estimación es: 25294.421.7 Conclusión
El coeficiente de determinación (R^2) de” 80.71% indica que este modelo logarítmico tiene una alta relacion entre las variables volumen derramados galones y Respuesta actual en galones. Este modelo proporciona una forma de predecir una variable en funcion de otra