library(ggplot2)
library(tidyverse)
library(tidytuesdayR)
library(countrycode)
2022 Week 32: Ferris Wheels
Setup
Load Data
<- tt_load("2022-08-09") tuesdata
Downloading file 1 of 1: `wheels.csv`
<- tuesdata$wheels
wheels
head(wheels)
…1 | name | height | diameter | opened | closed | country | location | number_of_cabins | passengers_per_cabin | seating_capacity | hourly_capacity | ride_duration_minutes | climate_controlled | construction_cost | status | design_manufacturer | type | vip_area | ticket_cost_to_ride | official_website | turns |
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
1 | 360 Pensacola Beach | 200.00 | NA | 2012-07-03 | 2013-01-01 | USA | Pensacola Beach; Florida | 42 | 6 | 252 | 1260 | 12.0 | Yes | Unknown | Moved | Realty Masters of FL | Transportable | Yes | NA | NA | 4 |
2 | Amuran | 303.00 | 199.8 | 2004-01-01 | NA | Japan | Kagoshima; Kyushu | 36 | NA | NA | NA | 14.5 | Yes | Unknown | Operating | NA | NA | NA | NA | NA | 1 |
3 | Asiatique Sky | 200.00 | 200.0 | 2012-12-15 | NA | Tailand | Asiatique the Riverfront | 42 | NA | NA | NA | NA | Yes | Unknown | Operating | Dutch Wheels (Vekoma) | NA | NA | NA | http://www.asiatiquesky.com/ | NA |
4 | Aurora Wheel | 295.00 | 272.0 | NA | NA | Japan | Nagashima Spa Land; Mie; Honshu | NA | NA | NA | NA | NA | NA | Unknown | Operating | NA | Fixed | NA | NA | http://www.nagashima-onsen.co.jp/ | NA |
5 | Baghdad Eye | 180.00 | NA | 2011-01-01 | NA | Iraq | Al-Zawraa Park; Baghdad | 40 | 6 | 240 | 960 | 15.0 | NA | $6 million USD | Operating | NA | NA | NA | 3.5 | NA | NA |
6 | Beijing Great Wheel | 692.64 | 642.7 | NA | NA | China | Chaoyang Park; Beijing | 48 | 40 | 1920 | 5760 | 20.0 | yes | $290 million USD | Delayed | The Great Wheel Corporation | Fixed | NA | NA | NA | 1 |
Clean Data
<- wheels |>
wheels mutate(region = countryname(country, destination = "region"),
region = case_when(
== "Phillippines" ~ "East Asia & Pacific",
country == "Dubai" ~ "Middle East & North Africa",
country TRUE ~ region),
diameter = replace_na(diameter, mean(diameter, na.rm = TRUE)))
Warning in countrycode_convert(sourcevar = sourcevar, origin = origin, destination = dest, : Some values were not matched unambiguously: Dubai, Phillippines
Plot
<- wheels |>
wheelPlot filter(opened > "1975-01-01") |>
ggplot(aes(x = opened,
y = height,
color = region,
fill = region)) +
geom_point(aes(size = diameter),
alpha = 0.75) +
theme_bw() +
theme(legend.position = "bottom",
legend.box = "vertical",
legend.box.just = "left") +
geom_smooth(method = "glm",
method.args = list(family = "quasipoisson")) +
scale_color_viridis_d() +
scale_fill_viridis_d() +
guides(color = guide_legend(nrow=2,
byrow=TRUE,
title = "Region"),
fill = guide_legend(nrow=2,
byrow=TRUE,
title = "Region"),
size = guide_legend(title = "Wheel Diameter")) +
xlab("Opening Date") +
ylab("Wheel Height") +
ggtitle("Ferris Wheel Height and Diameter by Region and Opening Date From 1975")
ggsave("Out/2022-08-09-final.jpg", plot = wheelPlot)
Saving 7 x 7 in image
`geom_smooth()` using formula 'y ~ x'
Warning: Removed 1 rows containing non-finite values (stat_smooth).
Warning: Removed 1 rows containing missing values (geom_point).
sessionInfo()
R version 4.2.1 (2022-06-23 ucrt)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 19043)
Matrix products: default
locale:
[1] LC_COLLATE=English_Australia.utf8 LC_CTYPE=English_Australia.utf8
[3] LC_MONETARY=English_Australia.utf8 LC_NUMERIC=C
[5] LC_TIME=English_Australia.utf8
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] countrycode_1.4.0 tidytuesdayR_1.0.2 forcats_0.5.2 stringr_1.4.1
[5] dplyr_1.0.9 purrr_0.3.4 readr_2.1.2 tidyr_1.2.0
[9] tibble_3.1.7 tidyverse_1.3.2 ggplot2_3.3.6
loaded via a namespace (and not attached):
[1] httr_1.4.4 viridisLite_0.4.1 bit64_4.0.5
[4] vroom_1.5.7 jsonlite_1.8.0 splines_4.2.1
[7] modelr_0.1.9 assertthat_0.2.1 highr_0.9
[10] selectr_0.4-2 googlesheets4_1.0.1 cellranger_1.1.0
[13] yaml_2.3.5 pillar_1.8.1 backports_1.4.1
[16] lattice_0.20-45 glue_1.6.2 digest_0.6.29
[19] rvest_1.0.3 colorspace_2.0-3 Matrix_1.4-1
[22] htmltools_0.5.2 pkgconfig_2.0.3 broom_1.0.1
[25] haven_2.5.1 scales_1.2.1 tzdb_0.3.0
[28] googledrive_2.0.0 mgcv_1.8-40 farver_2.1.1
[31] generics_0.1.3 usethis_2.1.6 ellipsis_0.3.2
[34] withr_2.5.0 cli_3.3.0 magrittr_2.0.3
[37] crayon_1.5.1 readxl_1.4.1 evaluate_0.16
[40] fs_1.5.2 fansi_1.0.3 nlme_3.1-158
[43] xml2_1.3.3 textshaping_0.3.6 tools_4.2.1
[46] hms_1.1.2 gargle_1.2.0 lifecycle_1.0.1
[49] munsell_0.5.0 reprex_2.0.2 compiler_4.2.1
[52] systemfonts_1.0.4 rlang_1.0.4 grid_4.2.1
[55] rstudioapi_0.14 htmlwidgets_1.5.4 labeling_0.4.2
[58] rmarkdown_2.16 gtable_0.3.1 DBI_1.1.3
[61] curl_4.3.2 R6_2.5.1 lubridate_1.8.0
[64] knitr_1.40 fastmap_1.1.0 bit_4.0.4
[67] utf8_1.2.2 ragg_1.2.2 stringi_1.7.6
[70] parallel_4.2.1 vctrs_0.4.1 dbplyr_2.2.1
[73] tidyselect_1.1.2 xfun_0.31