Actividades

Author

Kelly Beltran

Actividad Práctica 3 - R:

Existen varias señales correlacionadas con el aumento de las tasas de suicidios mundial, este conjunto de datos fue creado para encontrar este tipo de señales y contiene 27,820 observaciones que aportan información tanto socioeconómica como demográfica de cada país.

Las variables son:

suicides/100k: suicidios por cada 100 mil habitantes (tasas de suicidio).
country: país.
year: año.
sex: género (male, female).
age: edad (grupo de edad).
suicides_no: número de suicidios.
population: población.
country-year: clave compuesta país-año.
HDI: índice de desarrollo humano (IDH) por año.
gdp_for_year ($): producto interno bruto (PIB) por año.
gdp_per_capita: producto interno bruto per capita.
generation: generación.

-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.

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

Exploración de la Base de Datos

Número de filas y columnas

dim(master)

[1] 27820    12

La base de datos ‘master’ contiene 27,820 observaciones distribuidas en 12 variables. A continuación, se presentan los nombres de las variables:

colnames(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"

Análisis de Variables Categóricas

summary(select(master, where(is.character)))

   country              sex                age            country-year      
 Length:27820       Length:27820       Length:27820       Length:27820      
 Class :character   Class :character   Class :character   Class :character  
 Mode  :character   Mode  :character   Mode  :character   Mode  :character  
  generation       
 Length:27820      
 Class :character  
 Mode  :character

table(master$country) %>% 
        as.data.frame() %>% 
        arrange(desc(Freq))

                            Var1 Freq
1                        Austria  382
2                        Iceland  382
3                      Mauritius  382
4                    Netherlands  382
5                      Argentina  372
6                        Belgium  372
7                         Brazil  372
8                          Chile  372
9                       Colombia  372
10                       Ecuador  372
11                        Greece  372
12                        Israel  372
13                         Italy  372
14                         Japan  372
15                    Luxembourg  372
16                         Malta  372
17                        Mexico  372
18                   Puerto Rico  372
19             Republic of Korea  372
20                     Singapore  372
21                         Spain  372
22                United Kingdom  372
23                 United States  372
24                     Australia  360
25                      Bulgaria  360
26                    Costa Rica  360
27                        France  360
28                     Guatemala  360
29                       Ireland  360
30                        Norway  360
31                        Sweden  358
32                        Canada  348
33                       Finland  348
34                   New Zealand  348
35                  Turkmenistan  348
36                        Belize  336
37                   Saint Lucia  336
38                      Suriname  336
39                       Ukraine  336
40                       Uruguay  336
41                       Romania  334
42                      Thailand  334
43           Antigua and Barbuda  324
44                      Paraguay  324
45                      Portugal  324
46            Russian Federation  324
47           Trinidad and Tobago  324
48                Czech Republic  322
49                       Germany  312
50                    Kazakhstan  312
51                    Kyrgyzstan  312
52                       Grenada  310
53                       Hungary  310
54                      Barbados  300
55                        Guyana  300
56                        Kuwait  300
57                        Panama  300
58  Saint Vincent and Grenadines  300
59                       Armenia  298
60                          Cuba  288
61                   El Salvador  288
62                        Poland  288
63                       Bahamas  276
64                       Albania  264
65                       Denmark  264
66                       Georgia  264
67                      Slovakia  264
68                    Uzbekistan  264
69                       Croatia  262
70                     Lithuania  262
71                       Bahrain  252
72                       Belarus  252
73                       Estonia  252
74                        Latvia  252
75                      Slovenia  252
76                   Switzerland  252
77                  South Africa  240
78                        Serbia  216
79                    Seychelles  216
80                       Jamaica  204
81                    Azerbaijan  192
82                   Philippines  180
83                        Cyprus  178
84                         Qatar  178
85                         Aruba  168
86                          Fiji  132
87                      Kiribati  132
88                     Sri Lanka  132
89                      Maldives  120
90                    Montenegro  120
91                        Turkey   84
92                     Nicaragua   72
93          United Arab Emirates   72
94                          Oman   36
95         Saint Kitts and Nevis   36
96                    San Marino   36
97        Bosnia and Herzegovina   24
98                    Cabo Verde   12
99                      Dominica   12
100                        Macau   12
101                     Mongolia   10

Esta es una tabla de frecuencia para la variable ‘country’, ordenada de mayor a menor frecuencia. Nos permite identificar cuáles son los países más representados en el dataset; donde Austria, Iceland, Mauritius y Netherlands son los paises con mayor número de observaciones.

table(master$age) %>% 
        as.data.frame() %>% 
        arrange(desc(Freq))

         Var1 Freq
1 15-24 years 4642
2 25-34 years 4642
3 35-54 years 4642
4 55-74 years 4642
5   75+ years 4642
6  5-14 years 4610

Tenemos la distribución de edades en el dataset, ordenando las frecuencias de mayor a menor. Esta distribución indica que los rangos de edades está bastante equilibrada, con una representación ligeramente menor en el grupo de edades más jóvenes (5-14 years).

table(master$sex) %>% 
        as.data.frame() %>% 
        arrange(desc(Freq))

    Var1  Freq
1 female 13910
2   male 13910

ggplot(master, aes(x = sex, fill = sex)) +
  geom_bar() +
  theme_minimal() +
  labs(title = "Distribución de Sexo",
       x = "Sexo",
       y = "Frecuencia") +
  scale_fill_manual(values = c("#f8ad9d", "#5eb1bf"))

Se genera una tabla de frecuencia y un gráfico de barras para analizar la distribución de la variable ‘sex’; este análisis permite visualizar el equilibrio de género en el dataset, lo que indica una representación de género igualitaria en la base de datos.

table(master$generation) %>% 
        as.data.frame() %>% 
        arrange(desc(Freq))

             Var1 Freq
1    Generation X 6408
2          Silent 6364
3      Millenials 5844
4         Boomers 4990
5 G.I. Generation 2744
6    Generation Z 1470

ggplot(master, aes(x = generation, fill = generation)) +
  geom_bar() +
  theme_minimal() +
  labs(title = "Distribución de Generaciones",
       x = "Generación",
       y = "Frecuencia") +
  scale_fill_manual(values = c(
    "Generation X" = "#1b4332",        # Color específico para Gen X
    "Silent" = "#2d6a4f",  
    "Millenials" = "#40916c",# Color para Silent Generation
    "Boomers" = "#52b788", 
    "G.I. Generation" = "#95d5b2" , # Color para G.I. Generation
    "Generation Z" = "#d8f3dc"       
  ))

Se observa la distribución de la variable ‘generation’ mediante una tabla de frecuencias y un gráfico de barras. Este análisis es útil para entender la representatividad de las diferentes generaciones en el conjunto de datos.

La generación más representada es Generation X, con el 23% (6408) de las observaciones y la menos representada es Generation Z con el 5.3% (1470) de las observaciones.

Análisis de Variables Númericas

summary(select(master, where(is.numeric)))

      year       suicides_no        population       suicides/100k pop
 Min.   :1985   Min.   :    0.0   Min.   :     278   Min.   :  0.00   
 1st Qu.:1995   1st Qu.:    3.0   1st Qu.:   97498   1st Qu.:  0.92   
 Median :2002   Median :   25.0   Median :  430150   Median :  5.99   
 Mean   :2001   Mean   :  242.6   Mean   : 1844794   Mean   : 12.82   
 3rd Qu.:2008   3rd Qu.:  131.0   3rd Qu.: 1486143   3rd Qu.: 16.62   
 Max.   :2016   Max.   :22338.0   Max.   :43805214   Max.   :224.97   
                                                                      
  HDI for year   gdp_for_year ($)    gdp_per_capita ($)
 Min.   :0.483   Min.   :4.692e+07   Min.   :   251    
 1st Qu.:0.713   1st Qu.:8.985e+09   1st Qu.:  3447    
 Median :0.779   Median :4.811e+10   Median :  9372    
 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   :19456

par(mfrow = c(2, 2))
with(master, hist(suicides_no, main = "Número de suicidios", col = "lightblue"))
with(master, hist(population, main = "Población", col = "#8cc0de"))
with(master, hist(`gdp_per_capita ($)`, main = "PIB", col = "#6ab5b0"))
with(master, hist(`suicides/100k pop`, main = "tasas de suicidio", col = "#4a9b9b"))

Todos los histogramas muestran una distribución sesgada a la derecha (o asimetría positiva),nos indica que la mayoría de los datos tienen valores bajos, con unos pocos valores que son excepcionalmente altos.

ggplot(master, aes(x =master$`HDI for year`)) +
  geom_histogram(binwidth = 0.02, fill = "#2d6a6a", color = "grey") +
  labs(title = "IDH",
       x = "índice de desarrollo humano por año",
       y = "Frecuencia") +
  theme_minimal()

Warning: Removed 19456 rows containing non-finite outside the scale range
(`stat_bin()`).

Los valores NA son excluidos automáticamente del histograma. Esto significa que el histograma solo representa los datos válidos disponibles en la variable, y los NA no se reflejan en el gráfico.

Análisis Estadistico

master_genero <- master %>%
  filter(sex == "female")

head(master_genero)

# A tibble: 6 × 12
  country  year sex    age         suicides_no population `suicides/100k pop`
  <chr>   <dbl> <chr>  <chr>             <dbl>      <dbl>               <dbl>
1 Albania  1987 female 15-24 years          14     289700                4.83
2 Albania  1987 female 75+ years             1      35600                2.81
3 Albania  1987 female 35-54 years           6     278800                2.15
4 Albania  1987 female 25-34 years           4     257200                1.56
5 Albania  1987 female 5-14 years            0     311000                0   
6 Albania  1987 female 55-74 years           0     144600                0   
# ℹ 5 more variables: `country-year` <chr>, `HDI for year` <dbl>,
#   `gdp_for_year ($)` <dbl>, `gdp_per_capita ($)` <dbl>, generation <chr>

El conjunto de datos master_genero ahora contiene únicamente las observaciones correspondientes a individuos de sexo femenino.

ggplot(master_genero, aes(x =age, y = `suicides/100k pop`,fill = age)) +
  geom_boxplot() +
  labs(title = "Distribución de suicidios por 1000 habitantes según rango de edad",
       x = "Rango de edad",
       y = "Suicidios por cada 100 mil habitantes") +
  theme_minimal()+
  theme(legend.position = "none")+
  scale_fill_manual(values = c(
    "5-14 years" = "#d1e3f8",  
    "15-24 years" = "#a2c2e3",  
    "25-34 years" = "#7baed5",  
    "35-54 years" = "#4f9ac8",  
    "55-74 years" = "#2a6fa8",  
    "75+ years" = "#004e7c"     
  ))

En el boxplot, se observa que la mayoría de las cajas están ubicadas en la parte inferior del gráfico, lo que indica que la mayoría de los datos de suicidios por cada 100,000 habitantes son bajos para los diferentes rangos de edad. Además, todos los rangos de edad presentan datos atípicos, evidenciados por los puntos fuera de los bigotes de las cajas. Esto sugiere que, aunque la mayoría de los datos se agrupan en valores bajos, existen valores extremos que se desvían significativamente de la mediana.

table(master_genero$year)


1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 
 288  288  324  294  312  384  384  390  390  408  468  462  462  474  498  516 
2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 
 528  516  516  504  504  510  516  510  534  528  516  486  480  468  372   80

summary(select(master_genero, where(is.numeric)))

      year       suicides_no       population       suicides/100k pop
 Min.   :1985   Min.   :   0.0   Min.   :     460   Min.   :  0.000  
 1st Qu.:1995   1st Qu.:   1.0   1st Qu.:  100489   1st Qu.:  0.410  
 Median :2002   Median :  14.0   Median :  450766   Median :  3.160  
 Mean   :2001   Mean   : 112.1   Mean   : 1888769   Mean   :  5.393  
 3rd Qu.:2008   3rd Qu.:  73.0   3rd Qu.: 1519010   3rd Qu.:  7.410  
 Max.   :2016   Max.   :4053.0   Max.   :43805214   Max.   :133.420  
                                                                     
  HDI for year   gdp_for_year ($)    gdp_per_capita ($)
 Min.   :0.483   Min.   :4.692e+07   Min.   :   251    
 1st Qu.:0.713   1st Qu.:8.985e+09   1st Qu.:  3447    
 Median :0.779   Median :4.811e+10   Median :  9372    
 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   :9728

Aqui tenemos una visión general de la estructura de los datos en términos de variables numéricas y la cantidad de datos obtenidos por año.

Identificación de Valores NA

Primero verificamos que variables son las que tienen datos NA.

na_count <- colSums(is.na(master))
na_count

           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

ggplot(master, aes(y=master$`HDI for year`)) + 
    geom_boxplot(fill="#52b788", alpha=0.5) + 
    ylab("índice de desarrollo humano (IDH) por año")+
  theme_minimal()

Warning: Removed 19456 rows containing non-finite outside the scale range
(`stat_boxplot()`).

Se observa la presencia de un valor atípico en los datos. La línea de la mediana dentro de la caja está centrada, lo que indica una distribución relativamente equilibrada. Sin embargo, los bigotes no tienen el mismo tamaño, lo que sugiere una mayor dispersión hacia el extremo inferior de la distribución.

summary(master$`HDI for year`)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
  0.483   0.713   0.779   0.777   0.855   0.944   19456

datos_filtradosQ1 <- master %>%
  filter(year <= 1995) %>%
  pull(`HDI for year`)

summary(datos_filtradosQ1)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
  0.483   0.653   0.726   0.720   0.794   0.883    6060

datos_filtradosQ2 <- master %>%
  filter(year > 1995 & year < 2008  ) %>%
  pull(`HDI for year`)

summary(datos_filtradosQ2)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
  0.552   0.695   0.766   0.766   0.851   0.931   10188

datos_filtradosQ3 <- master %>%
  filter(year >= 2008) %>%
  pull(`HDI for year`)

summary(datos_filtradosQ3)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
  0.611   0.737   0.812   0.802   0.881   0.944    3208

Para identificar el periodo en el que se concentra una mayor cantidad de valores faltantes (NA) en la columna HDI for year, se realizaron filtros en la base de datos master dividiendo los datos en tres periodos:

Periodo 1: Hasta 1995. Periodo 2: Entre 1996 y 2007. Periodo 3: A partir de 2008

Estos resultados indican que la mayor concentración de datos faltantes se encuentra en el Periodo 2, que presenta la menor cantidad de valores NA. Esto sugiere que los datos sobre el (HDI) son más completos en el periodo más reciente (a partir de 2008), mientras que hay una notable cantidad de información faltante en los periodos anteriores, especialmente entre 1996 y 2007.

Imputacion de datos

data_imputed <- master %>% 
  mutate(across(where(is.numeric), ~ ifelse(is.na(.), median(., na.rm = TRUE), .)))

summary(data_imputed$`HDI for year`)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
 0.4830  0.7790  0.7790  0.7783  0.7790  0.9440

Se realizó una imputación de los valores faltantes utilizando la mediana de la variable HDI for year. Este proceso consistió en reemplazar los valores NA lo que proporciona una serie completa de datos.

Se usó la mediana como valor de imputación porque los datos tienen una distribución sesgada, ya que la mediana es menos sensible a los valores atípicos comparado con la media.

par(mfrow = c(1, 2))
with(master, hist(`HDI for year`, main = "HDI con NA", col = "#34a0a4"))
with(data_imputed, hist(`HDI for year`, main = "HDI sin NA", col = "#1a759f"))

Para concluir, se realizó una comparación entre los histogramas de la variable ‘HDI for year’ antes y después de la imputación de los valores faltantes. El primer histograma muestra la distribución de la variable excluyendo los valores NA. En este caso, los valores faltantes no se incluyen en la visualización, lo que puede ofrecer una imagen incompleta de la distribución de la variable. Por otro lado, el segundo histograma refleja la distribución después de que los NA fueron reemplazados con la mediana. Esta comparación permite observar cómo la imputación afecta la forma de la distribución.

Actividad Práctica 4 - R:

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 Colombia y los de EEUU, generando dos bases de datos, llamadas master_col y master_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.

Exploracion de datos por pais (Colombia y Estados Unidos)

Primero se realiza el filtro de la base de datos para que solo nos queden los registros de Colombia

# Filtrar datos de Colombia
master_col <- data_imputed %>%
  filter(country == "Colombia")

head(master_col)

# A tibble: 6 × 12
  country   year sex    age         suicides_no population `suicides/100k pop`
  <chr>    <dbl> <chr>  <chr>             <dbl>      <dbl>               <dbl>
1 Colombia  1985 male   75+ years            21     123400               17.0 
2 Colombia  1985 male   55-74 years         113    1015200               11.1 
3 Colombia  1985 male   25-34 years         193    2323700                8.31
4 Colombia  1985 male   15-24 years         256    3190200                8.02
5 Colombia  1985 male   35-54 years         188    2451100                7.67
6 Colombia  1985 female 15-24 years         117    3140700                3.73
# ℹ 5 more variables: `country-year` <chr>, `HDI for year` <dbl>,
#   `gdp_for_year ($)` <dbl>, `gdp_per_capita ($)` <dbl>, generation <chr>

# Filtrar datos de Estados unidos
master_eu <- data_imputed %>%
  filter(country == "United States")

head(master_eu)

# A tibble: 6 × 12
  country        year sex    age      suicides_no population `suicides/100k pop`
  <chr>         <dbl> <chr>  <chr>          <dbl>      <dbl>               <dbl>
1 United States  1985 male   75+ yea…        2177    4064000               53.6 
2 United States  1985 male   55-74 y…        5302   17971000               29.5 
3 United States  1985 male   25-34 y…        5134   20986000               24.5 
4 United States  1985 male   35-54 y…        6053   26589000               22.8 
5 United States  1985 male   15-24 y…        4267   19962000               21.4 
6 United States  1985 female 35-54 y…        2105   27763000                7.58
# ℹ 5 more variables: `country-year` <chr>, `HDI for year` <dbl>,
#   `gdp_for_year ($)` <dbl>, `gdp_per_capita ($)` <dbl>, generation <chr>

Análisis de la evolución de los suicidios por cada 100.000 habitantes, del PIB per cápita y del IDH

data_combined  <- bind_rows(master_col, master_eu)

data_combined %>% group_by(year, country) %>%
  summarize(mean_suicides = mean(`suicides/100k pop`, na.rm = TRUE), .groups = 'drop') %>%
  ggplot(aes(x = year, y = mean_suicides, color = country, group = country)) +
  geom_line() +
  labs(title = "Evolución de Suicidios por Cada 100,000 Habitantes",
       x = "Año",
       y = "Suicidios por 100,000 Habitantes",
       color = "País") +
  theme_minimal() +
  scale_color_manual(values = c("Colombia" ="#d95f02" , "United States" = "#1b9e77"))

En la evolución de la tasa de suicidios por cada 100,000 habitantes en ambos países, se observa que la tasa promedio general de suicidios es consistentemente inferior en Colombia en comparación con Estados Unidos. Esta diferencia sugiere que, a lo largo del tiempo, Colombia ha mantenido una tasa de suicidios más baja en comparación con Estados Unidos.

ggplot(data_combined, aes(x = year, y = `gdp_per_capita ($)`, color = country)) +
  geom_line() +
  labs(title = "Evolución del PIB per Cápita",
       x = "Año",
       y = "PIB per Cápita ($)",
       color = "País") +
  theme_minimal() +
  scale_color_manual(values = c("Colombia" = "#d95f02", "United States" = "#1b9e77"))

La gráfica de la evolución del PIB per cápita muestra que Estados Unidos presenta consistentemente valores mucho más altos en comparación con Colombia a lo largo del tiempo.

ggplot(data_combined, aes(x = year, y = `HDI for year`, color = country)) +
  geom_line() +
  labs(title = "Evolución del índice de desarrollo humano",
       x = "Año",
       y = "PIB per Cápita ($)",
       color = "País") +
  theme_minimal() +
  scale_color_manual(values = c("Colombia" = "#d95f02", "United States" = "#1b9e77"))

En este grafico la evolución del índice de desarrollo humano (IDH), se observa que los picos y las secciones planas en ambos países pueden atribuirse a la imputación de datos realizada. A pesar de esto, se evidencia una notable diferencia en los valores promedio del IDH entre Colombia y Estados Unidos, siendo el indice de Estados Unidos significativamente mayor a lo largo de los años.

Análisis por genero

library(gridExtra)


Adjuntando el paquete: 'gridExtra'

The following object is masked from 'package:dplyr':

    combine

cplot<- master_col %>% group_by(year, sex) %>%
  summarize(mean_suicides = mean(`suicides/100k pop`, na.rm = TRUE), .groups = 'drop') %>%
  ggplot(aes(x = year, y = mean_suicides, group = sex, color = sex)) +
  geom_line() +
  theme_minimal() +
  labs(title = "Evolución de Suicidios en Colombia",
       x = "Año",
       y = "Tasa de Suicidios por 100,000 Habitantes",
       color = "Género")   +
  scale_color_manual(values = c(
    "female" = "#fed9b7", 
    "male" = "#f07167"
  ))


eplot <- master_eu %>% group_by(year, sex) %>%
  summarize(mean_suicides = mean(`suicides/100k pop`, na.rm = TRUE), .groups = 'drop') %>%
  ggplot(aes(x = year, y = mean_suicides, group = sex, color = sex)) +
  geom_line() +
  theme_minimal() +
  labs(title = "Evolución de Suicidios en Estados Unidos",
       x = "Año",
       y = "Tasa de Suicidios por 100,000 Habitantes",
       color = "Género")  + 
  scale_color_manual(values = c(
    "female" ="#d8e2dc" , 
    "male" = "#64a6bd"
  ))


grid.arrange(cplot, eplot, ncol = 2)

Al analizar la tasa de suicidios por cada 100,000 habitantes desglosada por género, se observa una tendencia en la cual los hombres presentan tasas de suicidio significativamente más altas en comparación con las mujeres en ambos países. Sin embargo, al comparar los valores entre hombres y mujeres de los diferentes países, la tasa de suicidios en Colombia es mucho menor como se decía en los graficos anteriores, al compararse entre el mismo sexo en Colombia que en estados Unidos.

Análisis por grupo de edad

library(gridExtra)
coplot<- master_col %>% group_by(year, age) %>%
  summarize(mean_suicides = mean(`suicides/100k pop`, na.rm = TRUE), .groups = 'drop') %>%
  ggplot(aes(x = year, y = mean_suicides, group = age, color = age)) +
  geom_line() +
  theme_minimal() +
  labs(title = "Evolución de Suicidios en Colombia",
       x = "Año",
       y = "Tasa de Suicidios por 100,000 Habitantes",
       color = "Rango de edad")  +
  scale_color_manual(values = c(
    "15-24 years" = "#1f77b4", 
    "25-34 years" = "#ff7f0e",
    "35-54 years" = "#2ca02c",
    "5-14 years" = "#d62728",
    "55-74 years" = "#9467bd",
    "75+ years" = "#8c564b"
  ))

euplot <- master_eu %>% group_by(year, age) %>%
  summarize(mean_suicides = mean(`suicides/100k pop`, na.rm = TRUE), .groups = 'drop') %>%
  ggplot(aes(x = year, y = mean_suicides, group = age, color = age)) +
  geom_line() +
  theme_minimal() +
  labs(title = "Evolución de Suicidios en Estados Unidos",
       x = "Año",
       y = "Tasa de Suicidios por 100,000 Habitantes",
       color = "Rango de edad")  +
  scale_color_manual(values = c(
    "15-24 years" = "#1f77b4",  
    "25-34 years" = "#ff7f0e",
    "35-54 years" = "#2ca02c",
    "5-14 years" = "#d62728",
    "55-74 years" = "#9467bd",
    "75+ years" = "#8c564b"
  ))
  

grid.arrange(coplot, euplot, ncol = 2)

Los gráficos de tasas de suicidio por edad para Colombia y Estados Unidos revelan que en ambos países la tasa de suicidio es más alta en el grupo de edad superior a 75 años. Por otro lado, el grupo de edad de 5 a 14 años muestra la tasa más baja en ambos países.

Actividad Práctica 5 - R:

1 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. Deben entregar un script .R con los códigos usados. Este análisis puede consistir en:

1.1 Contextualizar tanto la base de datos como las variables describiendo en qué consiste cada una de ellas. La base de datos está en el sitio web: https://www.datos.gov.co/Transporte/Accidentalidad-en-Barranquilla/yb9r-2dsi

1.2. 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.

1.3. Analizar cada una de las variables según su tipo: numéricas y categóricas.

1.4. Filtrar la base de datos para entender mejor su estructura. Aplique filtros en al menos cinco oportunidades.

1.5. Utilice la función table para explorar la base de datos.

1.6. Identifique los valores NA (Not Available) en la base de datos.

1.7. Analice la presencia de posibles valores atípicos.

Realice una exploración y un análisis descriptivo completo (incluyendo tablas de resumen y gráficos) de la base de datos disponible en este enlace. Incluya gráficos que presenten los datos sobre un mapa de Colombia, para visualizar la distribución geográfica de los precios de los combustibles en el país (2018-2024).

Punto 1

knitr::kable(head(Accidentes))

FECHA_ACCIDENTE	HORA_ACCIDENTE	GRAVEDAD_ACCIDENTE	CLASE_ACCIDENTE	SITIO_EXACTO_ACCIDENTE	CANT_HERIDOS_EN _SITIO_ACCIDENTE	CANT_MUERTOS_EN _SITIO_ACCIDENTE	CANTIDAD_ACCIDENTES	AÑO_ACCIDENTE	MES_ACCIDENTE	DIA_ACCIDENTE
2018-01-01	01:30:00:am	Con heridos	Atropello	CL 87 9H 24	1	NA	1	2018	January	Mon
2018-01-01	02:00:00:pm	Solo daños	Choque	CL 110 CR 46	NA	NA	1	2018	January	Mon
2018-01-01	04:00:00:am	Solo daños	Choque	AV CIRCUNVALAR CR 9G	NA	NA	1	2018	January	Mon
2018-01-01	04:30:00:am	Solo daños	Choque	CLLE 72 CRA 29	NA	NA	1	2018	January	Mon
2018-01-01	05:20:00:pm	Solo daños	Choque	VIA 40 CALLE 75	NA	NA	1	2018	January	Mon
2018-01-01	06:00:00:pm	Con heridos	Choque	CR 8 CL 41	3	NA	1	2018	January	Mon

Descripción general de la base de datos

La base de datos contiene información sobre los incidentes de accidentalidad en la ciudad de Barranquilla, Colombia. Las variables son:

FECHA_ACCIDENTE: Fecha del accidente.
HORA_ACCIDENTE: Hora en que ocurrio el accidente.
GRAVEDAD_ACCIDENTE: Gravedad del accidente.
CLASE_ACCIDENTE: Tipo de accidente.
SITIO_EXACTO_ACCIDENTE: Lugar donde ocurrio el accidente.
**CANT_HERIDOS_EN _SITIO_ACCIDENTE**: Cantidad de heridos.
**CANT_MUERTOS_EN _SITIO_ACCIDENTE**: Cantidad de muertos.
CANTIDAD_ACCIDENTES: Cantidad de accidentes.
AÑO_ACCIDENTE: Año.
MES_ACCIDENTE: Mes.
DIA_ACCIDENTE : Dia.

Número de filas y columnas

dim(Accidentes)

[1] 25610    11

La base de datos ‘Accidentalidad_en_Barranquilla’ contiene 25,610 observaciones distribuidas en 11 variables. A continuación, se presentan los nombres de las variables:

Accidentes %>% names

 [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"

Análisis de variables categóricas

summary(select_if(Accidentes, is.character))

 HORA_ACCIDENTE     GRAVEDAD_ACCIDENTE CLASE_ACCIDENTE   
 Length:25610       Length:25610       Length:25610      
 Class :character   Class :character   Class :character  
 Mode  :character   Mode  :character   Mode  :character  
 SITIO_EXACTO_ACCIDENTE AÑO_ACCIDENTE      MES_ACCIDENTE     
 Length:25610           Length:25610       Length:25610      
 Class :character       Class :character   Class :character  
 Mode  :character       Mode  :character   Mode  :character  
 DIA_ACCIDENTE     
 Length:25610      
 Class :character  
 Mode  :character

lugares <-table(Accidentes$SITIO_EXACTO_ACCIDENTE) %>% 
        as.data.frame() %>% 
        arrange(desc(Freq))
head(lugares)

          Var1 Freq
1 CL 110 CR 9G   77
2  CL 110 CR 6   66
3 CL 110 CR 43   55
4   CL 17 CR 8   53
5   CL 30 CR 8   53
6 VIA 40 CL 85   53

table(Accidentes$GRAVEDAD_ACCIDENTE) %>% 
        as.data.frame() %>% 
        arrange(desc(Freq))

         Var1  Freq
1  Solo daños 15457
2 Con heridos  9901
3 Con muertos   252

ggplot(Accidentes, aes(x = GRAVEDAD_ACCIDENTE, fill = GRAVEDAD_ACCIDENTE)) +
  geom_bar() +
  theme_minimal() +
  labs(title = "Distribución de gravedad del accidente",
       x = "Gravedad",
       y = "Frecuencia") +
  scale_fill_manual(values = c("#00b4d8", "#90e0ef", "#0077b6"))

table(Accidentes$CLASE_ACCIDENTE) %>% 
        as.data.frame() %>% 
        arrange(desc(Freq))

            Var1  Freq
1         Choque 23819
2      Atropello  1344
3 Caida Ocupante   194
4           Otro   123
5    Volcamiento   117
6       Incendio    13

ggplot(Accidentes, aes(x = CLASE_ACCIDENTE, fill = CLASE_ACCIDENTE)) +
  geom_bar() +
  theme_minimal() +
  labs(title = "Distribución por clase de accidente",
       x = "Clase",
       y = "Frecuencia") +
  scale_fill_manual(values = c("#0077b6", "#00b4d8","#023e8a", "#90e0ef", "#48cae4","#48cae4"))

table(Accidentes$AÑO_ACCIDENTE) %>% 
        as.data.frame() %>% 
        arrange(desc(Freq))

  Var1 Freq
1 2018 5898
2 2019 5645
3 2021 4700
4 2022 3683
5 2020 3281
6 2023 1662
7 2024  741

ggplot(Accidentes, aes(x = AÑO_ACCIDENTE, fill = AÑO_ACCIDENTE)) +
  geom_bar() +
  theme_minimal() +
  labs(title = "Distribución por clase de accidente",
       x = "Clase",
       y = "Frecuencia") +
  scale_fill_manual(values = c("#1c3e35", "#467a69","#84d4b7", "#5b9883", "#6fb69d","#99f2d1","#ceedef"))

table(Accidentes$MES_ACCIDENTE) %>% 
        as.data.frame() %>% 
        arrange(desc(Freq))

        Var1 Freq
1   February 2477
2      March 2446
3    January 2349
4   December 2189
5        May 2121
6       June 2103
7    October 2090
8      April 2010
9   November 1995
10 September 1980
11      July 1932
12    August 1918

# Crear el gráfico de barras
ggplot(tabla_frecuencias, aes(x = Mes, y = Frecuencia, fill = Mes)) +
  geom_bar(stat = "identity") +
  theme_minimal() +
  labs(title = "Frecuencia de Accidentes por Mes",
       x = "Mes",
       y = "Frecuencia") +
  scale_fill_brewer(palette = "Set3") + 
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

Análisis de variables numéricas

summary(select_if(Accidentes, is.numeric))

 CANT_HERIDOS_EN _SITIO_ACCIDENTE CANT_MUERTOS_EN _SITIO_ACCIDENTE
 Min.   : 1.000                   Min.   :1.000                   
 1st Qu.: 1.000                   1st Qu.:1.000                   
 Median : 1.000                   Median :1.000                   
 Mean   : 1.472                   Mean   :1.036                   
 3rd Qu.: 2.000                   3rd Qu.:1.000                   
 Max.   :42.000                   Max.   :2.000                   
 NA's   :15626                    NA's   :25358                   
 CANTIDAD_ACCIDENTES
 Min.   :1          
 1st Qu.:1          
 Median :1          
 Mean   :1          
 3rd Qu.:1          
 Max.   :2

par(mfrow = c(1, 2))
with(Accidentes,hist(`CANT_HERIDOS_EN _SITIO_ACCIDENTE`, main = "Cantidad de Heridos", col = "#6ab5b0"))
with(Accidentes,hist(`CANT_MUERTOS_EN _SITIO_ACCIDENTE`, main = "Cantidad de Muertos", col = "#1a759f"))

Análisis de subconjuntos de la base de datos

Accidentes ocurridos el primer trimestre de cada año con muertos

Se usaran las variales ‘AÑO_ACCIDENTE’, ‘MES_ACCIDENTE’ y ‘GRAVEDAD_ACCIDENTE’

filtro1 <- Accidentes %>%
  filter(MES_ACCIDENTE %in% c("January", "February", "March")&
          GRAVEDAD_ACCIDENTE  == "Con muertos")

table(filtro1$AÑO_ACCIDENTE)


2018 2019 2020 2021 2022 2023 2024 
  11    9    9    6   20   10    7

table(filtro1$CLASE_ACCIDENTE)


  Atropello      Choque        Otro Volcamiento 
         19          48           3           2

En los primeros tres meses del año (enero, febrero y marzo), se han registrado un total de 64 accidentes con víctimas fatales entre 2018 y 2024. El año 2022 fue el más crítico, con 20 accidentes fatales, mientras que el año 2024 mostró una disminución a 7 casos. La mayoría de estos accidentes fueron choques (48 casos), seguidos por atropellos (19 casos), otros tipos de accidentes (3 casos), y volcamientos (2 casos).

Accidentes ocurridos por un choque y sin muertos

Se usaran las variales ‘CLASE_ACCIDENTE’ y ‘GRAVEDAD_ACCIDENTE’

filtro2 <- Accidentes %>%
  filter(GRAVEDAD_ACCIDENTE %in% c("Sin muertos", "Solo daños")&
          CLASE_ACCIDENTE  == "Choque" )

table(filtro2$AÑO_ACCIDENTE)


2018 2019 2020 2021 2022 2023 2024 
4111 4000 2165 3224 1878    5    2

table(filtro2$MES_ACCIDENTE)


    April    August  December  February   January      July      June     March 
     1218      1131      1361      1521      1429      1200      1246      1430 
      May  November   October September 
     1234      1223      1242      1150

Indica una tendencia decreciente significativa en los últimos años, pasando de 4,111 casos en 2018 a solo 2 en 2024, la distribución mensual es relativamente uniforme, con febrero, marzo y enero registrando el mayor número de accidentes, lo que sugiere una incidencia constante a lo largo del año, aunque ciertos meses como febrero destacan ligeramente.

Accidentes ocurridos sabados y domningos en el mes de diciembre

Se usaran las variales ‘DIA_ACCIDENTE’ y ‘MES_ACCIDENTE’

filtro3 <- Accidentes %>%
  filter(DIA_ACCIDENTE %in% c("Sat", "Sun")&
          MES_ACCIDENTE  == "December" )

table(filtro3$AÑO_ACCIDENTE)


2018 2019 2020 2021 2022 2023 
 145  103   99  111   48   28

table(filtro3$CLASE_ACCIDENTE)


     Atropello Caida Ocupante         Choque       Incendio           Otro 
            33              6            492              1              1 
   Volcamiento 
             1

Se observa una disminución en la cantidad de accidentes a lo largo de los años, pasando de 145 en 2018 a solo 28 en 2023. En cuanto a la clase de accidente, los choques representan la gran mayoría de los casos (492), mientras que otros tipos de accidentes como atropellos y caídas de ocupantes son mucho menos frecuentes, esto sugiere que los fines de semana de diciembre son particularmente peligrosos para accidentes vehiculares.

Accidentes ocurridos en el 2023 sin muertes

Se usaran las variales ‘GRAVEDAD_ACCIDENTE’ y ‘AÑO_ACCIDENTE’

filtro4 <- Accidentes %>%
  filter(GRAVEDAD_ACCIDENTE %in% c("Sin muertos", "Solo daños")&
          AÑO_ACCIDENTE  == "2023" )

table(filtro4$MES_ACCIDENTE)


December February  January    March      May 
       1        1        2        1        1

table(filtro4$CLASE_ACCIDENTE)


  Choque Incendio 
       5        1

En 2023, los accidentes sin muertes o con solo daños fueron escasos, con solo seis incidentes reportados. La mayoría ocurrieron en los meses de enero (2) y diciembre (1), con una distribución similar en febrero, marzo, y mayo, cada uno con un solo accidente. En términos de la clase de accidente, cinco de ellos fueron choques, mientras que uno fue debido a un incendio.

Accidentes ocurridos por atropello en los ultimos 3 años (2022,2023 y 2024)

Se usaran las variales ‘CLASE_ACCIDENTE’ y ‘AÑO_ACCIDENTE’

filtro5 <- Accidentes %>%
  filter(AÑO_ACCIDENTE %in% c("2022", "2023", "2024")&
          CLASE_ACCIDENTE  == "Atropello" )

table(filtro5$MES_ACCIDENTE)


    April    August  December  February   January      July      June     March 
       46        28        41        56        46        25        48        60 
      May  November   October September 
       59        32        38        34

table(filtro5$GRAVEDAD_ACCIDENTE)


Con heridos Con muertos 
        484          29

En los últimos tres años (2022, 2023 y 2024), se registraron un total de 513 accidentes por atropello, distribuidos a lo largo de todos los meses del año. La mayoría de estos accidentes resultaron en personas heridas (484 casos), mientras que 29 de ellos tuvieron consecuencias fatales. Marzo fue el mes con mayor cantidad de atropellos (60 incidentes), seguido de mayo (59 incidentes) y febrero (56 incidentes).

Identificar los valores NA

Veremos la cantidad de valores NA en todas la variables.

colSums(is.na(Accidentes))

                 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 
                               0

Vamos a visualizar con la libreria mice y confirmar cuales son las variables con los datos faltantes.

library(mice)


Adjuntando el paquete: 'mice'

The following object is masked from 'package:stats':

    filter

The following objects are masked from 'package:base':

    cbind, rbind

md.pattern(Accidentes, plot = TRUE, rotate.names = TRUE)

      FECHA_ACCIDENTE HORA_ACCIDENTE GRAVEDAD_ACCIDENTE CLASE_ACCIDENTE
83                  1              1                  1               1
9901                1              1                  1               1
169                 1              1                  1               1
15457               1              1                  1               1
                    0              0                  0               0
      SITIO_EXACTO_ACCIDENTE CANTIDAD_ACCIDENTES AÑO_ACCIDENTE MES_ACCIDENTE
83                         1                   1             1             1
9901                       1                   1             1             1
169                        1                   1             1             1
15457                      1                   1             1             1
                           0                   0             0             0
      DIA_ACCIDENTE CANT_HERIDOS_EN _SITIO_ACCIDENTE
83                1                                1
9901              1                                1
169               1                                0
15457             1                                0
                  0                            15626
      CANT_MUERTOS_EN _SITIO_ACCIDENTE      
83                                   1     0
9901                                 0     1
169                                  1     1
15457                                0     2
                                 25358 40984

summary(Accidentes$`CANT_HERIDOS_EN _SITIO_ACCIDENTE`)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
  1.000   1.000   1.000   1.472   2.000  42.000   15626

summary(Accidentes$`CANT_MUERTOS_EN _SITIO_ACCIDENTE`)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
  1.000   1.000   1.000   1.036   1.000   2.000   25358

Detección de valores atípicos

Realizamos boxplot ya que son útiles para detectar posibles valores atípicos.

par(mfrow = c(1, 2))
with(Accidentes,boxplot(`CANT_HERIDOS_EN _SITIO_ACCIDENTE`, main = "Cantidad de Heridos", col = "#6ab5b0"))
with(Accidentes,boxplot(`CANT_MUERTOS_EN _SITIO_ACCIDENTE`, main = "Cantidad de Muertos", col = "#1a759f"))

En el análisis de la variable, hemos identificado una serie de valores atípicos. Estos valores, que se desvían significativamente del rango típico de datos, se presentan a continuación:

boxplot.stats(Accidentes$`CANT_HERIDOS_EN _SITIO_ACCIDENTE`)$out

  [1]  5  7  8  4  4  4  4  4  5  4 11  4  7  5  5  4  8  8  4  6  5  5  4  5  4
 [26]  4  5  6 10  8  5  4  4  5  8  4  4  4 12  6  4  4  8  4  5  5  4 20  4  4
 [51]  4  4  4  5  4  4  4  4 22  4  4  4  5  4  4  4  7  5  4 13  6  6  5  4  4
 [76]  5  4  5  4 10 12  4  4  4  4 13  4  4  9  4  4  4  4  5  7  5  4  9 12  6
[101]  6  5 16 12  4  5  4  6  4  4 10  4  8  5  7  5  5  5  4  4  7  6  5  5  4
[126]  4 10  4  4  7  4  4  6  5  7  4  4  5  5 11  4  4  5  4  6  4  6  9  4 11
[151]  5  4  4  6  4  4  4  4  6  4  5 14  4  5  4  4  4  4  8  4 12 11  4  5  4
[176]  6  5  4  6 10  6  5  6 42  4  4  9  4  4  4  5  4  4  7  4  5  4  4  5  6
[201]  4  4  4  4  4  6 10  4  4  4  5  7 19  4  9  4  4  6  6  5  9  4  5  6  4
[226]  5  4  4  4  4  7  4 11  4 12 21  4  7  4  4  6  6  4  4  4  4  4  4  4  4
[251]  4  4  4  4  4  4  5  4  4  5  5  4  6  4  5  6  4 10  5  4  5 23  6 18  4
[276]  4 12  5  7  4  8 15  4  4  4  6  4  4 11  4  4  5  5  5  4  5 14  7  4  4
[301]  4  4  5

boxplot.stats(Accidentes$`CANT_MUERTOS_EN _SITIO_ACCIDENTE`)$out

[1] 2 2 2 2 2 2 2 2 2

Como puede ver, de esta variable CANT_MUERTOS_EN _SITIO_ACCIDENTE en realidad hay 9 puntos considerados como posibles valores atípicos: Todas las observaciones con un valor de 2.

data_imputedAcc <- Accidentes %>% 
  mutate(across(where(is.numeric), ~ ifelse(is.na(.), median(., na.rm = TRUE), .)))

summary(data_imputedAcc$`CANT_MUERTOS_EN _SITIO_ACCIDENTE`)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
      1       1       1       1       1       2

summary(data_imputedAcc$`CANT_HERIDOS_EN _SITIO_ACCIDENTE`)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  1.000   1.000   1.000   1.184   1.000  42.000

Tras realizar la imputación de datos utilizando la mediana, debido a la presencia de valores atípicos, se ha observado que ya no existen valores faltantes (NA) en la base de datos.

par(mfrow = c(2, 2))
with(Accidentes, hist(`CANT_HERIDOS_EN _SITIO_ACCIDENTE`, main = "Cantidad de heridos con NA", col = "lightblue"))
with(data_imputedAcc, hist(`CANT_HERIDOS_EN _SITIO_ACCIDENTE`, main = "Cantidad de heridos sin NA", col = "#8cc0de"))
with(Accidentes, hist(`CANT_MUERTOS_EN _SITIO_ACCIDENTE`, main = "Cantidad de muertos con NA", col = "#6ab5b0"))
with(data_imputedAcc, hist(`CANT_MUERTOS_EN _SITIO_ACCIDENTE`, main = "Cantidad de muertos sin NA", col = "#4a9b9b"))

Para Finalizar, se realizó una comparación entre los histogramas de la variable CANT_HERIDOS_EN _SITIO_ACCIDENTE y CANT_MUERTOS_EN _SITIO_ACCIDENTE antes y después de la imputación de los valores faltantes. En los histogramas de la izquierda se muestra la distribución de las variables excluyendo los valores NA. En este caso, los valores faltantes no se incluyen en la visualización, lo que puede ofrecer una imagen incompleta de la distribución de la variable. Por otro lado, en los histogramas de la derecha refleja la distribución después de que los NA fueron reemplazados con la mediana.

Punto 2

data1 <- read.csv("precios.csv")
data2 <- read.csv("precios (1).csv")
data3 <- read.csv("precios (2).csv")
data4 <- read.csv("precios (3).csv")

data <- bind_rows(data1, data2, data3, data4)

knitr::kable(head(data))

BANDERA	NOMBRE.COMERCIAL	PRODUCTO	FECHA.REGISTRO	DEPARTAMENTO	MUNICIPIO	VALOR.PRECIO
TERPEL	ESTACION DE SERVICIO SERVICENTRO LA PEDRERA	DIESEL	01-Jan-2023	AMAZONAS	LA PEDRERA	15000
TERPEL	ESTACION DE SERVICIO SERVICENTRO LA PEDRERA	GASOLINA MOTOR	01-Jan-2023	AMAZONAS	LA PEDRERA	15500
TERPEL	BALSA EL CONDOR	GASOLINA MOTOR	01-Jan-2023	AMAZONAS	LETICIA	11380
TERPEL	BALSA EL CONDOR	DIESEL	01-Jan-2023	AMAZONAS	LETICIA	10840
TERPEL	ESTACION DE SERVICIO DISTRIBUIDORA LOS COMUNEROS	GASOLINA MOTOR	01-Jan-2023	AMAZONAS	LETICIA	11380
TERPEL	ESTACION DE SERVICIO DISTRIBUIDORA LOS COMUNEROS	GASOLINA MOTOR	01-Jan-2023	AMAZONAS	LETICIA	11380

Esta base de datos es sobre precios de los combustibles en el país.

dim(data)

[1] 268001      7

La base de datos ‘data’ contiene 268,001 observaciones distribuidas en 7 variables. A continuación, se presentan los nombres de las variables:

data %>% names

[1] "BANDERA"          "NOMBRE.COMERCIAL" "PRODUCTO"         "FECHA.REGISTRO"  
[5] "DEPARTAMENTO"     "MUNICIPIO"        "VALOR.PRECIO"

data %>% glimpse

Rows: 268,001
Columns: 7
$ BANDERA          <chr> "TERPEL", "TERPEL", "TERPEL", "TERPEL", "TERPEL", "TE…
$ NOMBRE.COMERCIAL <chr> "ESTACION DE SERVICIO SERVICENTRO LA PEDRERA", "ESTAC…
$ PRODUCTO         <chr> "DIESEL", "GASOLINA MOTOR", "GASOLINA MOTOR", "DIESEL…
$ FECHA.REGISTRO   <chr> "01-Jan-2023", "01-Jan-2023", "01-Jan-2023", "01-Jan-…
$ DEPARTAMENTO     <chr> "AMAZONAS", "AMAZONAS", "AMAZONAS", "AMAZONAS", "AMAZ…
$ MUNICIPIO        <chr> "LA PEDRERA", "LA PEDRERA", "LETICIA", "LETICIA", "LE…
$ VALOR.PRECIO     <dbl> 15000, 15500, 11380, 10840, 11380, 11380, 10671, 1187…

Variables categoricas

table(data$BANDERA) %>% 
        as.data.frame() %>% 
        arrange(desc(Freq))

                  Var1  Freq
1               TERPEL 94823
2               PRIMAX 36112
3               BIOMAX 32225
4               TEXACO 27092
5            PETROMIL  17249
6         COOMULPINORT  8918
7          AYATAWACOOP  8078
8               ZEUSS   7488
9            PETROBRAS  4871
10         DISCOWACOOP  3929
11                ECOS  3613
12                ESSO  3502
13           PETRDECOL  3495
14          PETRODECOL  3337
15                PUMA  3059
16              DISCOM  2917
17              OCTANO  2221
18            PLUS MAS  1806
19               P Y B  1687
20               BRIO    719
21 ZAPATA Y VELASQUEZ    408
22                SAVE   285
23             PROXXON   167

table(data$PRODUCTO) %>% 
        as.data.frame() %>% 
        arrange(desc(Freq))

            Var1   Freq
1 GASOLINA MOTOR 127338
2         DIESEL 108263
3          EXTRA  32400

ggplot(data, aes(x = PRODUCTO, fill = PRODUCTO)) +
  geom_bar() +
  theme_minimal() +
  labs(title = "Distribución de combustible por producto",
       x = "PRODUCTO",
       y = "Frecuencia") +
  scale_fill_manual(values = c("#0077b6", "#00b4d8","#023e8a" ))

table(data$DEPARTAMENTO) %>% 
        as.data.frame() %>% 
        arrange(desc(Freq))

                                                       Var1  Freq
1                                                    NARIÑO 31054
2                                                 ANTIOQUIA 25009
3                                        NORTE DE SANTANDER 21752
4                                           VALLE DEL CAUCA 18754
5                                              CUNDINAMARCA 16631
6                                               BOGOTA D.C. 16031
7                                                     CESAR 15703
8                                                LA GUAJIRA 13694
9                                                 SANTANDER 10247
10                                                ATLANTICO  8595
11                                                   TOLIMA  8014
12                                                   BOYACA  7769
13                                                  CORDOBA  7440
14                                                  BOLIVAR  7027
15                                                 PUTUMAYO  6610
16                                                    HUILA  6355
17                                                     META  6250
18                                                    CAUCA  5617
19                                                RISARALDA  5435
20                                                MAGDALENA  5339
21                                                   CALDAS  4517
22                                                    SUCRE  4358
23                                                 CASANARE  2744
24                                                    CHOCO  2640
25                                                  QUINDIO  2555
26                                                  CAQUETA  2390
27                                                   ARAUCA  2312
28                                                 GUAVIARE  1043
29                                                  VICHADA   922
30                                                 AMAZONAS   513
31 ARCHIPIELAGO DE SAN ANDRES, SANTA CATALINA Y PROVIDENCIA   267
32                                                  GUAINIA   261
33                                                   VAUPES   153

Variable numérica

summary(data$VALOR.PRECIO)

    Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
       0     9350    10870    12022    13847 14750147

hist(data$VALOR.PRECIO,  main = "Valor del combustible", col = "lightblue")

Indentificar NA

Veremos la cantidad de valores NA en todas la variables.

colSums(is.na(data))

         BANDERA NOMBRE.COMERCIAL         PRODUCTO   FECHA.REGISTRO 
               0                0                0                0 
    DEPARTAMENTO        MUNICIPIO     VALOR.PRECIO 
               0                0                0

No encontramos valores NA.

Detección de valores atípicos

En el histograma de la variable numérica se observó una fuerte asimetría hacia la izquierda, indicando que la mayoría de los datos se encuentran concentrados en valores bajos. Además, se identificó un valor máximo significativamente mayor que el resto de los datos, lo que sugiere la presencia de valores atípicos o una cola larga en la distribución.

boxplot(data$VALOR.PRECIO, main = "Precio del combustible", col = "#6ab5b0")

atipico <- quantile(data$VALOR.PRECIO, 0.98, na.rm = TRUE)
atipico

  98% 
20282

data$VALOR.PRECIO[data$VALOR.PRECIO > atipico] <- NA

median_value <- median(data$VALOR.PRECIO, na.rm = TRUE)

data$VALOR.PRECIO[is.na(data$VALOR.PRECIO)] <- median_value

Para manejar los valores atípicos en la variable numérica, primero identificamos aquellos valores que se encuentran significativamente por encima del rango típico de la distribución, utilizando el percentil 98 como umbral. Los valores superiores a este umbral fueron reemplazados por NA para mitigar el impacto de los valores atípicos en el análisis. Posteriormente, los valores faltantes (NA) fueron imputados con la mediana de los datos restantes, garantizando así una base de datos más uniforme para el análisis.

boxplot(data$VALOR.PRECIO, main = "Precio del combustible", col = "#6ab5b0")

summary(data$VALOR.PRECIO)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
      0    9350   10760   11756   13610   20282

Mapa de Colombia

register_google(key = api_key)

mapa_base <- get_googlemap("Colombia",
                           maptype = "hybrid",
                           scale = 2,
                           zoom = 7)

ℹ <https://maps.googleapis.com/maps/api/staticmap?center=Colombia&zoom=7&size=640x640&scale=2&maptype=hybrid&key=xxx>

ℹ <https://maps.googleapis.com/maps/api/geocode/json?address=Colombia&key=xxx>

ggmap(mapa_base)

mapa <- st_read("C:\\Users\\KELLY\\Documents\\MGN2023_DPTO_POLITICO (1)", quiet = FALSE)

Reading layer `MGN_ADM_DPTO_POLITICO' from data source 
  `C:\Users\KELLY\Documents\MGN2023_DPTO_POLITICO (1)' using driver `ESRI Shapefile'
Simple feature collection with 33 features and 8 fields
Geometry type: MULTIPOLYGON
Dimension:     XY
Bounding box:  xmin: -81.73562 ymin: -4.229406 xmax: -66.84722 ymax: 13.39473
Geodetic CRS:  MAGNA-SIRGAS

mapa <- st_make_valid(mapa) 
departamentos_shapefile <- unique(mapa$dpto_cnmbr)
departamentos_dataframe <- unique(data$DEPARTAMENTO)

departamentos_no_en_dataframe <- setdiff(departamentos_shapefile, departamentos_dataframe)
departamentos_no_en_shapefile <- setdiff(departamentos_dataframe, departamentos_shapefile)

mapa <- mapa %>%
  mutate(DEPARTAMENTO = recode(dpto_cnmbr,
                               "NARI?O" = "NARIÑO","BOGOTÁ, D.C."="BOGOTA D.C.", "BOLÍVAR" = "BOLIVAR","BOYACÁ"="BOYACA", "ATLÁNTICO"="ATLANTICO","CAQUETÁ"= "CAQUETA", "CHOCÓ"="CHOCO","GUAINÍA"="GUAINIA","CÓRDOBA"="CORDOBA", "VAUPÉS"="VAUPES"))


data <- data %>%
  mutate(DEPARTAMENTO = recode(DEPARTAMENTO,
                               "ARCHIPIELAGO DE SAN ANDRES, SANTA CATALINA Y PROVIDENCIA" = "ARCHIPIELAGO DE SAN ANDRES"))


precios <- data %>%
  group_by(DEPARTAMENTO) %>%
  summarise(PROMEDIO = mean(VALOR.PRECIO, na.rm = TRUE))

mapa <- st_as_sf(mapa, wkt = "geometry")
st_crs(mapa_base)

Coordinate Reference System: NA

mapa_pre <- mapa %>%
  left_join(precios, by = c("DEPARTAMENTO" = "DEPARTAMENTO"))

ggplot(data = mapa_pre) +
  geom_sf(aes(fill = PROMEDIO), color = "black", size = 0.2) +  
  scale_fill_viridis_c(option = "magma", name = "Precio Promedio", direction = -1) +  
  geom_sf_text(aes(label = DEPARTAMENTO), size = 3, color = "white", check_overlap = TRUE) + 
  labs(title = "Precio Promedio por Departamento en Colombia",
       fill = "Precio Promedio") +
  theme_minimal() +
  theme(legend.position = "bottom",  
        plot.title = element_text(hjust = 0.5, face = "bold"))  +
  coord_sf(expand = FALSE)

Warning in st_point_on_surface.sfc(sf::st_zm(x)): st_point_on_surface may not
give correct results for longitude/latitude data