Modelo Lognormal - Latitud
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
Latitud <- as.numeric(datos$LatitudAccidente)
# Cantidad de datos de la variable
n_La <- length(Latitud)Cantidad total de datos: 2760
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.
caja_latitud <- boxplot(Latitud, plot = TRUE,
horizontal = TRUE,
main = "Gráfica N°1: Distribución de Latitud de accidentes en oleoductos EE.UU.",
xlab = "Latitud (°)",
col = "darkseagreen3")
Identificación de valores comunes y atípicos
LatitudVC <- subset(Latitud, Latitud < min(caja_latitud$out))
valores_outliers <- subset(Latitud, Latitud >= min(caja_latitud$out))Cantidad de valores comunes: 2749
Cantidad de valores atipicos: 11
2.Histograma de la variable con valores comunes
par(mar = c(4, 6, 4, 2))
options(scipen = 999)
hist(LatitudVC,freq = TRUE,
main = "Gráfica N°2: Histograma de latitud de accidentes",
breaks = 7,
xlab = "Latitud (°)",
ylab = "Cantidad",
col = "darkseagreen3",
las=1)
3.Conjetura del Modelo
Se considera que la variable LatitudVC, podría seguir una distribución lognormal.Bajo este modelo se asume que los valores de la variable se distribuyen de manera asimétrica, con una mayor concentración en valores relativamente bajos y una cola extendida hacia la derecha. Esto implica que la probabilidad de ocurrencia disminuye rápidamente hacia la izquierda, mientras que hacia la derecha decrece de forma más gradual, permitiendo la presencia de valores grandes aunque con menor frecuencia.
3.1 Definición de Hipótesis
Hipótesis nula(Ho): La Latitud de los accidentes siguen una distribución lognormal.
Hipótesis alternativa (H1): La Latitud de los accidentes NO siguen una distribución lognormal.
3.2 Ajuste del modelo normal
log_lat <- log(LatitudVC)
ulog <- mean(log_lat)
sigmalog <- sd(log_lat)Media (u) = 3.565183
Desviación estándar (sigma) = 0.1446842
3.3 Histograma con curva Normal
par(mar = c(4, 6, 4, 2))
HistLati <- hist(LatitudVC,
freq = FALSE,
breaks = 7,
main = "Gráfica N°3: Histograma de Latitud de accidentes
en oleoductos con curva Log-Normal",
xlab = "Latitud (°)",
las = 1,
ylab = "Densidad de probabilidad",
col = "darkseagreen3",
ylim = c(0, 0.08))
h <- length(HistLati$counts)
# Curva log-normal
x <- seq(min(LatitudVC), max(LatitudVC), 0.01)
curve(dlnorm(x, meanlog = ulog, sdlog = sigmalog),
type = "l", add = TRUE, col = "red", lwd = 4)
# Leyenda
legend("topright", legend = "Modelo Log-Normal",
col = "red", 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<-HistLati$counts3.4.2 Frecuencias Esperadas
P <- c(0)
for (i in 1:h)
{P[i] <-(plnorm(HistLati$breaks[i+1],ulog,sigmalog)-
plnorm(HistLati$breaks[i],ulog,sigmalog))}
Fe<-P*length(LatitudVC)3.4.3 Comprobación
Una forma rápida de comprobar la eficasia del modelo, es comparar el valor del tamaño muestral real y el tamaño muestral obtenido del modelo.
Tamaño del modelo
Tm <- sum(Fe)
Tm[1] 2726.179
Tamaño real
Tr <- length(LatitudVC)
Tr[1] 2749
4.Tests
4.1 Test de Pearson
Correlación de frecuencias
Correlacion_log <- cor(Fo, Fe) * 100La correlación de frecuencias es de = 93.81 %
Gráfica de correlación Fo vs Fe
plot(Fo, Fe,
main = "Gráfica N°4: Correlación de frecuencias en el modelo Log-Normal",
xlab = "Frecuencia Observada ",
ylab = "Frecuencia Esperada",
col = "darkseagreen3", pch = 19)
abline(lm(Fe ~ Fo), 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
n <- length(LatitudVC)
Fo_pct<- (Fo / n) * 100
Fe_pct <- P * 100Estadístico chi-cuadrado
x2_log <- sum((Fe_pct - Fo_pct)^2 / Fe_pct)El estadistico Chi-cuadrado es: 7.418081
4.2.2 Cálculo del Umbral de Aceptación
Grados de Libertad
gl_log <- (h - 1) - 2Definición del nivel de significancia
nivel_significancia <- 0.05Umbral de aceptación
umbral_aceptacion<- qchisq(1 - nivel_significancia, gl_log)El umbral de aceptación es: 7.814728
4.2.3 Decisión
if (x2_log < umbral_aceptacion) {
cat("Conclusión: No se rechaza H0, las latitudes de los accidentes podrían seguir una distribución lognormal.")
} else {
cat("Conclusión: Se rechaza H0, las latitudes de los accidentes NO siguen una distribución lognormal.")
}Conclusión: No se rechaza H0, las latitudes de los accidentes podrían seguir una distribución lognormal.
4.3 Tabla resumen de test
Variable <- c("Latitud")
Modelo <- c("Log-Normal")
Tabla_resumen <- data.frame(Variable,
Modelo,
Pearson = round(Correlacion_log,2),
Chi_Cuadrado = round(x2_log,2),
Umbral = round(umbral_aceptacion,2),
TestChi = c("Aprobado"))
colnames(Tabla_resumen) <- c("Variable",
"Modelo",
"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 Log-Normal**")
) %>%
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 Log-Normal | |||||
| Variable | Modelo | Test Pearson (%) | Chi-Cuadrado | Umbral de aceptación | Test de Bondad de ajuste |
|---|---|---|---|---|---|
| Latitud | Log-Normal | 93.81 | 7.42 | 7.81 | Aprobado |
| Autor: Grupo 1 | |||||
Los resultados de los tests indican que los datos de latitud pueden seguir una distribucion lognormal.
El estadístico Chi-cuadrado calculado (7.42) es menor que el umbral de aceptación (7.81), lo que indica que no se rechaza la hipótesis nula (H₀) y el modelo Log-Normal es adecuado para describir los datos observados.
El Test de Pearson reporta un nivel de ajuste del 93.81%, lo que indica que las frecuencias observadas se aproximan bastante a las frecuencias esperadas bajo la distribución lognormal, respaldando adicionalmente la validez del modelo.
5.Cálculo de probabilidades
- ¿Cuál es la probabilidad de que la latitud de accidentes se encuentre entre los 30° y 45°?
5.1 Estimación de Probabilidad
prob_log <- plnorm(45, mean = ulog, sd = sigmalog) - plnorm(30, mean = ulog, sd = sigmalog)La probabilidad de que las longitudes de los accidentes se encuentren entre 30° y 45°: 82.39 %
5.2 Gráfica de Probabilidad
y <- dlnorm(x, meanlog = ulog, sdlog = sigmalog)
plot(x, y, type = "l", col = "blue", lwd = 2,
main = "Gráfica N°5: Área bajo la curva log-normal (Latitud)",
xlab = "Latitud del accidente",
ylab = "Densidad de probabilidad")
x_sombreado <- seq(30, 45, length.out = 500)
y_sombreado <- dlnorm(x_sombreado, meanlog = ulog, sdlog = sigmalog)
polygon(c(x_sombreado, rev(x_sombreado)),
c(y_sombreado, rep(0, length(y_sombreado))),
col = rgb(1, 0, 0, 0.5), border = NA)
legend("topright",
legend = c("Modelo Log-normal", "Área de Probabilidad"),
col = c("blue", "#B03060"),
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
- e es el margen de error de la media
Media aritmética muestral
x <- mean(LatitudVC)La media muestral es de: 35.72155
Desviación estándar muestral
sigma_l<- sd(LatitudVC)La desviación estandar muestral es de: 5.258617
Error estándar de la media
e <- sigma_l/ sqrt(n)El error estandar de la media es de: 0.1002961
Intervalo de Confianza del 95%
limite_inferior <- x - 2 * e
limite_superior <- x + 2 * eEl limite inferior es: 35.52096
El limite superior es: 35.92214
Tabla
tabla_media_exp <- data.frame(
round(limite_inferior, 2),
round(x, 2),
round(limite_superior, 2),
round(sigma_l, 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 la Latitud de 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 la Latitud de los accidentes en oleoductos en EE.UU. | |||
| Límite inferior | Media poblacional | Límite superior | Desviación estándar poblacional |
|---|---|---|---|
| 35.52 | 35.72 | 35.92 | 5.26 |
| Autor: Grupo 1 | |||
7.Conclusión
La variable Latitud de los accidentes en oleoductos en EE.UU. se ajusta a un modelo log-normal, con una media poblacional estimada de 35.72° y una desviación estándar poblacional de 5.26°.
De acuerdo con este modelo, se estima que la probabilidad de que la latitud de un accidente se encuentre entre 30° y 45° es aproximadamente del 82.39%, lo que evidencia una fuerte concentración de accidentes en este rango geográfico y la presencia de una cola derecha característica de la distribución log-normal.
Aplicando el Teorema del Límite Central, se estimó que la media poblacional de la latitud se encuentra entre 35.52° y 35.92° con un 95% de confianza, proporcionando un rango confiable para la localización promedio de los accidentes en oleoductos en EE.UU.