#Librerías importantes
library(tidyverse)
library(dplyr)
library(tidyr)
library(gt)
library(scales)
library(devtools)

ENTREGABLE 1

1. Introducción

En el presente ejercicio se analiza el comportamiento de los incendios forestales en el estado de Idaho, utilizando un conjunto de datos históricos que registra información sobre año, causa y superficie afectada. El objetivo principal es filtrar los datos correspondientes a Idaho, agrupar la información por causa y año, y calcular el total de acres quemados, con el fin de identificar patrones y tendencias en la ocurrencia de incendios.

2. Importe de datos

df <- read_csv("C:/Users/danih/OneDrive/Documentos/R/VISU/RDataSets/StudyArea.csv")
df
## # A tibble: 439,362 × 14
##      FID ORGANIZATI UNIT  SUBUNIT SUBUNIT2       FIRENAME CAUSE YEAR_ STARTDATED
##    <dbl> <chr>      <chr> <chr>   <chr>          <chr>    <chr> <dbl> <chr>     
##  1     0 FWS        81682 USCADBR San Diego Bay… PUMP HO… Human  2001 1/1/01 0:…
##  2     1 FWS        81682 USCADBR San Diego Bay… I5       Human  2002 5/3/02 0:…
##  3     2 FWS        81682 USCADBR San Diego Bay… SOUTHBAY Human  2002 6/1/02 0:…
##  4     3 FWS        81682 USCADBR San Diego Bay… MARINA   Human  2001 7/12/01 0…
##  5     4 FWS        81682 USCADBR San Diego Bay… HILL     Human  1994 9/13/94 0…
##  6     5 FWS        81682 USCADBR San Diego Bay… IRRIGAT… Human  1994 4/22/94 0…
##  7     6 FWS        81682 USCADBR San Diego Bay… FIELD    Human  1999 12/6/99 0…
##  8    18 FWS        81682 USCADBR San Diego Bay… CALLA F… Human  2003 6/3/03 0:…
##  9    20 FWS        81682 USCADBR San Diego Bay… OVERPASS Human  2005 8/20/05 0…
## 10    21 FWS        81682 USCADBR San Diego Bay… TRAIN F… Human  2005 12/11/05 …
## # ℹ 439,352 more rows
## # ℹ 5 more variables: CONTRDATED <chr>, OUTDATED <chr>, STATE <chr>,
## #   STATE_FIPS <dbl>, TOTALACRES <dbl>

3. Desarrollo

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

df %>% 
  filter(STATE== 'Idaho') -> incendios_idaho 
incendios_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>

3.2 Seleccionar únicamente las columnas YEAR_, CAUSE y TOTALACRES.

incendios_idaho %>% 
  select(YEAR_, CAUSE, TOTALACRES) ->incendios_idaho
incendios_idaho
## # A tibble: 36,510 × 3
##    YEAR_ CAUSE   TOTALACRES
##    <dbl> <chr>        <dbl>
##  1  1987 Human          5  
##  2  1991 Natural      150  
##  3  1991 Human        800  
##  4  1990 Natural        2  
##  5  1985 Human         38  
##  6  1988 Human          2  
##  7  1991 Natural        0.2
##  8  1992 Human        150  
##  9  2002 Human         15  
## 10  1994 Human         30  
## # ℹ 36,500 more rows

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

incendios_idaho %>% 
  select("AÑO"="YEAR_", "CAUSA"="CAUSE", "Total_Acres"="TOTALACRES") ->incendios_idaho

incendios_idaho
## # A tibble: 36,510 × 3
##      AÑO CAUSA   Total_Acres
##    <dbl> <chr>         <dbl>
##  1  1987 Human           5  
##  2  1991 Natural       150  
##  3  1991 Human         800  
##  4  1990 Natural         2  
##  5  1985 Human          38  
##  6  1988 Human           2  
##  7  1991 Natural         0.2
##  8  1992 Human         150  
##  9  2002 Human          15  
## 10  1994 Human          30  
## # ℹ 36,500 more rows

3.4 Agrupar la información por CAUSE y YEAR_.

incendios_idaho %>% 
  group_by(CAUSA, AÑO) ->incendios_idaho_agrup 

incendios_idaho_agrup
## # A tibble: 36,510 × 3
## # Groups:   CAUSA, AÑO [96]
##      AÑO CAUSA   Total_Acres
##    <dbl> <chr>         <dbl>
##  1  1987 Human           5  
##  2  1991 Natural       150  
##  3  1991 Human         800  
##  4  1990 Natural         2  
##  5  1985 Human          38  
##  6  1988 Human           2  
##  7  1991 Natural         0.2
##  8  1992 Human         150  
##  9  2002 Human          15  
## 10  1994 Human          30  
## # ℹ 36,500 more rows

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

incendios_idaho_agrup %>% 
  #summarise()
  summarise(
    Total_Acres_Quemados = sum(Total_Acres, na.rm = TRUE), #si encuentra un NA no lo agrega a la suma(por eso el remove), en este caso la columna Total_Acres no tiene NA sino 0´s, por lo que se puede omitir.
    .groups = "drop"  #Evita una advertencia que sale al elimnar la estructura de agrupación
  ) -> incendios_idaho_resumen
incendios_idaho_resumen
## # A tibble: 96 × 3
##    CAUSA   AÑO Total_Acres_Quemados
##    <chr> <dbl>                <dbl>
##  1 Human  1980               71975.
##  2 Human  1981              219362.
##  3 Human  1982               34016.
##  4 Human  1983               48242.
##  5 Human  1984               36838.
##  6 Human  1985               68035.
##  7 Human  1986               43181.
##  8 Human  1987               35128.
##  9 Human  1988              810403.
## 10 Human  1989               28022.
## # ℹ 86 more rows

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

Gráfico de líneas múltiples

df_plot <- incendios_idaho_resumen %>%
  mutate(
    cause = ifelse(is.na(CAUSA), "Sin dato", CAUSA),
    cause = factor(CAUSA, levels = c("Natural", "Human", "Undetermined", "Sin dato"))
  )

pal_morada <- c(
  "Natural"       = "#3B0A6D",  
  "Human"         = "#7A1FA2",  
  "Undetermined"  = "#B57EDC",  
  "Sin dato"      = "#D8B4F8"   
)

ggplot(df_plot, aes(x = AÑO, y = Total_Acres_Quemados, color = CAUSA)) +
  geom_line(linewidth = 1.2, alpha = 0.95) +
  geom_point(size = 2, alpha = 0.95) +
  scale_color_manual(values = pal_morada) +
  scale_y_continuous(labels = label_number(big.mark = ".", decimal.mark = ",")) +
  labs(
    title = "Total de acres quemados por causa de incendios en Idaho",
    subtitle = "Suma anual de acres quemados (agrupado por causa)",
    x = "Año",
    y = "Acres quemados (total anual)",
    color = "Causa"
  ) +
  theme_minimal(base_size = 12) +
  theme(
    plot.title = element_text(face = "bold", size = 16),
    plot.title.position = "plot",
    plot.margin = margin(t = 20, r = 20, b = 20, l = 20),
    plot.subtitle = element_text(size = 11),
    axis.title = element_text(face = "bold"),
    legend.position = "right",
    legend.title = element_text(face = "bold"),
    panel.grid.minor = element_blank(),
    panel.background = element_rect(fill = "grey92", color = NA),
    plot.background  = element_rect(fill = "white", color = NA)
  )

Interpretación

A lo largo del período analizado, se observa que los incendios de origen natural presentan una mayor variabilidad y magnitud en comparación con los de origen humano. En particular, destacan picos pronunciados en ciertos años, donde la superficie afectada por incendios naturales supera ampliamente al resto de las causas, alcanzando valores superiores a los dos millones de acres quemados.

Por su parte, los incendios causados por actividades humanas muestran un comportamiento más estable, con fluctuaciones moderadas a lo largo del tiempo y valores considerablemente menores en términos de acres quemados. Si bien existen años con incrementos puntuales, la magnitud de estos eventos no alcanza los niveles observados en los incendios de origen natural.

Gráfico Heap Map

df_plot_filtrado <- df_plot %>%
  filter(cause %in% c("Human", "Natural"))

ggplot(df_plot_filtrado, aes(x = AÑO, y = CAUSA, fill = Total_Acres_Quemados)) +
  geom_tile() +
  scale_fill_gradient(low = "#EAD7FF", high = "#3B0A6D",
                      labels = label_number(big.mark=".", decimal.mark=",")) +
  labs(
    title = "Total de acres quemados por causa de incendios en Idaho",
    x = "Año",
    y = "Causa",
    fill = "Toral Acres"
  ) +
  theme_minimal(base_size = 12) +
  theme(
    plot.title = element_text(face = "bold", size = 16),
    plot.title.position = "plot",
    plot.subtitle = element_text(size = 11),
    axis.title = element_text(face = "bold"),
    panel.background = element_rect(fill = "grey95", color = NA),
    panel.grid = element_blank()
    
  )

### Interpretación

Los tonos más oscuros evidencian que los incendios de origen natural concentran los mayores niveles de acres quemados y presentan una variabilidad más marcada a lo largo del tiempo, con episodios puntuales de alta severidad. En contraste, los incendios de causa humana muestran una intensidad más baja y relativamente constante, sin alcanzar los niveles observados en los eventos naturales.

4.Conclusión

El análisis evidenció que los incendios de origen natural concentran la mayor cantidad de acres quemados en Idaho, especialmente en años caracterizados por picos significativos de afectación. Aunque los incendios de causa humana se presentan de manera recurrente, su impacto en términos de superficie afectada resulta considerablemente menor. Las visualizaciones desarrolladas permitieron identificar tendencias temporales y diferencias claras entre causas, demostrando la utilidad del análisis de datos para comprender la dinámica de los incendios forestales.

ENTREGABLE 2

1. Introducción

El presente análisis se desarrolla a partir del conjunto de datos athlete_events, que recopila más de un siglo de historia olímpica. En este ejercicio se examinan específicamente los resultados correspondientes a los Juegos Olímpicos de 2016, con el objetivo de identificar los cinco deportes con mayor número de medallas otorgadas y realizar un análisis descriptivo de los atletas ganadores en dichas disciplinas.

2. Importe de datos

df2 <- read_csv("https://raw.githubusercontent.com/cdeoroaguado/Datos/refs/heads/main/dataviz/athlete_events.csv")
df2 %>%
  filter(Year == 2016, !is.na(Medal)) -> Olimpiadas_2016 
Olimpiadas_2016
## # A tibble: 2,023 × 15
##       ID Name     Sex     Age Height Weight Team  NOC   Games  Year Season City 
##    <dbl> <chr>    <chr> <dbl>  <dbl>  <dbl> <chr> <chr> <chr> <dbl> <chr>  <chr>
##  1    62 "Giovan… M        21    198     90 Italy ITA   2016…  2016 Summer Rio …
##  2    65 "Patima… F        21    165     49 Azer… AZE   2016…  2016 Summer Rio …
##  3    73 "Luc Ab… M        31    182     86 Fran… FRA   2016…  2016 Summer Rio …
##  4   250 "Saeid … M        26    170     80 Iran  IRI   2016…  2016 Summer Rio …
##  5   455 "Denis … M        24    161     62 Russ… RUS   2016…  2016 Summer Rio …
##  6   455 "Denis … M        24    161     62 Russ… RUS   2016…  2016 Summer Rio …
##  7   455 "Denis … M        24    161     62 Russ… RUS   2016…  2016 Summer Rio …
##  8   465 "Matthe… M        30    197     92 Aust… AUS   2016…  2016 Summer Rio …
##  9   576 "Alejan… M        23    198     93 Spain ESP   2016…  2016 Summer Rio …
## 10   608 "Ahmad … M        20    178     68 Jord… JOR   2016…  2016 Summer Rio …
## # ℹ 2,013 more rows
## # ℹ 3 more variables: Sport <chr>, Event <chr>, Medal <chr>

Los datos fueron importados desde un repositorio público en formato CSV, este conjunto de datos cuenta con 271.116 observaciones y 15 variables. Se filtran los registros del año 2016 y se conservan únicamente aquellos atletas que obtuvieron medalla (Gold, Silver o Bronze) dado a la naturaleza del ejercicio.

Olimpiadas_2016 %>%
  count(Sport, sort = TRUE) %>%
  slice_head(n = 5) -> Top5_deportes
Top5_deportes
## # A tibble: 5 × 2
##   Sport         n
##   <chr>     <int>
## 1 Athletics   192
## 2 Swimming    191
## 3 Rowing      144
## 4 Football    106
## 5 Hockey       99

En este apartado se contabiliza el número de medallas otorgadas por deporte en 2016 y se seleccionan los cinco deportes con mayor frecuencia.

3. Desarrollo

3.1 Deportes con mayor número de medallas en 2016.

Olimpiadas_2016 %>% 
  semi_join(Top5_deportes, by = "Sport") %>% 
  count(Sport, Medal, name = "Medallas_2016") %>%
  pivot_wider(names_from = Medal, values_from = Medallas_2016, values_fill = 0) %>%
  mutate(Total = Gold + Silver + Bronze) %>%
  arrange(desc(Total)) -> Tabla_medallas_top5 


Tabla_medallas_top5 %>%
  gt() %>%
  tab_header(
    title = md("**Medallas otorgadas por deporte (Top 5)**"),
    subtitle = "Juegos olímpicos 2016"
  ) %>%
  cols_label(
    Sport = "Deporte",
    Gold = "Oro",
    Silver = "Plata",
    Bronze = "Bronce",
    Total = "Total"
  ) %>%
  fmt_number(columns = c(Gold, Silver, Bronze, Total), decimals = 0) %>%
  data_color(
    columns = Total,
    palette = c("#F2E9FF", "#3B0A6D")   
  ) %>%
  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_body(columns = Total)
  ) %>%
  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_column_labels(everything())
  ) %>%
  tab_options(
    table.font.names = "Arial",
    table.font.size = px(12),
    heading.title.font.size = px(16),
    heading.subtitle.font.size = px(12),
    column_labels.background.color = "#F5F5F5",
    table.border.top.style = "solid",
    table.border.top.color = "#D9D9D9",
    table.border.bottom.style = "solid",
    table.border.bottom.color = "#D9D9D9",
    row.striping.include_table_body = TRUE,
    row.striping.background_color = "#FAFAFA"
  )
Medallas otorgadas por deporte (Top 5)
Juegos olímpicos 2016
Deporte Bronce Oro Plata Total
Athletics 62 66 64 192
Swimming 57 71 63 191
Rowing 48 48 48 144
Football 36 35 35 106
Hockey 33 34 32 99

La tabla presenta, para cada uno de los cinco deportes principales, el número de medallas desagregado por tipo (oro, plata y bronce) y el total. Este resultado se encuentra asociado a la cantidad de pruebas incluidas en cada disciplina dentro del programa olímpico.

3.2 Distribución de la edad de los ganadores de medallas.

Olimpiadas_2016 %>%
  #filter(Sport %in% top5_sports$Sport, !is.na(Age)) %>%
  semi_join(Top5_deportes, by = "Sport") %>%
  filter(!is.na(Age)) %>%
  group_by(Sport) %>%
  summarise(
    n = n(),
    edad_media = mean(Age),
    edad_mediana = median(Age),
    edad_min = min(Age),
    edad_q1 = quantile(Age, 0.25),
    edad_q3 = quantile(Age, 0.75),
    edad_max = max(Age),
    .groups = "drop"
  ) %>%
  arrange(desc(n)) -> Tabla_edad_top5

Se analizó la edad de los atletas ganadores de medallas en 2016 en los cinco deportes seleccionados mediante estadísticas descriptivas (promedio, mediana, mínimo, máximo…). Esto permite comparar deportes donde tienden a ganar atletas más jóvenes vs. más experimentados.

Tabla_edad_top5 %>%
  gt() %>%
  tab_header(
    title = md("**Distribución de edades de ganadores (Top 5 deportes)**"),
    subtitle = "Juegos olímpicos 2016"
  ) %>%
  cols_label(
    Sport = "Deporte",
    n = "Total Medallas",
    edad_media = "Media",
    edad_mediana = "Mediana",
    edad_min = "Mín",
    edad_q1 = "Q1",
    edad_q3 = "Q3",
    edad_max = "Máx"
  ) %>%
  fmt_number(
    columns = c(n),
    decimals = 0
  ) %>%
  fmt_number(
    columns = c(edad_media, edad_mediana, edad_min, edad_q1, edad_q3, edad_max),
    decimals = 1
  ) %>%
  data_color(
    columns = edad_media,
    palette = c("#F2E9FF", "#3B0A6D")
  ) %>%
  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_column_labels(everything())
  ) %>%
  tab_options(
    table.font.names = "Arial",
    table.font.size = px(12),
    heading.title.font.size = px(16),
    heading.subtitle.font.size = px(12),
    column_labels.background.color = "#F5F5F5",
    row.striping.include_table_body = TRUE,
    row.striping.background_color = "#FAFAFA"
  )
Distribución de edades de ganadores (Top 5 deportes)
Juegos olímpicos 2016
Deporte Total Medallas Media Mediana Mín Q1 Q3 Máx
Athletics 192 26.4 26.0 19.0 24.0 29.2 40.0
Swimming 191 23.2 22.0 16.0 21.0 25.0 36.0
Rowing 144 28.1 28.0 20.0 25.0 31.0 40.0
Football 106 24.1 23.0 17.0 21.0 27.0 34.0
Hockey 99 26.4 27.0 19.0 24.0 29.0 37.0

En general, se observan diferencias entre deportes: algunos concentran ganadores en rangos de edad más jóvenes, mientras que otros presentan perfiles de edad relativamente mayores, lo que sugiere dinámicas competitivas distintas según la disciplina.

Los resultados muestran que existen diferencias en la edad de los atletas según el deporte, observándose edades promedio más bajas en disciplinas como natación y fútbol, y edades promedio más altas en deportes como remo y atletismo.

Gráfico de cajas y bigotes

library(ggplot2)
library(forcats)

df_age_plot <- Olimpiadas_2016 %>%
  semi_join(Top5_deportes, by = "Sport") %>%
  filter(!is.na(Age)) %>%
  mutate(Sport = fct_reorder(Sport, Age, .fun = median))
df_age_plot
## # A tibble: 732 × 15
##       ID Name     Sex     Age Height Weight Team  NOC   Games  Year Season City 
##    <dbl> <chr>    <chr> <dbl>  <dbl>  <dbl> <chr> <chr> <chr> <dbl> <chr>  <chr>
##  1    62 "Giovan… M        21    198     90 Italy ITA   2016…  2016 Summer Rio …
##  2   465 "Matthe… M        30    197     92 Aust… AUS   2016…  2016 Summer Rio …
##  3   690 "Chanta… F        31    172     72 Neth… NED   2016…  2016 Summer Rio …
##  4   846 "Valeri… F        31    193    120 New … NZL   2016…  2016 Summer Rio …
##  5  1017 "Nathan… M        27    198    100 Unit… USA   2016…  2016 Summer Rio …
##  6  1017 "Nathan… M        27    198    100 Unit… USA   2016…  2016 Summer Rio …
##  7  1017 "Nathan… M        27    198    100 Unit… USA   2016…  2016 Summer Rio …
##  8  1017 "Nathan… M        27    198    100 Unit… USA   2016…  2016 Summer Rio …
##  9  1551 "Oluwaf… M        20    172     79 Nige… NGR   2016…  2016 Summer Rio …
## 10  1561 "Mobola… M        20    180     62 Cana… CAN   2016…  2016 Summer Rio …
## # ℹ 722 more rows
## # ℹ 3 more variables: Sport <fct>, Event <chr>, Medal <chr>
ggplot(df_age_plot, aes(x = Sport, y = Age)) +
  geom_boxplot(fill = "#B57EDC", color = "#3B0A6D", width = 0.6, outlier_alpha = 0.4) +
  coord_flip() +
  labs(
    title = "Distribución de edades de ganadores por deporte",
    x = "Deporte",
    y = "Edad (años)"
  ) +
  theme_minimal(base_size = 12) +
  theme(
    plot.title = element_text(face = "bold", size = 16),
    plot.title.position = "plot",
    plot.subtitle = element_text(size = 11),
    axis.title = element_text(face = "bold"),
    panel.background = element_rect(fill = "grey95", color = NA),
    panel.grid.minor = element_blank(),
    plot.margin = margin(25, 20, 20, 20)
  )

El diagrama de cajas evidencia diferencias en la distribución de la edad entre deportes. Se observan variaciones tanto en la mediana como en la dispersión (rango intercuartílico), lo que indica que algunos deportes concentran ganadores en rangos de edad más homogéneos, mientras que otros presentan mayor variabilidad. Además, los valores atípicos sugieren la presencia de ganadores con edades notablemente distintas al grupo principal en ciertas disciplinas.

library(dplyr)
library(ggplot2)
library(scales)

pareto_edad <- Olimpiadas_2016 %>%
  semi_join(Top5_deportes, by = "Sport") %>%
  filter(!is.na(Age)) %>%
  mutate(
    rango_edad = cut(
      Age,
      breaks = seq(15, 45, by = 5),
      right = FALSE
    )
  ) %>%
  count(rango_edad) %>%
  arrange(desc(n)) %>%
  mutate(
    prop = n / sum(n),
    prop_acum = cumsum(prop),
    rango_edad = factor(rango_edad, levels = rango_edad)
  )

Gráfico de pareto

ggplot(pareto_edad, aes(x = rango_edad)) +
  geom_col(aes(y = n), fill = "#3B0A6D", alpha = 0.9) +
  geom_line(aes(y = prop_acum * max(n), group = 1),
            color = "#B57EDC", linewidth = 1.2) +
  geom_point(aes(y = prop_acum * max(n)),
             color = "#B57EDC", size = 2.5) +
  scale_y_continuous(
    name = "Número de ganadores",
    sec.axis = sec_axis(~ . / max(pareto_edad$n),
                        labels = percent_format(accuracy = 1),
                        name = "% acumulado")
  ) +
  labs(
    title = "Distribución de edad de ganadores (Top 5, 2016)",
    subtitle = "Barras: frecuencia por rango | Línea: porcentaje acumulado",
    x = "Rango de edad"
  ) +
  theme_minimal(base_size = 12) +
  theme(
    plot.title = element_text(face = "bold", size = 16),
    axis.title = element_text(face = "bold"),
    panel.background = element_rect(fill = "grey95", color = NA),
    panel.grid.minor = element_blank()
  )

El gráfico de Pareto evidencia que la mayor concentración de ganadores se encuentra en rangos de edad intermedios, especialmente entre los 20 y 29 años. La línea acumulada muestra que estos primeros rangos concentran más del 70% de los atletas premiados, lo que indica que el rendimiento olímpico en los principales deportes de 2016 se encuentra predominantemente en edades de madurez física óptima. Los rangos superiores presentan una menor frecuencia, lo que sugiere que la probabilidad de obtención de medalla disminuye a edades más avanzadas.

3.3 Equipos nacionales con mayor número de medallas.

Olimpiadas_2016 %>%
  filter(Sport %in% Top5_deportes$Sport) %>%
  #semi_join(Top5_deportes, by = "Sport") %>%
  count(Sport, Team, name = "medals") %>%
  group_by(Sport) %>%
  slice_max(order_by = medals, n = 1, with_ties = TRUE) %>% #slice max selecciona las filas que tienen los valores más altos, usando la columna medals para decidir
  #n=1 el número de posiciones top que se quieren
  #with_ties para el tratamiento de empates
  ungroup() %>% #por seguridad y que no afecte resultados posteriores
  arrange(desc(medals)) -> Top_Equi_Nacio

Top_Equi_Nacio
## # A tibble: 5 × 3
##   Sport     Team          medals
##   <chr>     <chr>          <int>
## 1 Swimming  United States     71
## 2 Athletics United States     46
## 3 Football  Germany           35
## 4 Hockey    Germany           33
## 5 Rowing    Great Britain     26

El resultado presenta los equipos nacionales que obtuvieron el mayor número de medallas en cada uno de los cinco deportes con mayor participación en los Juegos Olímpicos de 2016. Los resultados muestran un claro dominio de ciertos países en disciplinas específicas. En particular, Estados Unidos lidera en deportes como natación y atletismo, concentrando un número significativamente alto de medallas, mientras que Alemania destaca en disciplinas como fútbol y hockey. Por su parte, Gran Bretaña sobresale en remo. Estos resultados evidencian la especialización y fortaleza histórica de determinados países en deportes concretos, así como la distribución desigual del éxito deportivo entre los comités olímpicos nacionales.

3.4 Peso de los atletas ganadores según el sexo.

Olimpiadas_2016 %>%
  filter(
    Sport %in% Top5_deportes$Sport,
    !is.na(Weight),
    Sex %in% c("M", "F")
  ) %>%
  group_by(Sport, Sex) %>%
  summarise(
    Total = n(),
    peso_medio = mean(Weight),
    peso_mediano = median(Weight),
    peso_q1 = quantile(Weight, 0.25),
    peso_q3 = quantile(Weight, 0.75),
    .groups = "drop"
  ) -> resumen_peso

resumen_peso
## # A tibble: 10 × 7
##    Sport     Sex   Total peso_medio peso_mediano peso_q1 peso_q3
##    <chr>     <chr> <int>      <dbl>        <dbl>   <dbl>   <dbl>
##  1 Athletics F        95       62.6         59      55.5    68  
##  2 Athletics M        94       79.1         75.5    68      84.8
##  3 Football  F        54       63.0         63      59      66.8
##  4 Football  M        51       75.7         76      70.5    80  
##  5 Hockey    F        49       63.1         63      58      67  
##  6 Hockey    M        50       78.4         77      74      82  
##  7 Rowing    F        60       71.8         73.5    68      76  
##  8 Rowing    M        84       88.8         93      82      97  
##  9 Swimming  F        97       66.2         66      61      70  
## 10 Swimming  M        93       83.4         85      77      90

Finalmente, se exploró la distribución del peso de los atletas ganadores de medallas, diferenciando por sexo y deporte. En todos los deportes analizados, los atletas masculinos presentan un peso promedio superior al de las atletas femeninas, con variaciones en la magnitud de esta diferencia dependiendo de la disciplina.

ggplot(
  Olimpiadas_2016 %>% 
    semi_join(Top5_deportes, by = "Sport") %>% 
    filter(!is.na(Weight), Sex %in% c("M","F")),
  aes(x = Sport, y = Weight, fill = Sex)
) +
  geom_boxplot(color = "#3B0A6D", alpha = 0.9, width = 0.65) +
  coord_flip() +
  scale_fill_manual(
    values = c(
      "F" = "#B57EDC",   
      "M" = "#3B0A6D"   
    ),
    labels = c("F" = "Femenino", "M" = "Masculino")
  ) +
  labs(
    title = "Distribución del peso por sexo en ganadores (Top 5 deportes, 2016)",
    x = "Deporte",
    y = "Peso (kg)",
    fill = "Sexo"
  ) +
  theme_minimal(base_size = 12) +
  theme(
    plot.title = element_text(face = "bold", size = 16),
    plot.title.position = "plot",
    axis.title = element_text(face = "bold"),
    panel.background = element_rect(fill = "grey95", color = NA),
    panel.grid.minor = element_blank(),
    legend.title = element_text(face = "bold")
  )

En disciplinas como remo (Rowing) y natación (Swimming) se registran los mayores pesos promedio en hombres, superando los 80 kg en promedio, mientras que en mujeres estos valores oscilan entre los 65 y 72 kg. El remo, en particular, muestra una mayor dispersión en el peso de los hombres, evidenciada tanto en el rango intercuartílico como en la presencia de valores extremos.

En deportes como atletismo (Athletics) y hockey, aunque las diferencias entre sexos se mantienen, la variabilidad del peso es menor en comparación con disciplinas como el remo, lo que sugiere perfiles físicos más homogéneos dentro de estas categorías.

4. Conclusiones

El análisis realizado permitió explorar de manera descriptiva los resultados de los Juegos Olímpicos de 2016 en los cinco deportes con mayor número de medallas. A partir de los datos, se identificaron diferencias relevantes en las características de los atletas ganadores, particularmente en términos de edad, país y peso.

La exploración del conjunto de datos proporciona una visión general del comportamiento de estas variables en el contexto olímpico, cumpliendo con los objetivos planteados en el ejercicio y sentando las bases para análisis posteriores de mayor profundidad.

ENTREGABLE 3

1. Introducción

En el presente entregable se trabaja con el conjunto de datos us_state_population.tsv, el cual contiene información sobre la población de los estados de Estados Unidos a lo largo de distintos años. El objetivo principal es aplicar los principios de datos ordenados (tidy data), transformando la estructura del dataset mediante procesos de recopilación, unión y separación de variables utilizando funciones del paquete tidyverse.

2. Importe de datos

df3 <- read_tsv("C:/Users/danih/Documents/Dataviz_py/us_state_population.tsv", show_col_types = FALSE)
df3
## # A tibble: 51 × 11
##    State    Code  `2010` `2011` `2012` `2013` `2014` `2015` `2016` `2017` `2018`
##    <chr>    <chr>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
##  1 Alabama  AL    4.79e6 4.80e6 4.82e6 4.83e6 4.84e6 4.85e6 4.86e6 4.88e6 4.89e6
##  2 Alaska   AK    7.14e5 7.22e5 7.30e5 7.37e5 7.36e5 7.38e5 7.42e5 7.40e5 7.37e5
##  3 Arizona  AZ    6.41e6 6.47e6 6.56e6 6.63e6 6.73e6 6.83e6 6.95e6 7.05e6 7.17e6
##  4 Arkansas AR    2.92e6 2.94e6 2.95e6 2.96e6 2.97e6 2.98e6 2.99e6 3.00e6 3.01e6
##  5 Califor… CA    3.73e7 3.76e7 3.80e7 3.83e7 3.86e7 3.90e7 3.92e7 3.94e7 3.96e7
##  6 Colorado CO    5.05e6 5.12e6 5.19e6 5.27e6 5.35e6 5.45e6 5.54e6 5.62e6 5.70e6
##  7 Connect… CT    3.58e6 3.59e6 3.59e6 3.59e6 3.59e6 3.59e6 3.58e6 3.57e6 3.57e6
##  8 Delaware DE    9.00e5 9.07e5 9.15e5 9.24e5 9.33e5 9.41e5 9.49e5 9.57e5 9.67e5
##  9 Distric… DC    6.05e5 6.20e5 6.35e5 6.50e5 6.63e5 6.75e5 6.87e5 6.96e5 7.02e5
## 10 Florida  FL    1.88e7 1.91e7 1.93e7 1.96e7 1.99e7 2.02e7 2.06e7 2.10e7 2.13e7
## # ℹ 41 more rows

3. Desarrollo

3.1 Recopilación

years <- colnames(df3)[grep("^\\d{4}$", colnames(df3))]  

df3 %>%
  gather(key = "Year", value = "Population", all_of(years)) -> df3_recop

knitr::kable(head(df3_recop, 5))
State Code Year Population
Alabama AL 2010 4785448
Alaska AK 2010 713906
Arizona AZ 2010 6407774
Arkansas AR 2010 2921978
California CA 2010 37320903

En esta etapa se aplica la función gather() para transformar el dataset de formato ancho (wide), donde los años están distribuidos en columnas, a formato largo (long), creando las nuevas variables Year y Population. De esta manera, cada fila representa la población de un estado en un año específico.

3.2 Unión

df3_recop %>%
  unite(State_Code, State, Code, sep = "_", remove = TRUE) -> df3_unido 

knitr::kable(head(df3_unido, 5))
State_Code Year Population
Alabama_AL 2010 4785448
Alaska_AK 2010 713906
Arizona_AZ 2010 6407774
Arkansas_AR 2010 2921978
California_CA 2010 37320903

En esta sección se utiliza la función unite() para combinar las columnas State y Code en una nueva variable llamada State_Code, unificando ambas variables en una sola columna separada por un guion bajo. Esto ejemplifica cómo consolidar información cuando dos variables se desean representar en un único campo.

3.3 Separación

df3_unido %>%
  separate(State_Code, into = c("State", "Code"), sep = "_") -> df3_sep 
knitr::kable(head(df3_sep, 5))
State Code Year Population
Alabama AL 2010 4785448
Alaska AK 2010 713906
Arizona AZ 2010 6407774
Arkansas AR 2010 2921978
California CA 2010 37320903

Finalmente, se aplica la función separate() para dividir nuevamente la columna State_Code en las variables originales State y Code. Este procedimiento demuestra la operación inversa a unite(), permitiendo reorganizar correctamente la información en columnas independientes.

4. Conclusión

Se logró transformar el dataset desde un formato ancho a uno largo, así como combinar y dividir variables de manera estructurada. Estos procedimientos permiten obtener un conjunto de datos ordenado, facilitando su análisis y garantizando coherencia en la estructura de la información.