Ejercicios - Visualización de datos

Ejercicio 1

A partir del dataset df, el cual trata de los incendios forestales, realice las siguientes tareas:

Filtrar los registros para incluir únicamente los incendios ocurridos en el estado de Idaho.
Seleccionar únicamente las columnas YEAR_, CAUSE y TOTALACRES.
Renombrar estas columnas con nombres más claros y descriptivos.
Agrupar la información por CAUSE y YEAR_.
Resumir el total de acres quemados para cada combinación de causa y año.
Elaborar una visualización que muestre los resultados de manera clara.

df <- read_csv("~/Desktop/RDataSets/StudyArea.csv")

Desarrollo

Filtrar los registros para incluir únicamente los incendios ocurridos en el estado de Idaho.

df %>% 
  filter(STATE == 'Idaho')

## # A tibble: 36,510 × 14
##      FID ORGANIZATI UNIT  SUBUNIT SUBUNIT2       FIRENAME CAUSE YEAR_ STARTDATED
##    <dbl> <chr>      <chr> <chr>   <chr>          <chr>    <chr> <dbl> <chr>     
##  1  3971 FWS        14613 USIDBLR Bear Lake Nat… Y ROAD   Human  1987 5/7/87 0:…
##  2  3972 FWS        14613 USIDBLR Bear Lake Nat… LIFTON   Natu…  1991 5/2/91 0:…
##  3  3973 FWS        14613 USIDBLR Bear Lake Nat… SPRING … Human  1991 5/20/91 0…
##  4  3974 FWS        14613 USIDBLR Bear Lake Nat… RAINBOW  Natu…  1990 6/9/90 0:…
##  5  3975 FWS        14613 USIDBLR Bear Lake Nat… RAINBOW… Human  1985 4/18/85 0…
##  6  3976 FWS        14613 USIDBLR Bear Lake Nat… HOAGESON Human  1988 10/24/88 …
##  7  3977 FWS        14613 USIDBLR Bear Lake Nat… MERKLEY  Natu…  1991 7/25/91 0…
##  8  3978 FWS        14613 USIDBLR Bear Lake Nat… MERKLEY  Human  1992 9/2/92 0:…
##  9  3979 FWS        14613 USIDBLR Bear Lake Nat… MERKLEY  Human  2002 3/29/02 0…
## 10  3980 FWS        14613 USIDBLR Bear Lake Nat… N MERKL… Human  1994 7/11/94 0…
## # ℹ 36,500 more rows
## # ℹ 5 more variables: CONTRDATED <chr>, OUTDATED <chr>, STATE <chr>,
## #   STATE_FIPS <dbl>, TOTALACRES <dbl>

Seleccionar únicamente las columnas YEAR_, CAUSE y TOTALACRES.

df %>% 
  select(YEAR_,CAUSE,TOTALACRES)

## # A tibble: 439,362 × 3
##    YEAR_ CAUSE TOTALACRES
##    <dbl> <chr>      <dbl>
##  1  2001 Human        0.1
##  2  2002 Human        3  
##  3  2002 Human        0.5
##  4  2001 Human        0.1
##  5  1994 Human        1  
##  6  1994 Human        0.1
##  7  1999 Human        3  
##  8  2003 Human        0.1
##  9  2005 Human        0.1
## 10  2005 Human        0.1
## # ℹ 439,352 more rows

Renombrar estas columnas con nombres más claros y descriptivos.

df %>% 
  select(Año_del_Incendio =YEAR_, Causa_del_Incendio=CAUSE, Area_Total_Quemada=TOTALACRES)

## # A tibble: 439,362 × 3
##    Año_del_Incendio Causa_del_Incendio Area_Total_Quemada
##               <dbl> <chr>                           <dbl>
##  1             2001 Human                             0.1
##  2             2002 Human                             3  
##  3             2002 Human                             0.5
##  4             2001 Human                             0.1
##  5             1994 Human                             1  
##  6             1994 Human                             0.1
##  7             1999 Human                             3  
##  8             2003 Human                             0.1
##  9             2005 Human                             0.1
## 10             2005 Human                             0.1
## # ℹ 439,352 more rows

Agrupar la información por CAUSE y YEAR_.

df %>% 
  group_by(CAUSE, YEAR_)%>%
  summarise(Total_incendios = n())

## `summarise()` has grouped output by 'CAUSE'. You can override using the
## `.groups` argument.

## # A tibble: 119 × 3
## # Groups:   CAUSE [5]
##    CAUSE YEAR_ Total_incendios
##    <chr> <dbl>           <int>
##  1 Human  1980            3910
##  2 Human  1981            3669
##  3 Human  1982            2704
##  4 Human  1983            3621
##  5 Human  1984            3614
##  6 Human  1985            4036
##  7 Human  1986            4806
##  8 Human  1987            6267
##  9 Human  1988            5863
## 10 Human  1989            5851
## # ℹ 109 more rows

#group_by prepara los grupos, summarise hace el cálculo sobre cada grupo.

Resumir el total de acres quemados para cada combinación de causa y año.

df <- df %>% filter(!is.na(CAUSE))

df %>% 
  group_by(CAUSE, YEAR_)%>%
  summarise(Acres_quemados = sum(TOTALACRES))->df2

## `summarise()` has grouped output by 'CAUSE'. You can override using the
## `.groups` argument.

df2

## # A tibble: 85 × 3
## # Groups:   CAUSE [4]
##    CAUSE YEAR_ Acres_quemados
##    <chr> <dbl>          <dbl>
##  1 Human  1980        338450.
##  2 Human  1981        523872.
##  3 Human  1982        188587.
##  4 Human  1983        266244.
##  5 Human  1984        441094.
##  6 Human  1985        587403.
##  7 Human  1986        291648.
##  8 Human  1987        818224.
##  9 Human  1988       2292834.
## 10 Human  1989        357471.
## # ℹ 75 more rows

Elaborar una visualización que muestre los resultados de manera clara.

ggplot(df2, aes(x = YEAR_, y = Acres_quemados, color = CAUSE)) +
  geom_line() +
  labs(
    title = "Acres quemados por causa a través del tiempo",
    x = "Año",
    y = "Acres quemados"
  )

Ejercicio 2

Trabajaremos con el conjunto de datos de 120 años de historia olímpica adquirido por Randi Griffin en Randi-Griffin y puesto a disposición en athlete_events.

Su tarea consiste en identificar los cinco deportes más importantes según el mayor número de medallas otorgadas en el año 2016, y luego realizar el siguiente análisis:

1.Genere una tabla que indique el número de medallas concedidas en cada uno de los cinco principales deportes en 2016.

2.Elabore una tabla que muestre la distribución de la edad de los ganadores de medallas en los cinco principales deportes en 2016.

3.Identifique qué equipos nacionales ganaron el mayor número de medallas en los cinco principales deportes en 2016.

4.Presente un resumen de la tendencia del peso de los atletas masculinos y femeninos ganadores en los cinco principales deportes en 2016.

datos <-read_csv("~/Downloads/athlete_events.csv")

## Rows: 271116 Columns: 15
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (10): Name, Sex, Team, NOC, Games, Season, City, Sport, Event, Medal
## dbl  (5): ID, Age, Height, Weight, 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.

Desarrollo

1. Genere una tabla que indique el número de medallas concedidas en cada uno de los cinco principales deportes en 2016.

datos %>% 
  filter(Year==2016, !is.na(Medal)) %>% 
  group_by(Sport) %>% 
  summarise(Total_medallas = n(), .groups = "drop") %>% 
  arrange(desc(Total_medallas)) %>%
  head(n=5) ->Top5_deportes

kable(Top5_deportes)

Sport	Total_medallas
Athletics	192
Swimming	191
Rowing	144
Football	106
Hockey	99

2. Elabore una tabla que muestre la distribución de la edad de los ganadores de medallas en los cinco principales deportes en 2016.

La distribución de la edad de los medallistas se describe inicialmente mediante estadísticos resumen por deporte.

datos %>% 
  filter(Year==2016, !is.na(Medal), Sport %in% Top5_deportes$Sport, !is.na(Age))->top


top %>% 
  group_by(Sport) %>% 
   summarise(media_edad = mean(Age), 
            ds_edad = sd(Age),
            mediana_edad = median(Age), 
            ri_edad = IQR(Age),
            min_edad = min(Age),
            max_edad = max(Age),
            q1_edad = quantile(Age)[2],
            q3_edad = quantile(Age)[4], .groups = "drop") ->tabla2

kable(tabla2)

Sport	media_edad	ds_edad	mediana_edad	ri_edad	min_edad	max_edad	q1_edad	q3_edad
Athletics	26.41146	4.131665	26	5.25	19	40	24	29.25
Football	24.08491	4.336156	23	6.00	17	34	21	27.00
Hockey	26.38384	4.072574	27	5.00	19	37	24	29.00
Rowing	28.12500	3.871855	28	6.00	20	40	25	31.00
Swimming	23.23037	4.013047	22	4.00	16	36	21	25.00

En los cinco principales deportes de 2016, la edad promedio de los medallistas varía según la disciplina. Swimming presenta el promedio más bajo de 23.23 años (desviación estándar de 4.01 años) y mediana de 22 años (RI = 4 años), donde el 50% se encuentra entre 21 y 25 años, indicando predominio de atletas jóvenes. En contraste, Rowing muestra la mayor edad promedio de 28.13 años (desviación estándar de 3.87 años), con una mediana de 28 años (RI = 6 años) y el 50% de los atletas entre 25 y 31 años, indicando una distribución centrada en edades más maduras sugiriendo que el rendimiento máximo se alcanza en estas edades. En Athletics la edad promedio de los medallistas es 26.4 años (desviación estándar de 4.1 años), con una mediana de 26 años (RI=5.25 años), el 50% de los atletas se concentra entre 24 y 29.3 años, siendo edades entre 19 y 40 algunos valores altos poco frecuentes. En Football los medallistas presentan una edad promedio de 24.1 años (desviación estándar de 4.3 años), mediana de 23 años (RI = 6 años) y el 50% de los atletas entre 21 y 27 años, lo que indica una concentración en atletas jóvenes. Finalmente, en Hockey a edad promedio es de 26.4 años (desviación estándar de 4.1 años), con mediana de 27 años (RI = 5 años), el 50% de las edades se ubica entre 24 y 29 años, lo que indica una dispersión moderada y una concentración alrededor del valor central.

Para complementar el análisis, se presenta la distribución de frecuencias de la edad agrupada en intervalos.

top %>% 
  mutate(Rango_edad = ifelse(Age %in% 10:14, "10-14",
                      ifelse(Age %in% 15:19, "15-19",
                      ifelse(Age %in% 20:24, "20-24",
                      ifelse(Age %in% 25:29, "25-29",
                      ifelse(Age %in% 30:34, "30-34",
                      ifelse(Age %in% 35:39, "35-39", "40+"))))))) %>%
  group_by(Sport, Rango_edad) %>%
  summarise(Frecuencia = n(), .groups = "drop") -> tabla_final

kable(tabla_final)

Sport	Rango_edad	Frecuencia
Athletics	15-19	3
Athletics	20-24	67
Athletics	25-29	74
Athletics	30-34	43
Athletics	35-39	4
Athletics	40+	1
Football	15-19	11
Football	20-24	55
Football	25-29	24
Football	30-34	16
Hockey	15-19	4
Hockey	20-24	29
Hockey	25-29	45
Hockey	30-34	19
Hockey	35-39	2
Rowing	20-24	23
Rowing	25-29	74
Rowing	30-34	38
Rowing	35-39	7
Rowing	40+	2
Swimming	15-19	32
Swimming	20-24	98
Swimming	25-29	42
Swimming	30-34	16
Swimming	35-39	3

Lo cual confirma lo previamente dicho, la mayoría de los medallistas se concentra en intervalos de edad jóvenes-adultos, aunque se observan algunos casos de edades más altas.

3. Identifique qué equipos nacionales ganaron el mayor número de medallas en los cinco principales deportes en 2016.

De forma general, los equipos nacionales que ganaron el mayor número de medallas totales en los cinco principales deportes en 2016 sin especificar por deporte son los siguientes:

datos %>% 
  filter(Year==2016, !is.na(Medal), Sport %in% Top5_deportes$Sport, !is.na(Team)) ->top2

top2 %>% 
  group_by(Team) %>% 
  summarise(Frecuencia = n(), .groups = "drop") %>% 
  arrange(desc(Frecuencia))

## # A tibble: 54 × 2
##    Team          Frecuencia
##    <chr>              <int>
##  1 United States        127
##  2 Germany               88
##  3 Great Britain         69
##  4 Canada                45
##  5 Australia             43
##  6 Netherlands           34
##  7 Jamaica               30
##  8 Sweden                21
##  9 France                20
## 10 Brazil                19
## # ℹ 44 more rows

Sin embargo, si queremos identificarlos por deporte, sería de la siguiente manera:

datos %>% 
  filter(Year==2016, !is.na(Medal), Sport %in% Top5_deportes$Sport, !is.na(Team)) ->top2

top2 %>% 
  group_by(Sport, Team) %>% 
  summarise(Frecuencia = n(), .groups = "drop") %>% 
  arrange(Sport, desc(Frecuencia))

## # A tibble: 94 × 3
##    Sport     Team          Frecuencia
##    <chr>     <chr>              <int>
##  1 Athletics United States         46
##  2 Athletics Jamaica               30
##  3 Athletics Great Britain         14
##  4 Athletics Kenya                 13
##  5 Athletics Canada                10
##  6 Athletics Ethiopia               8
##  7 Athletics Bahamas                6
##  8 Athletics China                  6
##  9 Athletics France                 6
## 10 Athletics Japan                  5
## # ℹ 84 more rows

4. Presente un resumen de la tendencia del peso de los atletas masculinos y femeninos ganadores en los cinco principales deportes en 2016.

De manera similar al punto anterior, si queremos una resumen de la tendencia del peso de los atletas masculinos y femeninos ganadores en los cinco principales deportes en 2016 en total sin especificar los deportes sería el siguiente:

datos %>% 
  filter(Year==2016, !is.na(Medal), Sport %in% Top5_deportes$Sport, !is.na(Sex), !is.na(Weight)) ->top3

top3 %>% 
  group_by(Sex) %>% 
  summarise(
    media_peso = mean(Weight),
    sd_peso = sd(Weight),
    mediana_peso = median(Weight),
    ri_peso = IQR(Weight),
    min_peso = min(Weight),
    max_peso = max(Weight),
    q1_peso = quantile(Weight)[2],
    q3_peso = quantile(Weight)[4],
    .groups = "drop"
    
 )->tabla_peso
  
kable(tabla_peso)

Sex	media_peso	sd_peso	mediana_peso	ri_peso	min_peso	max_peso	q1_peso	q3_peso
F	65.24507	10.04168	65	12	40	136	59	71
M	81.80914	12.97826	80	17	47	134	73	90

En los cinco principales deportes de 2016, las atletas femeninas presentan un peso promedio de 65.25 kg (desviación estándar de 10.04 kg), donde el 50% de las medallistas pesa menos o igual a 65 kg, con un mínimo de 40 kg y un máximo de 136 kg. El 25% de las atletas pesa menos o igual a 59 kg y el 75% menos o igual a 71 kg. El valor máximo es considerablemente mayor que el tercer cuartil, lo que sugiere la presencia de valores atípicos.

Por su parte, los atletas masculinos presentan un peso promedio de 81.81 kg (desviación estándar de 12.98 kg), con una mediana de 80 kg, un mínimo de 47 kg y un máximo de 134 kg. El 25% pesa menos o igual a 73 kg y el 75% menos o igual a 90 kg, mostrando una mayor dispersión en comparación con las mujeres.

En general, se observa que los atletas masculinos tienen un peso promedio aproximadamente 16.5 kg mayor que las atletas femeninas, así como una mayor variabilidad en los valores registrados. Además, los valores máximos en ambos grupos superan considerablemente el tercer cuartil, sugiriendo posibles valores atípicos.

No obstante, si queremos especificar por deporte sería el siguiente resumen numérico:

datos %>% 
  filter(Year==2016, !is.na(Medal), Sport %in% Top5_deportes$Sport, !is.na(Sex), !is.na(Weight)) ->top3

top3 %>% 
  group_by(Sport, Sex) %>% 
  summarise(
    media_peso = mean(Weight),
    sd_peso = sd(Weight),
    mediana_peso = median(Weight),
    ri_peso = IQR(Weight),
    min_peso = min(Weight),
    max_peso = max(Weight),
    q1_peso = quantile(Weight)[2],
    q3_peso = quantile(Weight)[4],
    .groups = "drop"
    
 )->tabla_peso1
  
kable(tabla_peso1)

Sport	Sex	media_peso	sd_peso	mediana_peso	ri_peso	min_peso	max_peso	q1_peso	q3_peso
Athletics	F	62.57895	14.940719	59.0	12.50	40	136	55.5	68.00
Athletics	M	79.07447	17.764432	75.5	16.75	47	134	68.0	84.75
Football	F	62.96296	5.917556	63.0	7.75	52	75	59.0	66.75
Football	M	75.72549	8.251251	76.0	9.50	51	95	70.5	80.00
Hockey	F	63.06122	5.363488	63.0	9.00	54	74	58.0	67.00
Hockey	M	78.38000	6.249539	77.0	8.00	64	95	74.0	82.00
Rowing	F	71.76667	7.971063	73.5	8.00	50	86	68.0	76.00
Rowing	M	88.83333	12.520666	93.0	15.00	55	110	82.0	97.00
Swimming	F	66.19588	6.371550	66.0	9.00	52	85	61.0	70.00
Swimming	M	83.40860	8.877471	85.0	13.00	59	100	77.0	90.00

En los cinco deportes principales de 2016 se observa que, en todos los casos, los atletas masculinos presentan un peso promedio mayor que las atletas femeninas.

Por ejemplo, en Athletics, las mujeres tienen un peso promedio de 62.6 kg (desviación estándar de 14.94 kg), donde el 50% de las atletas pesa menos o igual a 59 kg, con un mínimo de 40 kg y un máximo de 136 kg. El 25% pesa menos o igual a 55.5 kg y el 75% menos o igual a 68 kg. Este valor máximo es considerablemente alto respecto al tercer cuartil, lo que sugiere la presencia de posibles valores atípicos. En contraste, los hombres en Athletics presentan un promedio de 79.07 kg (desviación estándar de 17.76 kg), con una mediana de 75.5 kg, un mínimo de 47 kg y un máximo de 134 kg. El 25% ésa menos o igual a 68 kg y el 75% menos o igual a 84.75, con un máximo que también indica la presencia de posibles valores atípicos.

De manera similar, en Football, los hombres tienen un peso promedio cercano a 75.7 kg, mientras que las mujeres presentan aproximadamente 63 kg. En Hockey, el promedio masculino es de 78.38 kg frente a 63.06 kg en mujeres. En Rowing, se presenta la mayor diferencia, con un promedio de 88.83 kg en hombres y 71.77 kg en mujeres. En Swimming, los hombres promedian 83.41 kg, mientras que las mujeres aproximadamente 66.20 kg.

Ejercicio 3

Considere el conjunto de datos us_state_population.tsv ubicado en la carpeta de datos de Python de github. Repita el procedimiento planteado en cada ítem de esta sección para obtener el nuevo dataframe con las nuevas columnas Year y Population. Realice unión y separación utilizando las columnas State y Code.

Desarrollo

Primero, cargamos el dataset a utilizar que en este caso es us_state_polutation.tsv:

df <- read_tsv("~/Downloads/us_state_population.tsv")
kable(df[1:7, ],
    caption = "Población de Estados Unidos",
    align = "c") %>%
  kable_styling(
    bootstrap_options = c("striped", "hover", "condensed"),
    full_width = TRUE,
    position = "center"
  ) %>% 
  row_spec(0, bold = TRUE, background = "lightgray")

Población de Estados Unidos
State	Code	2010	2011	2012	2013	2014	2015	2016	2017	2018
Alabama	AL	4785448	4798834	4815564	4830460	4842481	4853160	4864745	4875120	4887871
Alaska	AK	713906	722038	730399	737045	736307	737547	741504	739786	737438
Arizona	AZ	6407774	6473497	6556629	6634999	6733840	6833596	6945452	7048876	7171646
Arkansas	AR	2921978	2940407	2952109	2959549	2967726	2978407	2990410	3002997	3013825
California	CA	37320903	37641823	37960782	38280824	38625139	38953142	39209127	39399349	39557045
Colorado	CO	5048281	5121771	5193721	5270482	5351218	5452107	5540921	5615902	5695564
Connecticut	CT	3579125	3588023	3594395	3594915	3594783	3587509	3578674	3573880	3572665

Utilizamos la función gather() para convertir las columnas 2010, 2011,…, 2018 en dos nuevas columnas: una llamada Year, que contendrá los años, y otra llamada Population, que almacenará los valores correspondientes a cada año.

df1 <- gather(df, 
              "2010", "2011", "2012", "2013", "2014", "2015", "2016", "2017", "2018",
              key = "Year",
              value = "Population")
kable(df1[1:7, ],
    align = "c") %>%
  kable_styling(
    bootstrap_options = c("striped", "hover", "condensed"),
    full_width = TRUE,
    position = "center"
  ) %>% 
  row_spec(0, bold = TRUE, background = "lightgray")

State	Code	Year	Population
Alabama	AL	2010	4785448
Alaska	AK	2010	713906
Arizona	AZ	2010	6407774
Arkansas	AR	2010	2921978
California	CA	2010	37320903
Colorado	CO	2010	5048281
Connecticut	CT	2010	3579125

Ahora, haremos uso de la función union() para combinar las columnas State y Code en una sola. A la nueva columna la llamaremos State-Code.

df2 <- unite(df1, "State-Code", State, Code, sep = "-")
kable(df2[1:7, ],
    align = "c") %>%
  kable_styling(
    bootstrap_options = c("striped", "hover", "condensed"),
    full_width = TRUE,
    position = "center"
  ) %>% 
  row_spec(0, bold = TRUE, background = "lightgray")

State-Code	Year	Population
Alabama-AL	2010	4785448
Alaska-AK	2010	713906
Arizona-AZ	2010	6407774
Arkansas-AR	2010	2921978
California-CA	2010	37320903
Colorado-CO	2010	5048281
Connecticut-CT	2010	3579125

Por último, realizaremos la acción justamente inversa que se hace con la función separate(); esto es, separar dos variables que se colocaron en la misma columna.

df3 <- separate(df2, "State-Code", into = c("State", "Code"), sep = "-")
kable(df3[1:7, ],
    align = "c") %>%
  kable_styling(
    bootstrap_options = c("striped", "hover", "condensed"),
    full_width = TRUE,
    position = "center"
  ) %>% 
  row_spec(0, bold = TRUE, background = "lightgray")

State	Code	Year	Population
Alabama	AL	2010	4785448
Alaska	AK	2010	713906
Arizona	AZ	2010	6407774
Arkansas	AR	2010	2921978
California	CA	2010	37320903
Colorado	CO	2010	5048281
Connecticut	CT	2010	3579125

Finalmente, aplicamos spread() para completar el ejercicio. Esta función transformará los datos de nuevo al formato original con columnas separadas por año.

df4 = spread(df3, key = "Year", value = "Population")
kable(df4[1:7, ],
    align = "c") %>%
  kable_styling(
    bootstrap_options = c("striped", "hover", "condensed"),
    full_width = TRUE,
    position = "center"
  ) %>% 
  row_spec(0, bold = TRUE, background = "lightgray")

State	Code	2010	2011	2012	2013	2014	2015	2016	2017	2018
Alabama	AL	4785448	4798834	4815564	4830460	4842481	4853160	4864745	4875120	4887871
Alaska	AK	713906	722038	730399	737045	736307	737547	741504	739786	737438
Arizona	AZ	6407774	6473497	6556629	6634999	6733840	6833596	6945452	7048876	7171646
Arkansas	AR	2921978	2940407	2952109	2959549	2967726	2978407	2990410	3002997	3013825
California	CA	37320903	37641823	37960782	38280824	38625139	38953142	39209127	39399349	39557045
Colorado	CO	5048281	5121771	5193721	5270482	5351218	5452107	5540921	5615902	5695564
Connecticut	CT	3579125	3588023	3594395	3594915	3594783	3587509	3578674	3573880	3572665

Ejercicios - Visualización de datos

Alejandra Meneses y Mariangel Yepes

2026-02-07

Ejercicio 1

Desarrollo

Ejercicio 2

Desarrollo

Ejercicio 3

Desarrollo