Modelo Normal - Longitud
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
Longitud <- na.omit(datos$LongitudAccidente)
# Cantidad de datos de la variable
n_L <- length(Longitud)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.
Dcaja <- boxplot(Longitud, plot = TRUE,
horizontal = TRUE,
main = "Gráfica N°1: Distribución de la longitud de accidentes
en oleoductos ocurridos en EE.UU.",
xlab = "Longitud (°)",
col = "#DBD7FB")
Identificación de valores comunes y atípicos
valores_comunes <- Longitud[!(Longitud %in% Dcaja$out)]
valores_outliers <- Longitud[Longitud %in% Dcaja$out]Cantidad de valores comunes: 2413
Cantidad de valores atipicos: 347
2.Histograma de la variable con valores comunes
options(scipen = 999)
hist(valores_comunes,freq = TRUE,
main = "Gráfica N°2: Histograma de Longitud de accidentes en oleoductos",
xlab = "Longitud (°)",
ylab = "Cantidad",
col = "#DBD7FB",
las=1)
3.Conjetura del Modelo
Se considera que la variable Longitud, podría seguir una distribución normal. Bajo este modelo se asume que los valores de la variable se distribuyen de forma asimétrica, con una mayor concentración de observaciones en valores cercanos a un punto central positivo y una cola más extendida hacia valores superiores. Esto implica que la probabilidad de ocurrencia es mayor para valores moderados de latitud y disminuye progresivamente conforme los valores se alejan hacia la derecha, reflejando una distribución sesgada positivamente.
3.1 Definición de Hipótesis
Hipótesis nula(Ho): La Longitud de los accidentes siguen una distribución normal.
Hipótesis alternativa (H1): La Longitud de los accidentes NO siguen una distribución normal.
3.2 Ajuste del modelo normal
u<-mean(valores_comunes)
sigma<-sd(valores_comunes)Media (u) = -95.50597
Desviación estándar (sigma) = 6.228508
3.3 Histograma con curva Normal
Histo_long <- hist(valores_comunes, freq = FALSE,
main = "Gráfica N°3: Histograma de Longitud de accidentes
en oleoductos con curva Normal",
xlab = "Longitud (°)",
ylab = "Densidad de probabilidad",
col = "#DBD7FB")
# Curva normal
x_norm <- seq(min(valores_comunes), max(valores_comunes), length.out = 1000)
lines(x_norm, dnorm(x_norm, u, sigma), lwd = 3, col = "red")
# Leyenda
legend("topright", legend = "Modelo 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_norm <- Histo_long$counts
h <- length(Fo_norm)3.4.2 Frecuencias Esperadas
P_norm <- c()
for (i in 1:h) {
P_norm[i] <- pnorm(Histo_long$breaks[i+1], mean = u, sd = sigma) -
pnorm(Histo_long$breaks[i], mean = u, sd = sigma)
}
Fe_norm <- P_norm * length(valores_comunes)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_norm)
Tm[1] 2409.691
Tamaño real
Tr <- length(valores_comunes)
Tr[1] 2413
4.Tests
4.1 Test de Pearson
Correlación de frecuencias
Correlacion_norm <- cor(Fo_norm, Fe_norm) * 100La correlación de frecuencias es de = 95.82 %
Gráfica de correlación Fo vs Fe
plot(Fo_norm, Fe_norm,
main = "Gráfica N°4: Correlación de frecuencias en el modelo exponencial",
xlab = "Frecuencia Observada ", ylab = "Frecuencia Esperada",
col = "#DBD7FB", pch = 19)
abline(lm(Fe_norm ~ Fo_norm), 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(valores_comunes)
Fo_norm_pct<- (Fo_norm / n) * 100
Fe_norm_pct <- P_norm * 100Estadístico chi-cuadrado
x2_norm <- sum((Fe_norm_pct - Fo_norm_pct)^2 / Fe_norm_pct)El estadistico Chi-cuadrado es: 7.396439
4.2.2 Cálculo del Umbral de Aceptación
Grados de Libertad
gl_norm <- (h - 1) - 2Definición del nivel de significancia
nivel_significancia <- 0.05Umbral de aceptación
umbral_aceptacion<- qchisq(1 - nivel_significancia, gl_norm)El umbral de aceptación es: 11.0705
4.2.3 Decisión
if (x2_norm < umbral_aceptacion) {
cat("Conclusión: No se rechaza H0, las longitudes de los accidentes podrían seguir una distribución normal.")
} else {
cat("Conclusión: Se rechaza H0, las longitudes de los accidentes NO siguen una distribución normal.")
}Conclusión: No se rechaza H0, las longitudes de los accidentes podrían seguir una distribución normal.
4.3 Tabla resumen de test
Variable <- c("Longitud")
Modelo <- c("Normal")
Tabla_resumen <- data.frame(Variable,
Modelo,
Pearson = round(Correlacion_norm,2),
Chi_Cuadrado = round(x2_norm,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 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 Normal | |||||
| Variable | Modelo | Test Pearson (%) | Chi-Cuadrado | Umbral de aceptación | Test de Bondad de ajuste |
|---|---|---|---|---|---|
| Longitud | Normal | 95.82 | 7.4 | 11.07 | Aprobado |
| Autor: Grupo 1 | |||||
Los resultados de los tests indican que los datos de Longitud pueden seguir una distribucion normal.
El estadístico Chi-cuadrado calculado (10.79) es menor que el umbral de aceptación (11.07), lo que indica que no se rechaza la hipótesis nula (H₀) y el modelo normal es adecuado para describir los datos observados.
El Test de Pearson reporta un nivel de ajuste del 95.82%, lo que indica que las frecuencias observadas se aproximan bastante a las frecuencias esperadas bajo la distribución normal, respaldando adicionalmente la validez del modelo.
5.Cálculo de probabilidades
- ¿Cuál es la probabilidad de que la longitud de accidentes se encuentre entre -100°y -90°?
5.1 Estimación de Probabilidad
prob_norm <- pnorm(-90, mean = u, sd = sigma) - pnorm(-100, mean = u, sd = sigma)La probabilidad de que las longitudes de los accidentes se encuentren entre -100° y -90°: 57.64 %
5.2 Gráfica de Probabilidad
plot(x_norm, dnorm(x_norm, mean = u, sd = sigma), type = "l",
col = "blue", lwd = 2,
main = "Gráfica N°5: Curva de densidad con área de probabilidad
(Longitud(°))",
xlab = "Longitud (°)",
ylab = "Densidad de probabilidad")
x_somb_norm <- seq(-100, -90, length.out = 1000)
y_somb_norm <- dnorm(x_somb_norm, mean = u, sd = sigma)
polygon(c(x_somb_norm, rev(x_somb_norm)),
c(y_somb_norm, rep(0, length(y_somb_norm))),
col = rgb(1,0,0,0.4), border = NA)
legend("topright", legend = c("Modelo 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 (TLC) es fundamental en la inferencia estadística, ya que permite estimar la media poblacional (μ) mediante intervalos de confianza. Aun cuando la población sigue una distribución normal, el TLC garantiza que la media de las muestras de cualquier tamaño (n≥30), la distribución de las medias muestrales tiende a ser normal, independientemente de la forma de la población.
Esta propiedad es esencial porque garantiza que podemos aplicar técnicas estadísticas basadas en la normalidad, como la construcción de intervalos de confianza basados en 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(valores_comunes)La media muestral es de: -95.50597
Desviación estándar muestral
sigma_n<- sd(valores_comunes)La desviación estandar muestral es de: 6.228508
Error estándar de la media
e <- sigma/ sqrt(n)El error estandar de la media es de: 0.126796
Intervalo de Confianza del 95%
limite_inferior <- x - 2 * e
limite_superior <- x + 2 * eEl limite inferior es: -95.75956
El limite superior es: -95.25238
Tabla
tabla_media_exp <- data.frame(
round(limite_inferior, 2),
round(x, 2),
round(limite_superior, 2),
round(sigma_n, 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 Longitud 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 Longitud de los accidentes en oleoductos en EE.UU. | |||
| Límite inferior | Media poblacional | Límite superior | Desviación estándar poblacional |
|---|---|---|---|
| -95.76 | -95.51 | -95.25 | 6.23 |
| Autor: Grupo 1 | |||
7.Conclusión
La variable Longitud se ajusta adecuadamente a un modelo de distribución normal, con una media poblacional estimada de -95.51° y una desviación estándar poblacional de 6.23°.
De acuerdo con este modelo, la probabilidad de que la longitud de los accidentes ocurra entre -100° y -90° es aproximadamente del 57.65%, lo que evidencia una notable concentración de eventos dentro de este rango geográfico.
Aplicando el Teorema del Límite Central, se estimó que la media poblacional se encuentra entre -95.76° y -95.25° con un 95% de confianza, lo que proporciona un nivel de certeza estadística sólido sobre la localización promedio de los accidentes registrados en los oleoductos de EE.UU.