Actividad práctica 3
Henry David Saenz Valverde
2024-08-22
Ejercicio 3
- Importe la base de datos.
- Analice las características de la base de datos. Estas pueden incluir: número de filas, número de columnas, nombres de las variables, tipos de variables, entre otras.
- Analice cada una de las variables según su tipo: numéricas y categóricas.
- Filtre la base de datos para entender mejor su estructura.
- Explore la ayuda de la función table del paquete base y utilícela para explorar la base de datos.
- Identifique los valores NA (Not Available) en la base de datos.
- Analice la presencia de posibles valores atípicos.
- Decida qué hacer con los valores NA.
Introducción
En el presente informe se aborda el análisis exploratorio y descriptivo de un conjunto de datos relacionado a registros de suicidios o intentos de los mismos, posibles razones psicológicas, datos demográficos, entre otras variables de interés. El conjunto de datos posee registros de distintos países a nivel mundial, la población de los mismos y la tasa de suicidios por cada 10 mil habitantes.
Se iniciará con una inspección del conjunto de datos, su estructura, tipos de variables, datos faltantes y distribución de las variables. Posteriormente, se realizará una descripción gráfica de la información y posibles inferencias.
Análisis Exploratorio de los datos
Inspección del Conjunto de Datos
library(readr)## Warning: package 'readr' was built under R version 4.2.3master <- read_csv("master.csv")## Rows: 27820 Columns: 12
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (5): country, sex, age, country-year, generation
## dbl (6): year, suicides_no, population, suicides/100k pop, HDI for year, gdp...
## num (1): gdp_for_year ($)
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.head(master)## # A tibble: 6 × 12
## country year sex age suicides_no population `suicides/100k pop`
## <chr> <dbl> <chr> <chr> <dbl> <dbl> <dbl>
## 1 Albania 1987 male 15-24 years 21 312900 6.71
## 2 Albania 1987 male 35-54 years 16 308000 5.19
## 3 Albania 1987 female 15-24 years 14 289700 4.83
## 4 Albania 1987 male 75+ years 1 21800 4.59
## 5 Albania 1987 male 25-34 years 9 274300 3.28
## 6 Albania 1987 female 75+ years 1 35600 2.81
## # ℹ 5 more variables: `country-year` <chr>, `HDI for year` <dbl>,
## # `gdp_for_year ($)` <dbl>, `gdp_per_capita ($)` <dbl>, generation <chr>dim(master)## [1] 27820 12str(master)## spc_tbl_ [27,820 × 12] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ country : chr [1:27820] "Albania" "Albania" "Albania" "Albania" ...
## $ year : num [1:27820] 1987 1987 1987 1987 1987 ...
## $ sex : chr [1:27820] "male" "male" "female" "male" ...
## $ age : chr [1:27820] "15-24 years" "35-54 years" "15-24 years" "75+ years" ...
## $ suicides_no : num [1:27820] 21 16 14 1 9 1 6 4 1 0 ...
## $ population : num [1:27820] 312900 308000 289700 21800 274300 ...
## $ suicides/100k pop : num [1:27820] 6.71 5.19 4.83 4.59 3.28 2.81 2.15 1.56 0.73 0 ...
## $ country-year : chr [1:27820] "Albania1987" "Albania1987" "Albania1987" "Albania1987" ...
## $ HDI for year : num [1:27820] NA NA NA NA NA NA NA NA NA NA ...
## $ gdp_for_year ($) : num [1:27820] 2.16e+09 2.16e+09 2.16e+09 2.16e+09 2.16e+09 ...
## $ gdp_per_capita ($): num [1:27820] 796 796 796 796 796 796 796 796 796 796 ...
## $ generation : chr [1:27820] "Generation X" "Silent" "Generation X" "G.I. Generation" ...
## - attr(*, "spec")=
## .. cols(
## .. country = col_character(),
## .. year = col_double(),
## .. sex = col_character(),
## .. age = col_character(),
## .. suicides_no = col_double(),
## .. population = col_double(),
## .. `suicides/100k pop` = col_double(),
## .. `country-year` = col_character(),
## .. `HDI for year` = col_double(),
## .. `gdp_for_year ($)` = col_number(),
## .. `gdp_per_capita ($)` = col_double(),
## .. generation = col_character()
## .. )
## - attr(*, "problems")=<externalptr>A partir del nombre de las variables podemos identificar cuáles son categóricas y cuáles son numéricas.
names(master)## [1] "country" "year" "sex"
## [4] "age" "suicides_no" "population"
## [7] "suicides/100k pop" "country-year" "HDI for year"
## [10] "gdp_for_year ($)" "gdp_per_capita ($)" "generation"Vista de tabla
Observamos de manera gráfica a través de una tabla la información del
conjunto de datos, en la cual se evidencia la presencia de datos
faltantes en la columna HDI for year para varias de las
observaciones.
library(knitr)## Warning: package 'knitr' was built under R version 4.2.2kable(head(master, 10), caption = "Base de datos: Registros de suicidios a nivel mundial")| country | year | sex | age | suicides_no | population | suicides/100k pop | country-year | HDI for year | gdp_for_year (\()| gdp_per_capita (\)) | generation | |
|---|---|---|---|---|---|---|---|---|---|---|---|
| Albania | 1987 | male | 15-24 years | 21 | 312900 | 6.71 | Albania1987 | NA | 2156624900 | 796 | Generation X |
| Albania | 1987 | male | 35-54 years | 16 | 308000 | 5.19 | Albania1987 | NA | 2156624900 | 796 | Silent |
| Albania | 1987 | female | 15-24 years | 14 | 289700 | 4.83 | Albania1987 | NA | 2156624900 | 796 | Generation X |
| Albania | 1987 | male | 75+ years | 1 | 21800 | 4.59 | Albania1987 | NA | 2156624900 | 796 | G.I. Generation |
| Albania | 1987 | male | 25-34 years | 9 | 274300 | 3.28 | Albania1987 | NA | 2156624900 | 796 | Boomers |
| Albania | 1987 | female | 75+ years | 1 | 35600 | 2.81 | Albania1987 | NA | 2156624900 | 796 | G.I. Generation |
| Albania | 1987 | female | 35-54 years | 6 | 278800 | 2.15 | Albania1987 | NA | 2156624900 | 796 | Silent |
| Albania | 1987 | female | 25-34 years | 4 | 257200 | 1.56 | Albania1987 | NA | 2156624900 | 796 | Boomers |
| Albania | 1987 | male | 55-74 years | 1 | 137500 | 0.73 | Albania1987 | NA | 2156624900 | 796 | G.I. Generation |
| Albania | 1987 | female | 5-14 years | 0 | 311000 | 0.00 | Albania1987 | NA | 2156624900 | 796 | Generation X |
Resumen Estadístico de los Datos
summary(master)## country year sex age
## Length:27820 Min. :1985 Length:27820 Length:27820
## Class :character 1st Qu.:1995 Class :character Class :character
## Mode :character Median :2002 Mode :character Mode :character
## Mean :2001
## 3rd Qu.:2008
## Max. :2016
##
## suicides_no population suicides/100k pop country-year
## Min. : 0.0 Min. : 278 Min. : 0.00 Length:27820
## 1st Qu.: 3.0 1st Qu.: 97498 1st Qu.: 0.92 Class :character
## Median : 25.0 Median : 430150 Median : 5.99 Mode :character
## Mean : 242.6 Mean : 1844794 Mean : 12.82
## 3rd Qu.: 131.0 3rd Qu.: 1486143 3rd Qu.: 16.62
## Max. :22338.0 Max. :43805214 Max. :224.97
##
## HDI for year gdp_for_year ($) gdp_per_capita ($) generation
## Min. :0.483 Min. :4.692e+07 Min. : 251 Length:27820
## 1st Qu.:0.713 1st Qu.:8.985e+09 1st Qu.: 3447 Class :character
## Median :0.779 Median :4.811e+10 Median : 9372 Mode :character
## Mean :0.777 Mean :4.456e+11 Mean : 16866
## 3rd Qu.:0.855 3rd Qu.:2.602e+11 3rd Qu.: 24874
## Max. :0.944 Max. :1.812e+13 Max. :126352
## NA's :19456Revisión de Asimetría y Curtosis
library(e1071)
skewness <- apply(master[,sapply(master, is.numeric)], 2, skewness, na.rm = TRUE)
kurtosis <- apply(master[,sapply(master, is.numeric)], 2, kurtosis, na.rm = TRUE)
data.frame(Variable = names(skewness), Asimetría = skewness, Curtosis = kurtosis)## Variable Asimetría Curtosis
## year year -0.1602240 -1.0519158
## suicides_no suicides_no 10.3517939 157.1288677
## population population 4.4589335 27.3998492
## suicides/100k pop suicides/100k pop 2.9630949 12.1622530
## HDI for year HDI for year -0.3007695 -0.6488063
## gdp_for_year ($) gdp_for_year ($) 7.2329750 64.2170326
## gdp_per_capita ($) gdp_per_capita ($) 1.9632583 4.9360844suicides_no (Número de suicidios)
- Promedio (mean): Aproximadamente 242.57 suicidios por país y año.
- Desviación estándar (sd): 902.05, lo que indica una gran variabilidad entre los países. Esto significa que mientras algunos países tienen muy pocos suicidios, otros pueden tener cifras significativamente más altas.
- Mediana: 25 suicidios, lo que sugiere que más de la mitad de los registros tienen un número de suicidios por debajo de este valor.
- Mínimo y máximo: Varían entre 0 y 22,330, lo que muestra una gran diferencia entre países.
- Asimetría (skewness): 10.35, muy positiva, lo que indica que la distribución está fuertemente sesgada hacia la derecha. Esto significa que la mayoría de los países tienen un número bajo de suicidios, pero algunos tienen cifras excepcionalmente altas.
- Curtosis: 157.13, muy alta, indicando colas pesadas; esto refuerza la idea de que hay países con valores extremadamente altos que son outliers.
gdp_per_capita ($) (PIB per cápita)
- Promedio: 16,866.46 dólares, representando el PIB medio por persona.
- Desviación estándar: 18,887.58, lo que indica que los niveles de vida varían significativamente entre países.
- Mediana: 9,372 dólares, sugiriendo que la mitad de los países tienen un PIB per cápita menor a este valor.
- Mínimo y máximo: Oscila entre 251 y 126,100 dólares, mostrando una disparidad económica considerable entre países.
- Asimetría: 1.96, lo que sugiere un sesgo hacia la derecha; la mayoría de los países tienen un PIB per cápita bajo o moderado, con algunos valores muy altos.
- Curtosis: 4.94, mayor a 3, lo que indica colas más pesadas que en una distribución normal.
population (Población)
- Promedio: 1,844,792 personas por país y año.
- Desviación estándar: 3,917,799, lo que muestra una gran dispersión en el tamaño de la población entre países.
- Mediana: 430,150 personas, lo que sugiere que la mitad de los países tienen una población inferior a este valor.
- Mínimo y máximo: Desde 278 hasta más de 38 millones, mostrando una gran diversidad en el tamaño poblacional.
- Asimetría: 4.46, indicando que la distribución está sesgada hacia la derecha, es decir, unos pocos países tienen poblaciones extremadamente grandes.
- Curtosis: 27.40, lo que señala que hay colas pesadas, reflejando outliers con poblaciones muy grandes.
suicides/100k pop (Tasa de suicidios por cada 100,000 habitantes)
- Promedio: 12.82 suicidios por cada 100,000 habitantes.
- Desviación estándar: 18.96, lo que indica una variabilidad significativa en las tasas de suicidio.
- Mediana: 5.99, lo que muestra que la mitad de los países tienen tasas de suicidio menores a este valor.
- Mínimo y máximo: Rango desde 0 hasta 224.97, con algunas tasas extremadamente altas.
- Asimetría: 2.96, lo que sugiere un sesgo hacia la derecha; la mayoría de los países tienen tasas de suicidio bajas, pero algunos pocos tienen tasas muy altas.
- Curtosis: 12.16, indicando colas pesadas, lo que implica la presencia de países con tasas de suicidio inusualmente altas.
gdp_for_year ($) (PIB anual)
- Promedio: 4.56 billones de dólares. Desviación estándar: 1.45 billones, reflejando una gran variabilidad entre economías nacionales.
- Mediana: 481,469 millones de dólares, sugiriendo que la mitad de los países tienen un PIB anual menor a este valor.
- Mínimo y máximo: Varía de 469 millones a más de 18 billones, mostrando grandes diferencias económicas entre países.
- Asimetría: 7.23, muy alta, indicando que la mayoría de los países tienen PIB anuales relativamente bajos, con algunos países como outliers con PIB extremadamente altos.
- Curtosis: 64.22, lo que señala una distribución con colas muy pesadas, reflejando la gran disparidad económica a nivel mundial.
Revisión de asimetría y curtosis
Rangos de curtosis
Platicúrtica (Colas delgadas, menos outliers): Curtosis < 3Mesocúrtica (Distribución normal, colas moderadas: Curtosis igual o cercana a 3.Leptocúrtica (Colas extremadamente pesadas, muchos outliers: Curtosis > 3
Inspección de Posibles Errores o Inconsistencias
Se ejecuta la función de control o filtro de problemas en nuestro conjunto de datos para examinar si hay alguna inconsistencia en los mismos. Se observa que que no hay errores dentro del conjunto de datos.
prob1 <- problems(master)
prob1## # A tibble: 0 × 5
## # ℹ 5 variables: row <int>, col <int>, expected <chr>, actual <chr>, file <chr>Análisis Gráfico de las Variables
Distribución de Edad por Sexo (Apilado)
La grafica muestra que la proporción entre hombres y mujeres dentro de cada grupo de edad es relativamente estable, con las secciones rojas (mujeres) siendo consistentemente más grandes que las azules (hombres), lo que sugiere una ligera predominancia de mujeres en todos los grupos de edad. La distribución no presenta grandes variaciones, lo que sugiere homogeneidad en la representación de ambos sexos a lo largo de los grupos de edad.
library(ggplot2)## Warning: package 'ggplot2' was built under R version 4.2.3ggplot(master, aes(x = age, fill = sex)) +
geom_bar(position = "stack") +
labs(title = "Distribución de Edad por Sexo (Apilado)", x = "Grupo de Edad", y = "Frecuencia") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Comparación del Número Total de Suicidios entre Hombres y Mujeres.
La gráfica muestra una comparación del número total de suicidios entre hombres y mujeres. La barra correspondiente a los hombres es significativamente más alta, con un conteo que supera los 5 millones de suicidios, mientras que la barra para las mujeres muestra un conteo de alrededor de 1 millón de suicidios. Esto indica que, en los datos analizados, los hombres tienen una tasa de suicidios considerablemente mayor que las mujeres, con más de cinco veces la cantidad de suicidios
ggplot(master, aes(x = sex, y = suicides_no, fill = sex)) +
geom_bar(stat = "identity") +
labs(title = "Comparación del Número Total de Suicidios entre Hombres y Mujeres", x = "Sexo", y = "Número de Suicidios") +
theme_minimal()
Frecuencia de Suicidios Según Generaciones
lA gráfica muestra la frecuencia de suicidios según diferentes generaciones. La generación X presenta la frecuencia más alta, con más de 6,000 suicidios registrados. Le siguen la generación Silent y los Millennials, ambos con frecuencias cercanas a 6,000. Los Boomers también muestran una frecuencia alta, superando los 4,000 casos. En contraste, la G.I. Generation y la Generation Z tienen las frecuencias más bajas, con menos de 3,000 y alrededor de 2,000 casos respectivamente. Esta distribución sugiere que ciertas generaciones, como la generación X, tienen una mayor prevalencia de suicidios en comparación con otras, lo que podría reflejar diferencias generacionales en factores de riesgo y circunstancias sociales.
ggplot(master, aes(x = generation, fill = generation)) +
geom_bar() +
labs(title = "Frecuencia de Suicidios Según Generaciones", x = "Generación", y = "Frecuencia") +
scale_fill_manual(values = c("#cce5ff", "#99ccff", "#66b3ff", "#3399ff", "#0073e6", "#0059b3")) +
theme_minimal()
Inspección de suicidios por rangos anuales
Agrupamos los rangos anuales para mejor modelado e inspección de los datos. Para ello realizamos una tabla de frecuencias y aplicamos la n de sturges. se muestran los resultados a continuación:
Frecuencia Absoluta (Freq)
- Los periodos con mayor número de suicidios son 1999-2006 y 2006-2013, con 7,188 y 7,140 casos respectivamente.
- El periodo con menor cantidad de suicidios es 2013-2020, con 1,840 casos.
Frecuencia Relativa (Rel_Freq)
- La frecuencia relativa más alta corresponde al periodo 1999-2006 con un 26.38% de los suicidios, seguido de cerca por 2006-2013 con 26.21%.
- El periodo más reciente, 2013-2020, tiene la frecuencia relativa más baja, con solo 6.75%.
Frecuencia Acumulada (Cum_Freq)
Esta columna muestra el número total de suicidios acumulados hasta el final de cada periodo.
- Para el periodo 1985-1992, hay 4,752 suicidios acumulados, y al final del periodo 2013-2020, se acumulan un total de 27,244 suicidios.
Interpretación General
- La tabla indica que la mayor concentración de suicidios ocurrió entre 1999 y 2013, representando más del 50% de los casos totales en los periodos analizados. Además, se observa una disminución en la frecuencia de suicidios en el periodo más reciente (2013-2020), tanto en términos absolutos como relativos, lo que podría reflejar cambios en las tendencias o en las circunstancias socioeconómicas de esos años
## year_group suicides_no Rel_Freq Cum_Freq
## 1 (1985,1992] 1131636 0.1706235 1131636
## 2 (1992,1999] 1690352 0.2548644 2821988
## 3 (1999,2006] 1727255 0.2604285 4549243
## 4 (2006,2013] 1640887 0.2474063 6190130
## 5 (2013,2020] 442227 0.0666772 6632357Histograma de la distribución de suicidios por año
Se observa que los rangos de edad 1999-2006 y 2006-2013 concentran el mayor número de observaciones o suicidios, con más de 7,000 registros cada uno. Esto sugiere un aumento significativo en la cantidad de datos o en la incidencia de los eventos durante estos años. Los periodos 1992-1999 y 1985-1992 presentan frecuencias más bajas, con alrededor de 6,324 y 4,752 observaciones respectivamente. Sin embargo, el periodo más reciente (2013-2020) muestra una fuerte disminución, con solo 1,840 observaciones, lo que podría indicar un cambio en la tendencia de los eventos o en la recolección de datos en los últimos años.
ggplot(master, aes(x = year_group)) +
geom_histogram(stat = "count", fill = "skyblue", color = "black") +
labs(title = "Histograma de los años", x = "Rango de años", y = "Frecuencia") + scale_fill_manual(values = c("#99ccff", "#66b3ff", "#3399ff", "#0073e6", "#0059b3")) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Distribución del PIB per capita por sexo
El gráfico sugiere que, en la mayoría de los países, el PIB per cápita es bajo, independientemente del sexo. Sin embargo, hay algunas excepciones donde ciertos países presentan un PIB per cápita significativamente más alto, aunque estos son menos frecuentes. La similitud en la forma de los violines para ambos sexos indica que no hay una gran diferencia en la distribución del PIB per cápita entre hombres y mujeres en los datos analizados.
ggplot(master, aes(y = `gdp_per_capita ($)`, x = sex, fill = sex)) +
geom_violin(trim = FALSE) +
labs(title = "Distribución del PIB per Cápita por Sexo", y = "PIB per Cápita ($)", x = "Sexo") +
theme_minimal() +
scale_y_continuous(labels = scales::comma) +
scale_fill_manual(values = c("#a6cee3", "#1f78b4")) +
coord_flip()
Filtrado de datos
## package 'reactable' successfully unpacked and MD5 sums checked
##
## The downloaded binary packages are in
## C:\Users\CEDIS RECEPCION\AppData\Local\Temp\RtmpQHIB97\downloaded_packagesAnálisis de Datos Faltantes
Realizamos una imspección de datos faltantes para analizar si se debe
inputar datos en algún momento, para ello a través de una tabla,
observamos que para la variable HDI for year posee 19456
valores vacíos por lo que debe recibir un tratamiento particular. A
partir de esta información verificamos mediante la matriz de datos
faltantes qué proporción de datos faltantes equivale esta cantidad de
registros (6%), posterior a ellos examinaremos la normalidad de la
variable y decidiremos como inputar los datos.
missing_values <- colSums(is.na(master))
print(missing_values)## country year sex age
## 0 0 0 0
## suicides_no population suicides/100k pop country-year
## 0 0 0 0
## HDI for year gdp_for_year ($) gdp_per_capita ($) generation
## 19456 0 0 0
## year_group
## 576Matriz de Datos Faltantes
library(Amelia)
missmap(master, col = c("lightblue", "blue"), legend = TRUE)
Distribución de los Datos
Se debe inspeccionar la distribución de los datos para evaluar algún método de inputación posible para la variable con datos faltantes. Dado que tenemos una muestra mayor a 200, se aplicará el test de kolmogrov-smirnov cuyas hipotesis son:
- \(H_0\): Los datos se ajustan a una distribución normal.
- \(H_1\): Los datos no se ajustan a una distribución normal.
Examinamos la normalidad de la variable HDI for year y
se arroja el resultado de que p-valor < alfa, lo que indica que la
variable no sigue una distribución normal, por tanto se deben reemplazar
los datos faltantes por su mediana y nuevamente observamos la nueva
distribución de nuestros datos y la matriz de datos faltantes.
hdi_data <- master$`HDI for year`
# Usar la mediana
mediana_hdi <- median(hdi_data, na.rm = TRUE)
master$`HDI for year`[is.na(master$`HDI for year`)] <- mediana_hdi
ggplot(master, aes(x = `HDI for year`)) +
geom_histogram(binwidth = 0.01, fill = "steelblue", color = "black") +
labs(title = "Distribución del HDI (después de imputación)", x = "HDI", y = "Frecuencia") +
theme_minimal()
Matriz de datos faltantes posterior a la inputación por la mediana
Este gráfico confirma que, tras la imputación, el conjunto de datos ya no contiene valores faltantes. Esto es crucial para garantizar que el análisis posterior no se vea afectado por la ausencia de datos,
missmap(master, col = c("lightblue", "blue"), legend = TRUE)
Ejercicio 4
Considere la base de datos master y realice lo siguiente (utilice los operadores pipe de continuidad y compuesto):
- Edite y explore reglas para verificar que la base de datos no contenga posibles registros erróneos.
- Filtre los datos de
Colombiay los deEEUU, generando dos bases de datos,llamadas master_colymaster_eu. - Realice un análisis de la evolución de los suicidios por cada 100.000 habitantes, del PIB per cápita y del IDH, a lo largo de los años en ambos países.
- Realice un análisis de la evolución de los suicidios por cada 100.000 habitantes, del PIB per cápita y del IDH, a lo largo de los años en ambos países por género.
- Realice un análisis de la evolución de los suicidios por cada 100.000 habitantes, del PIB per cápita y del IDH, a lo largo de los años en ambos países por grupo de edad.
Inspección del conjunto de datos
Primeros realizaremos una inspección de valores faltantes en nuestro conjunto de datos y observamos la presencia de N/A’s en la variable de agrupación por año en 576 registros, posterior a ello, verificamos si hay valores negativos o outliers en nuestro conjunto de datos, luego los calculamos mediante el rango intercuartílico y filtramos el conjunto de datos. Se obseva que no hay presencia de valores negativos en nuestros datos y adicionalmente, se prevee la presencia de 3899 datos atípicos en el número de suicidios. Finalmente creamos un nuevo conjunto de datos filtrado.
missing_values <- sapply(master, function(x) sum(is.na(x)))
print(missing_values)## country year sex age
## 0 0 0 0
## suicides_no population suicides/100k pop country-year
## 0 0 0 0
## HDI for year gdp_for_year ($) gdp_per_capita ($) generation
## 0 0 0 0
## year_group
## 576library(dplyr)
negative_values <- master %>%
filter(suicides_no < 0 | `gdp_per_capita ($)` < 0 | `HDI for year` < 0 | `suicides/100k pop` < 0)
print(negative_values)## # A tibble: 0 × 13
## # ℹ 13 variables: country <chr>, year <dbl>, sex <chr>, age <chr>,
## # suicides_no <dbl>, population <dbl>, suicides/100k pop <dbl>,
## # country-year <chr>, HDI for year <dbl>, gdp_for_year ($) <dbl>,
## # gdp_per_capita ($) <dbl>, generation <chr>, year_group <fct>library(dplyr)
library(kableExtra)
IQR_suicides <- IQR(master$suicides_no, na.rm = TRUE)
lower_bound <- quantile(master$suicides_no, 0.25, na.rm = TRUE) - 1.5 * IQR_suicides
upper_bound <- quantile(master$suicides_no, 0.75, na.rm = TRUE) + 1.5 * IQR_suicides
outliers_suicides <- master %>%
filter(suicides_no < lower_bound | suicides_no > upper_bound)
reactable(outliers_suicides, searchable = TRUE, pagination = TRUE, defaultPageSize = 10)Análisis para Colombia
En las gráficas presentadas se muestra la evolución de tres indicadores clave en Colombia a lo largo de los años: la tasa de suicidios por cada 100.000 habitantes, el PIB per cápita y el Índice de Desarrollo Humano (IDH).
Evolución de Suicidios por cada 100.000 habitantes
- La primera gráfica muestra un aumento gradual en la tasa de suicidios por cada 100.000 habitantes desde 1985 hasta 2015. Se observa una tendencia al alza con fluctuaciones estacionales, especialmente notables a partir de los años 2000, lo que podría indicar un incremento en los factores de riesgo asociados con el suicidio a medida que el país ha atravesado diferentes crisis sociales y económicas.
Evolución del PIB per cápita
- La segunda gráfica refleja el crecimiento sostenido del PIB per cápita en Colombia desde finales de los años 80 hasta 2015. Este aumento se acelera particularmente durante los años 2000, alcanzando un pico alrededor de 2013 antes de experimentar una ligera disminución. Esta tendencia sugiere un progreso económico general en el país, aunque con algunas posibles interrupciones en el crecimiento económico reciente.
Evolución del Índice de Desarrollo Humano (IDH)
- La tercera gráfica presenta la evolución del IDH en Colombia, que muestra una variabilidad considerable en los primeros años, seguida por una estabilización a partir del año 2000. A pesar de las fluctuaciones iniciales, el IDH se ha mantenido relativamente estable, lo que sugiere un progreso sostenido en términos de desarrollo humano, aunque no sin desafíos, como lo indican las caídas temporales.
library(dplyr)
library(ggplot2)
library(gridExtra)
master_col <- master %>%
filter(country == "Colombia")
p1 <- ggplot(master_col, aes(x = year, y = `suicides/100k pop`)) +
geom_line(color = "#0059b3", size = 1) +
geom_point(color = "blue", size = 2) +
labs(title = "Evolución de Suicidios por cada 100.000 habitantes en Colombia",
x = "Año",
y = "Suicidios por cada 100.000 hab") +
theme_minimal() +
theme(axis.title.y = element_text(size = 10))
p2 <- ggplot(master_col, aes(x = year, y = `gdp_per_capita ($)`)) +
geom_line(color = "#0059b3", size = 1) +
geom_point(color = "#66b3ff", size = 2) +
labs(title = "Evolución del PIB per cápita en Colombia",
x = "Año",
y = "PIB per cápita ($)") +
theme_minimal() +
theme(axis.title.y = element_text(size = 10))
p3 <- ggplot(master_col, aes(x = year, y = `HDI for year`)) +
geom_line(color = "lightblue", size = 1) +
geom_point(color = "blue", size = 2) +
labs(title = "Evolución del IDH en Colombia",
x = "Año",
y = "IDH") +
theme_minimal() +
theme(axis.title.y = element_text(size = 10))
grid.arrange(p1, p2, p3, ncol = 1)
Análisis por género
Femenino
Evolución de Suicidios por cada 100.000 habitantes en Colombia
La tendencia de los suicidios por cada 100.000 habitantes en Colombia para las mujeres muestra un ligero aumento a lo largo del tiempo, especialmente a partir de la década de 1990. Sin embargo, la tasa de suicidios se mantiene en general por debajo de 10 suicidios por cada 100.000 habitantes, con fluctuaciones menores.
Contraste: Los hombres en Colombia presentan tasas de suicidio consistentemente más altas que las mujeres. La diferencia en la tasa es notable, con los hombres alcanzando hasta el doble de la tasa de las mujeres en algunos años.
Evolución del PIB per cápita en Colombia
El PIB per cápita para las mujeres en Colombia muestra una tendencia ascendente a lo largo de las décadas, con un crecimiento más pronunciado a partir del año 2000. Este aumento refleja una mejora en la economía a nivel nacional que afecta tanto a mujeres como a hombres.
Contraste: No se observa un contraste significativo en el PIB per cápita entre géneros, ya que ambos siguen tendencias muy similares.
Evolución del IDH en Colombia
La evolución del IDH para las mujeres en Colombia muestra fluctuaciones, especialmente en los años 1980 y 1990. Sin embargo, a partir de 1995, el IDH se estabiliza con una tendencia al alza gradual, reflejando mejoras en indicadores clave como la salud, educación y nivel de vida.
Contraste: Al igual que con el PIB per cápita, no se observa un contraste significativo en el IDH entre géneros. Ambos muestran tendencias similares, lo que sugiere que los indicadores de desarrollo humano han mejorado de manera equitativa para hombres y mujeres en Colombia.
library(dplyr)
library(ggplot2)
library(gridExtra)
master_col_female <- master_col %>%
filter(sex == "female")
p1_col_female <- ggplot(master_col_female, aes(x = year, y = `suicides/100k pop`)) +
geom_line(size = 1, color = "lightblue") +
geom_point(size = 2, color = "blue") +
labs(title = "Evolución de Suicidios por cada 100.000 habitantes para Mujeres en Colombia",
x = "Año",
y = "Suicidios por cada 100.000 hab") +
theme_minimal()
p2_col_female <- ggplot(master_col_female, aes(x = year, y = `gdp_per_capita ($)`)) +
geom_line(size = 1, color = "blue") +
geom_point(size = 2, color = "lightblue") +
labs(title = "Evolución del PIB per cápita para Mujeres en Colombia",
x = "Año",
y = "PIB per cápita ($)") +
theme_minimal()
p3_col_female <- ggplot(master_col_female, aes(x = year, y = `HDI for year`)) +
geom_line(size = 1, color = "lightblue") +
geom_point(size = 2, color = "blue") +
labs(title = "Evolución del IDH para Mujeres en Colombia",
x = "Año",
y = "IDH") +
theme_minimal()
grid.arrange(p1_col_female, p2_col_female, p3_col_female, ncol = 1)
Masculino
Evolución de Suicidios por cada 100.000 habitantes en Colombia
La tendencia para los hombres en Colombia es similar en cuanto al patrón general de aumento, pero con una diferencia significativa en las tasas. La tasa de suicidios para los hombres es considerablemente mayor, superando los 15 suicidios por cada 100.000 habitantes en varios años, y mostrando picos que llegan a alrededor de 20 suicidios por cada 100.000 habitantes.
Contraste: Los hombres en Colombia presentan tasas de suicidio consistentemente más altas que las mujeres. La diferencia en la tasa es notable, con los hombres alcanzando hasta el doble de la tasa de las mujeres en algunos años.
Evolución del PIB per cápita en Colombia
El PIB per cápita para los hombres sigue una tendencia casi idéntica a la de las mujeres, lo que indica que los cambios en la economía del país afectan de manera similar a ambos géneros. No hay diferencias significativas entre los géneros en esta métrica.
Contraste: No se observa un contraste significativo en el PIB per cápita entre géneros, ya que ambos siguen tendencias muy similares.
Evolución del IDH en Colombia
La evolución del IDH para los hombres en Colombia es casi idéntica a la de las mujeres, con las mismas fluctuaciones y una tendencia general de mejora y estabilización hacia los últimos años.
Contraste: Al igual que con el PIB per cápita, no se observa un contraste significativo en el IDH entre géneros. Ambos muestran tendencias similares, lo que sugiere que los indicadores de desarrollo humano han mejorado de manera equitativa para hombres y mujeres en Colombia.
master_col_male <- master_col %>%
filter(sex == "male")
p1_col_male <- ggplot(master_col_male, aes(x = year, y = `suicides/100k pop`)) +
geom_line(size = 1, color = "blue") +
geom_point(size = 2, color = "lightblue") +
labs(title = "Evolución de Suicidios por cada 100.000 habitantes para Hombres en Colombia",
x = "Año",
y = "Suicidios por cada 100.000 hab") +
theme_minimal()
p2_col_male <- ggplot(master_col_male, aes(x = year, y = `gdp_per_capita ($)`)) +
geom_line(size = 1, color = "lightblue") +
geom_point(size = 2, color = "blue") +
labs(title = "Evolución del PIB per cápita para Hombres en Colombia",
x = "Año",
y = "PIB per cápita ($)") +
theme_minimal()
p3_col_male <- ggplot(master_col_male, aes(x = year, y = `HDI for year`)) +
geom_line(size = 1, color = "blue") +
geom_point(size = 2, color = "lightblue") +
labs(title = "Evolución del IDH para Hombres en Colombia",
x = "Año",
y = "IDH") +
theme_minimal()
grid.arrange(p1_col_male, p2_col_male, p3_col_male, ncol = 1)
Análisis para los grupos de edad
- Los grupos de edad más jóvenes, como 15-24 años y 25-34 años, muestran fluctuaciones significativas en la tasa de suicidios, especialmente durante los años 1990 y principios de 2000.
- Las personas de 75 años y más presentan la tasa de suicidios más alta en general, con picos especialmente notables a mediados de los años 2000, aunque hay una tendencia a la baja hacia los años recientes.
- Los grupos de 35-54 años y 55-74 años muestran una tendencia relativamente estable con variaciones moderadas a lo largo del tiempo.
- El grupo más joven, 5-14 años, tiene las tasas de suicidio más bajas, manteniendo una tendencia relativamente estable y baja durante todo el período.
colombia_suicides_age <- master %>%
filter(country == "Colombia") %>%
group_by(year, age) %>%
summarise(avg_suicides = mean(`suicides/100k pop`, na.rm = TRUE))
ggplot(colombia_suicides_age, aes(x = year, y = avg_suicides, color = age)) +
geom_line() +
geom_point() +
labs(title = "Evolución de Suicidios por cada 100.000 habitantes en Colombia por Grupo de Edad",
x = "Año", y = "Suicidios por cada 100.000 hab") +
theme_minimal()
Aumento Progresivo: Desde 1985 hasta 2010, hay un aumento constante en el PIB per cápita para el grupo de 75+ años. El crecimiento se vuelve más pronunciado después de 2000, alcanzando un pico cercano a 2010.Pico y Disminución: Después del año 2010, el PIB per cápita alcanza un máximo, seguido de una leve disminución en los últimos años mostrados en la gráfica.
colombia_gdp_age <- master %>%
filter(country == "Colombia") %>%
group_by(year, age) %>%
summarise(avg_gdp = mean(`gdp_per_capita ($)`, na.rm = TRUE))
ggplot(colombia_gdp_age, aes(x = year, y = avg_gdp, color = age)) +
geom_line() +
geom_point() +
labs(title = "Evolución del PIB per cápita en Colombia por Grupo de Edad",
x = "Año", y = "PIB per cápita ($)") +
theme_minimal()
A lo largo de los años, el IDH para el grupo de 75+ años ha mantenido un valor alto en Colombia, aunque las caídas abruptas en ciertos años merecen atención para comprender los factores subyacentes que causaron estas disminuciones temporales. La estabilidad observada después de 2005 sugiere mejoras en el desarrollo humano para este grupo, con un ligero aumento hacia el final del período analizado.
colombia_hdi_age <- master %>%
filter(country == "Colombia") %>%
group_by(year, age) %>%
summarise(avg_hdi = mean(`HDI for year`, na.rm = TRUE))
ggplot(colombia_hdi_age, aes(x = year, y = avg_hdi, color = age)) +
geom_line() +
geom_point() +
labs(title = "Evolución del IDH en Colombia por Grupo de Edad",
x = "Año", y = "IDH") +
theme_minimal()
Análisis para Estados Unidos
En las gráficas presentadas se muestra la evolución de tres indicadores clave en Estados Unidos a lo largo de los años: la tasa de suicidios por cada 100.000 habitantes, el PIB per cápita y el Índice de Desarrollo Humano (IDH).
Evolución de Suicidios por cada 100.000 habitantes
- La primera gráfica muestra que la tasa de suicidios en Estados Unidos ha oscilado considerablemente desde 1985 hasta 2015. Aunque hay variaciones estacionales, se puede observar una tendencia general al alza a lo largo del tiempo, especialmente después del año 2000, donde la tasa de suicidios alcanza y se mantiene en niveles relativamente elevados (alrededor de 50-60 suicidios por cada 100.000 habitantes). Esta tendencia puede reflejar un aumento en los factores de riesgo y cambios socioeconómicos en el país.
Evolución del PIB per cápita
- La segunda gráfica muestra un crecimiento constante y significativo del PIB per cápita en Estados Unidos durante el período estudiado. Desde finales de los años 80 hasta 2015, el PIB per cápita ha mostrado una tendencia creciente, alcanzando valores cercanos a los 50.000 dólares. Esta tendencia indica un incremento sostenido en el nivel de vida promedio en el país, con un crecimiento económico estable a lo largo de las décadas.
Evolución del Índice de Desarrollo Humano (IDH)
- La tercera gráfica refleja una evolución positiva en el IDH de Estados Unidos, aunque con algunas fluctuaciones. El IDH comienza en valores alrededor de 0.8 a mediados de los años 80 y muestra una tendencia al alza, alcanzando un valor cercano a 0.9. Las fluctuaciones en los primeros años podrían indicar períodos de inestabilidad en algunos componentes del IDH, pero en general, Estados Unidos ha mostrado una mejora continua en términos de desarrollo humano.
library(dplyr)
library(ggplot2)
library(gridExtra)
master_eu <- master %>%
filter(country == "United States")
g1 <- ggplot(master_eu, aes(x = year, y = `suicides/100k pop`)) +
geom_line(color = "#0059b3", size = 1) +
geom_point(color = "blue", size = 2) +
labs(title = "Evolución de Suicidios por cada 100.000 habitantes en
United States",
x = "Año",
y = "Suicidios por cada 100.000 hab") +
theme_minimal() +
theme(axis.title.y = element_text(size = 10))
g2 <- ggplot(master_eu, aes(x = year, y = `gdp_per_capita ($)`)) +
geom_line(color = "#0059b3", size = 1) +
geom_point(color = "#66b3ff", size = 2) +
labs(title = "Evolución del PIB per cápita en
United States",
x = "Año",
y = "PIB per cápita ($)") +
theme_minimal() +
theme(axis.title.y = element_text(size = 10))
g3 <- ggplot(master_eu, aes(x = year, y = `HDI for year`)) +
geom_line(color = "lightblue", size = 1) +
geom_point(color = "blue", size = 2) +
labs(title = "Evolución del IDH en
United States",
x = "Año",
y = "IDH") +
theme_minimal() +
theme(axis.title.y = element_text(size = 10))
grid.arrange(g1, g2, g3, ncol = 1)
Análisis por género
Femenino
Evolución de Suicidios por cada 100.000 habitantes en Estados Unidos
En Estados Unidos, la tendencia de suicidios por cada 100.000 habitantes para las mujeres muestra una estabilidad a lo largo del tiempo, con tasas generalmente oscilando entre 4 y 6 suicidios por cada 100.000 habitantes. Hay una ligera tendencia al alza, pero la variación anual no es significativa.
Contraste: Similar a lo observado en Colombia, las tasas de suicidio para los hombres en Estados Unidos son mucho más altas que para las mujeres, con los hombres presentando hasta cuatro veces la tasa de suicidios en comparación con las mujeres.
Evolución del PIB per cápita en Estados Unidos
El PIB per cápita para las mujeres en Estados Unidos muestra una tendencia constante al alza, sin fluctuaciones significativas. Este crecimiento es sostenido y refleja una mejora económica continua en el país.
No se observan diferencias significativas en la evolución del PIB per cápita entre géneros, indicando que los cambios económicos han impactado de manera similar a ambos géneros en Estados Unidos.
Evolución del IDH en Estados Unidos
La evolución del IDH para las mujeres en Estados Unidos muestra una tendencia general de estabilidad en niveles altos, con algunas fluctuaciones menores a lo largo de los años. A partir del año 2000, el IDH se estabiliza en torno a 0.9.
Al igual que con el PIB per cápita, no hay diferencias significativas en la evolución del IDH entre hombres y mujeres en Estados Unidos. Ambos géneros muestran una tendencia de estabilidad en los niveles de desarrollo humano.
master_eu_female <- master_eu %>%
filter(sex == "female")
p1_eu_female <- ggplot(master_eu_female, aes(x = year, y = `suicides/100k pop`)) +
geom_line(size = 1, color = "blue") +
geom_point(size = 2, color = "lightblue") +
labs(title = "Evolución de Suicidios por cada 100.000 habitantes para Mujeres en Estados Unidos",
x = "Año",
y = "Suicidios por cada 100.000 hab") +
theme_minimal()
p2_eu_female <- ggplot(master_eu_female, aes(x = year, y = `gdp_per_capita ($)`)) +
geom_line(size = 1, color = "lightblue") +
geom_point(size = 2, color = "blue") +
labs(title = "Evolución del PIB per cápita para Mujeres en Estados Unidos",
x = "Año",
y = "PIB per cápita ($)") +
theme_minimal()
p3_eu_female <- ggplot(master_eu_female, aes(x = year, y = `HDI for year`)) +
geom_line(size = 1, color = "blue") +
geom_point(size = 2, color = "lightblue") +
labs(title = "Evolución del IDH para Mujeres en Estados Unidos",
x = "Año",
y = "IDH") +
theme_minimal()
grid.arrange(p1_eu_female, p2_eu_female, p3_eu_female, ncol = 1)
Masculino
Evolución de Suicidios por cada 100.000 habitantes en Estados Unidos
Para los hombres, la tasa de suicidios es considerablemente más alta, con valores que fluctúan entre 15 y 25 suicidios por cada 100.000 habitantes, con una tendencia a mantenerse en este rango a lo largo del tiempo.
Similar a lo observado en Colombia, las tasas de suicidio para los hombres en Estados Unidos son mucho más altas que para las mujeres, con los hombres presentando hasta cuatro veces la tasa de suicidios en comparación con las mujeres.
Evolución del PIB per cápita en Estados Unidos
La tendencia del PIB per cápita para los hombres es prácticamente idéntica a la de las mujeres, con un crecimiento continuo y sostenido sin diferencias notables entre los géneros.
No se observan diferencias significativas en la evolución del PIB per cápita entre géneros, indicando que los cambios económicos han impactado de manera similar a ambos géneros en Estados Unidos.
Evolución del IDH en Estados Unidos
La tendencia del IDH para los hombres sigue un patrón muy similar al de las mujeres, con estabilidad en niveles altos y pequeñas fluctuaciones en los años previos al 2000, seguido de una estabilización en niveles altos.
Al igual que con el PIB per cápita, no hay diferencias significativas en la evolución del IDH entre hombres y mujeres en Estados Unidos. Ambos géneros muestran una tendencia de estabilidad en los niveles de desarrollo humano.
master_eu_male <- master_eu %>%
filter(sex == "male")
p1_eu_male <- ggplot(master_eu_male, aes(x = year, y = `suicides/100k pop`)) +
geom_line(size = 1, color = "blue") +
geom_point(size = 2, color = "blue") +
labs(title = "Evolución de Suicidios por cada 100.000 habitantes para Hombres en Estados Unidos",
x = "Año",
y = "Suicidios por cada 100.000 hab") +
theme_minimal()
p2_eu_male <- ggplot(master_eu_male, aes(x = year, y = `gdp_per_capita ($)`)) +
geom_line(size = 1, color = "blue") +
geom_point(size = 2, color = "blue") +
labs(title = "Evolución del PIB per cápita para Hombres en Estados Unidos",
x = "Año",
y = "PIB per cápita ($)") +
theme_minimal()
p3_eu_male <- ggplot(master_eu_male, aes(x = year, y = `HDI for year`)) +
geom_line(size = 1, color = "blue") +
geom_point(size = 2, color = "blue") +
labs(title = "Evolución del IDH para Hombres en Estados Unidos",
x = "Año",
y = "IDH") +
theme_minimal()
grid.arrange(p1_eu_male, p2_eu_male, p3_eu_male, ncol = 1)
Análisis por edad
Grupo de edad 75+ años: Este grupo presenta las tasas de suicidio más altas a lo largo del período, aunque se observa una tendencia decreciente desde finales de los años 80 hasta alrededor del 2000, con una ligera estabilización y un leve aumento después del 2000.Grupos de edad 55-74 y 35-54 años: Estos grupos muestran una tasa de suicidio moderadamente alta, con una tendencia a la baja en los años 90, seguida de un leve aumento y estabilización en los años posteriores.Grupos de edad 25-34 y 15-24 años: Estos grupos tienen tasas de suicidio más bajas en comparación con los grupos mayores. Sin embargo, ambos grupos presentan una tendencia relativamente estable con ligeras fluctuaciones a lo largo del tiempo.Grupo de edad 5-14 años: Este grupo presenta las tasas más bajas de suicidios, con una línea casi plana y muy por debajo de los demás grupos, lo que indica una incidencia muy baja en comparación con los otros grupos de edad.
master_eu <- master %>% filter(country == "United States")
eu_data_age <- master_eu %>%
group_by(year, age) %>%
summarize(
avg_suicides = mean(`suicides/100k pop`, na.rm = TRUE),
avg_gdp = mean(`gdp_per_capita ($)`, na.rm = TRUE),
avg_hdi = mean(`HDI for year`, na.rm = TRUE)
)
ggplot(eu_data_age, aes(x = year, y = avg_suicides, color = age, group = age)) +
geom_line() +
geom_point() +
labs(title = "Evolución de Suicidios por cada 100.000 habitantes en Estados Unidos por Grupo de Edad",
x = "Año",
y = "Suicidios por cada 100.000 hab",
color = "Grupo de Edad") +
theme_minimal()
La gráfica muestra un crecimiento sostenido y constante del PIB per cápita en Estados Unidos a lo largo del tiempo. Desde aproximadamente 1985 hasta 2015, el PIB per cápita aumentó significativamente, pasando de alrededor de $20,000 a más de $60,000. Aunque la tendencia general es ascendente, se pueden observar pequeñas fluctuaciones alrededor del año 2000 y de nuevo alrededor de 2008, coincidiendo con la burbuja tecnológica y la crisis financiera, respectivamente
ggplot(eu_data_age, aes(x = year, y = avg_gdp, color = age, group = age)) +
geom_line() +
geom_point() +
labs(title = "Evolución del PIB per cápita en Estados Unidos por Grupo de Edad",
x = "Año",
y = "PIB per cápita ($)",
color = "Grupo de Edad") +
theme_minimal()
El IDH en Estados Unidos muestra un aumento constante y significativo a lo largo del tiempo, comenzando desde valores cercanos a 0.80 en 1985 hasta alcanzar valores superiores a 0.92 en 2015. Se observan picos notables en los valores del IDH en diferentes años, seguidos de caídas abruptas, especialmente antes del año 2000. Estos picos podrían estar relacionados con mejoras puntuales en la salud, educación o ingreso per cápita, que son los componentes del IDH. A partir de 2010, el IDH se mantiene en valores superiores a 0.90, lo que refleja un alto nivel de desarrollo humano en Estados Unidos en los años recientes.
ggplot(eu_data_age, aes(x = year, y = avg_hdi, color = age, group = age)) +
geom_line() +
geom_point() +
labs(title = "Evolución del IDH en Estados Unidos por Grupo de Edad",
x = "Año",
y = "IDH",
color = "Grupo de Edad") +
theme_minimal()
Ejercicio 5
- Realice un análisis descriptivo completo y actualizado al julio 31
2024, incluyendo graficos, tablas y georreferenciación de la base de
datos
Accidentalidad_en_Barranquilla.csv. - Contextualizar tanto la base de datos como las variables describiendo en qué consiste cada una de ellas.
- Analizar las características de la base de datos. Estas pueden incluir: número de filas, número de columnas, nombres de las variables, tipos de variables, entre otros.
- Analizar cada una de las variables según su tipo: numéricas y categóricas.
- Filtrar la base de datos para entender mejor su estructura. Aplique filtros en al menos cinco oportunidades.
- Utilice la función
tablepara explorar la base de datos. - Identifique los valores NA (Not Available) en la base de datos.
- Analice la presencia de posibles valores atípicos.
- Aplique imputación de datos usando las siguientes opciones para
method: method="pmm"method="norm.predict"method="norm.nob"method="norm"
- Identifique datos atípicos para cada variable en el dataset usando las técnicas estudiadas en clase. Además, realice imputación de los datos atípicos con base en lo desarrollado en el ítem anterior.
- Imputación/Capping/Predicción, Test de Rosner, Dixon, Grubbs, Hampel, Percentiles, Boxplots, Histogramas, Descriptivos
Análisis Exploratorio inicial de los datos
Inspección de los datos
Observamos el conjunto de datos inical correspondiente a los
registros de accidentes en la ciudad de Barranquilla, donde tenemos 11
variables para los 25610 registros de la información con presencia de
datos faltantes NA en columnas como
cantidad de heridos en acidente,
cantidad de muertos en accidente. Posterior a ello notamos
de acuerdo al nombre de cada variable que hay 6 de tipo caracter, 4 de
tipo numérico y 1 fecha.
library(readr)
ab <- read_csv("Accidentalidad_en_Barranquilla_20240831.csv")## Rows: 25610 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (6): HORA_ACCIDENTE, GRAVEDAD_ACCIDENTE, CLASE_ACCIDENTE, SITIO_EXACTO_...
## dbl (4): CANT_HERIDOS_EN _SITIO_ACCIDENTE, CANT_MUERTOS_EN _SITIO_ACCIDENTE...
## dttm (1): FECHA_ACCIDENTE
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.str(ab)## spc_tbl_ [25,610 × 11] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ FECHA_ACCIDENTE : POSIXct[1:25610], format: "2018-01-01" "2018-01-01" ...
## $ HORA_ACCIDENTE : chr [1:25610] "01:30:00:am" "02:00:00:pm" "04:00:00:am" "04:30:00:am" ...
## $ GRAVEDAD_ACCIDENTE : chr [1:25610] "Con heridos" "Solo daños" "Solo daños" "Solo daños" ...
## $ CLASE_ACCIDENTE : chr [1:25610] "Atropello" "Choque" "Choque" "Choque" ...
## $ SITIO_EXACTO_ACCIDENTE : chr [1:25610] "CL 87 9H 24" "CL 110 CR 46" "AV CIRCUNVALAR CR 9G" "CLLE 72 CRA 29" ...
## $ CANT_HERIDOS_EN _SITIO_ACCIDENTE: num [1:25610] 1 NA NA NA NA 3 1 NA NA NA ...
## $ CANT_MUERTOS_EN _SITIO_ACCIDENTE: num [1:25610] NA NA NA NA NA NA NA NA NA NA ...
## $ CANTIDAD_ACCIDENTES : num [1:25610] 1 1 1 1 1 1 1 1 1 1 ...
## $ AÑO_ACCIDENTE : num [1:25610] 2018 2018 2018 2018 2018 ...
## $ MES_ACCIDENTE : chr [1:25610] "January" "January" "January" "January" ...
## $ DIA_ACCIDENTE : chr [1:25610] "Mon" "Mon" "Mon" "Mon" ...
## - attr(*, "spec")=
## .. cols(
## .. FECHA_ACCIDENTE = col_datetime(format = ""),
## .. HORA_ACCIDENTE = col_character(),
## .. GRAVEDAD_ACCIDENTE = col_character(),
## .. CLASE_ACCIDENTE = col_character(),
## .. SITIO_EXACTO_ACCIDENTE = col_character(),
## .. `CANT_HERIDOS_EN _SITIO_ACCIDENTE` = col_double(),
## .. `CANT_MUERTOS_EN _SITIO_ACCIDENTE` = col_double(),
## .. CANTIDAD_ACCIDENTES = col_double(),
## .. AÑO_ACCIDENTE = col_double(),
## .. MES_ACCIDENTE = col_character(),
## .. DIA_ACCIDENTE = col_character()
## .. )
## - attr(*, "problems")=<externalptr>dim(ab)## [1] 25610 11Con base a los nombres de las variables podemos identificar cuáles son categóricas y cuáles son numéricas.
names(ab)## [1] "FECHA_ACCIDENTE" "HORA_ACCIDENTE"
## [3] "GRAVEDAD_ACCIDENTE" "CLASE_ACCIDENTE"
## [5] "SITIO_EXACTO_ACCIDENTE" "CANT_HERIDOS_EN _SITIO_ACCIDENTE"
## [7] "CANT_MUERTOS_EN _SITIO_ACCIDENTE" "CANTIDAD_ACCIDENTES"
## [9] "AÑO_ACCIDENTE" "MES_ACCIDENTE"
## [11] "DIA_ACCIDENTE"Vista de tabla
Observamos de manera gráfica a través de una tabla la información del
conjunto de datos, en la cual se evidencia la presencia de datos
faltantes en la columna Cantidad de heridos para varias de
las observaciones.
library(knitr)
reactable(ab, searchable = TRUE, pagination = TRUE, defaultPageSize = 10)Resumen Estadístico de los Datos
Cantidad de heridos en el sitio del accidente (CANT_HERIDOS_EN_SITIO_ACCIDENTE): El número de heridos por accidente varía considerablemente, con un rango que va desde 1 hasta 42 heridos en un solo accidente. La mediana, situada en 1, indica que en al menos la mitad de los accidentes se reportó un solo herido. Sin embargo, la media de 1.472 sugiere que hay accidentes con un número de heridos significativamente mayor, lo que podría señalar eventos con múltiples vehículos o situaciones de alta gravedad.Cantidad de muertos en el sitio del accidente (CANT_MUERTOS_EN_SITIO_ACCIDENTE): Similar a la cantidad de heridos, el número de muertos por accidente muestra variabilidad, aunque en menor medida. La mayoría de los accidentes que resultan en fallecimientos tienden a tener solo un muerto, como lo indica tanto la mediana como la media cercanas a 1. Sin embargo, existen registros de accidentes con hasta 2 fallecidos.
summary(ab)## FECHA_ACCIDENTE HORA_ACCIDENTE GRAVEDAD_ACCIDENTE
## Min. :2018-01-01 00:00:00.00 Length:25610 Length:25610
## 1st Qu.:2019-02-02 00:00:00.00 Class :character Class :character
## Median :2020-04-23 12:00:00.00 Mode :character Mode :character
## Mean :2020-07-31 19:57:36.05
## 3rd Qu.:2021-12-13 00:00:00.00
## Max. :2024-06-30 00:00:00.00
##
## CLASE_ACCIDENTE SITIO_EXACTO_ACCIDENTE CANT_HERIDOS_EN _SITIO_ACCIDENTE
## Length:25610 Length:25610 Min. : 1.000
## Class :character Class :character 1st Qu.: 1.000
## Mode :character Mode :character Median : 1.000
## Mean : 1.472
## 3rd Qu.: 2.000
## Max. :42.000
## NA's :15626
## CANT_MUERTOS_EN _SITIO_ACCIDENTE CANTIDAD_ACCIDENTES AÑO_ACCIDENTE
## Min. :1.000 Min. :1 Min. :2018
## 1st Qu.:1.000 1st Qu.:1 1st Qu.:2019
## Median :1.000 Median :1 Median :2020
## Mean :1.036 Mean :1 Mean :2020
## 3rd Qu.:1.000 3rd Qu.:1 3rd Qu.:2021
## Max. :2.000 Max. :2 Max. :2024
## NA's :25358
## MES_ACCIDENTE DIA_ACCIDENTE
## Length:25610 Length:25610
## Class :character Class :character
## Mode :character Mode :character
##
##
##
## Datos categóricos
Distribución de accidentes por día de la semana:
- El
marteses el día con mayor cantidad de accidentes, alcanzando un máximo de 4,009 accidentes, lo que representa el 15.65% del total. - El
domingopresenta el mínimo de accidentes con 2,577 registros, representando el 10.06%.
library(kableExtra)
library(dplyr)
library(knitr)
categorical_vars <- ab %>% select(where(is.character)) %>% colnames()
for(var in categorical_vars) {
freq_table <- ab %>%
group_by_at(var) %>%
summarise(Count = n()) %>%
mutate(Relative_Frequency = round(Count / sum(Count) * 100, 2)) %>%
arrange(desc(Count))
}
reactable(freq_table, searchable = TRUE, pagination = TRUE, defaultPageSize = 10)Revisión de Asimetría y Curtosis
Rangos de curtosis
Platicúrtica (Colas delgadas, menos outliers): Curtosis < 3Mesocúrtica (Distribución normal, colas moderadas: Curtosis igual o cercana a 3.Leptocúrtica (Colas extremadamente pesadas, muchos outliers: Curtosis > 3
library(e1071)
skewness <- apply(ab[,sapply(ab, is.numeric)], 2, skewness, na.rm = TRUE)
kurtosis <- apply(ab[,sapply(ab, is.numeric)], 2, kurtosis, na.rm = TRUE)
data.frame(Variable = names(skewness), Asimetría = skewness, Curtosis = kurtosis)## Variable Asimetría
## CANT_HERIDOS_EN _SITIO_ACCIDENTE CANT_HERIDOS_EN _SITIO_ACCIDENTE 10.066935
## CANT_MUERTOS_EN _SITIO_ACCIDENTE CANT_MUERTOS_EN _SITIO_ACCIDENTE 4.973948
## CANTIDAD_ACCIDENTES CANTIDAD_ACCIDENTES 71.542998
## AÑO_ACCIDENTE AÑO_ACCIDENTE 0.394913
## Curtosis
## CANT_HERIDOS_EN _SITIO_ACCIDENTE 217.2398546
## CANT_MUERTOS_EN _SITIO_ACCIDENTE 22.8308039
## CANTIDAD_ACCIDENTES 5116.6003593
## AÑO_ACCIDENTE -0.9050988CANT_HERIDOS_EN_SITIO_ACCIDENTE (Cantidad de heridos en sitio del accidente):
- Asimetría (Skewness): 10.07, lo que indica una fuerte asimetría positiva. Esto sugiere que la mayoría de los accidentes tienen pocos heridos, pero algunos eventos son extremos con un número muy alto de heridos.
- Curtosis: 217.24, lo que refleja colas extremadamente largas y pesadas, indicando la presencia de eventos atípicos o outliers con números de heridos mucho mayores que la mayoría.
CANT_MUERTOS_EN_SITIO_ACCIDENTE (Cantidad de muertos en sitio del accidente):
- Asimetría (Skewness): 4.97, lo que indica una asimetría positiva moderada. La mayoría de los accidentes tienen pocos o ningún muerto, pero existen algunos casos con un número considerablemente alto de fallecidos.
- Curtosis: 22.83, lo que también sugiere la existencia de outliers significativos, aunque menos extremos que en la variable de heridos.
CANTIDAD_ACCIDENTES (Cantidad de accidentes):
- Asimetría (Skewness): 71.54, una asimetría extremadamente alta que muestra que la mayoría de los registros tienen pocos accidentes, mientras que unos pocos registros tienen números muy elevados.
- Curtosis: 5116.60, indicando colas muy largas y la presencia de múltiples outliers extremos.
Análisis de datos faltantes NA's
Se realiza el conteo de datos faltantes por cada variable y se evidencia la presencia de NA en cantidad de heridos y cantidad de muertos en sitio del accidente. lo que equivale a cerca del 15% de toda nuestra base de datos.
faltantes <- colSums(is.na(ab))
faltantes## FECHA_ACCIDENTE HORA_ACCIDENTE
## 0 0
## GRAVEDAD_ACCIDENTE CLASE_ACCIDENTE
## 0 0
## SITIO_EXACTO_ACCIDENTE CANT_HERIDOS_EN _SITIO_ACCIDENTE
## 0 15626
## CANT_MUERTOS_EN _SITIO_ACCIDENTE CANTIDAD_ACCIDENTES
## 25358 0
## AÑO_ACCIDENTE MES_ACCIDENTE
## 0 0
## DIA_ACCIDENTE
## 0library(VIM)
aggr(ab,
numbers = TRUE,
col = c("navyblue", "red"),
cex.axis = 0.7,
gap = 3,
ylab = c("Proportion of missingness", "Missingness pattern"),
labels = names(ab),
cex.lab = 1.2,
axes = TRUE)
CANT_MUERTOS_EN_SITIO_ACCIDENTE:Esta variable presenta el mayor porcentaje de datos faltantes, con aproximadamente un 100% de valores faltantes. Esto indica que prácticamente no se cuenta con información sobre la cantidad de muertos en el sitio del accidente en este conjunto de datos.CANT_HERIDOS_EN_SITIO_ACCIDENTE:La segunda variable con más datos faltantes, con un poco más del 50% de sus valores faltantes. Esto significa que la mitad de los registros no incluyen información sobre el número de heridos en el sitio del accidente.
library(naniar)
gg_miss_var(ab, show_pct = TRUE)
Distribución de los datos
Se desea analizar la distribución de los datos y observar su comportamiento para determinar algún proceso o método para la imputación de los datos en las variables donde haya observaciones faltantes, luego se realizan pruebas analíticas para confirmas si las muestras provienen de una distribución normal o se debe utilizar otro método no paramétrico para la imputación de datos.
# library(gridExtra)
datos_numericos <- ab[, c("CANT_HERIDOS_EN _SITIO_ACCIDENTE",
"CANT_MUERTOS_EN _SITIO_ACCIDENTE",
"CANTIDAD_ACCIDENTES")]
hist_heridos <- ggplot(ab, aes(x = `CANT_HERIDOS_EN _SITIO_ACCIDENTE`)) +
geom_histogram(binwidth = 1, fill = "lightblue", color = "black") +
ggtitle("Distribución de Heridos") +
xlab("Distribución de Heridos")+
ylab("Número de Heridos")
theme_minimal()
bar_muertos <- ggplot(ab, aes(x = as.factor(`CANT_MUERTOS_EN _SITIO_ACCIDENTE`))) +
geom_bar(fill = "darkblue", color = "black") +
ggtitle("Conteo de Muertos") +
xlab("Número de Muertos en Accidente") +
ylab("Frecuencia") +
theme_minimal()
bar_accidentes <- ggplot(ab, aes(x = as.factor(`CANTIDAD_ACCIDENTES`))) +
geom_bar(fill = "blue", color = "black") +
ggtitle("Conteo de Accidentes") +
xlab("Cantidad de Accidentes") +
ylab("Frecuencia") +
theme_minimal()
grid.arrange(hist_heridos, bar_muertos, bar_accidentes, ncol = 3)
Verifiquemos la normalidad de la variable
CANT_HERIDOS_EN_SITIO_ACCIDENTE en el conjunto de datos. En
un Q-Q plot, si los puntos siguen aproximadamente una línea recta (la
línea roja), se puede concluir que la variable sigue una distribución
normal. Se observa que los puntos se desvían significativamente de la
línea recta, especialmente en los extremos (quantiles más altos y más
bajos). Esto indica que la distribución de la variable
CANT_HERIDOS_EN_SITIO_ACCIDENTE no sigue una distribución
normal.
datos_numericos <- ab[, c("CANT_HERIDOS_EN _SITIO_ACCIDENTE",
"CANT_MUERTOS_EN _SITIO_ACCIDENTE",
"CANTIDAD_ACCIDENTES")]
qqnorm(ab$`CANT_HERIDOS_EN _SITIO_ACCIDENTE`)
qqline(ab$`CANT_HERIDOS_EN _SITIO_ACCIDENTE`, col = "red")
Imputación de datos faltantes
SE realizará el proceso de imputación de datos sobre las variables
CANT_HERIDOS_EN _SITIO_ACCIDENTE y
CANT_MUERTOS_EN _SITIO_ACCIDENTE que presentan una alta
tasa de datos faltantes y adicionalemente, no poseen una distribución
específica, por lo que dada su distribución no especificada el método
más adecuado es Predictive Mean Matching o pmm. Se realizó
la imputación de datos con base a la mediana de los datos y a través del
gráfico de porcentaje para datos faltantes no se evidencia la presencia
de los mismo en nuestro conjunto de datos.
# install.package("cli") no sirve la libreria mice
# install.package("mice")
# library(cli)
# library(mice)
# Imputación por la media para las dos columnas específicas, aproximando al entero más cercano
ab$`CANT_HERIDOS_EN _SITIO_ACCIDENTE`[is.na(ab$`CANT_HERIDOS_EN _SITIO_ACCIDENTE`)] <- round(mean(ab$`CANT_HERIDOS_EN _SITIO_ACCIDENTE`, na.rm = TRUE))
ab$`CANT_MUERTOS_EN _SITIO_ACCIDENTE`[is.na(ab$`CANT_MUERTOS_EN _SITIO_ACCIDENTE`)] <- round(median(ab$`CANT_MUERTOS_EN _SITIO_ACCIDENTE`, na.rm = TRUE))
library(naniar)
gg_miss_var(ab, show_pct = TRUE)
library(VIM)
aggr(ab,
numbers = TRUE,
col = c("navyblue", "red"),
cex.axis = 0.7,
gap = 3,
ylab = c("Proportion of missingness", "Missingness pattern"),
labels = names(ab),
cex.lab = 1.2,
axes = TRUE)
hist_heridos <- ggplot(ab, aes(x = `CANT_HERIDOS_EN _SITIO_ACCIDENTE`)) +
geom_histogram(binwidth = 1, fill = "lightblue", color = "black") +
ggtitle("Distribución de Heridos") +
xlab("Distribución de Heridos")+
ylab("Número de Heridos")
theme_minimal()
bar_muertos <- ggplot(ab, aes(x = as.factor(`CANT_MUERTOS_EN _SITIO_ACCIDENTE`))) +
geom_bar(fill = "darkblue", color = "black") +
ggtitle("Conteo de Muertos") +
xlab("Número de Muertos en Accidente") +
ylab("Frecuencia") +
theme_minimal()
bar_accidentes <- ggplot(ab, aes(x = as.factor(`CANTIDAD_ACCIDENTES`))) +
geom_bar(fill = "blue", color = "black") +
ggtitle("Conteo de Accidentes") +
xlab("Cantidad de Accidentes") +
ylab("Frecuencia") +
theme_minimal()
grid.arrange(hist_heridos, bar_muertos, bar_accidentes, ncol = 3)
Vista en table
Posterior al proceso de imputación en datos faltantes, se
visualizarán las variables mediante filtros para analizar el
comportamiento de nuestros datos y evidenciar la presencia u ausencia de
datos atípicos. Primero analizaremos a través table la
proporción o relación entre la gravedad de los accidentes, la clase del
accidentes durante los diferentes meses del año.
Accidentes con heridos:
- El número de accidentes con heridos varía mes a mes. Marzo y enero presentan una alta incidencia con más de 740 accidentes en cada mes.
- Atropello, caída de ocupante, y choque son las clases de accidente más comunes en estos casos. Los meses con más accidentes de este tipo incluyen marzo, enero, y junio.
Accidentes con muertos:
- Aunque menos frecuentes, los accidentes con muertos se presentan de forma constante a lo largo del año, con algunos picos notables en septiembre (14 muertos) y marzo (8 muertos).
- Choque y atropello son las clases de accidentes que más frecuentemente resultan en muertes.
- Enero y septiembre son los meses con más fallecidos en accidentes de tránsito.
Accidentes con solo daños:
- Los accidentes que resultan solo en daños materiales son mucho más comunes que los otros tipos, con cifras que varían entre 1,150 y 1,521 accidentes mensuales.
- Choque es, de lejos, la clase de accidente más común en esta categoría.
- Febrero, marzo y enero son los meses con la mayor cantidad de estos accidentes.
library(reactable)
meses_ordenados <- c("January", "February", "March", "April", "May", "June",
"July", "August", "September", "October", "November", "December")
table_multiple_df <- as.data.frame(table(ab$GRAVEDAD_ACCIDENTE, ab$CLASE_ACCIDENTE, factor(ab$MES_ACCIDENTE, levels = meses_ordenados)))
reactable(
table_multiple_df,
pagination = TRUE, # Habilitar paginación
searchable = TRUE, # Habilitar búsqueda
striped = TRUE, # Añadir bandas a las filas
highlight = TRUE, # Resaltar las filas al pasar el cursor
columns = list(
Var1 = colDef(name = "Gravedad del Accidente"),
Var2 = colDef(name = "Clase de Accidente"),
Var3 = colDef(name = "Mes del Accidente"),
Freq = colDef(name = "Frecuencia")
),
defaultPageSize = 10, # Tamaño de página por defecto
showPageSizeOptions = TRUE, # Mostrar opciones para cambiar el tamaño de la página
pageSizeOptions = c(5, 10, 20), # Opciones de tamaño de página
bordered = TRUE, # Bordes en la tabla
compact = TRUE # Compactar el espacio en la tabla
)Filtrado de datos
Heridos:
- Promedio: En general, el número de heridos por mes varía entre 15 y 41.
- Máximo: El mayor número de heridos se registró en octubre, con 41 personas heridas.
- Mínimo: El menor número de heridos ocurrió en julio, con 15 personas heridas.
- Meses Críticos: Octubre (41 heridos), junio (37 heridos) y febrero/marzo (38 heridos cada uno) son los meses con más heridos.
Muertos:
- Promedio: El número de muertos por mes es generalmente bajo, con la mayoría de los meses registrando entre 0 y 3 muertes.
- Máximo: Los máximos de 3 muertes ocurrieron en enero y junio.
- Mínimo: En mayo y diciembre no se registraron muertes, lo que sugiere que estos meses fueron los más seguros en términos de fatalidades.
library(dplyr)
atropello_weekend <- ab %>%
filter(CLASE_ACCIDENTE == "Atropello" & DIA_ACCIDENTE %in% c("Sat", "Sun"))
tabla_atropello <- table(atropello_weekend$GRAVEDAD_ACCIDENTE,
atropello_weekend$CANTIDAD_ACCIDENTES,
factor(atropello_weekend$MES_ACCIDENTE, levels = meses_ordenados))
tabla_atropello_df <- as.data.frame(tabla_atropello)
reactable(tabla_atropello_df,
columns = list(
Var1 = colDef(name = "Gravedad del Accidente"),
Var2 = colDef(name = "Cantidad de Accidentes"),
Var3 = colDef(name = "Mes del Accidente"),
Freq = colDef(name = "Frecuencia")
),
pagination = TRUE,
defaultPageSize = 10,
bordered = TRUE,
highlight = TRUE,
searchable = TRUE)Filtro de choques entre semana
Los accidentes tipo Choque que ocurren en los días
laborables (lunes a viernes) en Barranquilla son en su mayoría
incidentes que no involucran heridos ni muertes, predominando los casos
categorizados como “Solo daños”. La gravedad de estos accidentes es
generalmente baja, lo que sugiere que aunque los choques son comunes, no
resultan en eventos de alta gravedad.
library(dplyr)
choque_weekday <- ab %>%
filter(CLASE_ACCIDENTE == "Choque" & DIA_ACCIDENTE %in% c("Mon", "Tue", "Wed", "Thu", "Fri"))
reactable(choque_weekday,
columns = list(
GRAVEDAD_ACCIDENTE = colDef(name = "Gravedad del Accidente"),
CANTIDAD_ACCIDENTES = colDef(name = "Cantidad de Accidentes"),
MES_ACCIDENTE = colDef(name = "Mes del Accidente"),
DIA_ACCIDENTE = colDef(name = "Día del Accidente"),
`CANT_HERIDOS_EN _SITIO_ACCIDENTE` = colDef(name = "Cantidad de Heridos"),
`CANT_MUERTOS_EN _SITIO_ACCIDENTE` = colDef(name = "Cantidad de Muertos")
),
pagination = TRUE,
defaultPageSize = 10,
bordered = TRUE,
highlight = TRUE,
searchable = TRUE)Filtro por número elevado de heridos
- Los accidentes con más de 10 heridos tienen un promedio de 14.4 heridos por evento.
- El mayor número de heridos en un solo accidente registrado es de 22 personas.
- El menor número de heridos en estos accidentes es 11 personas.
- La mayoría de los accidentes graves con un alto número de heridos tienen entre 11 y 22 heridos.
library(dplyr)
heridos_mayores <- ab %>%
filter(`CANT_HERIDOS_EN _SITIO_ACCIDENTE` > 10)
reactable(heridos_mayores,
columns = list(
GRAVEDAD_ACCIDENTE = colDef(name = "Gravedad del Accidente"),
CANTIDAD_ACCIDENTES = colDef(name = "Cantidad de Accidentes"),
MES_ACCIDENTE = colDef(name = "Mes del Accidente"),
DIA_ACCIDENTE = colDef(name = "Día del Accidente"),
`CANT_HERIDOS_EN _SITIO_ACCIDENTE` = colDef(name = "Cantidad de Heridos"),
`CANT_MUERTOS_EN _SITIO_ACCIDENTE` = colDef(name = "Cantidad de Muertos")
),
pagination = TRUE,
defaultPageSize = 10,
bordered = TRUE,
highlight = TRUE,
searchable = TRUE)Número elevado de muertos
Los accidentes con más de un muerto en Barranquilla representan eventos de alta gravedad y mortalidad, con un patrón recurrente de 2 muertos por evento. Estos accidentes también suelen tener varios heridos, lo que refuerza la necesidad de implementar medidas de seguridad vial más estrictas y rápidas intervenciones en las áreas más afectadas.
library(dplyr)
muertos_mayores <- ab %>%
filter(`CANT_MUERTOS_EN _SITIO_ACCIDENTE` > 1)
reactable(muertos_mayores,
columns = list(
GRAVEDAD_ACCIDENTE = colDef(name = "Gravedad del Accidente"),
CANTIDAD_ACCIDENTES = colDef(name = "Cantidad de Accidentes"),
MES_ACCIDENTE = colDef(name = "Mes del Accidente"),
DIA_ACCIDENTE = colDef(name = "Día del Accidente"),
`CANT_HERIDOS_EN _SITIO_ACCIDENTE` = colDef(name = "Cantidad de Heridos"),
`CANT_MUERTOS_EN _SITIO_ACCIDENTE` = colDef(name = "Cantidad de Muertos")
),
pagination = TRUE,
defaultPageSize = 10,
bordered = TRUE,
highlight = TRUE,
searchable = TRUE)Incendio los fines de semana
Los datos incluyen tanto accidentes con “Solo daños” como con “Con heridos”, indicando que aunque hay lesiones en algunos casos, en otros solo se reportaron daños materiales y todos los registros incluyen 1 muerto por accidente. La consistencia en el número de heridos y muertos en cada accidente resalta la gravedad de estos eventos y subraya la necesidad de medidas preventivas adicionales, especialmente durante los fines de semana.
library(dplyr)
incendio_weekend <- ab %>%
filter(CLASE_ACCIDENTE == "Incendio" & DIA_ACCIDENTE %in% c("Sat", "Sun"))
reactable(incendio_weekend,
columns = list(
GRAVEDAD_ACCIDENTE = colDef(name = "Gravedad del Accidente"),
CANTIDAD_ACCIDENTES = colDef(name = "Cantidad de Accidentes"),
MES_ACCIDENTE = colDef(name = "Mes del Accidente"),
DIA_ACCIDENTE = colDef(name = "Día del Accidente"),
`CANT_HERIDOS_EN _SITIO_ACCIDENTE` = colDef(name = "Cantidad de Heridos"),
`CANT_MUERTOS_EN _SITIO_ACCIDENTE` = colDef(name = "Cantidad de Muertos")
),
pagination = TRUE,
defaultPageSize = 10,
bordered = TRUE,
highlight = TRUE,
searchable = TRUE)Análisis de datos atípicos
Se decide realizar un análisis o inspección de datos atípicos en las
variables numéricas de nuestro interés, entre las que señalamos,
CANT_HERIDOS_EN _SITIO_ACCIDENTE,
CANT_MUERTOS_EN _SITIO_ACCIDENTE,
CANTIDAD_ACCIDENTES. Se hace una inspección visual a través
de cajas y bigotes y un diagrama de violín.
La mayoría de los datos están agrupados cerca de la línea central del boxplot. Esto sugiere que la mayoría de los accidentes tienen un número bajo de heridos, sin embargo, los valores atípicos están claramente visibles y dispersos en la gráfica, lo que indica la presencia de incidentes extremos en términos del número de heridos. Analizaremos de forma más aumentada estos datos atípicos.
Análisis para la variable
CANT_HERIDOS_EN _SITIO_ACCIDENTE
library(ggplot2)
library(gridExtra)
ggplot(ab, aes(y = `CANT_HERIDOS_EN _SITIO_ACCIDENTE`)) +
geom_boxplot(fill = "lightblue", color = "black") +
ggtitle("Diagrama de Cajas y Bigotes: Heridos en el Sitio del Accidente") +
xlab("Cantidad de Heridos en el Sitio del Accidente") +
ylab("Número de heridos") +
theme_minimal() +
coord_flip()
ggplot(ab, aes(x = factor(0), y = `CANT_HERIDOS_EN _SITIO_ACCIDENTE`)) +
geom_violin(fill = "navyblue", color = "black") +
ggtitle("Diagrama de Violín: Heridos en el Sitio del Accidente") +
xlab("Cantidad de Heridos en el Sitio del Accidente") +
ylab("Número de heridos") +
theme_minimal() +
coord_flip()
Los valores atípicos se repiten frecuentemente, especialmente el valor “2”, que aparece múltiples veces en los datos. Esto sugiere que el valor “2” se considera atípico en muchas de las observaciones, lo cual puede ser debido a que en la mayoría de los accidentes no se reportan heridos o solo hay uno, por lo que la presencia de más de un herido podría considerarse inusual. La mayoría de los valores atípicos están en el rango bajo, con valores como “2” y “3” siendo los más comunes. Sin embargo, también hay valores notablemente más altos, como “11”, “20”, y “42”, que representan situaciones extremas con un número considerable de heridos.
library(reactable)
out <- boxplot.stats(ab$`CANT_HERIDOS_EN _SITIO_ACCIDENTE`)$out
out_ind <- which(ab$`CANT_HERIDOS_EN _SITIO_ACCIDENTE` %in% c(out))
atipicos <- ab[out_ind, ]
reactable(atipicos,
columns = list(
FECHA_ACCIDENTE = colDef(name = "Fecha del Accidente"),
HORA_ACCIDENTE = colDef(name = "Hora del Accidente"),
GRAVEDAD_ACCIDENTE = colDef(name = "Gravedad del Accidente"),
CLASE_ACCIDENTE = colDef(name = "Clase del Accidente"),
SITIO_EXACTO_ACCIDENTE = colDef(name = "Sitio Exacto del Accidente"),
`CANT_HERIDOS_EN _SITIO_ACCIDENTE` = colDef(name = "Cantidad de Heridos"),
`CANT_MUERTOS_EN _SITIO_ACCIDENTE` = colDef(name = "Cantidad de Muertos"),
`CANTIDAD_ACCIDENTES` = colDef(name = "Cantidad de Accidentes"),
AÑO_ACCIDENTE = colDef(name = "Año del Accidente"),
MES_ACCIDENTE = colDef(name = "Mes del Accidente"),
DIA_ACCIDENTE = colDef(name = "Día del Accidente")
),
pagination = TRUE, # Habilitar la paginación
defaultPageSize = 10, # Tamaño de página predeterminado
bordered = TRUE, # Borde de la tabla
highlight = TRUE, # Resaltar filas al pasar el mouse
searchable = TRUE) # Habilitar búsquedaFiltro de Hampel para atípicos
Otro método, conocido como filtro de Hampel, consiste en considerar como valores atípicos los valores fuera del intervalo formado por la mediana, más o menos 3 desviaciones absolutas de la mediana:
- \(I=[\hat{X}−3⋅MAD, \hat{X}+3⋅MA]\):
donde MAD es la desviación absoluta de la mediana y se define como la mediana de las desviaciones absolutas de la mediana \(\hat{X}\) de los datos:
- \(MAD=k×median(|Xi−\hat{X}|)\)
Para este método, primero establecemos los límites del intervalo,
gracias a las funciones median() y mad(). En
este caso, k representa el factor de escala, por defecto, R lo considera
como 1. Para la variable CANT_HERIDOS_EN _SITIO_ACCIDENTE
los valores inferiores a 1 y superiores a 1 se
consideran datos atípicos.
lower_bound <- median(ab$`CANT_HERIDOS_EN _SITIO_ACCIDENTE`) - 3 * mad(ab$`CANT_HERIDOS_EN _SITIO_ACCIDENTE`, constant = 1)
cat("La parte inferior de los datos es:", lower_bound, "\n")## La parte inferior de los datos es: 1upper_bound <- median(ab$`CANT_HERIDOS_EN _SITIO_ACCIDENTE`) + 3 * mad(ab$`CANT_HERIDOS_EN _SITIO_ACCIDENTE`, constant = 1)
cat("La parte superior de los datos es:", upper_bound, "\n")## La parte superior de los datos es: 1Pruebas analíticas para datos atípicos
Prueba Rosner
La prueba de Rosner para detectar valores atípicos tiene
las siguientes ventajas. Se utiliza para detectar varios valores
atípicos a la vez (a diferencia de la prueba de Grubbs y Dixon, que debe
realizarse de forma iterativa para detectar múltiples valores atípicos),
y está diseñado para evitar el problema del enmascaramiento, en el que
un valor atípico cercano a otro atípico puede pasar desapercibido. A
diferencia de la prueba de Dixon, hay que tener en cuenta que la prueba
de Rosner es más apropiada cuando el tamaño de la muestra es grande
\((n≥20)\).
library(EnvStats)
test <- rosnerTest(ab$`CANT_HERIDOS_EN _SITIO_ACCIDENTE`, k = 500)
tabla_stats <- as.data.frame(test$all.stats)
colnames(tabla_stats) <- c("Index", "Mean", "Standard Deviation", "Value",
"Number of Observations", "R.i+1", "Lambda i+1", "Outlier")
reactable(tabla_stats,
columns = list(
Index = colDef(name = "Index"),
Mean = colDef(name = "Mean"),
`Standard Deviation` = colDef(name = "Standard Deviation"),
Value = colDef(name = "Value"),
`Number of Observations` = colDef(name = "Number of Observations"),
`R.i+1` = colDef(name = "R.i+1"),
`Lambda i+1` = colDef(name = "Lambda i+1"),
Outlier = colDef(name = "Outlier")
),
pagination = TRUE, # Habilitar la paginación
defaultPageSize = 10, # Tamaño de página predeterminado
bordered = TRUE, # Borde de la tabla
highlight = TRUE, # Resaltar filas al pasar el mouse
searchable = TRUE) # Habilitar búsquedaImputación ante datos atípicos
Se realizará el proceso de imputación a los datos atipicos a través
del método capping, es decir, para los valores que se
encuentran fuera de los límites de \(1.5⋅IQR\) podríamos poner un tope
sustituyendo las observaciones que se encuentran fuera del límite
inferior por el valor del 5th percentil y las que se encuentran por
encima del límite superior, por el valor del 95th percentil. Posterior a
ellos, visualizamos graficamente los valores atípicos y no evidenciamos
sino únicamente 1 dato atípico por fuera de la malla de imputación, si
deseamos normalizarlo, podemor observarlo a través de la prueba
Grubbs.
library(reactable)
# Proceso para generar los datos con capping
x <- ab$`CANT_HERIDOS_EN _SITIO_ACCIDENTE`
qnt <- quantile(x, probs=c(.25, .75), na.rm = TRUE) # Cuartiles
caps <- quantile(x, probs=c(.05, .95), na.rm = TRUE) # Percentiles 5th, 95th
H <- 1.5 * IQR(x, na.rm = TRUE)
x_original <- ab$`CANT_HERIDOS_EN _SITIO_ACCIDENTE` # Guardar los valores originales
x[x < (qnt[1] - H)] <- caps[1]
x[x > (qnt[2] + H)] <- caps[2]
# Crear un data frame para mostrar los resultados
data_frame <- data.frame(
Original = x_original,
Transformed = x,
Lower_Bound = caps[1],
Upper_Bound = caps[2]
)## Warning in data.frame(Original = x_original, Transformed = x, Lower_Bound =
## caps[1], : row names were found from a short variable and have been discarded# Crear la tabla con reactable
reactable(data_frame,
columns = list(
Original = colDef(name = "Original Values"),
Transformed = colDef(name = "Transformed Values"),
Lower_Bound = colDef(name = "Lower Bound (5th Percentile)"),
Upper_Bound = colDef(name = "Upper Bound (95th Percentile)")
),
pagination = TRUE, # Habilitar la paginación
defaultPageSize = 10, # Tamaño de página predeterminado
bordered = TRUE, # Borde de la tabla
highlight = TRUE, # Resaltar filas al pasar el mouse
searchable = TRUE) # Habilitar búsquedalibrary(ggplot2)
library(gridExtra)
ggplot(ab, aes(y = `CANT_HERIDOS_EN _SITIO_ACCIDENTE`)) +
geom_boxplot(fill = "lightblue", color = "black") +
ggtitle("Diagrama de Cajas y Bigotes: Heridos en el Sitio del Accidente") +
xlab("Cantidad de Heridos en el Sitio del Accidente") +
ylab("Número de heridos") +
theme_minimal() +
coord_flip()
ggplot(ab, aes(x = factor(0), y = `CANT_HERIDOS_EN _SITIO_ACCIDENTE`)) +
geom_violin(fill = "navyblue", color = "black") +
ggtitle("Diagrama de Violín: Heridos en el Sitio del Accidente") +
xlab("Cantidad de Heridos en el Sitio del Accidente") +
ylab("Número de heridos") +
theme_minimal() +
coord_flip()
Prueba de Grubbs para último dato superior atípico
La prueba de Grubbs permite detectar si el valor más alto o más bajo de un conjunto de datos es un valor atípico (ver Grubbs). La prueba de Grubbs detecta un valor atípico cada vez (valor más alto o más bajo), por lo que las hipótesis nula y alternativa son las siguientes:
- \(H0\): El valor más alto/bajo no es un valor atípico
- \(H1\): El valor más alto/bajo es un valor atípico
La función recibe los siguientes argumentos:
grubbs.test(x, type = 10, opposite = FALSE, two.sided = FALSE).
En este caso, type:
- 10 = prueba si el valor máximo es un valor atípico.
- 11 = prueba si tanto el valor mínimo como el máximo son valores atípicos.
- 20 = prueba si hay dos valores atípicos en una cola.
Dado que p-valor < alfa, no se rechaza la ipótesis nula, por tanto el dato 42 es un atípico y debemos alterarlo a través d eun método de imputación. Tomaremos el valor de 1 como suplente para dicho valor.
library(outliers)
test <- grubbs.test(ab$`CANT_HERIDOS_EN _SITIO_ACCIDENTE`, type = 10, opposite = FALSE, two.sided = FALSE)
test##
## Grubbs test for one outlier
##
## data: ab$`CANT_HERIDOS_EN _SITIO_ACCIDENTE`
## G = 53.84872, U = 0.88677, p-value < 2.2e-16
## alternative hypothesis: highest value 42 is an outlierout_ind <- which(ab$`CANT_HERIDOS_EN _SITIO_ACCIDENTE` == 42)
percentil_5 <- quantile(ab$`CANT_HERIDOS_EN _SITIO_ACCIDENTE`, probs = 0.05, na.rm = TRUE)
ab$`CANT_HERIDOS_EN _SITIO_ACCIDENTE`[out_ind] <- percentil_5
ggplot(ab, aes(y = `CANT_HERIDOS_EN _SITIO_ACCIDENTE`)) +
geom_boxplot(fill = "lightblue", color = "black") +
ggtitle("Diagrama de Cajas y Bigotes: Heridos en el Sitio del Accidente") +
xlab("Cantidad de Heridos en el Sitio del Accidente") +
ylab("Número de heridos") +
theme_minimal() +
coord_flip()
Análisis para la variable
CANT_MUERTOS_EN _SITIO_ACCIDENTE
Se evidencia la presencia de valores atípicos en la variable de cantidad de muesrtos en el sitio de accidentepara los datos mayores que 1 y menores que 1.
ggplot(ab, aes(y = `CANT_MUERTOS_EN _SITIO_ACCIDENTE`)) +
geom_boxplot(fill = "lightblue", color = "black") +
ggtitle("Diagrama de Cajas y Bigotes: Muertos en el Sitio del Accidente") +
ylab("Cantidad de Muertos en el Sitio del Accidente") +
theme_minimal() +
coord_flip()
ggplot(ab, aes(y = `CANT_MUERTOS_EN _SITIO_ACCIDENTE`, x = factor(0))) +
geom_violin(fill = "navyblue", color = "black") +
ggtitle("Diagrama de Violín: Muertos en el Sitio del Accidente") +
ylab("Cantidad de Muertos en el Sitio del Accidente") +
theme_minimal() +
coord_flip()
library(reactable)
out <- boxplot.stats(ab$`CANT_MUERTOS_EN _SITIO_ACCIDENTE`)$out
out_ind <- which(ab$`CANT_MUERTOS_EN _SITIO_ACCIDENTE` %in% c(out))
atipicos <- ab[out_ind, ]
reactable(atipicos,
columns = list(
FECHA_ACCIDENTE = colDef(name = "Fecha del Accidente"),
HORA_ACCIDENTE = colDef(name = "Hora del Accidente"),
GRAVEDAD_ACCIDENTE = colDef(name = "Gravedad del Accidente"),
CLASE_ACCIDENTE = colDef(name = "Clase del Accidente"),
SITIO_EXACTO_ACCIDENTE = colDef(name = "Sitio Exacto del Accidente"),
`CANT_HERIDOS_EN _SITIO_ACCIDENTE` = colDef(name = "Cantidad de Heridos"),
`CANT_MUERTOS_EN _SITIO_ACCIDENTE` = colDef(name = "Cantidad de Muertos"),
`CANTIDAD_ACCIDENTES` = colDef(name = "Cantidad de Accidentes"),
AÑO_ACCIDENTE = colDef(name = "Año del Accidente"),
MES_ACCIDENTE = colDef(name = "Mes del Accidente"),
DIA_ACCIDENTE = colDef(name = "Día del Accidente")
),
pagination = TRUE, # Habilitar la paginación
defaultPageSize = 10, # Tamaño de página predeterminado
bordered = TRUE, # Borde de la tabla
highlight = TRUE, # Resaltar filas al pasar el mouse
searchable = TRUE) # Habilitar búsquedaFiltro de Hampel para atípicos
Para la variable CANT_MUERTOS_EN _SITIO_ACCIDENTE los
valores inferiores a 1 y superiores a 1 se
consideran datos atípicos.
lower_bound <- median(ab$`CANT_MUERTOS_EN _SITIO_ACCIDENTE`) - 3 * mad(ab$`CANT_MUERTOS_EN _SITIO_ACCIDENTE`, constant = 1)
cat("La parte inferior de los datos es:", lower_bound, "\n")## La parte inferior de los datos es: 1upper_bound <- median(ab$`CANT_MUERTOS_EN _SITIO_ACCIDENTE`) + 3 * mad(ab$`CANT_MUERTOS_EN _SITIO_ACCIDENTE`, constant = 1)
cat("La parte superior de los datos es:", upper_bound, "\n")## La parte superior de los datos es: 1Pruebas analíticas para datos atípicos
Prueba Rosner
En cada iteración, un valor de 2 fue identificado como atípico. Esto sugiere que en las iteraciones iniciales, la Prueba de Rosner ha encontrado varios casos donde el valor 2 es significativamente diferente del resto de los datos.
library(EnvStats)
test <- rosnerTest(ab$`CANT_MUERTOS_EN _SITIO_ACCIDENTE`, k = 40)
tabla_stats <- as.data.frame(test$all.stats)
colnames(tabla_stats) <- c("Index", "Mean", "Standard Deviation", "Value",
"Number of Observations", "R.i+1", "Lambda i+1", "Outlier")
reactable(tabla_stats,
columns = list(
Index = colDef(name = "Index"),
Mean = colDef(name = "Mean"),
`Standard Deviation` = colDef(name = "Standard Deviation"),
Value = colDef(name = "Value"),
`Number of Observations` = colDef(name = "Number of Observations"),
`R.i+1` = colDef(name = "R.i+1"),
`Lambda i+1` = colDef(name = "Lambda i+1"),
Outlier = colDef(name = "Outlier")
),
pagination = TRUE, # Habilitar la paginación
defaultPageSize = 10, # Tamaño de página predeterminado
bordered = TRUE, # Borde de la tabla
highlight = TRUE, # Resaltar filas al pasar el mouse
searchable = TRUE) # Habilitar búsquedaImputación ante datos atípicos
Se realizará el proceso de imputación a los datos atipicos a través
del método capping, es decir, para los valores que se
encuentran fuera de los límites de \(1.5⋅IQR\) podríamos poner un tope
sustituyendo las observaciones que se encuentran fuera del límite
inferior por el valor del 5th percentil y las que se encuentran por
encima del límite superior, por el valor del 95th percentil. Posterior a
ellos, visualizamos graficamente los valores atípicos y no evidenciamos
sino únicamente 1 dato atípico por fuera de la malla de imputación, si
deseamos normalizarlo, podemor observarlo a través de la prueba
Grubbs.
library(reactable)
x <- ab$`CANT_MUERTOS_EN _SITIO_ACCIDENTE`
qnt <- quantile(x, probs=c(.25, .75), na.rm = TRUE) # Cuartiles
caps <- quantile(x, probs=c(.05, .95), na.rm = TRUE) # Percentiles 5th, 95th
H <- 1.5 * IQR(x, na.rm = TRUE)
x_original <- ab$`CANT_MUERTOS_EN _SITIO_ACCIDENTE` # Guardar los valores originales
x[x < (qnt[1] - H)] <- caps[1]
x[x > (qnt[2] + H)] <- caps[2]
# Crear un data frame para mostrar los resultados
data_frame <- data.frame(
Original = x_original,
Transformed = x,
Lower_Bound = caps[1],
Upper_Bound = caps[2]
)## Warning in data.frame(Original = x_original, Transformed = x, Lower_Bound =
## caps[1], : row names were found from a short variable and have been discarded# Crear la tabla con reactable
reactable(data_frame,
columns = list(
Original = colDef(name = "Original Values"),
Transformed = colDef(name = "Transformed Values"),
Lower_Bound = colDef(name = "Lower Bound (5th Percentile)"),
Upper_Bound = colDef(name = "Upper Bound (95th Percentile)")
),
pagination = TRUE, # Habilitar la paginación
defaultPageSize = 10, # Tamaño de página predeterminado
bordered = TRUE, # Borde de la tabla
highlight = TRUE, # Resaltar filas al pasar el mouse
searchable = TRUE) # Habilitar búsquedalibrary(ggplot2)
library(gridExtra)
ggplot(ab, aes(y = `CANT_MUERTOS_EN _SITIO_ACCIDENTE`)) +
geom_boxplot(fill = "lightblue", color = "black") +
ggtitle("Diagrama de Cajas y Bigotes: Heridos en el Sitio del Accidente") +
xlab("Cantidad de Heridos en el Sitio del Accidente") +
ylab("Número de heridos") +
theme_minimal() +
coord_flip()
ggplot(ab, aes(x = factor(0), y = `CANT_MUERTOS_EN _SITIO_ACCIDENTE`)) +
geom_violin(fill = "navyblue", color = "black") +
ggtitle("Diagrama de Violín: Heridos en el Sitio del Accidente") +
xlab("Cantidad de Heridos en el Sitio del Accidente") +
ylab("Número de heridos") +
theme_minimal() +
coord_flip()
Prueba de Grubbs para último dato superior atípico
La prueba de Grubbs permite detectar si el valor más alto o más bajo de un conjunto de datos es un valor atípico (ver Grubbs). La prueba de Grubbs detecta un valor atípico cada vez (valor más alto o más bajo), por lo que las hipótesis nula y alternativa son las siguientes:
\(H0\): El valor más alto/bajo no es un valor atípico
\(H1\): El valor más alto/bajo es un valor atípico
10 = prueba si el valor máximo es un valor atípico.
11 = prueba si tanto el valor mínimo como el máximo son valores atípicos.
20 = prueba si hay dos valores atípicos en una cola.
Dado que p-valor < alfa, no se rechaza la ipótesis nula, por tanto el dato 42 es un atípico y debemos alterarlo a través d eun método de imputación. Tomaremos el valor de 1 como suplente para dicho valor.
library(outliers)
test <- grubbs.test(ab$`CANT_MUERTOS_EN _SITIO_ACCIDENTE`, type = 10, opposite = FALSE, two.sided = FALSE)
test##
## Grubbs test for one outlier
##
## data: ab$`CANT_MUERTOS_EN _SITIO_ACCIDENTE`
## G = 53.33333, U = 0.88892, p-value < 2.2e-16
## alternative hypothesis: highest value 2 is an outlierout_ind <- which(ab$`CANT_MUERTOS_EN _SITIO_ACCIDENTE` == 2)
percentil_5 <- quantile(ab$`CANT_MUERTOS_EN _SITIO_ACCIDENTE`, probs = 0.05, na.rm = TRUE)
ab$`CANT_MUERTOS_EN _SITIO_ACCIDENTE`[out_ind] <- percentil_5
ggplot(ab, aes(y = `CANT_MUERTOS_EN _SITIO_ACCIDENTE`)) +
geom_boxplot(fill = "lightblue", color = "black") +
ggtitle("Diagrama de Cajas y Bigotes: Heridos en el Sitio del Accidente") +
xlab("Cantidad de Heridos en el Sitio del Accidente") +
ylab("Número de heridos") +
theme_minimal() +
coord_flip()
Análisis de datos atípicos para la variable
Cantidad de Accidentes
Inspeccionamos graficamente la variable y observamos la presencia de datos atípicos por encima de 1 accidente por día, por lo que procedemos a analizarlo medianteel test de grubbs
ggplot(ab, aes(y = `CANTIDAD_ACCIDENTES`)) +
geom_boxplot(fill = "lightblue", color = "black") +
ggtitle("Diagrama de Cajas y Bigotes: Cantidad de Accidentes") +
xlab("Cantidad de Accidentes") +
ylab("Cantidad de Accidentes") +
theme_minimal() +
coord_flip()
ggplot(ab, aes(y = `CANTIDAD_ACCIDENTES`, x = factor(0))) +
geom_violin(fill = "navyblue", color = "black") +
ggtitle("Diagrama de Violín: Cantidad de Accidentes") +
xlab("") +
ylab("Cantidad de Accidentes") +
theme_minimal() +
coord_flip()
library(reactable)
out <- boxplot.stats(ab$`CANT_MUERTOS_EN _SITIO_ACCIDENTE`)$out
out_ind <- which(ab$`CANT_MUERTOS_EN _SITIO_ACCIDENTE` %in% c(out))
atipicos <- ab[out_ind, ]
reactable(atipicos,
columns = list(
FECHA_ACCIDENTE = colDef(name = "Fecha del Accidente"),
HORA_ACCIDENTE = colDef(name = "Hora del Accidente"),
GRAVEDAD_ACCIDENTE = colDef(name = "Gravedad del Accidente"),
CLASE_ACCIDENTE = colDef(name = "Clase del Accidente"),
SITIO_EXACTO_ACCIDENTE = colDef(name = "Sitio Exacto del Accidente"),
`CANT_HERIDOS_EN _SITIO_ACCIDENTE` = colDef(name = "Cantidad de Heridos"),
`CANT_MUERTOS_EN _SITIO_ACCIDENTE` = colDef(name = "Cantidad de Muertos"),
`CANTIDAD_ACCIDENTES` = colDef(name = "Cantidad de Accidentes"),
AÑO_ACCIDENTE = colDef(name = "Año del Accidente"),
MES_ACCIDENTE = colDef(name = "Mes del Accidente"),
DIA_ACCIDENTE = colDef(name = "Día del Accidente")
),
pagination = TRUE, # Habilitar la paginación
defaultPageSize = 10, # Tamaño de página predeterminado
bordered = TRUE, # Borde de la tabla
highlight = TRUE, # Resaltar filas al pasar el mouse
searchable = TRUE) # Habilitar búsquedaPrueba de Grubbs para último dato superior atípico
La prueba de Grubbs permite detectar si el valor más alto o más bajo de un conjunto de datos es un valor atípico (ver Grubbs). La prueba de Grubbs detecta un valor atípico cada vez (valor más alto o más bajo), por lo que las hipótesis nula y alternativa son las siguientes:
\(H0\): El valor más alto/bajo no es un valor atípico
\(H1\): El valor más alto/bajo es un valor atípico
10 = prueba si el valor máximo es un valor atípico.
11 = prueba si tanto el valor mínimo como el máximo son valores atípicos.
20 = prueba si hay dos valores atípicos en una cola.
Dado que p-valor < alfa, no se rechaza la ipótesis nula, por tanto el dato 42 es un atípico y debemos alterarlo a través d eun método de imputación. Tomaremos el valor de 1 como suplente para dicho valor.
library(outliers)
test <- grubbs.test(ab$`CANT_MUERTOS_EN _SITIO_ACCIDENTE`, type = 10, opposite = FALSE, two.sided = FALSE)
test##
## Grubbs test for one outlier
##
## data: ab$`CANT_MUERTOS_EN _SITIO_ACCIDENTE`
## G = NaN, U = NaN, p-value < 2.2e-16
## alternative hypothesis: highest value 1 is an outlierout_ind <- which(ab$`CANT_MUERTOS_EN _SITIO_ACCIDENTE` == 2)
percentil_5 <- quantile(ab$`CANT_MUERTOS_EN _SITIO_ACCIDENTE`, probs = 0.05, na.rm = TRUE)
ab$`CANT_HERIDOS_EN _SITIO_ACCIDENTE`[out_ind] <- percentil_5
ggplot(ab, aes(y = `CANT_MUERTOS_EN _SITIO_ACCIDENTE`)) +
geom_boxplot(fill = "lightblue", color = "black") +
ggtitle("Diagrama de Cajas y Bigotes: Heridos en el Sitio del Accidente") +
xlab("Cantidad de Heridos en el Sitio del Accidente") +
ylab("Número de heridos") +
theme_minimal() +
coord_flip()