The Data

This week’s Tidy Tuesday data comes from Emil Hvitfeldt’s Ferris Wheel package. Very fun package and theme!

wheels <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2022/2022-08-09/wheels.csv')
wheels %>%
  glimpse()
## Rows: 73
## Columns: 22
## $ ...1                  <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 1…
## $ name                  <chr> "360 Pensacola Beach", "Amuran", "Asiatique Sky"…
## $ height                <dbl> 200.00, 303.00, 200.00, 295.00, 180.00, 692.64, …
## $ diameter              <dbl> NA, 199.80, 200.00, 272.00, NA, 642.70, NA, 200.…
## $ opened                <date> 2012-07-03, 2004-01-01, 2012-12-15, NA, 2011-01…
## $ closed                <date> 2013-01-01, NA, NA, NA, NA, NA, NA, NA, NA, NA,…
## $ country               <chr> "USA", "Japan", "Tailand", "Japan", "Iraq", "Chi…
## $ location              <chr> "Pensacola Beach; Florida", "Kagoshima; Kyushu",…
## $ number_of_cabins      <dbl> 42, 36, 42, NA, 40, 48, 42, NA, 36, 48, 36, 32, …
## $ passengers_per_cabin  <dbl> 6, NA, NA, NA, 6, 40, 8, NA, 8, 8, 20, 10, 8, 6,…
## $ seating_capacity      <dbl> 252, NA, NA, NA, 240, 1920, 336, NA, 288, 384, 7…
## $ hourly_capacity       <dbl> 1260, NA, NA, NA, 960, 5760, 1550, NA, 1440, 115…
## $ ride_duration_minutes <dbl> 12.0, 14.5, NA, NA, 15.0, 20.0, 13.0, 15.0, 12.0…
## $ climate_controlled    <chr> "Yes", "Yes", "Yes", NA, NA, "yes", "Yes", "Yes"…
## $ construction_cost     <chr> "Unknown", "Unknown", "Unknown", "Unknown", "$6 …
## $ status                <chr> "Moved", "Operating", "Operating", "Operating", …
## $ design_manufacturer   <chr> "Realty Masters of FL", NA, "Dutch Wheels (Vekom…
## $ type                  <chr> "Transportable", NA, NA, "Fixed", NA, "Fixed", "…
## $ vip_area              <chr> "Yes", NA, NA, NA, NA, NA, "Yes", NA, "Yes", NA,…
## $ ticket_cost_to_ride   <chr> NA, NA, NA, NA, "3.5", NA, "Adults – 13; VIP – 1…
## $ official_website      <chr> NA, NA, "http://www.asiatiquesky.com/", "http://…
## $ turns                 <dbl> 4, 1, NA, NA, NA, 1, 1, NA, 3, NA, NA, NA, NA, N…

Data Wrangling

# goal: extract continent variable via countrycode package
ferris_wheels <- wheels %>%
  mutate(continent = countrycode(country,
                                 origin = "country.name",
                                 destination = "continent")) %>%
  mutate(continent = case_when(
    country == "Dubai" ~ "Asia",
    country == "Phillippines" ~ "Asia",
    country == "Tailand" ~ "Asia",
    TRUE ~ continent))
# filtering the countries with the highest ferris wheels

countries_multiple_ferris <- ferris_wheels %>%
  group_by(country) %>%
  count() %>%
  arrange(desc(n)) %>%
  filter(n > 3)
#getting rid of na to make circle package 
df <- ferris_wheels %>%
  select(name, country, continent, height, number_of_cabins, passengers_per_cabin, ride_duration_minutes) %>%
  filter(country %in% countries_multiple_ferris$country) %>%
  drop_na()
df_pivot <- pivot_longer(df, cols = height:ride_duration_minutes, names_to = "variable_type", values_to = "value") %>%
  arrange(variable_type)
# picking variables with roughly same distribution/value magnitude
skim <- df_pivot %>%
  group_by(variable_type) %>%
  select_if(is.numeric) %>%
  skimr::skim() 

skim %>%
  select(skim_variable,variable_type, numeric.mean, numeric.hist)
## # A tibble: 4 × 4
##   skim_variable variable_type         numeric.mean numeric.hist
##   <chr>         <chr>                        <dbl> <chr>       
## 1 value         height                       333.  ▇▅▃▂▂       
## 2 value         number_of_cabins              44.4 ▆▆▇▁▆       
## 3 value         passengers_per_cabin          12.7 ▇▁▁▁▂       
## 4 value         ride_duration_minutes         18.8 ▇▆▆▅▁

The Plot

# creating manual legend
lgd_fill = Legend(at = c("Cabin Count", "Passengers/Cabin", "Ride Duration (minutes)"), type = "grid", 
    legend_gp = gpar(fill = c("lightblue", "lightgoldenrodyellow", "lavender")), title_position = "topleft", 
    title = "Fill Meanings")
# the wheely cool plot
par(bg = "gray97")

circos.initialize(df_pivot$country[38:148], x = df_pivot$value[38:148])

circos.track(ylim = c(0, 1), bg.col = "gray97", bg.border = "gray97", track.height = 0.1)

circos.text(x = -15, y = .5, labels = "China", facing = "bending.inside", col = "orange2", cex = .75)

circos.text(x = 27.5, y = .5, labels = "USA", facing = "bending.inside", col = "green3", cex = .75)

circos.text(x = 75, y = .5, labels = "Japan", facing = "bending.inside", col = "red", cex = .75)

circos.text(x = 140, y = .5, labels = "UK", facing = "bending.inside", col = "blue", cex = .75)

circos.track(ylim = c(0, 1), panel.fun = function(x, y) {
    pos = circlize:::polar2Cartesian(circlize(CELL_META$xcenter, CELL_META$ycenter))
    image = png::readPNG("cabin.png")
    rasterImage(image, 
        xleft = pos[1, 1] - 0.1, ybottom = pos[1.5, 2] - 0.1,
        xright = pos[1, 1] + 0.1, ytop = pos[1.5, 2]+ 0.1)
}, bg.col = "gray97", bg.border = "grey10", track.height = 0.2)

circos.trackHist(df_pivot$country[38:74], x = df_pivot$value[38:74], col = "white", 
    border = "grey5", bin.size = 1, bg.col = "lightblue", bg.border = c("red2", "blue2","orange2", "green3"))

circos.trackHist(df_pivot$country[75:111], x = df_pivot$value[75:111], force.ylim = FALSE, col = "white", 
    border = "grey5", bin.size = 1, bg.col = "lightgoldenrodyellow", bg.border = c("red2", "blue2","orange2", "green3"))
circos.trackHist(df_pivot$country[111:148], x = df_pivot$value[111:148], force.ylim = FALSE, col = "white", 
    border = "grey5", bin.size = 1, bg.col = "lavender", bg.border = c("red2", "blue2","orange2", "green3"))

draw(lgd_fill, x = unit(.85, "npc") + unit(1, "mm"), y = unit(75, "mm"), 
    just = c("right"))

title("Ferris Wheel Distributions for Four Countries with Highest Ferris Wheel Count", cex.main = 1)

title(sub = "08-09-2022 Tidy Tuesday | Github: @scolando", cex.main = .75, adj = 0.75)
# because i do not like the way of saving base graphs (the dpi was awful)
knitr::include_graphics('ferris_wheel.png')

praise::praise()
## [1] "You are fantabulous!"