2022 Week 32: Ferris Wheels

Setup

library(ggplot2)
library(tidyverse)
library(tidytuesdayR)
library(countrycode)

Load Data

tuesdata <- tt_load("2022-08-09")

    Downloading file 1 of 1: `wheels.csv`
wheels <- tuesdata$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(
             country == "Phillippines" ~ "East Asia & Pacific",
             country == "Dubai" ~ "Middle East & North Africa",
             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

wheelPlot <- wheels |> 
    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).

Final Plot

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