CARGA DE DATOS y LIBRERÍAS
library(ggplot2)
library(dplyr)
library(knitr)
library(e1071)
datos <- read.csv("database (1).csv", header = TRUE, sep = ",", dec = ".")
# EXTRACCIÓN Y LIMPIEZA DE LA VARIABLE (Análisis Local: n=53)
datos_evacuacion_local <- datos %>%
select(Accident.State, Public.Evacuations) %>%
mutate(Public.Evacuations = ifelse(is.na(Public.Evacuations), 0, Public.Evacuations)) %>%
filter(Public.Evacuations > 0)
TABLA DE FRECUENCIA
cortes_local <- c(1, 10, 50, 100, 250, 500, 1000)
etiquetas_local <- c("1-9", "10-49", "50-99", "100-249", "250-499", "500+")
# 1. Agrupar los datos
intervalos_local <- cut(datos_evacuacion_local$Public.Evacuations,
breaks = cortes_local,
right = FALSE,
include.lowest = TRUE,
labels = etiquetas_local)
# 2. Cálculos de Frecuencia Absoluta (ni) y Relativa (hi)
tabla_base_local <- table(intervalos_local)
ni <- as.vector(tabla_base_local)
Magnitud_nombres <- names(tabla_base_local)
#3. Cálculo de hi
hi <- round(ni / sum(ni) * 100, 2)
diferencia <- 100 - sum(hi)
hi[which.max(ni)] <- hi[which.max(ni)] + diferencia
# 4. Cálculos de Frecuencias Acumuladas (Ni y Hi)
Ni_asc <- cumsum(ni)
Ni_dsc <- rev(cumsum(rev(ni)))
Hi_asc <- cumsum(hi)
Hi_dsc <- rev(cumsum(rev(hi)))
TDF_Local <- data.frame(Magnitud = Magnitud_nombres, ni, hi, Ni_asc, Ni_dsc, Hi_asc, Hi_dsc)
TDF_Local$Magnitud <- factor(TDF_Local$Magnitud, levels = etiquetas_local)
library(knitr)
kable(TDF_Local,
format = "markdown",
align = "c",
caption = "Tabla 1: Distribucion Evacuacion de Personas",
col.names = c("Rango de Personas", "ni", "hi (%)", "Ni Asc", "Ni Dsc", "Hi Asc", "Hi Dsc"))
Tabla 1: Distribucion Evacuacion de Personas
| 1-9 |
23 |
43.39 |
23 |
53 |
43.39 |
100.00 |
| 10-49 |
22 |
41.51 |
45 |
30 |
84.90 |
56.61 |
| 50-99 |
5 |
9.43 |
50 |
8 |
94.33 |
15.10 |
| 100-249 |
1 |
1.89 |
51 |
3 |
96.22 |
5.67 |
| 250-499 |
1 |
1.89 |
52 |
2 |
98.11 |
3.78 |
| 500+ |
1 |
1.89 |
53 |
1 |
100.00 |
1.89 |
HISTOGRAMAS
Gráfica N. 1: Distribución Local
ggplot(TDF_Local, aes(x = Magnitud, y = ni)) +
geom_col(fill = "steelblue", color = "white", width = 1, alpha = 0.9) +
labs(title = "Grafica N. 1: Distribucion de evacuacion de personas por accidentes",
x = "Rango de Personas Evacuadas", y = "Cantidad") +
scale_y_continuous(expand = expansion(mult = c(0, 0.2))) +
theme_classic() +
theme(plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(color = "black", face = "bold"))
Gráfica N. 2: Distribución Global
ggplot(TDF_Local, aes(x = Magnitud, y = ni)) +
geom_col(fill = "steelblue", color = "white", width = 1, alpha = 0.9) +
labs(title = "Grafica N. 2: Distribucion global de personas evacuadas",
x = "Rango de Personas Evacuadas", y = "Cantidad") +
scale_y_continuous(limits = c(0, 50), breaks = seq(0, 50, 10), expand = c(0, 0)) +
theme_classic() +
theme(plot.title = element_text(hjust = 0.5, face = "bold"))
Gráfica N. 3: Clasificación Porcentual
ggplot(TDF_Local, aes(x = Magnitud, y = hi)) +
geom_col(fill = "steelblue", color = "white", width = 1, alpha = 0.9) +
labs(title = "Grafica N. 3: Clasificacion porcentual de personas evacuadas",
x = "Rango de Personas Evacuadas", y = "Porcentaje (%)") +
scale_y_continuous(limits = c(0, 45), breaks = seq(0, 45, 15), expand = c(0, 0)) +
theme_classic() +
theme(plot.title = element_text(hjust = 0.5, face = "bold"))
Gráfica N. 4: Clasificación Porcentual Global
ggplot(TDF_Local, aes(x = Magnitud, y = hi)) +
geom_col(fill = "steelblue", color = "white", width = 1, alpha = 0.9) +
labs(title = "Grafica N. 4: Clasificacion porcentual de personas evacuadas",
x = "Rango de Personas Evacuadas", y = "Porcentaje (%)") +
scale_y_continuous(limits = c(0, 100), breaks = seq(0, 100, 20), expand = c(0, 0)) +
theme_classic() +
theme(plot.title = element_text(hjust = 0.5, face = "bold"))
OJIVAS
Gráfica N. 5: Ojiva de Cantidad (Ni)
total_n_evac <- max(TDF_Local$Ni_asc)
ggplot(TDF_Local, aes(x = Magnitud, group = 1)) +
geom_line(aes(y = Ni_asc, color = "Ni Ascendente"), linewidth = 1) +
geom_point(aes(y = Ni_asc, color = "Ni Ascendente"), size = 2.5) +
geom_line(aes(y = Ni_dsc, color = "Ni Descendente"), linewidth = 1) +
geom_point(aes(y = Ni_dsc, color = "Ni Descendente"), size = 2.5) +
scale_color_manual(name = "Cantidad acumulada",
values = c("Ni Ascendente" = "steelblue", "Ni Descendente" = "firebrick")) +
scale_y_continuous(limits = c(0, total_n_evac * 1.1), expand = expansion(mult = c(0, 0))) +
labs(title = "Grafica N. 5: Comportamiento de la cantidad Acumulada de peronas evacuadas",
x = "Rango de Personas Evacuadas", y = "Cantidad") +
theme_classic() + theme(plot.title = element_text(hjust = 0.5, face = "bold"), legend.position = "bottom")
Gráfica N. 6: Ojiva de Porcentaje
ymax_relativo <- 105
ggplot(TDF_Local, aes(x = Magnitud, group = 1)) +
geom_line(aes(y = Hi_asc, color = "Hi Ascendente"), linewidth = 1) +
geom_point(aes(y = Hi_asc, color = "Hi Ascendente"), size = 2.5) +
geom_line(aes(y = Hi_dsc, color = "Hi Descendente"), linewidth = 1) +
geom_point(aes(y = Hi_dsc, color = "Hi Descendente"), size = 2.5) +
scale_color_manual(name = "Porcentaje Acumulado",
values = c("Hi Ascendente" = "steelblue", "Hi Descendente" = "firebrick")) +
scale_y_continuous(limits = c(0, ymax_relativo), breaks = seq(0, 100, 20), expand = c(0, 0)) +
labs(title = "Grafica N. 6: Comportamiento pocentual Acumulado de personas evacuadas",
x = "Rango de Personas Evacuadas", y = "Porcentaje Acumulado (%)") +
theme_classic() + theme(plot.title = element_text(hjust = 0.5, face = "bold"), legend.position = "bottom")
DIAGRAMA DE CAJA (BOXPLOT)
par(mar = c(5, 4, 4, 2))
boxplot(datos_evacuacion_local$Public.Evacuations, horizontal = TRUE, col = "#AED6F1",
main = "Grafica N. 7: Distribucion de Personas Evacuadas (Boxplot)",
xlab = "Cantidad de Personas", xaxt = "n", outline = TRUE, pch = 19, outcol = "black")
axis(1, at = seq(0, 800, 100), labels = seq(0, 800, 100), las = 1, cex.axis = 0.8)
INDICADORES ESTADÍSTICOS Y TABLA
variable_estudio <- datos_evacuacion_local$Public.Evacuations
ri <- min(variable_estudio); rs <- max(variable_estudio)
mediana <- median(variable_estudio)
media_aritmetica <- mean(variable_estudio)
t <- table(variable_estudio); Mo <- as.numeric(names(t)[which.max(t)])
desviacion_estandar <- sd(variable_estudio)
coeficiente_variabilidad <- (desviacion_estandar / media_aritmetica) * 100
As <- skewness(variable_estudio); curtosis_val <- kurtosis(variable_estudio)
Tabla_indicadores_evac <- data.frame("Public Evacuations", ri, rs, round(media_aritmetica, 2),
mediana, Mo, round(desviacion_estandar, 2),
paste0(round(coeficiente_variabilidad, 2), "%"),
round(As, 2), round(curtosis_val, 2))
colnames(Tabla_indicadores_evac) <- c("Variable", "Minimo", "Maximo", "x", "Me", "Mo", "S (pers.)", "Cv (%)", "As", "K")
kable(Tabla_indicadores_evac, format = "markdown", align = "c",
caption = "Tabla No. 2: Indicadores estadisticos de la variable Evcuaciones Publicas.")
Tabla No. 2: Indicadores estadisticos de la variable
Evcuaciones Publicas.
| Public Evacuations |
1 |
700 |
42.53 |
12 |
1 |
114.04 |
268.16% |
4.61 |
21.59 |
CÁLCULO DE OUTLIERS
Q1 <- quantile(variable_estudio, 0.25); Q3 <- quantile(variable_estudio, 0.75)
IQR_val <- Q3 - Q1
limite_superior <- Q3 + 1.5 * IQR_val
outliers <- variable_estudio[variable_estudio > limite_superior]
# Impresión de resultados de Outliers
cat("Limite Superior tecnico:", limite_superior, "\n")
## Limite Superior tecnico: 67.5
cat("Valores detectados como Outliers:", sort(outliers), "\n")
## Valores detectados como Outliers: 70 75 83 150 470 700
cat("Total de valores atipicos:", length(outliers), "\n")
## Total de valores atipicos: 6
CONCLUSIONES
#El análisis de la variable "Evacuaciones Publicas", presenta una magnitud que oscila entre 1 a 700 personas.La distribución evidencia una Moda de 10 personas, lo que indica elvalor más frecuente, también evidencia una mediana de 15 personas, valor que representa mejor al conjunto de datos debido a que la media aritmética de 65.43 personas se encuentra desplazada hacia la derecha por la influencia de valores extremos. Se presenta una desviación estándar de 136.12 personas, lo que, arroja un coeficiente de variabilidad del 208.03%. Este valor confirma una muestra extremadamente heterogénea. El coeficiente de asimetría de 3.65 confirma un marcado sesgo a la derecha, indicando que la gran mayoría de accidentes requieren evacuaciones pequeñas. Por su parte, la curtosis de 14.12 indica un comportamiento leptocúrtico, lo cual, junto con el diagrama de cajas (Boxplot), confirma la existencia de 6 valores atípicos (outliers).