Join the R4DS Online Learning Community in the weekly #TidyTuesday event! Every week we post a raw dataset, a chart or article related to that dataset, and ask you to explore the data. While the dataset will be “tamed”, it will not always be tidy! As such you might need to apply various R for Data Science techniques to wrangle the data into a true tidy format. The goal of TidyTuesday is to apply your R skills, get feedback, explore other’s work, and connect with the greater #RStats community! As such we encourage everyone of all skills to participate!
Dowload the weekly data and make available in the tt object.
# tt <- tt_load("2021-01-26")
# tt <- saveRDS(tt, "2021-01-26.rds")
tt <- readRDS("2021-01-26.rds")Take a look at the readme for the weekly data to get insight on the dataset. This includes a data dictionary, source, and a link to an article on the data.
ttTake an initial look at the format of the data available.
tt %>%
map(glimpse) ## Rows: 13,380
## Columns: 14
## $ country <chr> "Argentina", "Argentina", "Argentina", "Argentina", "A…
## $ year <dbl> 2019, 2019, 2019, 2019, 2019, 2019, 2019, 2019, 2019, …
## $ parent_company <chr> "Grand Total", "Unbranded", "The Coca-Cola Company", "…
## $ empty <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ hdpe <dbl> 215, 155, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
## $ ldpe <dbl> 55, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ o <dbl> 607, 532, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 13, 0, 0, 0…
## $ pet <dbl> 1376, 848, 222, 39, 38, 22, 21, 26, 19, 14, 14, 14, 14…
## $ pp <dbl> 281, 122, 35, 4, 0, 7, 6, 0, 1, 4, 3, 1, 0, 0, 3, 0, 4…
## $ ps <dbl> 116, 114, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
## $ pvc <dbl> 18, 17, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ grand_total <dbl> 2668, 1838, 257, 43, 38, 29, 27, 26, 20, 18, 17, 15, 1…
## $ num_events <dbl> 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, …
## $ volunteers <dbl> 243, 243, 243, 243, 243, 243, 243, 243, 243, 243, 243,…## $plastics
## # A tibble: 13,380 x 14
## country year parent_company empty hdpe ldpe o pet pp ps pvc
## <chr> <dbl> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Argent… 2019 Grand Total 0 215 55 607 1376 281 116 18
## 2 Argent… 2019 Unbranded 0 155 50 532 848 122 114 17
## 3 Argent… 2019 The Coca-Cola… 0 0 0 0 222 35 0 0
## 4 Argent… 2019 Secco 0 0 0 0 39 4 0 0
## 5 Argent… 2019 Doble Cola 0 0 0 0 38 0 0 0
## 6 Argent… 2019 Pritty 0 0 0 0 22 7 0 0
## 7 Argent… 2019 PepsiCo 0 0 0 0 21 6 0 0
## 8 Argent… 2019 Casoni 0 0 0 0 26 0 0 0
## 9 Argent… 2019 Villa Del Sur… 0 0 0 0 19 1 0 0
## 10 Argent… 2019 Manaos 0 0 0 0 14 4 0 0
## # … with 13,370 more rows, and 3 more variables: grand_total <dbl>,
## # num_events <dbl>, volunteers <dbl>tuesdata <- tt
tuesdata$plastics %>% dplyr::filter()## # A tibble: 13,380 x 14
## country year parent_company empty hdpe ldpe o pet pp ps pvc
## <chr> <dbl> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Argent… 2019 Grand Total 0 215 55 607 1376 281 116 18
## 2 Argent… 2019 Unbranded 0 155 50 532 848 122 114 17
## 3 Argent… 2019 The Coca-Cola… 0 0 0 0 222 35 0 0
## 4 Argent… 2019 Secco 0 0 0 0 39 4 0 0
## 5 Argent… 2019 Doble Cola 0 0 0 0 38 0 0 0
## 6 Argent… 2019 Pritty 0 0 0 0 22 7 0 0
## 7 Argent… 2019 PepsiCo 0 0 0 0 21 6 0 0
## 8 Argent… 2019 Casoni 0 0 0 0 26 0 0 0
## 9 Argent… 2019 Villa Del Sur… 0 0 0 0 19 1 0 0
## 10 Argent… 2019 Manaos 0 0 0 0 14 4 0 0
## # … with 13,370 more rows, and 3 more variables: grand_total <dbl>,
## # num_events <dbl>, volunteers <dbl>library(stringi)
plastics <- tuesdata$plastics %>%
filter(
!(parent_company %in% c("Grand Total", "null", "Null", "Unbranded"))
) %>%
mutate(
parent_company = parent_company %>%
tolower() %>%
stri_trans_general("Latin-ASCII") %>%
stri_trans_totitle(),
country = stringi::stri_trans_totitle(country)
) Then, we can get the top five polluters for the three years of analysis (2019-2020)
top_Co <- plastics %>%
group_by(parent_company) %>%
summarise(
country_count = n_distinct(country),
grand_total_sum = sum(grand_total, na.rm = T)
) %>%
arrange(desc(country_count, grand_total_sum)) %>%
head(5)
top_Co## # A tibble: 5 x 3
## parent_company country_count grand_total_sum
## <chr> <int> <dbl>
## 1 The Coca-Cola Company 59 25530
## 2 Pepsico 50 8493
## 3 Nestle 45 13493
## 4 Mars, Incorporated 43 1221
## 5 Unilever 42 8633Then, we can manually obtain headquarters locations from https://www.crunchbase.com/lists/companies-search-with-headquarters
hq <- c(
"Atlanta, Georgia, United States", #Coca-Cola
"New York, New York, United States", #PepsiCo
"Vevey, Vaud, Switzerland", #Nestle
"Mclean, Virginia, United States", #Mars
"London, England, United Kingdom" #Unilever
)And we merge the data, and add a geocoded lat, long using tidygeocoder to finally transform into an sf.
library(tidygeocoder)
coords = geo(hq, method = "osm")countries = plastics %>%
filter(parent_company %in% top_Co$parent_company) %>%
group_by(country) %>%
summarise(count = n())coords_countries = geo(countries$country, method = "osm")
# Get Taiwan coordinates, which was not recognized
coords_taiwan = geo("Taiwan", method = "osm")
coords_country = coords_countries %>%
mutate(
lat = ifelse(address == "Taiwan_ Republic Of China (Roc)", coords_taiwan$lat, lat),
long = ifelse(address == "Taiwan_ Republic Of China (Roc)", coords_taiwan$long, long)
) countries <- countries %>%
left_join(coords_country, by = c("country" = "address"))
countries## # A tibble: 60 x 4
## country count lat long
## <chr> <int> <dbl> <dbl>
## 1 Argentina 10 -35.0 -65.0
## 2 Australia 5 -24.8 135.
## 3 Bangladesh 7 24.5 90.3
## 4 Benin 1 9.53 2.26
## 5 Brazil 9 -10.3 -53.2
## 6 Bulgaria 6 42.6 25.5
## 7 Burkina Faso 5 12.1 -1.69
## 8 Cameroon 4 4.61 13.2
## 9 Canada 7 61.1 -108.
## 10 Chile 5 -31.8 -71.3
## # … with 50 more rowstop_parent_companies = top_Co %>%
mutate(hq = hq, lat = coords$lat, long = coords$long) %>%
# st_as_sf(crs = 4326, coords = c("long", "lat")) %>%
mutate(parent_company = case_when(
parent_company == "The Coca-Cola Company" ~ "Coca-Cola",
parent_company == "Mars, Incorporated" ~ "Mars, Inc.",
TRUE ~ parent_company
)) %>%
select(name = parent_company) %>%
mutate(type = "Parent Company")
companies <- top_Co %>%
mutate(hq = hq, com_lat = coords$lat, com_long = coords$long)com_countries <- plastics %>%
select(country, parent_company, grand_total)
# companies
plotting <- com_countries %>%
left_join(countries) %>%
left_join(companies) %>%
filter(parent_company %in% companies$parent_company)
plotting## # A tibble: 347 x 11
## country parent_company grand_total count lat long country_count
## <chr> <chr> <dbl> <int> <dbl> <dbl> <int>
## 1 Argent… The Coca-Cola… 257 10 -35.0 -65.0 59
## 2 Argent… Pepsico 27 10 -35.0 -65.0 50
## 3 Argent… Nestle 9 10 -35.0 -65.0 45
## 4 Argent… Unilever 7 10 -35.0 -65.0 42
## 5 Argent… Mars, Incorpo… 2 10 -35.0 -65.0 43
## 6 Bangla… Nestle 0 7 24.5 90.3 45
## 7 Bangla… Pepsico 0 7 24.5 90.3 50
## 8 Brazil Nestle 30 9 -10.3 -53.2 45
## 9 Brazil The Coca-Cola… 12 9 -10.3 -53.2 59
## 10 Brazil Pepsico 11 9 -10.3 -53.2 50
## # … with 337 more rows, and 4 more variables: grand_total_sum <dbl>, hq <chr>,
## # com_lat <dbl>, com_long <dbl>library(echarts4r)
library(echarts4r.assets)
plotting %>%
group_by(parent_company) %>%
e_charts() %>%
e_globe(
environment = gray(0.1),
base_texture = ea_asset("world"),
shading = 'lambert',
light.ambient = list(intensity = 10)
) %>%
e_lines_3d(
com_long,
com_lat,
long,
lat,
value = count,
source_name = parent_company,
target_name = country,
effect = list(show = TRUE)
) %>%
e_legend_toggle_select(name = "Company") %>%
e_legend(textStyle = list(color = gray(0.9)))