Modelo Exponencial - Costos de Remediación Ambiental
Grupo 1
1.Carga de datos
setwd("/cloud/project/")
datos <- read.csv("DerramesEEUU.csv", header = TRUE, sep=";" , dec=",",na.strings ="-")
str(datos)## 'data.frame': 2760 obs. of 59 variables:
## $ NumeroInforme : int 20100064 20100054 20100092 20100098 20100101 20100102 20100113 20100120 20100039 20100150 ...
## $ NumeroComplementario : int 15072 15114 15120 15127 15130 15132 15146 15162 15197 15205 ...
## $ DiaAccidente : int 8 25 10 28 27 29 11 23 15 11 ...
## $ MesAccidente : int 4 3 5 4 5 5 6 5 3 1 ...
## $ AnioAccidente : int 2010 2010 2010 2010 2010 2010 2010 2010 2010 2010 ...
## $ HoraAccidente : int 6 13 6 24 3 14 7 6 15 2 ...
## $ AmPmAccidente : chr "a. m." "p. m." "a. m." "p. m." ...
## $ IDOperador : int 31684 18779 30829 12105 20160 30003 1248 300 18718 32296 ...
## $ NombreOperador : chr "CONOCOPHILLIPS" "SUNOCO, INC (R&M)" "TEPPCO CRUDE PIPELINE, LLC" "MAGELLAN AMMONIA PIPELINE, L.P." ...
## $ NombreOleoductoInstalacion : chr "GD-03, GOLD LINE" "PHILADELPHIA REFINERY - WEST YARD" "HOBBS TO MIDLAND" "WHITING TO EARLY SEGMENT" ...
## $ UbicacionOleoducto : chr "ONSHORE" "ONSHORE" "ONSHORE" "ONSHORE" ...
## $ TipoOleoducto : chr "ABOVEGROUND" "ABOVEGROUND" "UNDERGROUND" "UNDERGROUND" ...
## $ TipoLiquido : chr "REFINED AND/OR PETROLEUM PRODUCT (NON-HVL), LIQUID" "REFINED AND/OR PETROLEUM PRODUCT (NON-HVL), LIQUID" "CRUDE OIL" "HVL OR OTHER FLAMMABLE OR TOXIC FLUID, GAS" ...
## $ SubtipoLiquido : chr "GASOLINE (NON-ETHANOL)" "OTHER" NA "ANHYDROUS AMMONIA" ...
## $ NombreLiquido : chr NA "VACUUM GAS OIL (VGO)" NA NA ...
## $ CiudadAccidente : chr "GREEN RIDGE" "PHILADELPHIA" "HOBBS" "SCHALLER" ...
## $ CondadoAccidente : chr "PETTIS" "PHILADELPHIA" "LEA" "IDA" ...
## $ EstadoAccidente : chr "MO" "PA" "NM" "IA" ...
## $ LatitudAccidente : num 38.6 39.9 32.6 42.5 30.2 ...
## $ LongitudAccidente : num -93.4 -75.2 -103.1 -95.3 -91.2 ...
## $ CategoriaCausa : chr "NATURAL FORCE DAMAGE" "MATERIAL/WELD/EQUIP FAILURE" "CORROSION" "MATERIAL/WELD/EQUIP FAILURE" ...
## $ SubcategoriaCausa : chr "TEMPERATURE" "NON-THREADED CONNECTION FAILURE" "EXTERNAL" "CONSTRUCTION, INSTALLATION OR FABRICATION-RELATED" ...
## $ LiberacionInvoluntariaBarriles : num 0.24 1700 2 0.36 1.31 ...
## $ LiberacionIntencionalBarriles : chr "0" "0" NA "0.05" ...
## $ RecuperacionLiquidoBarriles : num 0.07 1699 0.48 0 0 ...
## $ PerdidaNetaBarriles : num 0.17 1 1.52 0.36 1.31 ...
## $ IgnicionLiquido : chr "NO" "NO" "NO" "NO" ...
## $ ExplosionLiquido : chr "NO" "NO" "NO" "NO" ...
## $ CierreOleoducto : chr "YES" "YES" "NO" "NO" ...
## $ DiaCierre : int 8 25 NA NA 27 NA NA 23 15 11 ...
## $ MesCierre : int 4 3 NA NA 5 NA NA 5 3 1 ...
## $ AnioCierre : int 2010 2010 NA NA 2010 NA NA 2010 2010 2010 ...
## $ HoraCierre : int 6 18 NA NA 3 NA NA 7 16 2 ...
## $ AmPmCierre : chr "a. m." "p. m." NA NA ...
## $ DiaReinicio : int 9 28 NA NA 27 NA NA 23 15 15 ...
## $ MesReinicio : int 4 3 NA NA 5 NA NA 5 3 1 ...
## $ AnioReinicio : int 2010 2010 NA NA 2010 NA NA 2010 2010 2010 ...
## $ HoraReinicio : int 10 16 NA NA 24 NA NA 9 18 15 ...
## $ AmPmReinicio : chr "a. m." "p. m." NA NA ...
## $ EvacuacionesPublicas : int NA 0 NA NA 0 0 0 0 NA 0 ...
## $ LesionesEmpleadosOperador : int NA NA NA NA NA NA NA NA NA NA ...
## $ LesionesContratistasOperador : int NA NA NA NA NA NA NA NA NA NA ...
## $ LesionesRescatistasEmergencia : int NA NA NA NA NA NA NA NA NA NA ...
## $ OtrasLesiones : int NA NA NA NA NA NA NA NA NA NA ...
## $ LesionesPublico : int NA NA NA NA NA NA NA NA NA NA ...
## $ TodasLesiones : int NA NA NA NA NA NA NA NA NA NA ...
## $ FallecimientosEmpleadosOperador : int NA NA NA NA NA NA NA NA NA NA ...
## $ FallecimientosContratistasOperador : int NA NA NA NA NA NA NA NA NA NA ...
## $ FallecimientosRescatistasEmergencia : int NA NA NA NA NA NA NA NA NA NA ...
## $ OtrosFallecimientos : int NA NA NA NA NA NA NA NA NA NA ...
## $ FallecimientosPublico : int NA NA NA NA NA NA NA NA NA NA ...
## $ TodosFallecimientos : int NA NA NA NA NA NA NA NA NA NA ...
## $ CostosDaniosPropiedad : int 0 0 30000 12000 2720 NA 750 1300 NA 29360 ...
## $ CostosMercanciaPerdidas : int 27 0 100 30 1500 150 300 340 46 136233 ...
## $ CostosDaniosPropiedadesPublicasPrivadas: int 0 0 1000 5000 0 0 0 0 NA NA ...
## $ CostosRespuestaEmergencia : int 0 0 NA 0 1000 NA 400 2445 10999 NA ...
## $ CostosRemediacionAmbiental : int 0 100000 20000 15000 NA NA 6050 3350 452 NA ...
## $ OtrosCostos : int 0 0 NA 0 NA NA 0 2530 NA NA ...
## $ TodosCostos : int 27 100000 51100 32030 5220 150 7500 9965 11497 165593 ...1.1 Extracción de datos
CostosRA <- na.omit(datos$CostosRemediacionAmbiental)
# Cantidad de datos de la variable
n_C <- length(CostosRA)Cantidad total de datos: 2752
1.2 Diagrama de Caja
Debido al gran volumen de datos, es recomendable analizar primero el comportamiento general de la variable. Para ello, se construyó un diagrama de caja (boxplot) con el objetivo de identificar el rango en el que se concentra la mayoría de los valores y, de esta manera, obtener un conjunto representativo de datos.
options(scipen = 999)
caja_costos <- boxplot(CostosRA , plot = TRUE,
horizontal = TRUE,
main = "Gráfica N°1: Distribución de Costos de Remediación Ambiental
de accidentes en oleoductos ocurridos en EE.UU.",
xlab = "Costos de Remediación Ambiental")
Identificación de valores comunes y atípicos
valores_comunes<-subset(CostosRA,CostosRA <min(caja_costos$out))
valores_outliers<-subset(CostosRA,CostosRA >=min(caja_costos$out))Cantidad de valores comunes: 2283
Cantidad de outliers: 469
2. Análisis de la variable con valores comunes
2.1 Filtración de valores mayores a cero
CostosRA_filtrado <- valores_comunes[valores_comunes > 0]
n <- length(CostosRA_filtrado)Cantidad de datos filtrados: n = 1071
2.2 Histograma de la variable filtrada
options(scipen = 999)
Histograma <- hist(CostosRA_filtrado,freq = TRUE,
main = "Gráfica N°2:Histograma de costos de Remediación Ambiental",
xlab = "Costos de Remediación Ambiental ($)",
ylab = "Cantidad",
col = "#DEC895",
las=1)
3.Conjetura del Modelo
Se considera que la variable CostosRA_filtrado, podría seguir una distribución exponencial. Bajo este modelo se asume que los eventos ocurren de manera continua e independiente en el tiempo, con una tasa constante de ocurrencia que describe la rapidez con la que aparecen estos costos
3.1 Definición de Hipótesis
Hipótesis nula(Ho): Los Costos de Remediación Ambiental siguen una distribución exponencial
Hipótesis alternativa (H1): Los Costos de Remediación Ambiental no siguen una distribución exponencial.
3.2 Ajuste del modelo exponencial
lambda <- 1 / mean(CostosRA_filtrado)Estimación de lambda (tasa): 0.0001147621
3.3 Histograma con curva Exponencial
par(mar = c(5, 6, 4, 2))
# Histograma
Histo_RA <- hist(CostosRA_filtrado, freq = FALSE,
main = "Gráfica N°3: Histograma de Costos de Remediación Ambiental
con curva exponencial",
xlab = "Costos de Remediación Ambiental ($)",
ylab = "",
col = "#DEC895",
las = 1,
cex.axis = 0.8,
cex.lab = 0.9,
border = "white")
mtext("Densidad de probabilidad", side = 2, line = 4,cex.axis = 0.7)
# Curva teórica
x_exp <- seq(min(CostosRA_filtrado), max(CostosRA_filtrado), length.out = 1000)
lines(x_exp, dexp(x_exp, rate = lambda), col = "#B81840", lwd = 2)
# Leyenda
legend("topright", legend = "Modelo Exponencial",
col = "#B81840", lwd = 2, lty = 1,
box.lty = 1,box.col = "black",
cex = 0.8)
3.4 Cálculo de Frecuencias
3.4.1 Frecuencias Observadas
Fo_exp <- (Histo_RA$counts)
h2 <- length(Fo_exp)3.4.2 Frecuencias Esperadas
P_exp <- c()
for (i in 1:h2) {
P_exp[i] <- pexp(Histo_RA$breaks[i+1], rate = lambda) - pexp(Histo_RA$breaks[i], rate = lambda)
}
Fe_exp <- P_exp * length(CostosRA_filtrado)3.4.3 Comprobación
Comparación del tamaño real y del modelo
Tamaño del modelo
Tm <- sum(Fe_exp)
Tm## [1] 1060.132[1] 1060.132
Tamaño real
Tr <- length(CostosRA_filtrado)
Tr## [1] 1071[1] 1071
4.Tests
4.1 Test de Pearson
Correlación de frecuencias
correlacion_exp <- cor(Fo_exp, Fe_exp) * 100La correlación de frecuencias es de = 94.91 %
Gráfica de correlación Fo vs Fe
plot(Fo_exp, Fe_exp,
main = "Gráfica N°4: Correlación de frecuencias en el modelo exponencial",
xlab = "Frecuencia Observada ", ylab = "Frecuencia Esperada",
col = "#DEC895", pch = 19)
abline(lm(Fe_exp ~ Fo_exp), col = "red", lwd = 2)
4.2 Test de Bondad de ajuste
4.2.1 Cálculo del Estadístico Chi-cuadrado
Frecuencia Observada y Esperada porcentual
Fo_exp_pct <- (Fo_exp / n) * 100
Fe_exp_pct <- P_exp * 100Estadístico chi-cuadrado
x2_exp <- sum((Fe_exp_pct - Fo_exp_pct)^2 / Fe_exp_pct)El estadistico Chi-cuadrado es: 10.78976
4.2.2 Cálculo del Umbral de Aceptación
Grados de Libertad
gl_exp <- (h2 - 1)-1Definición del nivel de significancia
nivel_significancia <- 0.05Umbral de aceptación
umbral_aceptacion<- qchisq(1 - nivel_significancia, gl_exp)El umbral de aceptación es: 12.59159
4.2.3 Decisión
if (x2_exp < umbral_aceptacion) {
cat("Conclusión: No se rechaza H0, los costos de remediacion ambiental podrían seguir una distribución exponencial.")
} else {
cat("Conclusión: Se rechaza H0, los costos de remediacion ambiental NO siguen una distribución exponencial.")
}Conclusión: No se rechaza H0, los costos de remediacion ambiental podrían seguir una distribución exponencial.
4.3 Tabla resumen de test
Variable <- c("Costos de Remediación Ambiental")
Tabla_resumen <- data.frame(Variable,
Pearson = round(correlacion_exp,2),
Chi_Cuadrado = round(x2_exp,2),
Umbral = round(umbral_aceptacion,2),
TestChi = c("Aprobado"))
colnames(Tabla_resumen) <- c("Variable",
"Test Pearson (%)",
"Chi-Cuadrado",
"Umbral de aceptación",
"Test de Bondad de ajuste")
library(gt)
Tabla_resumen %>%
gt() %>%
tab_header(
title = md("**Tabla N°1**"),
subtitle = md("**Resumen de los Tests Aplicados al Modelo 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 de los Tests Aplicados al Modelo Exponencial | ||||
| Variable | Test Pearson (%) | Chi-Cuadrado | Umbral de aceptación | Test de Bondad de ajuste |
|---|---|---|---|---|
| Costos de Remediación Ambiental | 94.91 | 10.79 | 12.59 | Aprobado |
| Autor: Grupo 1 | ||||
Los resultados de los tests indican que los datos de Costos de Remediación Ambiental pueden seguir un modelo exponencial.
El estadístico Chi-cuadrado calculado (10.79) es menor que el umbral de aceptación (12.59), lo que indica que no se rechaza la hipótesis nula (H₀) y el modelo exponencial es adecuado para describir los costos observados.
El Test de Pearson reporta un nivel de ajuste del 94.91%, lo que indica que las frecuencias observadas se aproximan bastante a las frecuencias esperadas bajo la distribución exponencial, respaldando adicionalmente la validez del modelo.
5.Cálculo de probabilidades
- ¿Cuál es la probabilidad de que los Costos de Remediación Ambiental se encuentren entre 5,000 y 10,000 dolares?
5.1 Estimación de Probabilidad
prob_exp <- pexp(10000, rate = lambda) - pexp(5000, rate = lambda)La probabilidad de que los Costos de Remediación estén entre 5000 y 10000 dolares es del: 24.6 %
5.2 Gráfica de Probabilidad
#Curva de densidad
x_exp_plot <- seq(min(CostosRA_filtrado), max(CostosRA_filtrado), length.out = 1000)
y_exp_plot <- dexp(x_exp_plot, rate = lambda)
#Grafica
par(mar = c(5, 6, 4, 2))
plot(x_exp_plot, y_exp_plot, type = "l",
col = "blue", lwd = 2,
las=1,
cex.axis= 0.8,
cex.lab = 0.9,
main = "Gráfica N°5: Curva de densidad con área de probabilidad
(Costos de Remediación Ambiental)",
xlab = "Costos de Remediación Ambiental ($)",
ylab = "")
mtext("Densidad de probabilidad", side = 2, line = 4,cex.axis = 0.8)
# Área sombreada entre 10,000 y 5,000
x_somb_exp <- seq(5000, 10000, length.out = 1000)
y_somb_exp <- dexp(x_somb_exp, rate = lambda)
polygon(c(x_somb_exp, rev(x_somb_exp)),
c(y_somb_exp, rep(0, length(y_somb_exp))),
col = rgb(1, 0, 0, 0.4), border = NA)
legend("topright", legend = c("Modelo Exponencial", "Área de Probabilidad"),
col = c("blue", "#B81840"), lwd = 2, pch = c(NA, 15))
6.Teorema del Límite Central
El Teorema del Límite Central establece que, aunque las variables individuales de una población no sigan una distribución normal, la distribución de las medias muestrales tiende a ser normal cuando el tamaño de la muestra es suficientemente grande (n ≥ 30).
Por lo tanto, es posible estimar la media poblacional mediante intervalos de confianza, aun cuando la distribución original de los datos no sea normal.Esto se puede hacer con tres postulados principales:
Donde x es la media aritmética muestral y e es el margen de error
Media aritmética muestral
x <- mean(CostosRA_filtrado)La media muestral es de: 8713.678
Desviación estándar muestral
sigma_costosRA <- sd(CostosRA_filtrado)La desviación estandar muestral es de: 9243.124
Error estándar de la media
e <- sigma_costosRA / sqrt(n)El error estandar de la media es de: 282.4386
Intervalo de Confianza del 95%
limite_inferior <- x - 2 * e
limite_superior <- x + 2 * eEl limite inferior es: 8148.801
El limite superior es: 9278.555
Tabla
tabla_media_exp <- data.frame(
round(limite_inferior, 2),
round(x, 2),
round(limite_superior, 2),
round(sigma_costosRA, 2)
)
colnames(tabla_media_exp) <- c("Límite inferior", "Media poblacional",
"Límite superior", "Desviación estándar poblacional")
library(gt)
tabla_media_exp%>%
gt() %>%
tab_header(
title = md("**Tabla N°2**"),
subtitle = md("**Media poblacional estimada de Costos de Remediación Ambiental
en los accidentes en oleoductos en EE.UU.**")
) %>%
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°2 | |||
| Media poblacional estimada de Costos de Remediación Ambiental en los accidentes en oleoductos en EE.UU. | |||
| Límite inferior | Media poblacional | Límite superior | Desviación estándar poblacional |
|---|---|---|---|
| 8148.8 | 8713.68 | 9278.56 | 9243.12 |
| Autor: Grupo 1 | |||
7.Conclusión
La variable Costos de Remediación Ambiental se ajusta adecuadamente a un modelo exponencial, con una media poblacional estimada de 8,713.68 USD y una desviación estándar poblacional de 9,243.12 USD.
De acuerdo con este modelo, se estima que la probabilidad de que los costos de remediación se encuentren entre 5,000 y 10,000 USD es aproximadamente del 24.6%, lo que refleja que cerca de una cuarta parte de los casos se sitúa dentro de este rango de costos, es decir se esperaría que cerca de uno de cada cuatro accidentes presente un costo de remediación comprendido entre 5,000 USD y 10,000 USD.
Aplicando el Teorema del Límite Central, se estima que la media poblacional se encuentra entre 8,148.8 y 9,278.56 dólares con un 95% de confianza, proporcionando un nivel de certeza adecuado sobre el rango probable en el que se ubican los costos promedio de remediación ambiental en los accidentes de oleoductos en EE.UU.