├── 2020 ├── 20200428_BroadwayMusicals │ ├── Broadway_plot.png │ ├── README.md │ └── tidytuesday_20200428.R ├── 20200505_AnimalCrossing │ ├── AnimalCrossing_plot.png │ ├── README.md │ └── tidytuesday_20200505.R ├── 20200512_Volcanoes │ ├── README.md │ ├── Volcanoes_plot.gif │ └── tidytuesday_20200512.R ├── 20200519_BeachVolleyball │ ├── BeachVolleyball_plot.png │ ├── README.md │ └── tidytuesday_20200519.R ├── 20200526_Cocktails │ ├── Cocktails_plot.png │ ├── README.md │ └── tidytuesday_20200526.R ├── 20200602_MarbleRaces │ ├── MarbleRaces_plot.png │ ├── README.md │ └── tidytuesday_20200602.R ├── 20200609_AfricanAmericanAchievements │ ├── AfricanAmericanAchievements_plot.png │ ├── README.md │ └── tidytuesday_20200609.R ├── 20200616_AfricanAmericanHistory │ ├── AfricanAmericanHistory_plot.png │ ├── README.md │ └── tidytuesday_20200616.R ├── 20200623_Caribou │ ├── Caribou_plot.gif │ ├── Caribou_plot.png │ ├── README.md │ └── tidytuesday_20200623.R ├── 20200630_ClaremontRun │ ├── ClaremontRun_plot.png │ ├── README.md │ └── tidytuesday_20200630.R ├── 20200707_CoffeeRatings │ ├── CoffeeRatings_plot.png │ ├── README.md │ └── tidytuesday_20200707.R ├── 20200714_Astronauts │ ├── Astronauts_plot.png │ ├── README.md │ └── tidytuesday_20200714.R ├── 20200721_AustralianAnimals │ ├── AustralianAnimals_plot.png │ ├── README.md │ └── tidytuesday_20200721.R ├── 20200728_PalmerPenguins │ ├── PalmerPenguins_plot.png │ ├── README.md │ └── tidytuesday_20200728.R ├── 20200804_EuropeanEnergy │ ├── EuropeanEnergy_plot.png │ ├── README.md │ └── tidytuesday_20200804.R ├── 20200811_AvatarLastAirbender │ ├── AvatarLastAirbender_plot.png │ ├── README.md │ └── tidytuesday_20200811.R ├── 20200818_ExtinctPlants │ ├── ExtinctPlants_plot.png │ ├── README.md │ └── tidytuesday_20200818.R ├── 20200825_Chopped │ ├── Chopped_plot.png │ ├── README.md │ └── tidytuesday_20200825.R ├── 20200901_GlobalCropYields │ ├── GlobalCropYields_plot.png │ ├── README.md │ └── tidytuesday_20200901.R ├── 20200908_Friends │ ├── Friends_plot.png │ ├── README.md │ └── tidytuesday_20200908.R ├── 20200915_GovKidSpending │ ├── GovKidSpending_plot.gif │ ├── README.md │ └── tidytuesday_20200915.R ├── 20200922_HimalayanClimbers │ ├── HimalayanClimbers_plot.png │ ├── README.md │ └── tidytuesday_20200922.R ├── 20200929_BeyonceTaylorSwift │ ├── BeyonceTaylorSwift_plot.png │ ├── README.md │ └── tidytuesday_20200929.R ├── 20201006_NCAAwomensBasketball │ ├── NCAAwomensBasketball_plot.png │ ├── README.md │ └── tidytuesday_20201006.R ├── 20201013_DatasaurusDozen │ ├── DatasaurusDozen_plot.png │ ├── README.md │ └── tidytuesday_20201013.R ├── 20201020_AmericanBeerFestival │ ├── AmericanBeerFestival_plot.png │ ├── README.md │ └── tidytuesday_20201020.R ├── 20201027_CanadianWindTurbines │ ├── CanadianWindTurbines_plot.png │ ├── README.md │ └── tidytuesday_20201027.R ├── 20201103_IkeaFurniture │ ├── IkeaFurniture_plot.png │ ├── README.md │ └── tidytuesday_20201103.R ├── 20201110_HistoricalPhones │ ├── HistoricalPhones_plot.png │ ├── README.md │ └── tidytuesday_20201110.R ├── 20201117_BlackInData │ ├── BlackInData_plot.png │ ├── README.md │ └── tidytuesday_20201117.R ├── 20201124_WashingtonTrails │ ├── README.md │ ├── WashingtonTrails_plot.png │ └── tidytuesday_20201124.R ├── 20201201_TorontoShelters │ ├── README.md │ ├── TorontoShelters_plot.png │ └── tidytuesday_20201201.R ├── 20201208_Women2020 │ ├── README.md │ ├── Women2020_plot.png │ └── tidytuesday_20201208.R ├── 20201215_NinjaWarrior │ ├── NinjaWarrior_plot.png │ ├── README.md │ └── tidytuesday_20201215.R ├── 20201222_BigMacIndex │ ├── BigMacIndex_plot.png │ ├── README.md │ └── tidytuesday_20201222.R └── README.md ├── 2021 ├── 20210105_TransitCostProject │ ├── README.md │ ├── TransitCostProject_plot.png │ └── tidytuesday_20210105.R ├── 20210112_ArtCollections │ ├── ArtCollections_plot.png │ ├── README.md │ └── tidytuesday_20210112.R ├── 20210119_KenyaCensus │ ├── KenyaCensus_plot.png │ ├── README.md │ └── tidytuesday_20210119.R ├── 20210126_PlasticPollution │ ├── PlasticPollution_plot.png │ ├── README.md │ └── tidytuesday_20210126.R ├── 20210202_HBCUenrollment │ ├── HBCUenrollment_plot.png │ ├── README.md │ └── tidytuesday_20210202.R ├── 20210209_WealthIncome │ ├── README.md │ ├── WealthIncome_plot.png │ └── tidytuesday_20210209.R ├── 20210216_DuBoisChallenge │ ├── DuBoisChallenge_plot.png │ ├── README.md │ ├── original-plate-02.jpg │ └── tidytuesday_20210216.R ├── 20210223_EmploymentEarnings │ ├── EmploymentEarnings_plot.gif │ ├── EmploymentEarnings_plot.png │ ├── README.md │ └── tidytuesday_20210223.R ├── 20210302_SuperBowlAds │ ├── README.md │ ├── SuperBowlAds_plot.png │ └── tidytuesday_20210302.R ├── 20210309_BechdelTest │ ├── BechdelTest_plot.png │ ├── README.md │ └── tidytuesday_20210309.R ├── 20210316_VideoGames │ ├── README.md │ ├── VideoGames_plot.png │ └── tidytuesday_20210316.R ├── 20210323_UNVotes │ ├── README.md │ ├── UNVotes_plot.png │ └── tidytuesday_20210323.R ├── 20210330_MakeupShades │ ├── MakeupShades_plot.png │ ├── README.md │ └── tidytuesday_20210330.R ├── 20210406_GlobalDeforestation │ ├── GlobalDeforestation_plot.png │ ├── README.md │ └── tidytuesday_20210406.R ├── 20210413_USPostOffices │ ├── README.md │ ├── USPostOffices_plot.gif │ ├── USPostOffices_plot.png │ └── tidytuesday_20210413.R ├── 20210420_NetflixTitles │ ├── NetflixTitles_plot.png │ ├── README.md │ └── tidytuesday_20210420.R ├── 20210427_CEODepartures │ ├── CEODepartures_plot.png │ ├── README.md │ └── tidytuesday_20210427.R ├── 20210504_WaterAccessPoints │ ├── README.md │ ├── WaterAccessPoints_plot.png │ └── tidytuesday_20210504.R ├── 20210511_USBroadband │ ├── README.md │ ├── USBroadband_plot.png │ └── tidytuesday_20210511.R ├── 20210518_SalarySurvey │ ├── README.md │ ├── SalarySurvey_plot.png │ └── tidytuesday_20210518.R ├── 20210525_MarioKart │ ├── MarioKart_plot.png │ ├── README.md │ └── tidytuesday_20210525.R ├── 20210601_SurvivorTVShow │ ├── README.md │ ├── SurvivorTVShow_plot.png │ └── tidytuesday_20210601.R ├── 20210608_GreatLakesFish │ ├── GreatLakesFish_plot.png │ ├── README.md │ └── tidytuesday_20210608.R ├── 20210615_WEBduBois │ ├── README.md │ ├── WEBduBois_plot.png │ └── tidytuesday_20210615.R ├── 20210622_PublicParkAccess │ ├── PublicParkAccess_plot.png │ ├── README.md │ └── tidytuesday_20210622.R ├── 20210629_AnimalRescues │ ├── AnimalRescues_plot.png │ ├── README.md │ └── tidytuesday_20210629.R ├── 20210706_IndependenceDays │ ├── IndependenceDays_plot.png │ ├── README.md │ └── tidytuesday_20210706.R ├── 20210713_ScoobyDoo │ ├── README.md │ ├── ScoobyDoo_plot.png │ └── tidytuesday_20210713.R ├── 20210720_USDroughts │ ├── README.md │ ├── USDroughts_plot.png │ └── tidytuesday_20210720.R ├── 20210727_OlympicMedals │ ├── OlympicMedals_plot.png │ ├── README.md │ └── tidytuesday_20210727.R ├── 20210803_ParalympicMedals │ ├── ParalympicMedals_plot.png │ ├── README.md │ └── tidytuesday_20210803.R ├── 20210810_BEAInfrastructure │ ├── BEAInfrastructure_plot.png │ ├── README.md │ └── tidytuesday_20210810.R ├── 20210817_StarTrekVoice │ ├── README.md │ ├── StarTrekVoice_plot.png │ └── tidytuesday_20210817.R ├── 20210824_Lemurs │ ├── README.md │ └── tidytuesday_20210824.R ├── 20210831_BirdBaths │ ├── README.md │ └── tidytuesday_20210831.R ├── 20210907_Formula1Races │ ├── README.md │ └── tidytuesday_20210907.R ├── 20210914_BillboardTop100 │ ├── README.md │ └── tidytuesday_20210914.R └── README.md ├── .gitignore └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | .DS_Store 6 | ExtraCodeChunks/ 7 | -------------------------------------------------------------------------------- /2020/20200428_BroadwayMusicals/Broadway_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20200428_BroadwayMusicals/Broadway_plot.png -------------------------------------------------------------------------------- /2020/20200428_BroadwayMusicals/README.md: -------------------------------------------------------------------------------- 1 | ![Broadway_plot.png](Broadway_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20200428_BroadwayMusicals/tidytuesday_20200428.R: -------------------------------------------------------------------------------- 1 | # Broadway musicals over time 2 | # TidyTuesday 2020 week 18 3 | # RJS updated 4/28/2020 4 | 5 | # Load libraries --------------------- 6 | 7 | library(tidyverse) 8 | library(scales) 9 | sessionInfo() 10 | 11 | theme_set(theme_light()) 12 | 13 | # Load data -------------------------- 14 | 15 | grosses_raw <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-04-28/grosses.csv') 16 | pre_1985_starts <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-04-28/pre-1985-starts.csv') 17 | 18 | 19 | # Data formatting & analysis --------- 20 | 21 | # Add in year column from the date stamp 22 | grosses_raw$week_char<-as.character(grosses_raw$week_ending) 23 | grosses<-grosses_raw %>% 24 | separate(week_char,into=c("year","month","date"), sep="-", remove = FALSE) 25 | 26 | # Number of new plays per year 27 | newplaydates<-grosses %>% 28 | group_by(show) %>% 29 | # find start date 30 | summarise(showstart=min(week_ending)) %>% 31 | # order it 32 | arrange(showstart) 33 | # Add in year column from the date stamp 34 | newplaydates$showstart_char<-as.character(newplaydates$showstart) 35 | newplaysyears<-newplaydates %>% 36 | separate(showstart_char,into=c("year","month","date"), sep="-") %>% 37 | select(show, year) %>% 38 | group_by(year) 39 | 40 | # Add in pre-1985 starts - it's a mess! 41 | pre_1985_starts$start_date_char<-as.character(pre_1985_starts$start_date) 42 | pre_1985_years<-pre_1985_starts %>% 43 | separate(start_date_char,into=c("preyear","month","date"), sep="-") %>% 44 | select(show, preyear) %>% 45 | group_by(preyear) 46 | # combine variables 47 | allnewyears<- newplaysyears %>% left_join(pre_1985_years) 48 | allnewyears$year[1:19]<-allnewyears$preyear[1:19] 49 | allnewyears<- select(allnewyears, c(show, year)) 50 | newplaysperyear<-allnewyears %>% 51 | group_by(year) %>% 52 | summarise(totalnew=n()) 53 | newplaysperyear$cumnew<-cumsum(newplaysperyear$totalnew) 54 | pre1985totals<-newplaysperyear[1:6,] 55 | pre1985totals<-rename(pre1985totals, sumshows=cumnew) 56 | 57 | # Total shows per year 58 | showsperyear<-grosses %>% 59 | group_by(year, show) %>% 60 | summarise(performances = sum(performances)) %>% 61 | group_by(year) %>% 62 | summarise(sumshows=n()) %>% 63 | # add in pre-1985 totals 64 | full_join(pre1985totals) %>% 65 | select(year, sumshows) 66 | 67 | # Join data together, calculate old shown per year 68 | allshowsnew<- 69 | left_join(newplaysperyear, showsperyear) %>% 70 | # subtract new shows from total shows 71 | mutate(totalold=sumshows-totalnew) 72 | 73 | # Okay but there's some years missing!? fill them in... 74 | yearframe<-data.frame(year=as.character(1975:2020)) 75 | # fill with the value above 76 | allshowsnewcompl<-full_join(allshowsnew, yearframe) %>% 77 | arrange(year) %>% 78 | fill(totalold) %>% 79 | fill(sumshows) %>% 80 | fill(cumnew) 81 | # fill in new shows with 0 82 | allshowsnewcompl$totalnew<-replace_na(allshowsnewcompl$totalnew, 0) 83 | # gather old and new into one column to plot 84 | allshowsnewcomplgath<-gather(allshowsnewcompl,totalnew,totalold, key="oldnew", value="number") 85 | 86 | 87 | # Plotting ----------------------- 88 | 89 | plot1<-ggplot(showsperyear, aes(x=as.numeric(year), y=sumshows))+ 90 | geom_point(alpha=0.8)+geom_line()+ 91 | scale_fill_manual(labels=c("New plays","Old plays"), values=c("aquamarine3", "midnightblue"))+ 92 | scale_x_continuous("Year",expand = c(0,0), breaks = seq(1974, 2020, 4)) + 93 | scale_y_continuous("Number of shows playing",expand = c(0,0), limits=c(0,90))+ 94 | theme(panel.grid.minor = element_blank(), panel.border = element_rect(color="lightgrey"), 95 | title = element_text(color="grey25"), plot.background = element_blank(), 96 | legend.position = c(0.1, 0.85), legend.title = element_blank(), 97 | legend.background = element_rect(fill=NA), 98 | legend.text = element_text(size=14))+ 99 | labs(title="The number of Broadway shows playing every year is increasing") 100 | 101 | plot2<-ggplot(allshowsnewcomplgath, aes(x=as.numeric(year), y=number, fill=oldnew))+ 102 | geom_col(alpha=0.8, position="fill")+ 103 | scale_fill_manual(labels=c("New shows","Old shows"), values=c("aquamarine3", "midnightblue"))+ 104 | scale_x_continuous("Year",expand = c(0,0), breaks = seq(1974, 2020, 4)) + 105 | scale_y_continuous("Percent of shows playing",expand = c(0,0), labels = percent_format())+ 106 | theme(panel.grid.minor = element_blank(), panel.border = element_rect(color="lightgrey"), 107 | title = element_text(color="grey25"), plot.background = element_blank(), 108 | legend.position = c(0.9, 0.2), legend.title = element_blank(), 109 | legend.text = element_text(size=12))+ 110 | labs(title="But most Broadway shows are from previous years!") 111 | 112 | 113 | # Saving -------------------------- 114 | 115 | cowplot::plot_grid(plot1, plot2, 116 | align="hv", nrow=2, ncol=1) 117 | ggsave("BroadwayShows_plot.png", bg="transparent", width = 8, height = 5.5, dpi=400) 118 | -------------------------------------------------------------------------------- /2020/20200505_AnimalCrossing/AnimalCrossing_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20200505_AnimalCrossing/AnimalCrossing_plot.png -------------------------------------------------------------------------------- /2020/20200505_AnimalCrossing/README.md: -------------------------------------------------------------------------------- 1 | ![AnimalCrossing_plot.png](AnimalCrossing_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20200505_AnimalCrossing/tidytuesday_20200505.R: -------------------------------------------------------------------------------- 1 | # Animal Crossing 2 | # TidyTuesday 2020 week 19 3 | # RJS updated 5/5/2020 4 | 5 | # Load libraries --------------------- 6 | 7 | library(tidyverse) 8 | library(ggalt) 9 | library(ggtext) 10 | library(scales) 11 | 12 | sessionInfo() 13 | theme_set(theme_light()) 14 | 15 | # Load data -------------------------- 16 | 17 | #critic <- readr::read_tsv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-05-05/critic.tsv') 18 | #user_reviews <- readr::read_tsv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-05-05/user_reviews.tsv') 19 | #items <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-05-05/items.csv') 20 | villagers <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-05-05/villagers.csv') 21 | 22 | # Data formatting & analysis --------- 23 | 24 | dumbbell_vil <-villagers %>% 25 | group_by(gender) %>% 26 | count(species) %>% 27 | distinct() %>% 28 | tidyr::spread(gender, n) %>% 29 | mutate(gap = `male` - `female`) %>% 30 | arrange(desc(gap)) %>% 31 | drop_na(gap) 32 | 33 | 34 | # Plotting --------------------------- 35 | 36 | ggplot(dumbbell_vil, aes(x = `female`, xend = `male`, 37 | y = reorder(species, gap), 38 | group = species)) + 39 | geom_dumbbell(aes(color=gap), size = 4, 40 | colour_x = "darkmagenta", 41 | colour_xend = "#1380A1") + 42 | scale_color_gradient2(low="darkmagenta", mid="white", high="#1380A1")+ 43 | labs( 44 | title = "**Are Villager species usually male or 45 | female?** 46 | ", 47 | subtitle = "The most common male Villager is a frog 48 | and the most common female is a cat 49 | ", 50 | caption = "Plot by @rjstevick \n Source: VillagerDB", 51 | x = "Number of Villagers", y = "" 52 | ) + 53 | theme(plot.title = element_markdown(lineheight = 1.1), 54 | plot.subtitle = element_markdown(lineheight = 0.5), 55 | text = element_text(size=18), 56 | legend.position = "none") 57 | 58 | 59 | # Saving ----------------------------- 60 | 61 | ggsave("AnimalCrossing_plot.png", bg="transparent", width = 10.5, height = 6.5, dpi=400) 62 | -------------------------------------------------------------------------------- /2020/20200512_Volcanoes/README.md: -------------------------------------------------------------------------------- 1 | ![Volcanoes_plot.gif](Volcanoes_plot.gif) 2 | -------------------------------------------------------------------------------- /2020/20200512_Volcanoes/Volcanoes_plot.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20200512_Volcanoes/Volcanoes_plot.gif -------------------------------------------------------------------------------- /2020/20200512_Volcanoes/tidytuesday_20200512.R: -------------------------------------------------------------------------------- 1 | # Volcano Eruptions! 2 | # TidyTuesday 2020 week 20 3 | # RJS updated 5/12/2020 4 | 5 | # Load libraries --------------------- 6 | 7 | library(tidyverse) 8 | library(maps) 9 | library(mapdata) 10 | library(ggplot2) 11 | library(ggmap) 12 | library(gganimate) 13 | 14 | sessionInfo() 15 | theme_set(theme_light()) 16 | 17 | # Load data -------------------------- 18 | 19 | volcano <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-05-12/volcano.csv') 20 | eruptions <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-05-12/eruptions.csv') 21 | #events <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-05-12/events.csv') 22 | #tree_rings <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-05-12/tree_rings.csv') 23 | #sulfur <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-05-12/sulfur.csv') 24 | 25 | w2hr <- map_data("world") # world map 26 | 27 | # Data formatting & analysis --------- 28 | 29 | volcanoerupt<-left_join(volcano, eruptions) %>% 30 | drop_na(c(start_year,vei)) %>% 31 | filter(start_year>1960, start_year<2017) 32 | 33 | # Plotting --------------------------- 34 | 35 | plotv<- ggplot() + 36 | geom_polygon(data=w2hr, 37 | aes(x=long, y=lat, group=group), 38 | fill="grey30", color="grey60") + 39 | geom_point(volcanoerupt, 40 | mapping = aes(x = longitude, y = latitude, 41 | color = elevation, size=vei, 42 | # add a group so the points don't animate from each other 43 | group=as.factor(start_year)), 44 | shape=17, alpha=0.6)+ 45 | scale_colour_viridis_c("Elevation (m)", option="magma")+ 46 | scale_size_continuous("Volcano \nExplosivity \nIndex")+ 47 | scale_x_continuous(expand=c(0,0)) + scale_y_continuous(expand=c(0,0)) + 48 | coord_fixed(1.3) + theme_minimal() + 49 | labs(caption = "Plot by @rjstevick \n Data since 1960, Source: Smithsonian & Wikipedia", 50 | x = NULL, y = NULL) + 51 | theme(legend.text = element_text(color="grey30", size=14), 52 | axis.text = element_blank()) 53 | 54 | #animate based on year volcano started erupting 55 | plotanimate<-plotv+ 56 | transition_manual(frames=start_year, cumulative = TRUE)+ 57 | ggtitle("Cumulative volcano eruptions per year: {current_frame}") 58 | 59 | # render animation 60 | animate(plot = plotanimate, 61 | nframes = length(unique(volcanoerupt$start_year)), 62 | fps = 4, end_pause = 8, height = 380, width =600) 63 | 64 | ## Saving ----------------------------- 65 | 66 | anim_save("Volcanoes_plot.gif") 67 | -------------------------------------------------------------------------------- /2020/20200519_BeachVolleyball/BeachVolleyball_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20200519_BeachVolleyball/BeachVolleyball_plot.png -------------------------------------------------------------------------------- /2020/20200519_BeachVolleyball/README.md: -------------------------------------------------------------------------------- 1 | ![BeachVolleyball_plot.png](BeachVolleyball_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20200519_BeachVolleyball/tidytuesday_20200519.R: -------------------------------------------------------------------------------- 1 | # Beach volleyball 2 | # TidyTuesday 2020 week 21 3 | # RJS updated 5/19/2020 4 | 5 | # Load libraries 6 | library(tidyverse) 7 | sessionInfo() 8 | theme_set(theme_light()) 9 | 10 | # Load data 11 | vb_matches <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-05-19/vb_matches.csv', guess_max = 76000) 12 | 13 | # Data formatting & analysis % plotting in one step!! 14 | vb_matches %>% 15 | # put all player countries into one column named "player_country" 16 | gather(c(w_p1_country, w_p2_country, 17 | l_p1_country, l_p2_country), 18 | key="player", 19 | value="player_country") %>% 20 | # group by the country columns 21 | group_by(country, player_country) %>% 22 | # count number of combos per country:player_country 23 | count() %>% 24 | # clean up variable 25 | drop_na() %>% ungroup() %>% 26 | # define scale so the outlier isn't too obnoxious 27 | mutate(ncolors=cut(n, breaks=c(0,10,25,50,75,100,125,150,175,200,1000,25000,50000,max(n)), 28 | labels=c(10,25,50,75,100,125,150,175,200,1000,25000,50000,max(n)))) %>% 29 | # Plotting 30 | ggplot(aes(y=reorder(country,-n), 31 | x=reorder(player_country,-n), 32 | size=ncolors, 33 | color=ncolors))+ 34 | geom_point(alpha=0.8)+ 35 | scale_colour_viridis_d(option = "plasma") + 36 | theme(axis.text.x=element_text(angle=90, hjust=1), 37 | axis.text = element_text(size=8), 38 | legend.position="right", 39 | plot.background = element_rect(fill="bisque"), 40 | legend.background = element_blank(),panel.background = element_blank(),legend.key=element_blank())+ 41 | labs(x="Player countries", y="Match location", 42 | color="Number of \ncombinations",size="Number of \ncombinations", 43 | caption = "Plot by @rjstevick \n Source: BigTimeStats", 44 | title = "Where do beach volleyball players come from and where do they play?", 45 | subtitle = "The most common combo is from the USA, playing in the USA") 46 | 47 | # Saving ----------------------------- 48 | ggsave("BeachVolleyball_plot.png", bg="transparent", width = 12, height = 6.5, dpi=400) 49 | -------------------------------------------------------------------------------- /2020/20200526_Cocktails/Cocktails_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20200526_Cocktails/Cocktails_plot.png -------------------------------------------------------------------------------- /2020/20200526_Cocktails/README.md: -------------------------------------------------------------------------------- 1 | ![Cocktails_plot.png](Cocktails_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20200526_Cocktails/tidytuesday_20200526.R: -------------------------------------------------------------------------------- 1 | # Common cocktail recipes 2 | # TidyTuesday 2020 week 22 3 | # Rebecca Stevick updated 5/26/2020 4 | 5 | # Load libraries --------------------- 6 | 7 | library(tidyverse) 8 | theme_set(theme_minimal()) 9 | 10 | # Load data -------------------------- 11 | 12 | #cocktails <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-05-26/cocktails.csv') 13 | boston_cocktails <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-05-26/boston_cocktails.csv') 14 | 15 | boston_cocktails %>% 16 | # select 10 common cocktails 17 | filter(name=="Margarita" | name=="Mojito" | name=="Martini" | 18 | name=="Daiquiri" | name=="Cosmopolitan" | name=="Manhattan Cocktail (dry)" | 19 | name=="Sidecar" | name=="Moscow Mule" | name=="Gimlet" | 20 | name=="Long Island Iced Tea") %>% 21 | # separate out the ingredient measurements from the "oz" 22 | separate(measure, sep=" o", into=c("measurenum", "units"), remove=FALSE) %>% 23 | # make the measurements numeric 24 | mutate(measurenumeric=recode(measurenum, 25 | "1/2"=0.5, "1"=1, "1 1/2"=1.5, 26 | "2"=2, "3/4"=0.75, "3"=0.05, "7"=0.05)) %>% 27 | # add ginger beer to the moscow mule because it needs it 28 | add_row(name = "Moscow Mule", ingredient = "Ginger Beer", measurenumeric=4) %>% 29 | # add soda water to the mojito because it needs it 30 | add_row(name = "Mojito", ingredient = "Soda Water", measurenumeric=3) %>% 31 | # combine some ingredient names 32 | mutate(ingredient=recode(ingredient, 33 | "Simple Syrup, 1/2 oz"="Simple Syrup", 34 | "Fresh Lime Juice"="Lime Juice", 35 | "Old Thompson Blended Whiskey"="Whiskey", 36 | "Mr. Boston Gin"="Gin", 37 | "Fresh orange juice and orange wheel"="Fresh orange juice and slice", 38 | "Cointreau or triple sec"="Triple Sec", 39 | "Lime wedges"="Lime Juice")) %>% 40 | # simplify drink names 41 | mutate(name=recode(name,"Manhattan Cocktail (dry)"="Manhattan", 42 | "Long Island Iced Tea"="Long Island \nIced Tea")) %>% 43 | # plotting time! 44 | ggplot(aes(x=name, y=measurenumeric,fill=ingredient))+ 45 | # add bars 46 | geom_bar(stat="identity")+ 47 | # define y-axis breaks and labels 48 | scale_y_continuous(NULL, breaks=c(0,0.5,1,1.5,2,2.5,3,3.5,4,4.5,5,5.5,6), 49 | labels = scales::unit_format(accuracy=0.1, unit="oz"), 50 | # remove the padding on the top and bottom 51 | expand=c(0,0))+ 52 | # move x-axis to top 53 | scale_x_discrete(NULL,position="top")+ 54 | # define color scheme per ingredient 55 | scale_fill_manual(NULL,values=c("Lime Juice"="mediumspringgreen", 56 | "Powdered Sugar"="peachpuff1", 57 | "Gin"="honeydew3","Triple Sec"="orange", 58 | "Dry Vermouth"="darkseagreen4","Cognac"="red3", 59 | "Fresh lemon juice"="yellow","Light Rum"="lightsalmon", 60 | "Vodka"="paleturquoise1", "Madeira"="darkred", 61 | "Fresh orange juice and slice"="darkorange3", 62 | "Blanco tequila"="lemonchiffon1", 63 | "Simple Syrup"="lightsteelblue2", 64 | "Cranberry Juice"="indianred2", 65 | "Fresh mint leaves"="darkgreen", 66 | "Whiskey"="lightsalmon4", 67 | "Ginger Beer"="burlywood3", 68 | "Soda Water"="burlywood1"))+ 69 | # move legend to bottom 70 | theme(legend.position="bottom", 71 | # remove axis lines 72 | panel.grid.major.x = element_blank(), panel.grid.minor.y = element_blank(), 73 | # thicken y-axis lines 74 | panel.grid.major.y = element_line(size=0.5,color="grey40"), 75 | # make text bigger and grey 76 | text = element_text(size=18, color="grey30"), 77 | axis.text.x = element_text(color="grey10", face="bold"), 78 | # center the title 79 | plot.title = element_text(hjust = 0.5), 80 | # make the caption smaller and more grey 81 | plot.caption = element_text(size=12, color="grey50"))+ 82 | # add those labels 83 | labs(caption = "Plot by @rjstevick | Source: Kaggle", 84 | title = "Common Recipes for your geom_bartender()") 85 | 86 | 87 | # Saving ----------------------------- 88 | 89 | ggsave("Cocktails_plot.png", bg="transparent", width = 12, height = 6.5, dpi=400) 90 | -------------------------------------------------------------------------------- /2020/20200602_MarbleRaces/MarbleRaces_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20200602_MarbleRaces/MarbleRaces_plot.png -------------------------------------------------------------------------------- /2020/20200602_MarbleRaces/README.md: -------------------------------------------------------------------------------- 1 | ![MarbleRaces_plot.png](MarbleRaces_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20200602_MarbleRaces/tidytuesday_20200602.R: -------------------------------------------------------------------------------- 1 | # Marble races - top 3 teams ggbump plot 2 | # TidyTuesday 2020 week 23 3 | # Rebecca Stevick updated 6/2/2020 4 | 5 | # Load libraries 6 | library(tidyverse) 7 | library(ggbump) 8 | 9 | # Load data 10 | marbles <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-06-02/marbles.csv') 11 | 12 | # let's get piping! 13 | marbles %>% 14 | # group data by marble race 15 | group_by(race) %>% 16 | # make a new rank column per race group 17 | mutate(rank = rank(time_s, ties.method = "random")) %>% 18 | # select only the top 3 teams per race 19 | filter(rank <= 3) %>% 20 | # plotting time! 21 | ggplot(aes(x=race, 22 | # make the y-axis a factor and flip it 23 | y=reorder(as.factor(rank),-rank), 24 | # need to define group for the colors for ggbump 25 | color=team_name, group=team_name))+ 26 | # add ggbump lines 27 | geom_bump(size = 2, alpha=0.8)+ 28 | # add points since they look like marbles! 29 | geom_point(size = 6, alpha=0.8) + 30 | # remove extra white space 31 | scale_y_discrete(expand=c(0.1,0.1))+ 32 | # remove the background lines 33 | cowplot::theme_minimal_grid(font_size = 14, line_size = 0) + 34 | # and edit the theme 35 | theme(legend.position="bottom", panel.grid.major = element_blank(), 36 | text = element_text(size=18, color="grey30"), 37 | axis.text.x = element_text(color="grey10", face="bold"), 38 | plot.caption = element_text(size=12, color="grey50"))+ 39 | # define the colors 40 | scale_color_manual(values = c("#d9498b","#61b855","#b452bc","#bab141","#6f67d1","#d57731","#618aca", 41 | "#c9423c","#51b79f","#9b476c","#5f813d","#c585c8","#ac8044","#d67776"))+ 42 | # add those labels 43 | labs(x="Race", y="Team Ranking", color=NULL, 44 | caption="Plot by @rjstevick | Source: Jelle's Marble Runs", 45 | title="Every team wins all the time!", 46 | subtitle="Top 3 teams at each race") 47 | 48 | 49 | # Saving ----------------------------- 50 | 51 | ggsave("MarbleRaces_plot.png", bg="transparent", width = 12, height = 6.5, dpi=400) 52 | -------------------------------------------------------------------------------- /2020/20200609_AfricanAmericanAchievements/AfricanAmericanAchievements_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20200609_AfricanAmericanAchievements/AfricanAmericanAchievements_plot.png -------------------------------------------------------------------------------- /2020/20200609_AfricanAmericanAchievements/README.md: -------------------------------------------------------------------------------- 1 | ![AfricanAmericanAchievements_plot.png](AfricanAmericanAchievements_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20200609_AfricanAmericanAchievements/tidytuesday_20200609.R: -------------------------------------------------------------------------------- 1 | # African American Achievements 2 | # TidyTuesday 2020 week 24 3 | # Rebecca Stevick updated 6/9/2020 4 | 5 | # Load libraries 6 | library(tidyverse) 7 | library(ggtext) 8 | library(ggrepel) 9 | library(hrbrthemes) 10 | 11 | # Load data 12 | firsts <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-06-09/firsts.csv') 13 | science <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-06-09/science.csv') 14 | 15 | firsts %>% 16 | # select years since 1990 17 | filter(year>=1990) %>% 18 | # select females 19 | filter(gender=="Female African American Firsts") %>% 20 | # clean up person category 21 | mutate(person = str_remove_all(person, "\\(.*\\)"), # remove anything in parentheses 22 | person = str_remove_all(person, "\\(.*"), # remove open parenthesis 23 | person = str_remove_all(person, "\\[.*\\]")) %>% # remove anything in brackets 24 | # add a column with name and accomplishments merged 25 | unite(person, accomplishment, 26 | col="name_accomplishment", sep=": ", 27 | remove=FALSE) %>% 28 | # plotting time 29 | ggplot(aes(x=category, y=year, color=category, 30 | # fix the width of the text 31 | label=str_wrap(name_accomplishment, 40)))+ 32 | # add text to plot that repels (ggrepel) 33 | geom_label_repel(segment.colour = NA, label.size=0, alpha=0.7, fontface="bold", 34 | family=font_an, size=3.2)+ 35 | # move x-axis to the top 36 | scale_x_discrete(position="top")+ 37 | # make y-axis breaks every 5 years 38 | scale_y_continuous(breaks = scales::breaks_width(5))+ 39 | # change the theme 40 | theme_ipsum()+ 41 | # add colors for each category 42 | scale_color_manual(values=c("#682C37","#D67B44","#34273B","darkblue","#D95B42","#CEA347","#4E7147"))+ 43 | theme(panel.grid.minor = element_blank(), 44 | panel.grid.major.y = element_line(size=2, color="gray75"), 45 | plot.background = element_rect(fill="gray90", color=NA), 46 | axis.text = element_text(color="gray20", face="bold"), 47 | legend.position="none")+ 48 | labs(x=NULL, y="Year", 49 | caption="Plot by @rjstevick | Source: Wikipedia \"List of African-American firsts\"", 50 | title="Female African-American \"firsts\" since 1990") 51 | 52 | 53 | # Saving ----------------------------- 54 | ggsave("AfricanAmericanAchievements_plot.png", bg="transparent", width = 15, height = 8, dpi=400) 55 | -------------------------------------------------------------------------------- /2020/20200616_AfricanAmericanHistory/AfricanAmericanHistory_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20200616_AfricanAmericanHistory/AfricanAmericanHistory_plot.png -------------------------------------------------------------------------------- /2020/20200616_AfricanAmericanHistory/README.md: -------------------------------------------------------------------------------- 1 | ![AfricanAmericanHistory_plot.png](AfricanAmericanHistory_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20200616_AfricanAmericanHistory/tidytuesday_20200616.R: -------------------------------------------------------------------------------- 1 | # African American History - US Census data 2 | # TidyTuesday 2020 week 25 3 | # Rebecca Stevick updated 6/16/2020 4 | 5 | # Load libraries 6 | library(tidyverse) 7 | library(hrbrthemes) 8 | 9 | # Load data - Important context on the datasets here: https://github.com/rfordatascience/tidytuesday/blob/master/data/2020/2020-06-16/readme.md 10 | census <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-06-16/census.csv') 11 | # blackpast <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-06-16/blackpast.csv') 12 | # slave_routes <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-06-16/slave_routes.csv') 13 | # african_names <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-06-16/african_names.csv') 14 | 15 | census %>% 16 | # put free and slave into one column 17 | gather(key="slave_free", value="number", black_free:black_slaves) %>% 18 | # remove the total values 19 | filter(division!="USA Total") %>% 20 | # group by region and year 21 | group_by(year, slave_free, region) %>% 22 | # sum up to get rid of the divisions 23 | summarise(sumnum=sum(number)) %>% 24 | # plotting time 25 | ggplot(aes(x=year, y=sumnum, fill=slave_free))+ 26 | # put the year on the y-axis 27 | coord_flip()+ 28 | # make a panel for each region 29 | facet_grid(.~region)+ 30 | # add bar plot normalized to 1 31 | geom_col(position="fill", alpha=0.7)+ 32 | # define colors and labels for the fill 33 | scale_fill_manual(labels=c("Free","Enslaved"), 34 | values=c("grey50","black"))+ 35 | # make the percent axis say % 36 | scale_y_continuous(labels=scales::percent_format())+ 37 | # change the theme 38 | theme_ipsum()+ 39 | theme(panel.grid.minor = element_blank(), 40 | panel.grid.major.y = element_line(color="gray75"), 41 | plot.background = element_blank(), 42 | axis.text = element_text(size=14, color="gray40", face="bold"), 43 | strip.text = element_text(color="gray40", size=18, face="bold"), 44 | legend.text = element_text(size=14, color="gray40", face="bold"), 45 | legend.position=c(0.92, 1.14), 46 | legend.direction = "horizontal")+ 47 | labs(x=NULL, y=NULL, fill=NULL, 48 | caption="Plot by @rjstevick | Source: US Census Archives", 49 | title="Census of US African-Americans and their status by region (1790 to 1870)") 50 | 51 | # Saving ----------------------------- 52 | ggsave("AfricanAmericanHistory_plot.png", bg="transparent", width = 12, height = 6.5, dpi=400) 53 | -------------------------------------------------------------------------------- /2020/20200623_Caribou/Caribou_plot.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20200623_Caribou/Caribou_plot.gif -------------------------------------------------------------------------------- /2020/20200623_Caribou/Caribou_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20200623_Caribou/Caribou_plot.png -------------------------------------------------------------------------------- /2020/20200623_Caribou/README.md: -------------------------------------------------------------------------------- 1 | ![Caribou_plot.gif](Caribou_plot.gif) 2 | ![Caribou_plot.png](Caribou_plot.png) 3 | -------------------------------------------------------------------------------- /2020/20200623_Caribou/tidytuesday_20200623.R: -------------------------------------------------------------------------------- 1 | # Caribou Locations over time 2 | # TidyTuesday 2020 week 26 3 | # Rebecca Stevick updated 6/23/2020 4 | 5 | # Load libraries 6 | library(tidyverse) 7 | library(ggmap) 8 | library(PNWColors) 9 | library(lubridate) 10 | library(gganimate) 11 | library(showtext) 12 | 13 | theme_set(theme_minimal()) 14 | 15 | # Load data 16 | individuals <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-06-23/individuals.csv') 17 | locations <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-06-23/locations.csv') 18 | 19 | # Add a new column with year and season combined for animation 20 | locations<- locations %>% 21 | # pull out year from timestamp 22 | mutate(year=year(timestamp)) %>% 23 | # order dataframe by year 24 | arrange(year) %>% 25 | # make new column with year and season 26 | unite(col="yearseason", season, year, sep=" ", remove=FALSE) 27 | 28 | # Make the static plot with all observations shown 29 | plotstat<- 30 | # load in the map data 31 | get_stamenmap(bbox = make_bbox(lat=c(52,58), lon=c(-132, -118)), 32 | crop = TRUE, zoom = 6) %>% 33 | # plot the map and set the coordinates 34 | ggmap() + coord_equal()+ 35 | # add the caribou locations as hexes 36 | geom_hex(data=locations, aes(x=longitude, y=latitude), 37 | # make 5 bins for every lat/long 38 | binwidth = c(0.15, 0.15), 39 | # make the hexes a little transparent 40 | alpha=0.8, 41 | # add thin white borders to hexes 42 | color=alpha("white", 0.8), lwd=0.2)+ 43 | # change the color scheme 44 | scale_fill_gradientn(colours=rev(pnw_palette("Moth", 10)), 45 | # change to log scale so it's easier to see changes 46 | trans="log", 47 | # define where the labels/breaks are on the legend 48 | breaks=c(1, 20, 400, 8000))+ 49 | # fix where the legend is and its format 50 | theme(legend.position=c(0.12,0.15),legend.direction = "horizontal", 51 | # give the legend a transparent background 52 | legend.background = element_rect(fill=alpha("white", 0.5), color="transparent"), 53 | # add axis ticks for lat/long labels 54 | axis.ticks = element_line(inherit.blank=FALSE, color="grey30", size = 0.8), 55 | # make all the text grey 56 | text = element_text(size=12, color="grey30"), 57 | # change the size and color of the legend title 58 | legend.title = element_text(size=11), 59 | # make the main title bigger 60 | plot.title = element_text(size=16, family="HoltwoodOneSC"), 61 | # make the caption smaller and more grey 62 | plot.caption = element_text(size=12, color="grey50"), 63 | # transparent background 64 | plot.background = element_blank())+ 65 | # put the legend title on the top 66 | guides(fill = guide_colourbar(title.position="top"))+ 67 | # add those labels 68 | labs(x=NULL,y=NULL, fill="Number of caribou \nobservations (log scale)", 69 | caption = "Sources: Movebank, BC Ministry of Environment & ggmap \nPlot by @rjstevick for #TidyTuesday", 70 | title="Cumulative caribou locations 1988-2016") 71 | 72 | #animate map based on year and season 73 | plotanimate<-plotstat+ 74 | transition_manual(frames=factor(yearseason, levels=unique(yearseason)), cumulative = FALSE)+ 75 | # Leave faded hexes on the map 76 | #shadow_trail(alpha = 0.1)+ 77 | # Add title with year/season shown 78 | ggtitle("Where did the caribou roam in {current_frame}?") 79 | 80 | 81 | # Saving ----------------------------- 82 | 83 | # render animation 84 | animate(plot = plotanimate, 85 | nframes = length(unique(locations$yearseason)), 86 | fps = 2, end_pause = 8, 87 | #define size and resolution of the gif 88 | height = 6, width = 12, units = "in", res = 100) 89 | 90 | # save the animation 91 | anim_save("Caribou_plot.gif") 92 | 93 | # save the total static image too 94 | ggsave(plot=plotstat, "Caribou_plot.png", bg="transparent", width = 12, height = 6.5, dpi=400) 95 | -------------------------------------------------------------------------------- /2020/20200630_ClaremontRun/ClaremontRun_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20200630_ClaremontRun/ClaremontRun_plot.png -------------------------------------------------------------------------------- /2020/20200630_ClaremontRun/README.md: -------------------------------------------------------------------------------- 1 | Highlighed on TidyX Episode 17: https://www.youtube.com/watch?v=PDN_PJMpvTo 2 | 3 | ![ClaremontRun_plot.png](ClaremontRun_plot.png) 4 | -------------------------------------------------------------------------------- /2020/20200630_ClaremontRun/tidytuesday_20200630.R: -------------------------------------------------------------------------------- 1 | # Claremont Run of X-men 2 | # TidyTuesday 2020 week 27 3 | # Rebecca Stevick updated 6/30/2020 4 | 5 | # Load libraries 6 | library(tidyverse) 7 | library(ggpubr) 8 | library(hrbrthemes) 9 | 10 | # Load data - use the characters data set. Many others available in the Claremont Run package: remotes::install_github("malcolmbarrett/claremontrun") 11 | characters <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-06-30/characters.csv') 12 | 13 | # let's look at when characters flew! 14 | flying<-characters %>% 15 | # remove rows that aren't flying 16 | drop_na(flying_with_another_character) %>% 17 | group_by(character) %>% 18 | # count up number of flights per character 19 | count(name="fly") %>% 20 | arrange(desc(fly)) 21 | 22 | # and when they hugged! 23 | hugging<-characters %>% 24 | # remove actions that aren't hugging 25 | drop_na(hugging_with_which_character) %>% 26 | group_by(character) %>% 27 | # count up number of hugs per character 28 | count(name="hug") %>% 29 | arrange(desc(hug)) 30 | 31 | # join hugging and flying counts per character 32 | flyinghugging<-full_join(flying, hugging) %>% 33 | # add in a 0 if they didn't hug or fly 34 | replace_na(list("hug"=0, "fly"=0)) 35 | 36 | # plotting time 37 | ggplot(flyinghugging, aes(x=fly, y=hug))+ 38 | # add diamond points for each character 39 | geom_point(shape=18, size=6, 40 | # highlight characters who hug more than 20 times 41 | color=ifelse(flyinghugging$hug > 20, "royalblue3", "gray60"))+ 42 | # add regression line 43 | geom_smooth(method="lm", color="red3", fill="red2", alpha=0.1)+ 44 | # show regression equation, R2 and p-value 45 | stat_regline_equation(label.x = 24, label.y=12, color="red3") + stat_cor(label.x=24, label.y=11, color="red3")+ 46 | # add label and arrow for Storm 47 | geom_label(aes(x = 24, y = 21, label = "Storm \n(Ororo Munroe)"),alpha=0, hjust = 1, vjust = 0.5, lineheight = 0.8, colour = "gray70", label.size = NA, size = 4)+ 48 | geom_curve(aes(x = 24, y = 21, xend = 27, yend = 22), colour = "gray70", size=0.5, curvature = -0.2, arrow = arrow(length = unit(0.03, "npc")))+ 49 | # add label and arrow for Shadowcat 50 | geom_label(aes(x = 5, y = 21, label = "Ariel/Sprite/Shadowcat \n(Kitty Pryde)"), alpha=0, hjust = 0, vjust = 0.5, lineheight = 0.8, colour = "gray70", label.size = NA, size = 4)+ 51 | geom_curve(aes(x = 5, y = 21, xend = 3, yend = 23), colour = "gray70", size=0.5, curvature = -0.3,arrow = arrow(length = unit(0.03, "npc")))+ 52 | # change the overall theme 53 | theme_ft_rc()+ 54 | # edit the text sizes 55 | theme(plot.title=element_text(size=20),plot.subtitle = element_text(color="royalblue", face="bold"), axis.title.x = element_text(size=14, face="bold"), axis.title.y = element_text(size=14, face="bold"), plot.caption = element_text(size=12))+ 56 | # add those labels 57 | labs(x="Number of issues where character flew", y="Number of issues where \ncharacter hugged someone", 58 | title="X-Men characters who fly more also hug more", 59 | subtitle="Frequent huggers are highlighted in blue.", 60 | caption = "Source: @ClarementRun | Plot by @rjstevick for #TidyTuesday") 61 | 62 | 63 | # Saving ----------------------------- 64 | ggsave("ClaremontRun_plot.png", width = 12, height = 6.5, dpi=400) 65 | -------------------------------------------------------------------------------- /2020/20200707_CoffeeRatings/CoffeeRatings_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20200707_CoffeeRatings/CoffeeRatings_plot.png -------------------------------------------------------------------------------- /2020/20200707_CoffeeRatings/README.md: -------------------------------------------------------------------------------- 1 | ![CoffeeRatings_plot.png](CoffeeRatings_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20200707_CoffeeRatings/tidytuesday_20200707.R: -------------------------------------------------------------------------------- 1 | # Coffee Ratings: top producers and locations 2 | # TidyTuesday 2020 week 28 3 | # Rebecca Stevick updated 7/8/2020 4 | 5 | # Load libraries 6 | library(tidyverse) 7 | 8 | # Load data 9 | tuesdata <- tidytuesdayR::tt_load('2020-07-07') 10 | coffee_ratings <- tuesdata$coffee_ratings 11 | 12 | # make a barplot of number of coffees per country 13 | coffeebar<-coffee_ratings %>% 14 | # group by country of origin 15 | group_by(country_of_origin) %>% 16 | # count number of beans rated per country 17 | count() %>% drop_na() %>% 18 | # fix some country names 19 | mutate(country_of_origin=recode(country_of_origin, 20 | "Cote d?Ivoire"="Ivory Coast", 21 | "Tanzania, United Republic Of"="Tanzania", 22 | "United States"="USA")) %>% 23 | # plotting time 24 | ggplot(aes(x=reorder(country_of_origin, -n), y=n, fill=n)) + geom_col() + 25 | # change color of fill 26 | scale_fill_gradient(low="#ddc7b8", high="#382b22") + 27 | # remove extra white space 28 | scale_y_continuous(expand=c(0,0)) + 29 | # change themes 30 | coord_flip() + theme_minimal() + 31 | theme(legend.position="none",panel.grid = element_blank(), 32 | text = element_text(color="#4b392d", family="Arial Narrow", size=8), 33 | axis.ticks.x = element_line(inherit.blank = FALSE)) + 34 | labs(x=NULL, y=NULL, fill=NULL) 35 | 36 | # make a map with barplot in the corner 37 | coffee_ratings %>% 38 | # group by country of origin 39 | group_by(country_of_origin) %>% 40 | # count number of beans rated per country 41 | count() %>% drop_na() %>% 42 | # fix some country names 43 | mutate(country_of_origin=recode(country_of_origin, 44 | "Cote d?Ivoire"="Ivory Coast", 45 | "Tanzania, United Republic Of"="Tanzania", 46 | "United States"="USA")) %>% 47 | # add in map data based on the country 48 | left_join(map_data("world"), by=c("country_of_origin"="region")) %>% 49 | # start plotting 50 | ggplot(aes(x=long, y=lat, group=group)) + 51 | # add world map 52 | geom_polygon(data=map_data("world"), fill="grey90", color="white") + 53 | # add coffee locations, colored by number of beans rated 54 | geom_polygon(aes(fill=n), color="#f1e8e2") + 55 | # change color of fill 56 | scale_fill_gradient("Number of coffee \nbean varieties graded", low="#ddc7b8", high="#382b22") + 57 | # remove all theme elements and fix the x-y so the map doesn't warp 58 | theme_void() + coord_fixed(1.3) + 59 | # remove extra white space 60 | scale_x_continuous(expand=c(0,0)) + scale_y_continuous(expand=c(0,0)) + 61 | # extra theme changed 62 | theme(legend.position=c(0.75,0.14), legend.direction = "horizontal", 63 | text = element_text(color="#4b392d", family="Arial Narrow", face="bold"), 64 | plot.title = element_text(hjust = 0.5, size=18))+ 65 | # put the legend title on the top and centered 66 | guides(fill = guide_colourbar(title.position="top", title.hjust = 0.5))+ 67 | # add those labels 68 | labs(title="Where are coffee beans grown around the world?", 69 | caption = "Source: James LeDoux & Coffee Quality Database \nPlot by @rjstevick")+ 70 | # add the bar plot on the bottom left of the map 71 | annotation_custom(ggplotGrob(coffeebar), 72 | xmin = -175, ymin = -78, 73 | xmax = -15, ymax=15) 74 | 75 | 76 | # Saving ----------------------------- 77 | ggsave("CoffeeRatings_plot.png", bg="transparent", width = 8, height = 5.6, dpi=400) 78 | -------------------------------------------------------------------------------- /2020/20200714_Astronauts/Astronauts_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20200714_Astronauts/Astronauts_plot.png -------------------------------------------------------------------------------- /2020/20200714_Astronauts/README.md: -------------------------------------------------------------------------------- 1 | ![Astronauts_plot.png](Astronauts_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20200714_Astronauts/tidytuesday_20200714.R: -------------------------------------------------------------------------------- 1 | # Astronaut population database 2 | # TidyTuesday 2020 week 29 3 | # Rebecca Stevick updated 7/14/2020 4 | 5 | # Load libraries 6 | library(tidyverse) 7 | library(ggchicklet) #devtools::install_github("hrbrmstr/ggchicklet") 8 | library(nationalparkcolors) #devtools::install_github("katiejolly/nationalparkcolors") 9 | library(hrbrthemes) 10 | 11 | # Load data 12 | tuesdata <- tidytuesdayR::tt_load('2020-07-14') 13 | astronauts <- tuesdata$astronauts 14 | 15 | # Goal: number of astronauts per year and their nationalities. 16 | # And which spacecraft did they take? 17 | 18 | # Let's get piping! 19 | astronauts %>% 20 | # select the top 2 countries (US and Russia) and lump all others into "Others" 21 | mutate(nationalityother=fct_lump(f=nationality, n=2, other_level="Others")) %>% 22 | # make new column with the cleaned spacecraft name. Extract the word before a " " or a "-"in the ascend_shuttle column 23 | mutate(spacecraft=str_extract(ascend_shuttle, "[^ |-]+")) %>% 24 | # remove any mission numbers in the spacecraft column 25 | mutate(spacecraft=str_extract(spacecraft, "[:alpha:]+")) %>% 26 | # fix some of the names 27 | mutate(spacecraft=recode(spacecraft, "gemini"="Gemini", "soyuz"="Soyuz", "apollo"="Apollo", 28 | "ASTP"="Apollo-Soyuz", "STS"="Space Shuttle", "MA"="Mercury-Atlas")) %>% 29 | # count number of astronauts per year and nationality and arrange 30 | group_by(year_of_mission, nationalityother, spacecraft) %>% count() %>% arrange(desc(n)) %>% 31 | # plot year on x-axis and number of missions on y-axis 32 | ggplot(aes(x=year_of_mission, y=n, 33 | # fill by nationality, in order of abundance 34 | fill=factor(nationalityother,levels=unique(nationalityother)), 35 | # outline color by spacecraft 36 | color=spacecraft))+ 37 | # add rounded bar graph (chicklets) 38 | geom_chicklet(width=0.7, lwd=1)+ 39 | # edit the breaks on x-axis 40 | scale_x_continuous(breaks=scales::pretty_breaks(n=20))+ 41 | # change fill colors using national park palettes 42 | scale_fill_manual(values=c(park_palette("Saguaro", 3)))+ 43 | # change outline colors 44 | scale_color_manual(values=rev(RColorBrewer::brewer.pal(n = 11, name = "Set3")))+ 45 | # edit the theme 46 | theme_ipsum()+ theme(legend.position = c(0.2,0.78), legend.direction = "horizontal", 47 | plot.background = element_rect(fill="gray60", color="transparent"), 48 | panel.grid.minor = element_blank())+ 49 | # put the legend titles on top 50 | guides(fill=guide_legend(position=1, title.position="top"), 51 | # the chicklet outlines were tricky... this is the only way I could get colors to show up 52 | color=guide_legend(title.position="top", override.aes = list(fill=rev(c("white",RColorBrewer::brewer.pal(n = 11, name = "Set3"))))))+ 53 | # add those labels 54 | labs(title= "Space Race! Astronaut missions peaked in 1985.", 55 | subtitle="Number of astronaut missions each year are colored by nationality. Outline color indicates which spacecraft used for ascent. 948/1277 missions were U.S. astronauts in the Space Shuttle.", 56 | x="Year of Mission", y="Number of astronauts", fill="Astronaut Nationality (fill)", color="Ascent Spacecraft Used (outline)", 57 | caption = "Data from Corlett, Stavnichuk & Komarova. Life Sciences in Space Research (2020). 58 | Plot by @rjstevick for #TidyTuesday") 59 | 60 | # Saving ----------------------------- 61 | ggsave("Astronauts_plot.png", width = 14, height = 7, dpi=400) 62 | -------------------------------------------------------------------------------- /2020/20200721_AustralianAnimals/AustralianAnimals_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20200721_AustralianAnimals/AustralianAnimals_plot.png -------------------------------------------------------------------------------- /2020/20200721_AustralianAnimals/README.md: -------------------------------------------------------------------------------- 1 | ![AustralianAnimals_plot.png](AustralianAnimals_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20200721_AustralianAnimals/tidytuesday_20200721.R: -------------------------------------------------------------------------------- 1 | # Australian Animal outcomes 2 | # TidyTuesday 2020 week 30 3 | # Rebecca Stevick updated 7/21/2020 4 | 5 | # Load libraries 6 | library(tidyverse) 7 | library(hrbrthemes) 8 | library(waffle) # devtools::install_github("hrbrmstr/waffle") 9 | library(ggtext) 10 | library(extrafont) 11 | 12 | # to get the glyphs to work for the pictogram. help from here https://www.r-craft.org/r-news/quick-hit-waffle-1-0-font-awesome-5-pictograms-and-more/ 13 | # install_fa_fonts(); extrafont::font_import(); extrafont::loadfonts(quiet = TRUE) 14 | # extrafont::fonttable() %>% as_tibble() %>% filter(grepl("Awesom", FamilyName)) %>% select(afmfile, FullName, FamilyName, FontName) 15 | 16 | # Load data 17 | tuesdata <- tidytuesdayR::tt_load('2020-07-21') 18 | animal_complaints <- tuesdata$animal_complaints 19 | 20 | # Let's get piping! 21 | animal_complaints %>% 22 | # separate date column into month and year 23 | separate(col="Date Received",sep=" ", into=c("Month","Year")) %>% 24 | # group and calculate the number of complaints per animal/month/year 25 | group_by(Year, Month, `Animal Type`) %>% count() %>% 26 | # calculate the mean per animal/month 27 | group_by(Month, `Animal Type`) %>% summarise(meancomplaints=mean(n)) %>% 28 | # divide mean complaints by 20 for the waffle 29 | mutate(meancomplaints20=round(meancomplaints/20)) %>% ungroup() %>% 30 | # add levels to Month so it plots in order 31 | mutate(Month=factor(Month, levels=c("January","February","March","April","May","June","July", 32 | "August","September","October","November","December"))) %>% 33 | # time to plot! use example here: https://github.com/hrbrmstr/waffle 34 | ggplot(aes(label=`Animal Type`, colour = `Animal Type`, values=meancomplaints20))+ 35 | # add pictogram for each animal type 36 | geom_pictogram(n_rows = 7, size=3, flip = TRUE, family = "FontAwesome5Free-Solid") + 37 | # separate plots by month 38 | facet_wrap(~Month, ncol=4)+ 39 | # define colors and pictograms 40 | scale_label_pictogram(name=NULL, values = c("cat","dog")) + 41 | scale_color_manual(name = NULL,values = c("#a40000", "#c68958")) + 42 | # set themes 43 | theme_ipsum(grid="") + theme_enhance_waffle()+ 44 | theme(legend.position = "none", plot.subtitle = element_markdown(lineheight = 0.5), 45 | strip.text = element_text(face="bold"))+ 46 | # add those labels 47 | labs(title= "Average animal complaints per month in Australia", 48 | subtitle="Each **dog** or **cat** represents 20 complaints (1999-2017)", 49 | caption = "Source: Royal Society for the Prevention of Cruelty to Animals | Plot by @rjstevick for #TidyTuesday") 50 | 51 | # Saving ----------------------------- 52 | ggsave("AustralianAnimals_plot.png", bg="transparent", width = 9, height = 6, dpi=400) 53 | -------------------------------------------------------------------------------- /2020/20200728_PalmerPenguins/PalmerPenguins_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20200728_PalmerPenguins/PalmerPenguins_plot.png -------------------------------------------------------------------------------- /2020/20200728_PalmerPenguins/README.md: -------------------------------------------------------------------------------- 1 | ![PalmerPenguins_plot.png](PalmerPenguins_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20200728_PalmerPenguins/tidytuesday_20200728.R: -------------------------------------------------------------------------------- 1 | # Palmer Penguins 2 | # TidyTuesday 2020 week 31 3 | # Rebecca Stevick updated 7/28/2020 4 | 5 | # Load libraries 6 | library(tidyverse) 7 | library(hrbrthemes) 8 | library(ggtext) 9 | library(ggimage) 10 | 11 | # Load data 12 | library(palmerpenguins) 13 | 14 | # make dataframe of image links, make sure the facet variable is the same 15 | images<-data.frame(species=c("Adelie","Chinstrap","Gentoo"), 16 | image=c("https://www.nationalgeographic.com/content/dam/animals/thumbs/rights-exempt/birds/a/adelie-penguin_thumb.jpg", 17 | "https://www.nationalgeographic.com/content/dam/animals/thumbs/rights-exempt/birds/c/chinstrap-penguin.jpg", 18 | "https://www.nationalgeographic.com/content/dam/animals/thumbs/rights-exempt/birds/g/gentoo-penguin_thumb.ngsversion.1489602603532.adapt.1900.1.JPG")) 19 | 20 | # Let's get piping! 21 | penguins %>% 22 | drop_na(sex) %>% 23 | # start ggplot with body mass on x-axis 24 | ggplot(aes(x=body_mass_g))+ 25 | # add penguin images to background 26 | geom_image(data=images, aes(x=4550, y=6.5, image=image), 27 | size = 1, by="height")+ 28 | # add histogram, colored by penguin sex 29 | geom_histogram(aes(fill = sex), color=alpha("white",0.3), 30 | alpha = 0.6, position = "identity") + 31 | # facet/new panel for each species 32 | facet_grid(.~species)+ 33 | # change bar colors 34 | scale_fill_manual(values=c("darkmagenta","skyblue2")) + 35 | # remove extra white space 36 | scale_x_continuous(expand = c(0,0))+ 37 | scale_y_continuous(breaks=seq(0,14, by=3), expand = c(0,0))+ 38 | # make sure the photos don't warp 39 | scale_size_identity()+ 40 | # change theme 41 | theme_ipsum()+ 42 | theme(legend.position="none", strip.text=element_text(face="bold"), 43 | plot.subtitle=element_markdown(lineheight = 0.5), 44 | plot.title = element_text(family="Amaranth"), 45 | axis.ticks.x=element_line(inherit.blank=FALSE),axis.ticks.y=element_line(inherit.blank=FALSE)) + 46 | # add labels 47 | labs(x="Body mass (grams)", y="Number of penguins", shape=NULL, color=NULL, 48 | title= "Size distributions of Palmer Penguin species", 49 | subtitle="In all 3 species surveyed, **female penguins** weigh less than **male penguins**.", 50 | caption = "data from Gorman, Williams & Fraser (2014). doi.org/10.1371/journal.pone.0090081 51 | photos from National Geographic photo ark (rights exempt, links in code) | plot by @rjstevick for #TidyTuesday") 52 | 53 | # Saving ----------------------------- 54 | ggsave("PalmerPenguins_plot.png", bg="transparent", width = 8, height = 5, dpi=400) 55 | -------------------------------------------------------------------------------- /2020/20200804_EuropeanEnergy/EuropeanEnergy_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20200804_EuropeanEnergy/EuropeanEnergy_plot.png -------------------------------------------------------------------------------- /2020/20200804_EuropeanEnergy/README.md: -------------------------------------------------------------------------------- 1 | ![EuropeanEnergy_plot.png](EuropeanEnergy_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20200804_EuropeanEnergy/tidytuesday_20200804.R: -------------------------------------------------------------------------------- 1 | # European Energy treemap 2 | # TidyTuesday 2020 week 32 3 | # Rebecca Stevick updated 8/04/2020 4 | 5 | # Load libraries 6 | library(tidyverse) 7 | library(hrbrthemes) 8 | library(treemapify) 9 | 10 | # Load data 11 | tuesdata <- tidytuesdayR::tt_load('2020-08-04') 12 | 13 | # time to pipe, use energy_types 14 | tuesdata$energy_types %>% 15 | # combine the year columns into one 16 | pivot_longer(names_to= "year", values_to="value", `2016`:`2018`) %>% 17 | # remove missing data and select only year 2018 and level 1 types 18 | drop_na(value, country_name) %>% filter(level=="Level 1" & year=="2018") %>% 19 | # sum up the energy generated per country 20 | group_by(country) %>% mutate(sumValue=sum(value)) %>% ungroup() %>% 21 | # make a new column with only the top 20 generating countries, label the others as "Others" 22 | mutate(countryOther=forcats::fct_lump_n(f=country_name, w=sumValue, other_level="All other \ncountries", n=20)) %>% 23 | # time to plot 24 | ggplot(aes(area = value, # area of each square is the energy generated per country/type 25 | fill = factor(type, levels=unique(type)), # keep the order of energy so that Other is last 26 | label = type, subgroup = countryOther))+ 27 | # add the tree map and add borders between countries 28 | geom_treemap(color = "gray20") + geom_treemap_subgroup_border(color = "gray90", lwd=5)+ 29 | # change the fill colors - based on nationalparkcolors::park_palette("CraterLake", n=7) 30 | scale_fill_manual(values = c("#4E7147", "#BE9C9D", "#376597","#7DCCD3", "#DBA662", "#9888A5", "#F7ECD8"))+ 31 | # edit the text colors and sizes 32 | geom_treemap_text(aes(family=font_rc_light), colour = "gray75", place = "topleft", reflow = FALSE, size = 10)+ 33 | geom_treemap_subgroup_text(aes(family=font_rc), col = 'white', 34 | # fit the text to the box so its size is relative to energy generation 35 | grow = TRUE, padding.y = grid::unit(3, "mm"),padding.x = grid::unit(3, "mm")) + 36 | # change theme and position the legend 37 | theme_ipsum_rc()+theme(legend.position = c(0.78,1.1), legend.direction = "horizontal")+ 38 | # add labels 39 | labs(fill=NULL, title="European Energy Generation in 2018", 40 | subtitle="each area is proportional to energy generated per type & country in GWh (Gigawatt hours) 41 | the top 20 countries are shown - all others are grouped together as \"All other countries\"", 42 | caption="data from Eurostat Energy | plot by @rjstevick for #TidyTuesday") 43 | 44 | # Saving ----------------------------- 45 | ggsave("EuropeanEnergy_plot.png", bg = "transparent", width = 12, height = 7, dpi = 400) 46 | 47 | 48 | 49 | ## try it with the treemap package as well 50 | library(treemap) 51 | tuesdata$energy_types %>% 52 | pivot_longer(names_to= "year", values_to="value", `2016`:`2018`) %>% 53 | drop_na(value, country_name) %>% filter(level=="Level 1" & year=="2018") %>% 54 | group_by(country) %>% mutate(sumValue=sum(value)) %>% ungroup() %>% 55 | mutate(countryOther=forcats::fct_lump_n(f=country_name, w=sumValue, other_level="All other countries", n=20)) %>% 56 | treemap(index=c("countryOther", "type"), 57 | vSize = "value", vColor="type", type="categorical", 58 | palette=c("#4E7147", "#BE9C9D", "#376597","#7DCCD3", "#DBA662", "#9888A5", "#F7ECD8"), 59 | overlap.labels = 0.4, fontsize.labels = c(18, 12), 60 | title = "European Energy Generation in 2018", 61 | align.labels=list(c("center", "top"), c("right", "bottom"))) 62 | -------------------------------------------------------------------------------- /2020/20200811_AvatarLastAirbender/AvatarLastAirbender_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20200811_AvatarLastAirbender/AvatarLastAirbender_plot.png -------------------------------------------------------------------------------- /2020/20200811_AvatarLastAirbender/README.md: -------------------------------------------------------------------------------- 1 | ![AvatarLastAirbender_plot.png](AvatarLastAirbender_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20200811_AvatarLastAirbender/tidytuesday_20200811.R: -------------------------------------------------------------------------------- 1 | # Avatar: The Last Airbender 2 | # TidyTuesday 2020 week 33 3 | # Rebecca Stevick updated 8/11/2020 4 | 5 | # Load libraries 6 | library(tidyverse) 7 | library(tvthemes) # for the Avatar theme 8 | library(ggstream) 9 | 10 | extrafont::loadfonts() 11 | 12 | # Load data 13 | tuesdata <- tidytuesdayR::tt_load('2020-08-11') 14 | 15 | tuesdata$avatar %>% 16 | filter(character != "Scene Description") %>% 17 | group_by(book, book_num, chapter, chapter_num, character) %>% count() %>% 18 | group_by(character) %>% mutate(sumn=sum(n)) %>% ungroup() %>% 19 | mutate(characterOther=forcats::fct_lump_n(f=character, w=sumn, other_level="All other \ncharacters", n=7)) %>% 20 | ggplot(aes(x=chapter_num, y=n, fill=reorder(characterOther, desc(sumn)))) + 21 | geom_stream(bw = 0.4, color = "white", alpha=0.7)+ 22 | facet_grid(.~book)+ 23 | scale_fill_avatar(palette = "FireNation")+ 24 | scale_x_continuous(expand=c(0,0))+scale_y_continuous(labels = c(0,50,100,150,200))+ 25 | theme_avatar(title.font = "Slayer", text.font = "Slayer")+ 26 | theme(legend.position = "top", plot.caption = element_text(family="Montserrat", size=12), 27 | axis.title = element_text(hjust=1), legend.background = element_rect(fill = NA, color = NA))+ 28 | labs(fill=NULL, x="Chapter Number", y="Number of spoken lines", 29 | title="Avatar: the last airbender ", 30 | subtitle="Number of lines spoken by each character per episode per book", 31 | caption="data from Avatar wiki/Appa package | plot by @rjstevick for #TidyTuesday") 32 | 33 | # Saving ----------------------------- 34 | ggsave("AvatarLastAirbender_plot.png", width = 10, height = 6, dpi = 400) 35 | 36 | -------------------------------------------------------------------------------- /2020/20200818_ExtinctPlants/ExtinctPlants_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20200818_ExtinctPlants/ExtinctPlants_plot.png -------------------------------------------------------------------------------- /2020/20200818_ExtinctPlants/README.md: -------------------------------------------------------------------------------- 1 | ![ExtinctPlants_plot.png](ExtinctPlants_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20200818_ExtinctPlants/tidytuesday_20200818.R: -------------------------------------------------------------------------------- 1 | # IUCN Extinct Plants threats by continent 2 | # TidyTuesday 2020 week 34 3 | # Rebecca Stevick updated 8/27/2020 4 | 5 | # Load libraries --------------- 6 | library(tidyverse) # for general data manipulation 7 | library(ggtext) # to add colored text to the plot 8 | library(nationalparkcolors) # for discrete color schemes 9 | library(waffle) # for geom_pictogram 10 | library(hrbrthemes) # for the overall theme 11 | library(extrafont) # for loading the pictogram font 12 | loadfonts() # load fonts into the R session (works on Mac, Windows is harder and needs extra steps) 13 | 14 | # Load data -------------------- 15 | tuesdata <- tidytuesdayR::tt_load('2020-08-18') 16 | 17 | # Analysis and plotting -------- 18 | tuesdata$threats %>% 19 | # select only rows with data 20 | filter(threatened == 1) %>% 21 | # sum up number of threats per type and continent 22 | group_by(continent, threat_type) %>% count() %>% 23 | # divide numbers by 5 for the waffle so it's not overwhelming. unfortunately, this drops species <2... 24 | mutate(n5=round(n/5)) %>% ungroup() %>% 25 | # time to plot! 26 | ggplot(aes(label = threat_type, colour = threat_type, values = n5))+ 27 | # add pictogram for each threat type. define rows and size of pictogram 28 | geom_pictogram(n_rows = 8, size = 4, flip = TRUE, family = "FontAwesome5Free-Solid")+ 29 | # separate plots by continent. put all panels in one row 30 | facet_wrap(~continent, ncol = 7)+ 31 | # define pictograms using font awesome icons 32 | scale_label_pictogram(name = NULL, values = c("tractor", "tree", "thermometer-three-quarters", "city", 33 | "lightbulb", "cubes", "female", "leaf", 34 | "house-damage", "smog", "road", "question"))+ 35 | # define color palette using nationalparkcolors 36 | scale_color_manual(name = NULL, values = c(park_palette("Saguaro", n=6), park_palette("SmokyMountains", n=6)))+ 37 | # set themes from hrbr and waffle 38 | theme_ipsum(grid = "") + theme_enhance_waffle()+ 39 | # edit themes 40 | theme(legend.position = "bottom", # put legend at bottom of plot 41 | strip.text = element_text(face="bold"), # make the continent names bold 42 | plot.subtitle = element_markdown(lineheight = 0.5), # subtitle as markdown so I can add color 43 | panel.background = element_rect(fill="grey80", color="transparent"), # add grey background with no border to panels 44 | panel.spacing.x = unit(0.5, "lines"))+ # decrease space between panels 45 | # add those labels 46 | labs(title = "Threatened: Why are plants in danger on each continent?", 47 | subtitle = "The greatest number of threatened species are in Africa, where the greatest threat is 48 | **Agriculture & Aquaculture**. Each symbol represents 5 species.", 49 | caption = "data from International Union for Conservation of Nature (IUCN) | plot by @rjstevick for #TidyTuesday") 50 | 51 | # Saving ------------------------ 52 | ggsave("ExtinctPlants_plot.png", width = 11.5, height = 6, bg="transparent",dpi = 400) 53 | -------------------------------------------------------------------------------- /2020/20200825_Chopped/Chopped_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20200825_Chopped/Chopped_plot.png -------------------------------------------------------------------------------- /2020/20200825_Chopped/README.md: -------------------------------------------------------------------------------- 1 | ![Chopped_plot.png](Chopped_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20200825_Chopped/tidytuesday_20200825.R: -------------------------------------------------------------------------------- 1 | # Chopped TV Show network 2 | # TidyTuesday 2020 week 35 3 | # Rebecca Stevick updated 8/31/2020 4 | 5 | # Load libraries 6 | library(tidyverse) 7 | library(hrbrthemes) 8 | library(widyr) 9 | library(tidygraph) 10 | library(ggraph) 11 | library(patchwork) 12 | 13 | # Load data 14 | tuesdata <- tidytuesdayR::tt_load('2020-08-25') 15 | chopped <- tuesdata$chopped 16 | 17 | # My first attempt at a network in awhile! 18 | # Unfortunately, the ingredients aren't really connected and this got out of hand pretty quickly... 19 | 20 | # List of most common dessert ingredients (occuring in >9 episodes) 21 | topingredients <- chopped %>% 22 | select(dessert, series_episode) %>% 23 | separate_rows(dessert, sep=", ") %>% 24 | group_by(dessert) %>% count() %>% ungroup() %>% 25 | filter(n>=9) %>% mutate(topingredient=dessert) 26 | # Make bar/lollipop plot of ingredients 27 | barplot<-ggplot(topingredients, aes(x = n, y = reorder(dessert,-n))) + 28 | geom_segment(aes(x = 0, y = reorder(dessert,-n),xend = n, yend = reorder(dessert,-n)), 29 | color = "chocolate4",alpha = 0.6, lwd = 1.5)+ 30 | geom_point(aes(color=dessert), size = 4, alpha = 0.9)+ 31 | scale_x_continuous(expand = c(0,0.2), breaks = scales::breaks_pretty(n=5))+ 32 | scale_color_manual(name=NULL, values=c("purple4","navyblue","burlywood3","aquamarine4", 33 | "cadetblue2","coral2","darkgoldenrod2","darkred"))+ 34 | theme_ipsum()+ theme(panel.grid.major.y = element_blank(), panel.grid.minor.x = element_blank(), 35 | axis.title.x = element_text(size=12), legend.position="none", 36 | plot.margin = unit(c(0,0,0,0), "cm"))+ 37 | labs(x="Number of episodes", y=NULL) 38 | 39 | # Network of which ingredients are paired with the most common ingredients 40 | comboingredientsgraph<-chopped %>% 41 | select(series_episode, dessert) %>% 42 | separate_rows(dessert, sep=", ") %>% 43 | # Make pairs of all ingredients for each episode 44 | pairwise_count(dessert, series_episode, sort=TRUE, upper=FALSE) %>% 45 | # Get the top ingredient in the first column 46 | full_join(topingredients, by=c("item1"="dessert")) %>% 47 | full_join(topingredients, by=c("item2"="dessert")) %>% 48 | mutate(topingredient=coalesce(topingredient.x, topingredient.y)) %>% drop_na(topingredient) %>% 49 | mutate(pairedingredient=case_when(is.na(topingredient.x) ~ item1, is.na(topingredient.y) ~ item2, TRUE ~ "other")) %>% 50 | # Build graph object 51 | select(topingredient, pairedingredient) %>% 52 | as_tbl_graph() %>% mutate(Popularity = centrality_power()) %>% mutate(Popularitycut=cut_interval(Popularity, n = 2)) 53 | 54 | # Plot the network 55 | graph<-ggraph(comboingredientsgraph, layout="fr")+ 56 | geom_edge_link(aes(color = node1.name, start_cap = label_rect(node1.name), end_cap = label_rect(node2.name)), 57 | show.legend = FALSE, width = 0.5, arrow = arrow(length = unit(1.5, 'mm'))) + 58 | geom_node_text(aes(label = name, color = Popularitycut, size=Popularitycut), show.legend = FALSE) + 59 | scale_colour_manual(values=c(alpha("grey50",0.6),"black")) + scale_size_manual(values=c(2,2.5)) + 60 | scale_edge_colour_manual(values=c("purple4","navyblue","burlywood3","aquamarine4", 61 | "cadetblue2","coral2","darkgoldenrod2","darkred"))+ 62 | theme(plot.margin = unit(c(0,0,0,0), "cm"), axis.text.x=element_blank(), axis.text.y=element_blank(), 63 | axis.title.x = element_blank(), axis.title.y = element_blank()) 64 | 65 | # Patchwork of barplot and network together 66 | theme_set(theme_ipsum(grid = "")) 67 | barplot + graph + 68 | plot_annotation(title="Top dessert ingredients in Chopped are never used together.", 69 | subtitle="Blackberries are the most common ingredient. Ingredients are rarely repeated together!", 70 | caption="data from Kaggle | plot by @rjstevick for #TidyTuesday")+ 71 | plot_layout(ncol = 2, widths = c(1, 3)) 72 | 73 | # Saving ----------------------------- 74 | ggsave("Chopped_plot.png", bg = "transparent", width = 12, height = 6, dpi = 400) 75 | -------------------------------------------------------------------------------- /2020/20200901_GlobalCropYields/GlobalCropYields_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20200901_GlobalCropYields/GlobalCropYields_plot.png -------------------------------------------------------------------------------- /2020/20200901_GlobalCropYields/README.md: -------------------------------------------------------------------------------- 1 | ![GlobalCropYields_plot.png](GlobalCropYields_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20200901_GlobalCropYields/tidytuesday_20200901.R: -------------------------------------------------------------------------------- 1 | # Global crop yields 2 | # TidyTuesday 2020 week 36 3 | # Rebecca Stevick updated 9/1/2020 4 | 5 | # Load libraries --------------- 6 | library(tidyverse) 7 | library(geofacet) 8 | library(ggimage) 9 | library(extrafont) 10 | 11 | # Load data -------------------- 12 | tuesdata <- tidytuesdayR::tt_load('2020-09-01') 13 | key_crop_yields <- tuesdata$key_crop_yields 14 | 15 | # Analysis and formatting ------ 16 | 17 | # Import potato image 18 | potato<-"https://static.thenounproject.com/png/26079-200.png" 19 | 20 | # Clean up potato-growing countries 21 | potatocountries<- key_crop_yields %>% 22 | drop_na(`Potatoes (tonnes per hectare)`) %>% drop_na(Code) %>% 23 | filter(!grepl("OWID", Code)) %>% 24 | # group yearly info by decade 25 | mutate(Decade=as.factor(cut_width(Year, width=10, 26 | labels=c("1955-1965","1966-1975","1976-1985", 27 | "1986-1995","1996-2005","2006-2015","(2015,2025]")))) %>% 28 | group_by(Entity, Code, Decade) %>% summarise(Potatoes=sum(`Potatoes (tonnes per hectare)`)) %>% 29 | filter(Decade!="(2015,2025]") # remove partial decade 30 | 31 | # Edit world grid and add extra countries 32 | world_countries_grid1_edit<-world_countries_grid1 %>% 33 | # since geo_facet doesn't accept blanks, only use these columns 34 | select(name, code_alpha3, col, row) %>% 35 | # add in the countries with potatoes that aren't in "world_countries_grid1" 36 | add_row(name="Bermuda", code_alpha3="BMU", col=3, row=2)%>% 37 | add_row(name="Faeroe Islands", code_alpha3="FRO", col=13, row=2)%>% 38 | add_row(name="French Polynesia", code_alpha3="PYF", col=27, row=20)%>% 39 | add_row(name="Guadeloupe", code_alpha3="GLP", col=8, row=5)%>% 40 | add_row(name="Montserrat", code_alpha3="MSR", col=6, row=6)%>% 41 | add_row(name="New Caledonia", code_alpha3="NCL", col=25, row=20)%>% 42 | add_row(name="Reunion", code_alpha3="REU", col=20, row=19)%>% 43 | add_row(name="Taiwan", code_alpha3="TWN", col=25, row=8) %>% 44 | add_row(name="Palestine", code_alpha3="PSE", col=19, row=10)%>% 45 | # Since we put Palestine where Qatar is, move QAT and ARE over to the right 46 | filter(code_alpha3!="QAT") %>% filter(code_alpha3!="ARE") %>% 47 | add_row(name="Qatar", code_alpha3="QAT", col=20, row=10)%>% 48 | add_row(name="United Arab Emirates", code_alpha3="ARE", col=21, row=10)%>% 49 | # remove countries that don't grow potatoes 50 | filter(code_alpha3 %in% potatocountries$Code) 51 | 52 | # Plotting --------------------- 53 | 54 | # Plot sum total potatoes grown over time in the world 55 | globalpotatoplot2<-potatocountries %>% 56 | group_by(Decade) %>% 57 | summarise(globalpotatoes=sum(Potatoes)) %>% 58 | ggplot(aes(x=Decade, y=globalpotatoes, fill=globalpotatoes)) + 59 | geom_col(alpha=0.8)+ 60 | geom_text(aes(label=Decade), nudge_y=800, size=3,family="Titillium Web")+ 61 | scale_fill_gradient(low="#6e6355", high="#423b33")+ 62 | theme_classic()+ 63 | labs(x=NULL,y="Global potatoes \n(tons per hectare per decade)")+ 64 | theme(legend.position = "none", 65 | text=element_text(size=10,color="#423b33",family="Titillium Web"), 66 | axis.line = element_blank(), axis.text.x = element_blank(), 67 | axis.ticks = element_blank(), panel.background = element_rect(fill="transparent"), 68 | panel.grid.major.y = element_line(color="bisque3")) 69 | 70 | # Plot potatoes grown over time on the world grid 71 | geofacetplot<-potatocountries %>% 72 | ggplot(aes(x=Decade, y=0, fill=Potatoes)) + geom_tile()+ 73 | # add country name on top of mini heatmaps 74 | geom_text(aes(x="1986-1995", label=Code), size=4, 75 | color="darkolivegreen", family="Titillium Web")+ 76 | # change fill color 77 | scale_fill_gradient2(name="Potatoes (tons per hectare per decade)", low="bisque3", high="#6e6355")+ 78 | # remove extra space on y-axis 79 | scale_y_continuous(expand=c(0,0))+ 80 | # create a panel per country in its location on a world map 81 | facet_geo(~Code, grid=world_countries_grid1_edit)+ 82 | # add blank theme 83 | theme_void()+ 84 | # edit plot theme 85 | theme(plot.title = element_text(size=32, family="Titillium Web", face="bold", color="#423b33"), 86 | plot.subtitle = element_text(size=18, family="Titillium Web", color="#423b33"), 87 | plot.caption = element_text(size=12, family="Titillium Web", color="#423b33"), 88 | strip.text = element_blank(), legend.position = c(0.75,0.9), legend.direction = "horizontal", 89 | legend.key.width = unit(1, "cm"), text=element_text(size=8,color="#423b33",family="Titillium Web"))+ 90 | guides(fill = guide_colourbar(title.position="top", title.hjust = 0.5))+ 91 | # add those labels 92 | labs(title="Global potato production is increasing", 93 | subtitle="Each mini heatmap indicates the total potato production in each country per decade (1955-2015)", 94 | caption="data from Our World in Data | plot by @rjstevick for #TidyTuesday") 95 | 96 | # Could not add the global potato plot directly to the geo facets, since we don't have x,y coordinates 97 | # So, create a blank plot 98 | qplot(1:10, 1:10, color=I("transparent"))+theme_void() + 99 | # then add the geofacet plots 100 | annotation_custom(grob = ggplotGrob(geofacetplot), 101 | xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf) + 102 | # then inset the global potato plot on the bottom left 103 | annotation_custom(grob = ggplotGrob(globalpotatoplot2), 104 | xmin = 0.5, xmax = 3.6, ymin = 0.3, ymax = 3.5) 105 | # and add a potato 106 | # geom_image(aes(x=9.7, y=9.3, image=potato), size=0.16)+scale_size_identity() 107 | # geom_image(aes(x=3, y=2.2, image=potato), size=0.18)+scale_size_identity() 108 | 109 | # Saving ----------------------- 110 | ggsave("GlobalCropYields_plot.png", bg = "transparent", width = 12, height = 6.5, dpi = 400) 111 | -------------------------------------------------------------------------------- /2020/20200908_Friends/Friends_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20200908_Friends/Friends_plot.png -------------------------------------------------------------------------------- /2020/20200908_Friends/README.md: -------------------------------------------------------------------------------- 1 | ![Friends_plot.png](Friends_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20200908_Friends/tidytuesday_20200908.R: -------------------------------------------------------------------------------- 1 | # Friends emotions 2 | # TidyTuesday 2020 week 37 3 | # Rebecca Stevick updated 9/8/2020 4 | 5 | # Load libraries --------------- 6 | library(tidyverse) 7 | # download Friends font from https://www.ffonts.net/Friends.font.download, then install on your computer, then run extrafont::font_import() 8 | 9 | # Load data -------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2020-09-08') 11 | 12 | # Analysis and plotting ------ 13 | 14 | # join the emotions with who said them 15 | friends <- tuesdata$friends 16 | friends_emotions <- tuesdata$friends_emotions %>% 17 | left_join(friends) 18 | 19 | # make a dataframe for each arrow data with the facet included 20 | arrowross<-data.frame(x=1,xend=1.3,y=340,yend=303,emotion="Scared") 21 | arrowjoey<-data.frame(x=1.1,xend=0.82,y=270,yend=210,emotion="Mad") 22 | 23 | friends_emotions %>% 24 | # select only main characters 25 | filter(speaker %in% c("Ross Geller", "Monica Geller", "Chandler Bing", "Joey Tribbiani", "Rachel Green")) %>% 26 | # remove neutral since it's similar for everyone 27 | filter(emotion != "Neutral") %>% 28 | # group by speaker and emotion, then count 29 | group_by(speaker, emotion) %>% count() %>% 30 | # time to plot! 31 | ggplot(aes(x=emotion, y=n, fill=speaker))+ 32 | # add a column and facet by emotion 33 | geom_col(position="dodge")+facet_grid(~emotion, scales = "free")+ 34 | # change color scheme 35 | scale_fill_manual(values=c("#ff4238", "#ffDC00", "#42A2D6", "#9a0006", "#fff580"))+ 36 | # add label and arrow for Ross 37 | geom_label(data=arrowross, aes(x=x,y=y, label = "Ross is the \nmost scared"),inherit.aes=FALSE, alpha=0, hjust = 1, vjust = 0.5, lineheight = 0.8, family="Tahoma", color="white", label.size = NA, size = 4)+ 38 | geom_curve(data=arrowross, aes(x=x,y=y,yend=yend,xend=xend),inherit.aes=FALSE, color="white", size=0.5, curvature = -0.2, arrow = arrow(length = unit(0.08, "npc")))+ 39 | # add label and arrow for Joey 40 | geom_label(data=arrowjoey, aes(x=x,y=y, label = "Joey is the \nleast mad"),inherit.aes=FALSE, alpha=0, hjust = 0.2, vjust = 0, lineheight = 0.8, family="Tahoma", color="white", label.size = NA, size = 4)+ 41 | geom_curve(data=arrowjoey, aes(x=x,y=y,yend=yend,xend=xend),inherit.aes=FALSE, color="white", size=0.5, curvature = 0.2, arrow = arrow(length = unit(0.08, "npc")))+ 42 | # change up the theme 43 | theme_minimal()+ 44 | theme(plot.background = element_rect("black"), text=element_text(family="Friends", color="white"), 45 | axis.text.y = element_text(family="Tahoma", color="white"), plot.caption = element_text(family="Tahoma", color="white", size=11), 46 | plot.title = element_text(family="Friends", color="white", size=28, hjust=0.5), 47 | axis.text.x = element_blank(), axis.ticks = element_line(color="black"), 48 | panel.grid.major.x = element_blank(), panel.grid.minor.y = element_blank(), 49 | strip.text = element_text(family="Friends", color="white", size=12), legend.position = "top")+ 50 | # add those labels 51 | labs(title="The one with the emotional friends", 52 | caption="data from friends R package (Emil Hvitfeldt) | plot by @rjstevick for #TidyTuesday", 53 | x=NULL, y="Number of times emotion expressed", fill=NULL) 54 | 55 | # Saving ----------------------- 56 | ggsave("Friends_plot.png", width = 12, height = 6.5, dpi = 400) 57 | -------------------------------------------------------------------------------- /2020/20200915_GovKidSpending/GovKidSpending_plot.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20200915_GovKidSpending/GovKidSpending_plot.gif -------------------------------------------------------------------------------- /2020/20200915_GovKidSpending/README.md: -------------------------------------------------------------------------------- 1 | ![GovKidSpending_plot.gif](GovKidSpending_plot.gif) 2 | -------------------------------------------------------------------------------- /2020/20200915_GovKidSpending/tidytuesday_20200915.R: -------------------------------------------------------------------------------- 1 | # Government spending on kids 2 | # TidyTuesday 2020 week 38 3 | # Rebecca Stevick updated 9/16/2020 4 | 5 | # Load libraries --------------- 6 | library(tidyverse) 7 | library(gganimate) 8 | 9 | # Load data -------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2020-09-15') 11 | kids <- tuesdata$kids 12 | 13 | # Analysis and plotting ------ 14 | basemap <- kids %>% 15 | # select only PK12ed and join with the map data per state 16 | mutate(region=tolower(state)) %>% filter(variable=="PK12ed") %>% 17 | left_join(map_data("state")) %>% 18 | # make map area 19 | ggplot(aes(x = long, y = lat, group = group, fill = inf_adj_perchild)) + 20 | geom_polygon(color = "white") + 21 | # change color scheme 22 | scale_fill_viridis_b(name = "Amount per child in $USD \n(adjusted for inflation)", 23 | labels = c("$0"," ","$4"," ","$8"," ","$12"," ","$16"," ","$20"), # not the most elegant method, but it works... 24 | breaks = seq(0, 20, 2), limits = c(0,20)) + 25 | # remove all theme elements and fix the x-y so the map doesn't warp 26 | theme_void() + coord_fixed(1.3) + 27 | guides(fill = guide_colourbar(title.position="top")) + 28 | theme(plot.background = element_rect(fill="black"),plot.margin = unit(c(0.5,0.5,0.5,0.5), "cm"), 29 | legend.position = c(.18,.1), legend.direction = "horizontal", legend.key.width = unit(1, "cm"), 30 | text = element_text(family="Tahoma", color="white"), legend.title = element_text(size=9), 31 | plot.title = element_text(family = "Education Pencil", size = 15)) # font from https://fr.ffonts.net/Education-Pencil.font.download 32 | 33 | #animate based on year 34 | plotanimate<-basemap + transition_manual(frames = year) + 35 | # add those labels 36 | labs(caption = "data from Urban Institute | plot by @rjstevick for #TidyTuesday", 37 | title = "Education spending per child in the US has increased since 1996", 38 | subtitle = "Amount of money spent on PreK-12 education per child in {current_frame}") 39 | 40 | # render animation 41 | animate(plot = plotanimate, nframes = length(unique(kids$year)), 42 | fps = 3, end_pause = 10, height = 450, width = 670, res = 100) 43 | 44 | # Saving ----------------------- 45 | anim_save("GovKidSpending_plot.gif") 46 | -------------------------------------------------------------------------------- /2020/20200922_HimalayanClimbers/HimalayanClimbers_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20200922_HimalayanClimbers/HimalayanClimbers_plot.png -------------------------------------------------------------------------------- /2020/20200922_HimalayanClimbers/README.md: -------------------------------------------------------------------------------- 1 | ![HimalayanClimbers_plot.png](HimalayanClimbers_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20200922_HimalayanClimbers/tidytuesday_20200922.R: -------------------------------------------------------------------------------- 1 | # Himalayan Climbers 2 | # TidyTuesday 2020 week 39 3 | # Rebecca Stevick updated 9/22/2020 4 | 5 | # Load libraries --------------- 6 | library(tidyverse) 7 | library(ggridges) 8 | library(hrbrthemes) 9 | 10 | # Load data -------------------- 11 | tuesdata <- tidytuesdayR::tt_load('2020-09-22') 12 | peaks <- tuesdata$peaks 13 | 14 | # Analysis and plotting ------ 15 | 16 | peaks %>% 17 | # select only climbed peaks 18 | filter(climbing_status=="Climbed") %>% 19 | # separate out the countries in each expedition 20 | separate_rows(first_ascent_country, sep=", ") %>% 21 | # fix some country names 22 | mutate(first_ascent_country=recode(first_ascent_country, 23 | "US"="USA", "Netherands"="Netherlands", 24 | "Inida"="India", "W Germany"="Germany")) %>% 25 | 26 | # count up ascents per country for cleaner plotting 27 | group_by(first_ascent_country) %>% add_count() %>% ungroup() %>% 28 | # select countries with more than 2 ascents 29 | filter(first_ascent_year>1900, n>2) %>% 30 | # time to plot! 31 | ggplot(aes(x=first_ascent_year, 32 | y=reorder(first_ascent_country,n), 33 | fill=stat(x)))+ 34 | # add ridges 35 | geom_density_ridges_gradient(alpha=0.8, scale=2,rel_min_height = 0.005)+ 36 | # add points for each first ascent 37 | geom_jitter(alpha=0.4, shape=20, width=0, color="steelblue4")+ 38 | # set limits on x-axis and remove extra space 39 | scale_x_continuous(limits=c(1900, 2030), expand=c(0,0))+ 40 | # edit fill color 41 | scale_fill_gradient(low="aliceblue", high="steelblue4")+ 42 | # edit theme 43 | theme_ipsum()+ 44 | theme(legend.position="none", panel.grid.major.y = element_blank(), 45 | title=element_text(color="#254661"))+ 46 | # add those labels 47 | labs(x=NULL, y=NULL, 48 | title="Nepalese climbers have participated in the most first ascents of the Himalayas", 49 | subtitle="Timeline of first ascents of Himalayan Peaks by country", 50 | caption="All countries with more than 2 first ascents are shown. 51 | data from The Himalayan Database/Elizabeth Hawley | plot by @rjstevick for #TidyTuesday") 52 | 53 | # Saving ----------------------- 54 | ggsave("HimalayanClimbers_plot.png", bg="transparent", width = 12, height = 6.5, dpi = 400) 55 | -------------------------------------------------------------------------------- /2020/20200929_BeyonceTaylorSwift/BeyonceTaylorSwift_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20200929_BeyonceTaylorSwift/BeyonceTaylorSwift_plot.png -------------------------------------------------------------------------------- /2020/20200929_BeyonceTaylorSwift/README.md: -------------------------------------------------------------------------------- 1 | ![BeyonceTaylorSwift_plot.png](BeyonceTaylorSwift_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20200929_BeyonceTaylorSwift/tidytuesday_20200929.R: -------------------------------------------------------------------------------- 1 | # Beyonce & Taylor Swift Lyrics - focus on Beyonce 2 | # TidyTuesday 2020 week 40 3 | # Rebecca Stevick updated 10/6/2020 4 | 5 | # Load libraries --------------- 6 | library(tidyverse) 7 | library(tidytext) 8 | library(ggimage) 9 | library(beyonce) # devtools::install_github("dill/beyonce") 10 | extrafont::loadfonts() 11 | 12 | # Load data -------------------- 13 | 14 | beyonce_lyrics <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-09-29/beyonce_lyrics.csv') 15 | musicnote<-"https://www.transparentpng.com/thumb/musical-notes/musical-notes-png-0.png" 16 | 17 | # Analysis and plotting ------ 18 | 19 | beyonce_lyrics %>% 20 | # separate each song line by word 21 | unnest_tokens(word, line) %>% 22 | # group by word and remove stop words 23 | group_by(word) %>% anti_join(stop_words) %>% 24 | # count number of times each word occurs, then select just the top 30 25 | count(sort=TRUE) %>% ungroup() %>% slice_head(n=30) %>% 26 | # start plotting 27 | ggplot(aes(x=reorder(word,n), y=n, fill=n)) + 28 | # add bars and text 29 | geom_col() + geom_text(aes(label=word, y=n/2), color="white", family="Andale Mono") + 30 | # change color scheme 31 | scale_fill_gradientn(colours=beyonce_palette(27, type = "continuous")) + 32 | # switch axes and add theme 33 | coord_flip() + theme_minimal() + 34 | # edit the theme 35 | theme(axis.text.y = element_blank(), axis.title.x=element_text(hjust=1), legend.position="none", 36 | text = element_text(family="Andale Mono"))+ 37 | # add the music note image 38 | geom_image(aes(x=11, y=1000, image=musicnote), size=0.6)+scale_size_identity()+ 39 | # add those labels 40 | labs(y="Number of times word was sung", x=NULL, 41 | title="Most common lyrics in Beyoncé songs", 42 | caption="data from Dr. Sara Stoudt | plot by @rjstevick for #TidyTuesday") 43 | 44 | # Saving ----------------------- 45 | ggsave("BeyonceTaylorSwift_plot.png", bg="transparent", width = 7, height = 5, dpi = 400) 46 | -------------------------------------------------------------------------------- /2020/20201006_NCAAwomensBasketball/NCAAwomensBasketball_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20201006_NCAAwomensBasketball/NCAAwomensBasketball_plot.png -------------------------------------------------------------------------------- /2020/20201006_NCAAwomensBasketball/README.md: -------------------------------------------------------------------------------- 1 | ![NCAAwomensBasketball_plot.png](NCAAwomensBasketball_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20201006_NCAAwomensBasketball/tidytuesday_20201006.R: -------------------------------------------------------------------------------- 1 | # NCAA Women's Basketball - UMD! 2 | # TidyTuesday 2020 week 41 3 | # Rebecca Stevick updated 10/7/2020 4 | 5 | # Load libraries --------------- 6 | library(tidyverse) 7 | library(hrbrthemes) 8 | library(emojifont) 9 | extrafont::loadfonts() 10 | 11 | # Load data -------------------- 12 | tuesdata <- tidytuesdayR::tt_load('2020-10-06') 13 | 14 | # Analysis and plotting -------- 15 | tuesdata$tournament %>% 16 | # select only UMD 17 | filter(school=="Maryland") %>% 18 | # group the wins and losses into one column 19 | pivot_longer(full_w:full_l) %>% 20 | # add text for the years with tournament finishes 21 | mutate(win=case_when(tourney_finish == "Champ" ~ "Champions!", 22 | tourney_finish == "NSF" ~ "Final Four", 23 | tourney_finish == "RF" ~ "Elite Eight", 24 | tourney_finish == "RSF" ~ "Sweet Sixteen")) %>% 25 | # add glyphs for the years with tournament finishes 26 | mutate(winpict=fontawesome(case_when(tourney_finish == "Champ" ~ "fa-trophy", 27 | tourney_finish == "NSF" ~ "fa-asterisk", 28 | tourney_finish == "RF" ~ "fa-bandcamp", 29 | tourney_finish == "RSF" ~ "fa-birthday-cake"))) %>% 30 | # start plotting 31 | ggplot(aes(x=year, y=value, fill=name))+ 32 | # add barplot 33 | geom_col(position="fill", color="white")+ 34 | # add glyph icons to the top 35 | geom_text(aes(color=win, label=winpict, y=1.05), family = 'fontawesome-webfont', size=4, key_glyph=draw_key_point)+ 36 | # change bar and glyph colors 37 | scale_fill_manual(values=c("red3", "gold2"), labels=c("Loss", "Win"))+ 38 | scale_color_manual(values=c("black", "red3", "gold2", "grey"), limits=c("Champions!","Final Four","Elite Eight","Sweet Sixteen"))+ 39 | # add percent labels and change theme 40 | scale_y_continuous(labels=scales::percent_format()) + theme_ipsum()+ 41 | # add those labels 42 | labs(x=NULL, y=NULL, fill="Overall Season \nWin or Loss", color="Tournament Results", 43 | title="University of Maryland NCAA Women's Basketball record", 44 | caption="data from FiveThirtyEight | plot by @rjstevick for #TidyTuesday") 45 | 46 | # Saving ----------------------- 47 | ggsave("NCAAwomensBasketball_plot.png", bg="transparent", width = 10, height = 5, dpi = 400) 48 | -------------------------------------------------------------------------------- /2020/20201013_DatasaurusDozen/DatasaurusDozen_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20201013_DatasaurusDozen/DatasaurusDozen_plot.png -------------------------------------------------------------------------------- /2020/20201013_DatasaurusDozen/README.md: -------------------------------------------------------------------------------- 1 | ![DatasaurusDozen_plot.png](DatasaurusDozen_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20201013_DatasaurusDozen/tidytuesday_20201013.R: -------------------------------------------------------------------------------- 1 | # Datasaurus Dozen 2 | # TidyTuesday 2020 week 42 3 | # Rebecca Stevick updated 10/13/2020 4 | 5 | # Load libraries --------------- 6 | library(tidyverse) 7 | library(patchwork) 8 | library(nationalparkcolors) 9 | 10 | # Load data -------------------- 11 | tuesdata <- tidytuesdayR::tt_load('2020-10-13') 12 | datasaurus <- tuesdata$datasaurus %>% mutate(dataset = str_to_title(str_replace(dataset, "_", " "))) 13 | 14 | # Analysis and plotting -------- 15 | 16 | datasaurus %>% group_by(dataset) %>% summarise_all(list(mean=mean, median=median)) 17 | 18 | plots<-datasaurus %>% ggplot(aes(x=x, y=y))+ 19 | facet_wrap(~dataset, ncol=3) + 20 | geom_density_2d_filled()+ 21 | geom_point(aes(color=dataset))+ labs(x=NULL, y=NULL)+ 22 | scale_color_manual(values=c(park_palette("GeneralGrant"),park_palette("CraterLake")))+ 23 | theme_minimal() + theme(legend.position = "none") 24 | 25 | ybox<-datasaurus %>% ggplot(aes(x=dataset, y=y, fill=dataset))+coord_flip()+ 26 | geom_boxplot()+labs(x=NULL)+theme_minimal()+ theme(legend.position = "none")+ 27 | scale_fill_manual(values=c(park_palette("GeneralGrant"),park_palette("CraterLake"))) 28 | xbox<-datasaurus %>% ggplot(aes(x=dataset, y=x, fill=dataset))+ 29 | geom_boxplot()+labs(x=NULL)+theme_minimal()+ theme(legend.position = "none", axis.text.x = element_blank())+ 30 | scale_fill_manual(values=c(park_palette("GeneralGrant"),park_palette("CraterLake"))) 31 | 32 | ybox+plots+plot_spacer()+xbox+plot_layout(widths=c(1,4), heights=c(3,1))+ 33 | plot_annotation(title="Not all medians are created equal... ", 34 | subtitle="Datasets from datasauRus all have similar means and medians, but different x-y shapes.", 35 | caption="data from datasauRus R package | plot by @rjstevick for #TidyTuesday", 36 | theme=theme(text = element_text('mono'), plot.title = element_text(size=18, face="bold"))) 37 | 38 | # Saving ----------------------- 39 | ggsave("DatasaurusDozen_plot.png", bg="transparent", width = 11, height = 8, dpi = 400) 40 | -------------------------------------------------------------------------------- /2020/20201020_AmericanBeerFestival/AmericanBeerFestival_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20201020_AmericanBeerFestival/AmericanBeerFestival_plot.png -------------------------------------------------------------------------------- /2020/20201020_AmericanBeerFestival/README.md: -------------------------------------------------------------------------------- 1 | ![AmericanBeerFestival_plot.png](AmericanBeerFestival_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20201020_AmericanBeerFestival/tidytuesday_20201020.R: -------------------------------------------------------------------------------- 1 | # Great American Beer Festival map/pictogram 2 | # TidyTuesday 2020 week 43 3 | # Rebecca Stevick updated 10/20/2020 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(geofacet) 8 | library(emojifont) 9 | 10 | # Load data ---------------------- 11 | tuesdata <- tidytuesdayR::tt_load('2020-10-20') 12 | 13 | # Analysis and plotting ---------- 14 | # help from here https://stackoverflow.com/questions/59593058/how-to-make-a-faceted-waffle-chart-filling-each-bin-from-top-left 15 | 16 | # let's get piping! 17 | tuesdata$beer_awards %>% 18 | # fix some state names 19 | mutate(state=recode(state, "Ak"="AK", "wa"="WA")) %>% 20 | # count number of awards earned per state 21 | group_by(state, medal) %>% count() %>% 22 | # order the medal as a factor 23 | mutate(medal=factor(medal, levels=c("Gold","Silver","Bronze"))) %>% 24 | # divide counts by 10 and then make a row for each state/medal combo based on this number 25 | mutate(n10=ceiling(n/10)) %>% uncount(n10) %>% 26 | # order by state and then group 27 | arrange(medal) %>% group_by(state) %>% 28 | # make a waffle guide for the points, based on 8 rows/columns 29 | mutate(num = row_number(), x_pos = (num - 1) %/% 8, y_pos = 8 - (num - 1) %% 8 - 1) %>% 30 | # time to plot 31 | ggplot(aes(x=x_pos, y=y_pos, colour=medal)) + 32 | # add the icons as points, select fa-beer as the icon 33 | geom_text(family = 'fontawesome-webfont', label=fontawesome("fa-beer"), size=3) + 34 | # make a panel for each state in its geographical location (relatively) 35 | facet_geo(~state) + 36 | # change icon colors 37 | scale_color_manual(name=NULL,values=c("gold2","#C0C0C0","#CD7F32")) + 38 | # change global theme 39 | theme_void() + 40 | # edit theme 41 | theme(text=element_text(size=18), plot.title=element_text(face="bold", size=30), 42 | strip.text = element_text(face="bold"), 43 | panel.background=element_rect(fill="cornsilk", color="transparent"), 44 | legend.position=c(0.92,0.2), legend.text=element_text(size=18)) + 45 | # make the legend steins bigger 46 | guides(colour = guide_legend(override.aes = list(size=10))) + 47 | # add those labels 48 | labs(x=NULL, y=NULL, title="Which states produce the best beer?", 49 | subtitle="Great American Beer Festival awards earned per state since 1987. Each stein represents up to 10 awards.", 50 | caption="data from Great American Beer Festival | plot by @rjstevick for #TidyTuesday") 51 | 52 | # Saving ------------------------- 53 | ggsave("AmericanBeerFestival_plot.png", bg="transparent", width = 14, height = 8, dpi = 400) 54 | -------------------------------------------------------------------------------- /2020/20201027_CanadianWindTurbines/CanadianWindTurbines_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20201027_CanadianWindTurbines/CanadianWindTurbines_plot.png -------------------------------------------------------------------------------- /2020/20201027_CanadianWindTurbines/README.md: -------------------------------------------------------------------------------- 1 | ![CanadianWindTurbines_plot.png](CanadianWindTurbines_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20201027_CanadianWindTurbines/tidytuesday_20201027.R: -------------------------------------------------------------------------------- 1 | # Canadian Wind Turbines 2 | # TidyTuesday 2020 week 44 3 | # Rebecca Stevick updated 11/1/2020 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(ggrepel) 8 | library(extrafont) 9 | 10 | # Load data ---------------------- 11 | tuesdata <- tidytuesdayR::tt_load('2020-10-27') 12 | 13 | # Analysis and plotting ---------- 14 | tuesdata$`wind-turbine` %>% 15 | # group the data by province/territory to calculate summary statistics 16 | group_by(province_territory) %>% 17 | # now summarize the data for count and mean of variables 18 | summarise(count=n(), # count the number of windmills in each province 19 | meandiam=mean(rotor_diameter_m), # mean of their diameters 20 | meanlat=mean(latitude), # mean of their latitudes 21 | meanlong=mean(longitude)) %>% # mean of their longitudes 22 | # start to plot 23 | ggplot()+ 24 | # add a map of Canada 25 | geom_polygon(data=map_data("world") %>% filter(region=="Canada"), 26 | aes(x=long, y=lat, group=group), fill="grey90", color="white") + 27 | # add a point and star at each mean windmill location 28 | geom_point(aes(x=meanlong, y=meanlat, color=count), size=4, shape=20)+ 29 | geom_point(aes(x=meanlong, y=meanlat, size=meandiam, color=count), shape=8)+ 30 | # add labels for the points 31 | geom_text_repel(aes(x=meanlong, y=meanlat, color=count, 32 | label=str_wrap(province_territory, 14)), # wrap the labels so they fit better 33 | nudge_y=1.5, family="Amaranth", segment.alpha=0)+ 34 | # change the color scheme 35 | scale_color_gradient(low="red3",high="black")+ 36 | # add overall theme and fix the coordinates so the map doesn't warp 37 | theme_void() + coord_fixed(1.3)+ 38 | # edit the theme and legend position 39 | theme(text=element_text(family="Amaranth"), 40 | legend.position=c(0.9,0.7), legend.box="horizontal", legend.direction = "vertical")+ 41 | # add title to the top left of the plot 42 | geom_text(aes(x=-110, y=78, label="Canadian Windmills by Province/Territory"), 43 | size=7, fontface="bold", family="Amaranth")+ 44 | # add subtitle under the title 45 | geom_text(aes(x=-110, y=76, label="Each point represents the mean location, size, and diameter of the windmills in the territory."), 46 | size=4, family="Amaranth", color="red4")+ 47 | # add caption on bottom left inset 48 | geom_text(aes(x=-125, y=43, label="data from open.canada.ca | plot by @rjstevick for #TidyTuesday"), 49 | size=3, family="Amaranth", color="grey60")+ 50 | # add those labels 51 | labs(color="Number of \nWindmills", 52 | size="Mean diameter \nof Windmills (m)") 53 | 54 | # Saving ------------------------- 55 | ggsave("CanadianWindTurbines_plot.png", bg="transparent", width = 11, height = 7, dpi = 400) 56 | -------------------------------------------------------------------------------- /2020/20201103_IkeaFurniture/IkeaFurniture_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20201103_IkeaFurniture/IkeaFurniture_plot.png -------------------------------------------------------------------------------- /2020/20201103_IkeaFurniture/README.md: -------------------------------------------------------------------------------- 1 | ![IkeaFurniture_plot.png](IkeaFurniture_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20201103_IkeaFurniture/tidytuesday_20201103.R: -------------------------------------------------------------------------------- 1 | # Ikea furniture! 2 | # TidyTuesday 2020 week 45 3 | # Rebecca Stevick updated 11/3/2020 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(ggalt) 8 | library(ggtext) 9 | library(hrbrthemes) 10 | library(extrafont) 11 | 12 | # Load data ---------------------- 13 | tuesdata <- tidytuesdayR::tt_load('2020-11-03') 14 | ikea <- tuesdata$ikea 15 | 16 | # Analysis and plotting ---------- 17 | ikea %>% 18 | # only use products that have a previous price 19 | filter(old_price!="No old price") %>% 20 | # fix the old price column so it can be formatted as a number 21 | separate(old_price, into=c("SR","old_price", "multipack"), sep=" |/", remove=FALSE) %>% 22 | mutate(old_price=as.numeric(gsub(",", "",old_price))) %>% 23 | group_by(category) %>% # or group by category and name 24 | # convert saudi riyals to USD 25 | mutate(price_usd=price*0.27, old_price_usd=old_price*0.27) %>% 26 | # summary statistics 27 | summarise(meanprice=mean(price_usd), 28 | meanoldprice=mean(old_price_usd), 29 | # determine mean difference between previous and current price 30 | diff=meanprice-meanoldprice) %>% 31 | # start plotting 32 | ggplot(aes(x = meanprice, xend = meanoldprice, y = reorder(category, diff), group = category))+ 33 | # add dumbbells based on previous and current prices 34 | geom_dumbbell(aes(color=diff), size = 3, shape=15, colour_x = "#ffcc00", colour_xend = "#003399")+ 35 | # change color scheme 36 | scale_color_gradient2(low="#ffcc00", mid="white", high="#003399")+ 37 | # add dollar signs to x-axis text 38 | scale_x_continuous(labels=scales::label_dollar(), limits=c(0,NA))+ 39 | # change the overall theme 40 | theme_ipsum()+ 41 | # edit the theme 42 | theme(legend.position = "none", 43 | plot.title = element_markdown(lineheight = 1.1), 44 | plot.subtitle = element_markdown(lineheight = 0.5))+ 45 | # add those labels 46 | labs(title="IKEA items never increase in cost", 47 | subtitle="**Current item prices** are always lower than 48 | **past item prices** in all categories.", 49 | x="Mean price of category (USD $)",y=NULL, 50 | caption="data from Kaggle via IKEA | plot by @rjstevick for #TidyTuesday") 51 | 52 | # Saving ------------------------- 53 | ggsave("IkeaFurniture_plot.png", bg="transparent", width = 8, height = 5, dpi = 400) 54 | -------------------------------------------------------------------------------- /2020/20201110_HistoricalPhones/HistoricalPhones_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20201110_HistoricalPhones/HistoricalPhones_plot.png -------------------------------------------------------------------------------- /2020/20201110_HistoricalPhones/README.md: -------------------------------------------------------------------------------- 1 | ![HistoricalPhones_plot.png](HistoricalPhones_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20201110_HistoricalPhones/tidytuesday_20201110.R: -------------------------------------------------------------------------------- 1 | # Technology adoption and historical phone data 2 | # TidyTuesday 2020 week 46 3 | # Rebecca Stevick updated 11/10/2020 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(ggtext) 8 | 9 | # Load data ---------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2020-11-10') 11 | 12 | # Analysis and plotting ---------- 13 | # join mobile data with landline data 14 | tuesdata$mobile %>% full_join(tuesdata$landline) %>% 15 | # group the subscription numbers into one column 16 | pivot_longer(c(mobile_subs,landline_subs), names_to="datatype") %>% 17 | # drop any missing values and remove the last year since it's incomplete 18 | drop_na(value) %>% filter(year!=2017) %>% 19 | # plot the data, use group to define one line per country/code 20 | ggplot(aes(x = datatype, y = value, color = continent, group = code)) + 21 | # make a panel for each year 22 | facet_grid(.~year) + 23 | # add lines for each country that are transparent, wider, and have a rectangle key in the legend 24 | geom_line(alpha = 0.5, lwd = 1.5, key_glyph = draw_key_rect) + 25 | # remove extra while space around axes 26 | scale_y_continuous(expand = c(0,0.2)) + scale_x_discrete(expand = c(0,0)) + 27 | # change the color scheme to the Arches parks palette 28 | scale_color_manual(values = nationalparkcolors::park_palette("Arches",5)) + 29 | # change the overall theme 30 | theme_minimal() + 31 | # edit the theme 32 | theme(text = element_text(family = "Andale Mono"), legend.position = "bottom", # change all text font and move the legend to the bottom 33 | panel.grid = element_line(color="white"), panel.grid.minor.y = element_blank(), # change the grid color and remove minor y axis lines 34 | axis.text.x = element_blank(), plot.caption = element_text(hjust = 0.5, size = 8, color = "#8c816c"), # remove x-axis text and edit the caption (centered and brown) 35 | plot.title = element_text(size = 24), plot.subtitle = element_markdown(size=9, family = "Avenir-Black", color = "#8c816c"), # make the title bigger and edit the subtitle (font and brown) 36 | plot.tag.position = c(0.06, 0.115), plot.tag = element_text(hjust = 1, angle = 50, size = 11, lineheight=1.5)) + # position the tag under the x-axis of the first panel and rotate its position 37 | # add those labels 38 | labs(title = "Mobile phone plans have replaced landlines over time", 39 | subtitle = "The transition from landlines to mobile subscriptions started in 1997 in Asian countries. Monaco is the only country with more landlines than mobile plans in 2016.", 40 | y = "Number of subscriptions per 100 people", 41 | x = NULL, color = "lines for each country in", tag = "Landline \nMobile", # use tag as x-axis label 42 | caption = "data from OurWorldInData.org | plot by @rjstevick for #TidyTuesday") 43 | 44 | # Saving ------------------------- 45 | ggsave("HistoricalPhones_plot.png", bg = "#e8e6e1", width = 12, height = 7, dpi = 400) 46 | -------------------------------------------------------------------------------- /2020/20201117_BlackInData/BlackInData_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20201117_BlackInData/BlackInData_plot.png -------------------------------------------------------------------------------- /2020/20201117_BlackInData/README.md: -------------------------------------------------------------------------------- 1 | ![BlackInData_plot.png](BlackInData_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20201117_BlackInData/tidytuesday_20201117.R: -------------------------------------------------------------------------------- 1 | # BLack in Data week table 2 | # TidyTuesday 2020 week 47 3 | # Rebecca Stevick updated 11/17/2020 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(gt) 8 | 9 | # Load data ---------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2020-11-17') 11 | 12 | # Analysis and plotting ---------- 13 | table <- tuesdata$black_in_data %>% 14 | gt() %>% 15 | fmt_date(columns = vars(date), date_style = 2) %>% 16 | fmt(columns = 'link', 17 | fns = function(myurl,mytext=myurl) {paste('',mytext,'')}) %>% 18 | opt_table_font(font = list(google_font("Space Mono"), default_fonts())) %>% 19 | tab_options(table.background.color="azure", 20 | column_labels.background.color = "black", 21 | table.font.size = px(12), 22 | column_labels.font.size = px(20), 23 | heading.background.color = "white", 24 | heading.align = "left", 25 | heading.title.font.size = px(28)) %>% 26 | tab_header(title = "#BlackInDataWeek events -- November 16-21, 2020") %>% 27 | tab_source_note(source_note = "data from #BlackInDataWeek | table by @rjstevick for #TidyTuesday") 28 | table 29 | 30 | # Saving ------------------------- 31 | table %>% gtsave("BlackInData_plot.png") 32 | -------------------------------------------------------------------------------- /2020/20201124_WashingtonTrails/README.md: -------------------------------------------------------------------------------- 1 | ![WashingtonTrails_plot.png](WashingtonTrails_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20201124_WashingtonTrails/WashingtonTrails_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20201124_WashingtonTrails/WashingtonTrails_plot.png -------------------------------------------------------------------------------- /2020/20201124_WashingtonTrails/tidytuesday_20201124.R: -------------------------------------------------------------------------------- 1 | # Washington Trails 2 | # TidyTuesday 2020 week 48 3 | # Rebecca Stevick updated 11/24/2020 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(extrafont) 8 | 9 | # Load data ---------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2020-11-24') 11 | 12 | # Analysis and plotting ---------- 13 | tuesdata$hike_data %>% 14 | # separate out key words in features and then wrap the words 15 | unnest(features) %>% mutate(labelfeatures=str_wrap(features, width=12)) %>% 16 | # calculate mean rating per feature keyword 17 | group_by(labelfeatures) %>% summarise(meanrate=mean(as.numeric(rating), na.rm=TRUE)) %>% 18 | # start plotting 19 | ggplot(aes(x=reorder(labelfeatures,meanrate), y=meanrate, fill=meanrate))+ 20 | # add columns and switch to polar plot 21 | geom_col(alpha = 0.8) + coord_polar(clip = "off")+ 22 | # edit the fill color 23 | scale_fill_gradient(high='darkgreen', low='grey65', breaks=c(3,3.25,3.5))+ 24 | # change the global theme 25 | theme_minimal()+ 26 | # edit the theme 27 | theme(text = element_text(family="Montserrat"), legend.position = "bottom", legend.key.width = unit(1.5, "cm"), 28 | plot.title = element_text(face="bold", hjust=0.5, size=18), plot.subtitle = element_text(hjust=0.5), 29 | plot.caption = element_text(hjust=0.5), axis.text.y = element_blank(), axis.text.x = element_text(size=12))+ 30 | # center the legend title 31 | guides(fill = guide_colourbar(title.position="top", title.hjust = 0.5))+ 32 | # add those labels 33 | labs(title="The Trail Ratings Paradox", 34 | subtitle="Washington trails that do not allow dogs have the highest ratings... \nand trails with coast views have the lowest ratings.", 35 | x=NULL, y=NULL, fill="Mean Rating per keyword", 36 | caption = "data from Washington Trails Association | plot by @rjstevick for #TidyTuesday") 37 | 38 | # Saving ------------------------- 39 | ggsave("WashingtonTrails_plot.png", bg = "transparent", width = 7, height = 7, dpi = 400) 40 | -------------------------------------------------------------------------------- /2020/20201201_TorontoShelters/README.md: -------------------------------------------------------------------------------- 1 | ![TorontoShelters_plot.png](TorontoShelters_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20201201_TorontoShelters/TorontoShelters_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20201201_TorontoShelters/TorontoShelters_plot.png -------------------------------------------------------------------------------- /2020/20201201_TorontoShelters/tidytuesday_20201201.R: -------------------------------------------------------------------------------- 1 | # Toronto homeless shelters 2 | # TidyTuesday 2020 week 49 3 | # Rebecca Stevick updated 12/01/2020 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(ggalt) 8 | library(lubridate) 9 | library(ggtext) 10 | library(hrbrthemes) 11 | 12 | # Load data ---------------------- 13 | tuesdata <- tidytuesdayR::tt_load('2020-12-01') 14 | 15 | # Analysis and plotting ---------- 16 | tuesdata$shelters %>% 17 | # add a month-year variable from the occupancy_date 18 | mutate(monthyear = as.yearmon(format(occupancy_date, "%Y-%m"))) %>% 19 | # calculate sum of the occupancy and capacity per month 20 | group_by(monthyear) %>% 21 | summarise(sumoccupancy=sum(occupancy), sumcapacity=sum(capacity, na.rm=TRUE)) %>% 22 | # filter months where the capacity was 0 23 | filter(sumcapacity != 0) %>% 24 | # calculate the difference between the capacity and occupancy 25 | mutate(diff=sumcapacity-sumoccupancy) %>% 26 | # start plotting 27 | ggplot(aes(y = monthyear, x = sumoccupancy, xend = sumcapacity))+ 28 | # add dumbbells based on occupancy and capacity 29 | geom_dumbbell(aes(color=diff), size = 4, shape=16, 30 | colour_x = "#81a9ad", colour_xend = "#2d2926")+ 31 | # change color scheme 32 | scale_color_gradient(low="#f5f5f5", high="#537380")+ 33 | # change the overall theme and flip axis 34 | theme_ipsum() + coord_flip()+ 35 | # edit the theme 36 | theme(legend.position = "none", 37 | plot.title = element_markdown(lineheight = 1.1, color="grey50"), 38 | plot.subtitle = element_markdown(lineheight = 0.5))+ 39 | # add those labels 40 | labs(x=NULL, y=NULL, title="Toronto homeless shelter capacity and occupancy have increased over time", 41 | caption = "data from opendatatoronto | plot by @rjstevick for #TidyTuesday") 42 | 43 | # Saving ------------------------- 44 | ggsave("TorontoShelters_plot.png", bg = "transparent", width = 10, height = 5, dpi = 400) 45 | -------------------------------------------------------------------------------- /2020/20201208_Women2020/README.md: -------------------------------------------------------------------------------- 1 | ![Women2020_plot.png](Women2020_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20201208_Women2020/Women2020_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20201208_Women2020/Women2020_plot.png -------------------------------------------------------------------------------- /2020/20201208_Women2020/tidytuesday_20201208.R: -------------------------------------------------------------------------------- 1 | # Women of 2020 poster 2 | # TidyTuesday 2020 week 50 3 | # Rebecca Stevick updated 12/16/2020 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(ggimage) 8 | 9 | # Load data ---------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2020-12-08') 11 | 12 | # Analysis and plotting ---------- 13 | tuesdata$women %>% 14 | # make a grid guide for the points, based on 8 rows/columns 15 | mutate(num = row_number(), x_pos = (num - 1) %/% 10, y_pos = 10 - (num - 1) %% 10 - 1) %>% 16 | # time to plot 17 | ggplot()+ 18 | # add background rectangles based on woman's category 19 | geom_rect(aes(xmin = x_pos-0.5, xmax = x_pos+0.5, ymin = y_pos-0.5, ymax = y_pos+0.5, fill=category), color="#FBEAD6", lwd=2) + 20 | # add photo of woman 21 | geom_image(aes(x = x_pos, y = y_pos+0.1, image = img), size = 0.05, by = "width") + 22 | # add woman's names 23 | geom_text(aes(x = x_pos, y = y_pos-0.3, label = str_wrap(name, width=15)), size = 4, hjust=0.5, lineheight=0.8) + 24 | # make sure the photos don't warp and remove extra white space 25 | scale_size_identity() + scale_x_continuous(expand=c(0,0)) + scale_y_continuous(expand=c(0,0)) + 26 | # change background colors and make glyphs bigger 27 | scale_fill_manual(values=c("#FBEAD6", "#83CDC0", "#D3A3A1", "#A79CA5","#466D53"), 28 | guide = guide_legend(keyheight = unit(12, units = "mm"), keywidth = unit(12, units = "mm"))) + 29 | # change theme 30 | theme_void() + 31 | # edit theme 32 | theme(text = element_text(family="Amaranth", size=22), plot.title = element_text(size=40, hjust=0.5), 33 | legend.position = "bottom", legend.justification = c(0,0)) + 34 | # add those labels 35 | labs(title="Women of 2020", fill=NULL, caption = "data from the BBC | plot by @rjstevick for #TidyTuesday") 36 | 37 | # Saving ------------------------- 38 | ggsave("Women2020_plot.png", bg = "transparent", width = 15, height = 15, dpi = 400) 39 | -------------------------------------------------------------------------------- /2020/20201215_NinjaWarrior/NinjaWarrior_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20201215_NinjaWarrior/NinjaWarrior_plot.png -------------------------------------------------------------------------------- /2020/20201215_NinjaWarrior/README.md: -------------------------------------------------------------------------------- 1 | ![NinjaWarrior_plot.png](NinjaWarrior_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20201215_NinjaWarrior/tidytuesday_20201215.R: -------------------------------------------------------------------------------- 1 | # Ninja Warrior 2 | # TidyTuesday 2020 week 51 3 | # Rebecca Stevick updated 12/15/2020 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(ggrepel) 8 | 9 | # Load data ---------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2020-12-15') 11 | 12 | # Analysis and plotting ---------- 13 | tuesdata$ninja_warrior %>% 14 | # count number of times each obstacle was in each position 15 | group_by(obstacle_name, obstacle_order) %>% count(sort=TRUE) %>% 16 | # select the top-occuring obstacle for each position in the course 17 | group_by(obstacle_order) %>% top_n(n = 1, wt = n) %>% 18 | ggplot(aes(x=obstacle_order, y=n)) + 19 | geom_step(color="#2980B9", size=3) + geom_point(color="#2980B9", size=5) + 20 | geom_label_repel(aes(label=obstacle_name), fill="#E74C3C", family="Cinzel Black", segment.colour = NA) + 21 | scale_y_continuous(limits=c(0,NA)) + 22 | theme_minimal() + 23 | theme(text=element_text(family="Titillium Web", size=16), 24 | plot.title=element_text(family="Cinzel Black", hjust=0.5, size=28, color="#1A5276"), 25 | plot.subtitle=element_text(family="Cinzel", hjust=0.5, color="#2980B9"))+ 26 | # add those labels 27 | labs(x=NULL, y="Frequency of obstacle", 28 | title = "The most common Ninja Warrior course", 29 | subtitle="Averaged across 10 seasons of courses", 30 | caption = "data from the Data.World | plot by @rjstevick for #TidyTuesday") 31 | 32 | # Saving ------------------------- 33 | ggsave("NinjaWarrior_plot.png", bg = "transparent", width = 11, height = 5, dpi = 400) 34 | -------------------------------------------------------------------------------- /2020/20201222_BigMacIndex/BigMacIndex_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2020/20201222_BigMacIndex/BigMacIndex_plot.png -------------------------------------------------------------------------------- /2020/20201222_BigMacIndex/README.md: -------------------------------------------------------------------------------- 1 | ![BigMacIndex_plot.png](BigMacIndex_plot.png) 2 | -------------------------------------------------------------------------------- /2020/20201222_BigMacIndex/tidytuesday_20201222.R: -------------------------------------------------------------------------------- 1 | # Big mac index 2 | # TidyTuesday 2020 week 52 3 | # Rebecca Stevick updated 12/22/2020 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(hrbrthemes) 8 | 9 | # Load data ---------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2020-12-22') 11 | 12 | # Analysis and plotting ---------- 13 | tuesdata$`big-mac` %>% 14 | # remove countries without adjusted costs 15 | drop_na(usd_adjusted) %>% 16 | # add variable with positive or negative 17 | mutate(costsign=as.character(sign(usd_adjusted))) %>% 18 | # remove US since it's just 0 19 | filter(name!="United States") %>% 20 | # start plotting 21 | ggplot(aes(x=date, y=usd_adjusted, fill=costsign)) + 22 | # add panel per country 23 | facet_wrap(.~name, ncol = 9) + 24 | # add line at x-axis 25 | geom_hline(yintercept=0)+ 26 | # add filled area 27 | geom_area() + 28 | # change fill color 29 | scale_fill_manual(values=c("firebrick4","goldenrod1")) + 30 | # change theme 31 | theme_ipsum() + 32 | # edit theme 33 | theme(legend.position = "none", panel.spacing = unit(0.2, "cm"), 34 | strip.text = element_text(family="Helvetica Bold", face="bold"), 35 | axis.text.x = element_text(size=7), axis.text.y = element_text(size=7), 36 | panel.grid.minor = element_blank(), panel.grid.major = element_blank(), 37 | panel.background=element_rect(fill="#fdf5f5", color="transparent")) + 38 | # add those labels 39 | labs(x=NULL, y="Big Mac Index, relative to $USD", 40 | title="Big Mac Purchasing Power", 41 | subtitle="The value of local currency: Cost of a local Big Mac, normalized to the cost of a Big Mac in the US and the local exhange rate", 42 | caption = "data from the The Economist | plot by @rjstevick for #TidyTuesday") 43 | 44 | # Saving ------------------------- 45 | ggsave("BigMacIndex_plot.png", bg = "transparent", width = 13.5, height = 7, dpi = 400) 46 | -------------------------------------------------------------------------------- /2021/20210105_TransitCostProject/README.md: -------------------------------------------------------------------------------- 1 | ![TransitCostProject_plot.png](TransitCostProject_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210105_TransitCostProject/TransitCostProject_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210105_TransitCostProject/TransitCostProject_plot.png -------------------------------------------------------------------------------- /2021/20210105_TransitCostProject/tidytuesday_20210105.R: -------------------------------------------------------------------------------- 1 | # Transit cost project 2 | # TidyTuesday 2021 week 2 3 | # Rebecca Stevick updated 1/12/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | 8 | # Load data ---------------------- 9 | tuesdata <- tidytuesdayR::tt_load('2021-01-05') 10 | 11 | # Analysis and plotting ---------- 12 | tuesdata$transit_cost %>% 13 | drop_na(country) %>% 14 | # select the top 10 longest tunnel projects 15 | arrange(desc(tunnel)) %>% head(n = 10L) %>% 16 | # start plotting 17 | ggplot(aes(x=tunnel, y=reorder(city,tunnel), fill=country))+ 18 | # add bar plot 19 | geom_col(alpha = 0.8)+ 20 | # add construction year to the end of each bar 21 | geom_text(aes(x=tunnel-10, label = year), size = 7, color="white", family="Baloo")+ 22 | # change the color of the bar 23 | scale_fill_manual(values = PNWColors::pnw_palette("Starfish", n=8))+ 24 | # remove the extra white space in the x-axis 25 | scale_x_continuous(expand = c(0,0))+ 26 | # change the global theme 27 | theme_minimal()+ 28 | # edit the theme 29 | theme(text=element_text(family="Baloo"), # change font 30 | plot.title = element_text(hjust=0, size=24), # change position and size of title 31 | plot.caption = element_text(color="grey40"), # change color of the caption 32 | legend.position = "none", # remove the legend 33 | axis.text.y = element_text(size = 14))+ # make the y-axis text bigger 34 | # add those labels 35 | labs(title="Longest transit tunnels in the world", 36 | x="Tunnel Length (km)", y=NULL, 37 | caption = "data from the Transit Costs Project | plot by @rjstevick for #TidyTuesday") 38 | 39 | # Saving ------------------------- 40 | ggsave("TransitCostProject_plot.png", bg = "transparent", width = 9, height = 5, dpi = 400) 41 | -------------------------------------------------------------------------------- /2021/20210112_ArtCollections/ArtCollections_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210112_ArtCollections/ArtCollections_plot.png -------------------------------------------------------------------------------- /2021/20210112_ArtCollections/README.md: -------------------------------------------------------------------------------- 1 | ![ArtCollections_plot.png](ArtCollections_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210112_ArtCollections/tidytuesday_20210112.R: -------------------------------------------------------------------------------- 1 | # Art Collections 2 | # TidyTuesday 2021 week 3 3 | # Rebecca Stevick updated 1/15/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(ggstream) 8 | library(hrbrthemes) 9 | library(nationalparkcolors) 10 | 11 | # Load data ---------------------- 12 | tuesdata <- tidytuesdayR::tt_load('2021-01-12') 13 | 14 | # Analysis and plotting ---------- 15 | tuesdata$artwork %>% 16 | # filter out oldest data and drop any missing data 17 | filter(year >= 1740) %>% drop_na(medium) %>% 18 | # select top 15 mediums and group all others into an "Others" category 19 | mutate(mediumother = fct_lump_n(medium, 15)) %>% 20 | # count number of artworks per medium per year 21 | group_by(year, mediumother) %>% count() %>% 22 | # start plotting. order medium by the total number 23 | ggplot(aes(x = year, y = n, fill = reorder(mediumother,n))) + 24 | # add geom_stream of the mediums 25 | geom_stream(bw = 0.4, color = "white", alpha = 0.7) + 26 | # define the color scheme 27 | scale_fill_manual(values = c(park_palette("Redwoods"), park_palette("GeneralGrant"), park_palette("CraterLake")))+ 28 | # set the overall theme 29 | theme_ft_rc() + 30 | # edit theme elements 31 | theme(legend.position = c(0.72,0.88), legend.direction = "horizontal", 32 | legend.text = element_text(size=8), plot.title = element_text(size=32), 33 | panel.grid.major.y = element_blank(), panel.grid.minor.y = element_blank())+ 34 | # add those labels 35 | labs(title = "The Art of Embracing Change", 36 | subtitle = "Evolution of art styles in the Tate Collection since the 1700s", 37 | fill = NULL, x = NULL, y = "Total number of works of art", 38 | caption = "data from Tate Art Museum | plot by @rjstevick for #TidyTuesday") 39 | 40 | # Saving ------------------------- 41 | ggsave("ArtCollections_plot.png", width = 13, height = 7.5, dpi = 400) 42 | -------------------------------------------------------------------------------- /2021/20210119_KenyaCensus/KenyaCensus_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210119_KenyaCensus/KenyaCensus_plot.png -------------------------------------------------------------------------------- /2021/20210119_KenyaCensus/README.md: -------------------------------------------------------------------------------- 1 | ![KenyaCensus_plot.png](KenyaCensus_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210119_KenyaCensus/tidytuesday_20210119.R: -------------------------------------------------------------------------------- 1 | # Kenya Census 2 | # TidyTuesday 2021 week 4 3 | # Rebecca Stevick updated 1/19/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(waffle) # for geom_pictogram 8 | library(hrbrthemes) # for the overall theme 9 | library(extrafont) # for loading the pictogram font 10 | 11 | # Load data ---------------------- 12 | tuesdata <- tidytuesdayR::tt_load('2021-01-19') 13 | 14 | # Analysis and plotting ---------- 15 | tuesdata$crops %>% 16 | # remove the kenya overall category 17 | filter(SubCounty != "KENYA") %>% 18 | # put all the crops into one column 19 | pivot_longer(cols = Tea:`Khat (Miraa)`, names_to = "crop", values_to = "n") %>% 20 | # remove any missing data 21 | drop_na() %>% 22 | # divide numbers by 2000 for the waffle so it's not overwhelming. 23 | mutate(nsub = ceiling(n/2000)) %>% # unfortunately, this drops some data so use ceiling() 24 | # add a column with edited county names 25 | mutate(countynames = str_to_sentence(SubCounty)) %>% 26 | # time to plot! 27 | ggplot(aes(label = crop, color = crop, values = nsub)) + 28 | # add pictogram for each crop type. define rows and size of pictogram 29 | geom_pictogram(n_rows = 10, size = 2, flip = TRUE, family = "FontAwesome5Free-Solid") + 30 | # separate panels by county, put 11 panels per row 31 | facet_wrap(~countynames, ncol = 11) + 32 | # define pictograms using font awesome icons, get a little creative here... 33 | scale_label_pictogram(values = c("dot-circle", "copyright", "lemon", 34 | "cookie", "coffee", "leaf", 35 | "certificate", "seedling", "bookmark"))+ 36 | # define color palette using PNWcolors 37 | scale_color_manual(values = c(PNWColors::pnw_palette("Cascades", n = 9)))+ 38 | # set themes from hrbr and waffle 39 | theme_ipsum(grid = "") + theme_enhance_waffle() + 40 | # edit the theme 41 | theme(panel.spacing = unit(0.2, "lines"), strip.text = element_text(face = "bold"), 42 | legend.position = c(0.86, 0.1), legend.direction = "horizontal", 43 | legend.text = element_text(size = 11), plot.title = element_text(size = 26), 44 | plot.caption = element_text(size = 11), plot.subtitle = element_text(size = 13, face = "italic"), 45 | panel.background = element_rect(color = "transparent", fill = "grey80"))+ 46 | # change layout of the legend to have bigger icons and 3 rows 47 | guides(label = guide_legend(nrow = 3, override.aes = list(size = 4)))+ 48 | # add those labels 49 | labs(title = "Which Crops are Farmed in Kenya?", 50 | subtitle = "Each icon represents up to 2000 people growing each crop in 2019", 51 | color = NULL, label = NULL, 52 | caption = "data from rKenyaCensus | plot by @rjstevick for #TidyTuesday") 53 | 54 | # Saving ------------------------- 55 | ggsave("KenyaCensus_plot.png", bg = "transparent", width = 15, height = 8, dpi = 400) 56 | -------------------------------------------------------------------------------- /2021/20210126_PlasticPollution/PlasticPollution_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210126_PlasticPollution/PlasticPollution_plot.png -------------------------------------------------------------------------------- /2021/20210126_PlasticPollution/README.md: -------------------------------------------------------------------------------- 1 | ![PlasticPollution_plot.png](PlasticPollution_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210126_PlasticPollution/tidytuesday_20210126.R: -------------------------------------------------------------------------------- 1 | # Plastic Pollution 2 | # TidyTuesday 2021 week 5 3 | # Rebecca Stevick updated 2/2/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | 8 | # Load data ---------------------- 9 | tuesdata <- tidytuesdayR::tt_load('2021-01-26') 10 | 11 | # Analysis and plotting ---------- 12 | tuesdata$plastics %>% 13 | filter(country=="United States of America" & year==2019) %>% 14 | group_by(parent_company) %>% summarise_at(vars(hdpe:grand_total), sum, na.rm=TRUE) %>% 15 | pivot_longer(hdpe:pvc, names_to="plastic_type", values_to="count") %>% 16 | filter(parent_company!="Grand Total" & parent_company!="Unbranded") %>% 17 | filter(grand_total>10) %>% 18 | # remove plastic types that don't exist in this subset of data 19 | filter(count!=0) %>% 20 | # start plotting 21 | ggplot(aes(x=count, y=reorder(parent_company,-grand_total), fill=plastic_type))+ 22 | geom_col()+ 23 | scale_fill_manual(values = nationalparkcolors::park_palette("Denali"), 24 | limits = c("hdpe", "ldpe", "pet", "pp", "o"), 25 | labels = c("Polyethylene, high density", "Polyethylene, low density", "Polyester", "Polypropylene", "Other"))+ 26 | scale_x_continuous(expand = c(0,0))+ 27 | theme_minimal()+ 28 | theme(text = element_text(size = 16, family = "Cochin"), legend.position = c(0.75,0.7), 29 | plot.title = element_text(size = 28, family = "Copperplate"), plot.subtitle = element_text(size=12))+ 30 | # add those labels 31 | labs(title = "All the polys", 32 | subtitle = "Most abundant plastic pollution types and sources in the US in 2019", 33 | x = NULL, y = NULL, fill = "Plastic Type", 34 | caption = "data from Break Free from Plastic | plot by @rjstevick for #TidyTuesday") 35 | 36 | # Saving ------------------------- 37 | ggsave("PlasticPollution_plot.png", bg = "transparent", width = 9, height = 5, dpi = 400) 38 | -------------------------------------------------------------------------------- /2021/20210202_HBCUenrollment/HBCUenrollment_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210202_HBCUenrollment/HBCUenrollment_plot.png -------------------------------------------------------------------------------- /2021/20210202_HBCUenrollment/README.md: -------------------------------------------------------------------------------- 1 | ![HBCUenrollment_plot.png](HBCUenrollment_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210202_HBCUenrollment/tidytuesday_20210202.R: -------------------------------------------------------------------------------- 1 | # HBCU enrollment 2 | # TidyTuesday 2021 week 6 3 | # Rebecca Stevick updated 2/3/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(hrbrthemes) 8 | 9 | # Load data ---------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2021-02-02') 11 | hs_students <- tuesdata$hs_students 12 | 13 | # Analysis and plotting ---------- 14 | hs_students %>% 15 | # remove random erroneous data in the Total column (which is actually year) 16 | filter(Total < 2020) %>% 17 | # remove the columns with standard error 18 | select(-contains("Error")) %>% 19 | # put all percentages by race/ethnicity into a single column 20 | pivot_longer(White1:`Two or more race`) %>% 21 | # remove this total category 22 | filter(name != "Total - Asian/Pacific Islander") %>% 23 | # add the education percentage as a numeric value 24 | mutate(percent = as.numeric(value)) %>% 25 | # define order of race/ethnicity variable 26 | mutate(name = factor(name, levels=c("White1", "Asian/Pacific Islander - Pacific Islander", 27 | "Two or more race", "Asian/Pacific Islander - Asian", "Black1", 28 | "American Indian/\r\nAlaska Native", "Hispanic"))) %>% 29 | # start plotting - year on the x-axis, education rate on the y-axis, color by race/ethnicity 30 | ggplot(aes(x = Total, y = percent, fill = name))+ 31 | # add area with dodged position so they all plot in front of each other 32 | geom_area(position = position_dodge(width = 0), alpha = 0.7, color = "white")+ 33 | # add color scheme and better labels for the fill colors 34 | scale_fill_viridis_d(option = "A", labels = c("White", "Pacific Islander", "Two or more races", 35 | "Asian", "Black","American Indian/Alaska Native", "Hispanic"))+ 36 | # add percent scale to the y-axis 37 | scale_y_continuous(labels = scales::percent_format(scale = 1), limits = c(0,100))+ 38 | # add global theme 39 | theme_ft_rc()+ 40 | # edit theme 41 | theme(legend.position = c(0.2,0.73), legend.text = element_text(color="gray90"), 42 | plot.caption = element_text(color="white"), plot.title = element_text(size = 26, family = "Education Pencil"), 43 | panel.grid.minor.y = element_blank(), panel.grid.major.y = element_line(color="gray70"))+ 44 | # add those labels 45 | labs(title = "The race for education", 46 | subtitle = "Inequities in high school education rate have barely improved since 1940", 47 | x = NULL, y = "Percent of persons age 25 and over with a high school degree", fill = NULL, 48 | caption = "data from Data.World | plot by @rjstevick for #TidyTuesday") 49 | 50 | # Saving ------------------------- 51 | ggsave("HBCUenrollment_plot.png", bg = "transparent", width = 10, height = 6, dpi = 400) 52 | -------------------------------------------------------------------------------- /2021/20210209_WealthIncome/README.md: -------------------------------------------------------------------------------- 1 | ![WealthIncome_plot.png](WealthIncome_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210209_WealthIncome/WealthIncome_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210209_WealthIncome/WealthIncome_plot.png -------------------------------------------------------------------------------- /2021/20210209_WealthIncome/tidytuesday_20210209.R: -------------------------------------------------------------------------------- 1 | # Wealth and income - lifetime earnings by race/gender 2 | # TidyTuesday 2021 week 7 3 | # Rebecca Stevick updated 2/9/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(hrbrthemes) 8 | 9 | # Load data ---------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2021-02-09') 11 | # use lifetime earn data, but many more included in tuesdata 12 | lifetime_earn <- tuesdata$lifetime_earn 13 | # recreate a version of figure 5 shown here https://apps.urban.org/features/wealth-inequality-charts/ 14 | 15 | # Analysis and plotting ---------- 16 | lifetime_earn %>% 17 | # add a column with the fomatted earning values 18 | mutate(lifetime_earn_format = paste("$",round(lifetime_earn/1000000,1)," million", sep = ""), 19 | # edit the hispanic category name 20 | race = recode(race, "Hispanic any race"="Hispanic")) %>% 21 | # start plotting 22 | ggplot(aes(x = race, y = lifetime_earn, fill = gender))+ 23 | # add barplot, with bars dodged by gender 24 | geom_col(position = position_dodge(width = 0.95))+ 25 | # annotate the top of each bar with its value 26 | geom_text(aes(label = lifetime_earn_format, y = lifetime_earn+100000), 27 | position = position_dodge(width = 0.95), family = "Arial Narrow", color = "grey40")+ 28 | # add a horizontal line at y=0 29 | geom_abline()+ 30 | # add dollar signs to the y-axis scale 31 | scale_y_continuous(labels = scales::label_dollar())+ 32 | # edit the fill colors 33 | scale_fill_manual(values = c("midnightblue","plum4"))+ 34 | # change the global theme 35 | theme_ipsum()+ 36 | # edit the theme 37 | theme(panel.grid.major.x = element_blank(), axis.text.x = element_text(face = "bold", size = 16, color = "black"), 38 | legend.position = c(0.15,0.93), legend.direction = "horizontal", legend.text = element_text(size = 14, face = "bold"), 39 | plot.caption = element_text(color = "grey40"), axis.text.y = element_text(color = "grey40"), 40 | plot.title = element_text(size = 24), plot.subtitle = element_text(color = "grey40"))+ 41 | # add those labels 42 | labs(title = "Inequities add up in lifetime earnings", 43 | subtitle = "Average lifetime earnings by race/ethnicity and gender at age 58-62, for people born 1950-54. Data in 2015 $USD.", 44 | x = NULL, y = NULL, fill = NULL, 45 | caption = "data from Melissa Favreault, Urban Institute's tabulations from the 2008 Survey of Income and Program \nplot by @rjstevick for #TidyTuesday") 46 | 47 | # Saving ------------------------- 48 | ggsave("WealthIncome_plot.png", bg = "transparent", width = 10, height = 5.8, dpi = 400) 49 | -------------------------------------------------------------------------------- /2021/20210216_DuBoisChallenge/DuBoisChallenge_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210216_DuBoisChallenge/DuBoisChallenge_plot.png -------------------------------------------------------------------------------- /2021/20210216_DuBoisChallenge/README.md: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /2021/20210216_DuBoisChallenge/original-plate-02.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210216_DuBoisChallenge/original-plate-02.jpg -------------------------------------------------------------------------------- /2021/20210216_DuBoisChallenge/tidytuesday_20210216.R: -------------------------------------------------------------------------------- 1 | # Du Bois Challenge 2 | # TidyTuesday 2021 week 8 3 | # Rebecca Stevick updated 2/16/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | 8 | # Load data ---------------------- 9 | # Data for plate 2: Relative Negro Population of the States of the United States 10 | tuesdata <- read_csv('https://raw.githubusercontent.com/ajstarks/dubois-data-portraits/master/plate02/data.csv') 11 | 12 | # function to increase vertical spacing between legend keys by @clauswilke. 13 | # https://stackoverflow.com/questions/11366964/is-there-a-way-to-change-the-spacing-between-legend-items-in-ggplot2 14 | draw_key_polygon3 <- function(data, params, size) { 15 | lwd <- min(data$size, min(size) / 4) 16 | grid::rectGrob(width = grid::unit(0.6, "npc"), height = grid::unit(0.6, "npc"), 17 | gp = grid::gpar(col = data$colour, fill = alpha(data$fill, data$alpha), lty = data$linetype, lwd = lwd * .pt, linejoin = "mitre"))} 18 | 19 | # Analysis and plotting ---------- 20 | tuesdata %>% 21 | # make a dataframe of state names and abbreviations, join with population data 22 | left_join(data.frame(state.abb, state.name), by = c("State" = "state.abb")) %>% 23 | # make state names lowercase and order the population category 24 | mutate(region = tolower(state.name), 25 | Population = factor(Population, levels = c("750,000 AND OVER", "600,000 - 750,000", "500,000 - 600,000", "300,000 - 500,000", "200,000 - 300,000", 26 | "100,000 - 200,000", "50,000 - 100,000", "25,000 - 50,000", "10,000 - 25,000", "UNDER - 10,000"))) %>% 27 | # join data with map data 28 | left_join(map_data("state")) %>% 29 | # make map area, fill by population 30 | ggplot(aes(x = long, y = lat, group = group, fill = Population)) + 31 | # add states, with thinner grey outlines and use spread out legend keys (polygon3) 32 | geom_polygon(color = "grey20", lwd = 0.2, key_glyph = "polygon3") + 33 | # remove all theme elements and fix the x-y so the map doesn't warp 34 | theme_void() + coord_fixed(1.3) + 35 | # define fill colors 36 | scale_fill_manual(values = c("#20211c", "#9a8d7d", "seashell3", "#6f543e", "#2c2449", "#bd354d", "#d5afa6", "#dcac41", "#d2c5b2")) + 37 | # edit the theme 38 | theme(text = element_text(family = "Charter"), plot.title = element_text(margin = margin(t=10, b = 100), size = 18, hjust = 0.5, face = "bold"), 39 | plot.caption = element_text(size=8, hjust=0.5, margin = margin(t = 30, unit = "pt")), 40 | plot.margin = margin(r = 50, l = 50, unit = "pt"), 41 | legend.position = "bottom", legend.text = element_text(color = "grey20", margin = margin(r = 40, unit = "pt")))+ 42 | # put legend items in 2 columns 43 | guides(fill = guide_legend(ncol = 2, keyheight = unit(12, units = "mm"), keywidth = unit(12, units = "mm"))) + 44 | # add those labels 45 | labs(title = "RELATIVE NEGRO POPULATION OF THE STATES OF THE \nUNITED STATES.", fill = NULL, 46 | caption = "recreation of W.E.B Du Bois's Plate 2: Relative Negro Population of the States of the United States 47 | data from Du Bois data challenge | plot by @rjstevick for #TidyTuesday") 48 | 49 | # Saving ------------------------- 50 | ggsave("DuBoisChallenge_plot.png", bg = "#dfd3c3", width = 7, height = 8.5, dpi = 400) 51 | -------------------------------------------------------------------------------- /2021/20210223_EmploymentEarnings/EmploymentEarnings_plot.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210223_EmploymentEarnings/EmploymentEarnings_plot.gif -------------------------------------------------------------------------------- /2021/20210223_EmploymentEarnings/EmploymentEarnings_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210223_EmploymentEarnings/EmploymentEarnings_plot.png -------------------------------------------------------------------------------- /2021/20210223_EmploymentEarnings/README.md: -------------------------------------------------------------------------------- 1 | ![EmploymentEarnings_plot.gif](EmploymentEarnings_plot.gif) 2 | 3 |
4 | 5 | ![EmploymentEarnings_plot.png](EmploymentEarnings_plot.png) 6 | -------------------------------------------------------------------------------- /2021/20210223_EmploymentEarnings/tidytuesday_20210223.R: -------------------------------------------------------------------------------- 1 | # Employment and Earnings 2 | # TidyTuesday 2021 week 9 3 | # Rebecca Stevick updated 2/28/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(ggalt) 8 | library(ggtext) 9 | library(gganimate) 10 | 11 | # Load data ---------------------- 12 | tuesdata <- tidytuesdayR::tt_load('2021-02-23') 13 | employed <- tuesdata$employed 14 | 15 | # Analysis and plotting ---------- 16 | employed %>% 17 | filter(race_gender!="TOTAL") %>% # filter(year==2020) %>% 18 | mutate(gender=case_when(race_gender=="Men" ~ "Men", 19 | race_gender=="Women" ~ "Women", 20 | TRUE ~ "NA")) %>% filter(gender!="NA") %>% 21 | drop_na() %>% 22 | mutate(industry = recode(industry, "Mining, quarrying, and\r\noil and gas extraction" = "Mining, quarrying, and oil and gas extraction")) %>% 23 | group_by(gender, industry, year) %>% summarise(employed = sum(employ_n)) %>% 24 | group_by(industry, year) %>% mutate(percent = employed / sum(employed)) %>% 25 | select(-c(employed)) %>% 26 | pivot_wider(names_from = gender, values_from = percent) %>% mutate(diff = Men-Women) -> employededit 27 | 28 | # start plotting 29 | ggplot(employededit, aes(y = reorder(industry,diff), x = Women, xend = Men))+ 30 | geom_dumbbell(size = 4, colour_x = "#7669a8", colour_xend = "#509e9d", color = "grey80", alpha = 0.7)+ 31 | geom_text(aes(label = industry, color = diff), x = 0.5, family = "Copperplate")+ 32 | scale_color_gradient2(high = "#509e9d", mid = "black", low = "#7669a8", midpoint = 0)+ 33 | scale_x_continuous(labels = scales::label_percent(), limits = c(0,1))+ 34 | theme_void()+ 35 | theme(text = element_text(family = "Helvetica", color = "grey30"), 36 | legend.position = "none", axis.text.x = element_text(inherit.blank = FALSE), 37 | panel.grid.major.x = element_line(inherit.blank = FALSE, color = "grey90"), 38 | plot.background = element_blank(), 39 | plot.title = element_markdown(hjust = 0.5, lineheight = 1.1, color = "grey30", family = "Copperplate", size=24), 40 | plot.subtitle = element_markdown(hjust = 0.5, lineheight = 0.5, margin = margin(4,0,10,0)), 41 | plot.caption = element_text(hjust = 0.5, margin = margin(10,0,0,0))) -> plot 42 | 43 | #animate based on year 44 | plotanimate <- plot + transition_manual(frames = year, cumulative = FALSE)+ 45 | # add those labels 46 | labs(title = "Do industries employ more **men** or **women**?", 47 | subtitle = "Each point indicates the percentage of each gender per industry in {current_frame}", 48 | caption = "data from BLS | plot by @rjstevick for #TidyTuesday") 49 | 50 | # render animation 51 | animate(plot = plotanimate, nframes = length(unique(employededit$year)), 52 | fps = 1, height = 500, width = 1000, res = 100) 53 | 54 | # Saving ------------------------- 55 | anim_save("EmploymentEarnings_plot.gif") 56 | -------------------------------------------------------------------------------- /2021/20210302_SuperBowlAds/README.md: -------------------------------------------------------------------------------- 1 | ![SuperBowlAds_plot.png](SuperBowlAds_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210302_SuperBowlAds/SuperBowlAds_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210302_SuperBowlAds/SuperBowlAds_plot.png -------------------------------------------------------------------------------- /2021/20210302_SuperBowlAds/tidytuesday_20210302.R: -------------------------------------------------------------------------------- 1 | # Superb Owl Ads 2 | # TidyTuesday 2021 week 10 3 | # Rebecca Stevick updated 3/13/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(hrbrthemes) 8 | 9 | # Load data ---------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2021-03-02') 11 | youtube <- tuesdata$youtube 12 | 13 | # Analysis and plotting ---------- 14 | youtube %>% 15 | # put themes into one column 16 | pivot_longer(funny:use_sex) %>% 17 | # select only true rows 18 | filter(value==TRUE) %>% 19 | # count number of ads per theme per year 20 | group_by(name, year) %>% count() %>% 21 | # Fix theme names 22 | mutate(name = str_to_sentence(name), 23 | name = recode(name, "Show_product_quickly"="Shows product quickly", "Use_sex"="Uses sex")) %>% 24 | # start plotting 25 | ggplot(aes(x = year, y = name, fill = n)) + 26 | # add tiles and change color scheme 27 | geom_tile() + scale_fill_viridis_c(option = "E") + 28 | # change global theme 29 | theme_ipsum() + 30 | # edit theme 31 | theme(panel.grid.major.y = element_blank(), panel.grid.major.x = element_blank(), 32 | legend.title = element_text(vjust=0.75, family = "Copperplate"), 33 | plot.title = element_text(hjust=0.5, size=24, family = "Copperplate"), legend.position = "top") + 34 | # add those labels 35 | labs(title = "Superb Owl ad themes from XXXIV to LIV", 36 | x = NULL, y = NULL, fill = "Number of ads", 37 | caption = "data from FiveThirtyEight via superbowl-ads.com | plot by @rjstevick for #TidyTuesday") 38 | 39 | # Saving ------------------------- 40 | ggsave("SuperBowlAds_plot.png", bg = "transparent", width = 10, height = 6, dpi = 400) 41 | -------------------------------------------------------------------------------- /2021/20210309_BechdelTest/BechdelTest_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210309_BechdelTest/BechdelTest_plot.png -------------------------------------------------------------------------------- /2021/20210309_BechdelTest/README.md: -------------------------------------------------------------------------------- 1 | ![BechdelTest_plot.png](BechdelTest_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210309_BechdelTest/tidytuesday_20210309.R: -------------------------------------------------------------------------------- 1 | # Bechdel Test 2 | # TidyTuesday 2021 week 11 3 | # Rebecca Stevick updated 3/16/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(ggalt) 8 | library(ggtext) 9 | library(patchwork) 10 | library(ggpubr) 11 | 12 | # Load data ---------------------- 13 | tuesdata <- tidytuesdayR::tt_load('2021-03-09') 14 | movies <- tuesdata$movies 15 | 16 | # Set global theme --------------- 17 | theme_set(theme_cleveland() + 18 | theme(text = element_text(family = "Rockwell"), plot.title = element_text(size = 24, lineheight = 1.2), 19 | legend.position = "none", plot.subtitle = element_markdown(), 20 | plot.caption = element_text(hjust = 0.5, size = 8, color = "grey50"))) 21 | 22 | # Analysis and plotting ---------- 23 | 24 | # plot 1 - avg imdb rating of movies that pass/fail per genre 25 | rating <- movies %>% 26 | # separate the genre categories into rows 27 | drop_na(genre) %>% separate_rows(genre, sep = ", ") %>% 28 | # calculate the average rating per genre per pass/fail 29 | group_by(genre, binary) %>% summarise(avgrating = mean(imdb_rating)) %>% 30 | # put pass/fail into their own columns 31 | pivot_wider(names_from = binary, values_from = avgrating) %>% 32 | # calculate the difference between pass/fail 33 | mutate(diff = FAIL-PASS) %>% 34 | # remove genres with < 30 movies 35 | filter(genre != "Western" & genre != "War" & genre != "Documentary" & genre != "Musical") %>% 36 | # start plotting 37 | ggplot(aes(y = reorder(genre, FAIL), x = PASS, xend = FAIL, color = diff)) + 38 | # add the dumbbell 39 | geom_dumbbell(size = 3, colour_x = "aquamarine3", colour_xend = "violetred4") + 40 | # define gradient for dumbbell bar fill 41 | scale_color_gradient(low = "grey80", high = "grey40") + 42 | # add/remove labels 43 | labs(x = "Average IMDB rating", y = NULL, color = NULL) 44 | 45 | # extract order of y-axis values for the second plot 46 | orderedgenre <- ggplot_build(rating)$layout$panel_params[[1]]$y$get_labels() 47 | 48 | # plot 2 - number of movies that pass/fail per genre 49 | number <- movies %>% 50 | # separate the genre categories into rows 51 | drop_na(genre) %>% separate_rows(genre, sep = ", ") %>% 52 | # count the number of movies per genre per pass/fail 53 | group_by(genre, binary) %>% count() %>% 54 | # put pass/fail into their own columns 55 | pivot_wider(names_from = binary, values_from = n) %>% 56 | # calculate the difference between pass/fail 57 | mutate(diff = FAIL-PASS) %>% 58 | # remove genres with < 30 movies 59 | filter(genre != "Western" & genre != "War" & genre != "Documentary" & genre != "Musical") %>% 60 | # order the genre categories in the same way as the first ratings graph 61 | mutate(genre = factor(genre, levels = orderedgenre)) %>% 62 | # start plotting 63 | ggplot(aes(y = genre, x = PASS, xend = FAIL, color = diff)) + 64 | # add the dumbbell 65 | geom_dumbbell(size = 3, colour_x = "aquamarine3", colour_xend = "violetred4") + 66 | # define gradient for dumbbell bar fill 67 | scale_color_gradient(low = "grey80", high = "grey40") + 68 | # put the y-axis on the right 69 | scale_y_discrete(position = "right") + 70 | # add/remove labels 71 | labs(x = "Number of movies", y = NULL, color = NULL) 72 | 73 | # show both plots together with labels 74 | rating + number + 75 | # add those labels 76 | plot_annotation(title = "Gender bias in movies by genre (1970-2013)", 77 | subtitle = "
Movies that **fail** the Bechdel test usually get higher IMDB ratings, except in the Animation and Family genres. 78 | But, there are more movies that **pass** the Bechdel test in the Music, Romance, Horror, and Family genres. 79 | In the Action genre, there are 2.4 movies that **fail** the Bechdel test for every 1 movie that **passes**.
", 80 | caption = "data from FiveThirtyEight | plot by @rjstevick for #TidyTuesday") 81 | 82 | # Saving ------------------------- 83 | ggsave("BechdelTest_plot.png", bg = "transparent", width = 10, height = 6, dpi = 400) 84 | -------------------------------------------------------------------------------- /2021/20210316_VideoGames/README.md: -------------------------------------------------------------------------------- 1 | ![VideoGames_plot.png](VideoGames_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210316_VideoGames/VideoGames_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210316_VideoGames/VideoGames_plot.png -------------------------------------------------------------------------------- /2021/20210316_VideoGames/tidytuesday_20210316.R: -------------------------------------------------------------------------------- 1 | # Video Games + Sliced - tabletop simulator popularity over time 2 | # TidyTuesday 2021 week 12 3 | # Rebecca Stevick updated 3/16/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(hrbrthemes) # for the global theme 8 | library(ggtext) # to color the title text 9 | library(ggimage) # to add the logo 10 | library(lubridate) # formatting datestamps 11 | library(scales) # format plot axes 12 | 13 | # Load data ---------------------- 14 | tuesdata <- tidytuesdayR::tt_load('2021-03-16') 15 | games <- tuesdata$games 16 | 17 | logo <- "https://upload.wikimedia.org/wikipedia/en/3/39/Tabletop_Simulator_logo.png" 18 | 19 | # Analysis and plotting ---------- 20 | games %>% 21 | # select only tabletop simulator game data 22 | filter(gamename == "Tabletop Simulator") %>% 23 | # unite month and year columns, then format as a timestamp 24 | unite(yearmonth, month:year) %>% mutate(date = my(yearmonth)) %>% 25 | # start plotting average players over time 26 | ggplot(aes(x = date)) + 27 | # add peal players as area background 28 | geom_area(aes(y = peak), fill = "lightcyan4", color = "lightcyan4") + 29 | # add average players as light cyan line 30 | geom_line(aes(y = avg), color = "lightcyan", lwd = 1.2) + 31 | # add seagreen vertical line at April 2020 32 | geom_vline(aes(xintercept = as.Date("2020-04-01")), color = "seagreen1") + 33 | # add logo image at the top right 34 | geom_image(aes(x = as.Date("2015-12-01"), y = 30000, image = logo), size = 0.35) + scale_size_identity() + 35 | # Change date labels on y-axis. Put labels at each January 36 | scale_x_date(date_labels = "%Y", breaks = seq(as.Date("2014-01-01"), as.Date("2022-01-01"), by = "12 months")) + 37 | # define y-axis breaks and format labels with commas 38 | scale_y_continuous(breaks = c(0, 10000, 20000,30000, 40000), 39 | labels = label_comma(), limits = c(0,NA)) + 40 | # change global theme 41 | theme_ft_rc() + 42 | # edit theme 43 | theme(plot.title = element_markdown(family = "Futura", lineheight = 1.1, color = "lightcyan"), 44 | plot.subtitle = element_markdown(color = "grey80"), 45 | axis.title.y = element_markdown(), 46 | panel.grid.major = element_line(color = "grey45")) + 47 | # add those labels 48 | labs(title = "Online boardgamers quadrupled in April 2020", 49 | subtitle = "The **average number** and peak number of Tabletop Simulator players were highest during the COVID-19 lockdowns", 50 | x = NULL, y = "Average number of players | Peak players", 51 | caption = "\ndata from Steam/steamcharts | photo from wikipedia | plot by @rjstevick for #TidyTuesday") 52 | 53 | # Saving ------------------------- 54 | ggsave("VideoGames_plot.png", width = 9.5, height = 6, dpi = 400) 55 | -------------------------------------------------------------------------------- /2021/20210323_UNVotes/README.md: -------------------------------------------------------------------------------- 1 | ![UNVotes_plot.png](UNVotes_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210323_UNVotes/UNVotes_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210323_UNVotes/UNVotes_plot.png -------------------------------------------------------------------------------- /2021/20210323_UNVotes/tidytuesday_20210323.R: -------------------------------------------------------------------------------- 1 | # UN Votes 2 | # TidyTuesday 2021 week 13 3 | # Rebecca Stevick updated 3/23/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(hrbrthemes) 8 | 9 | # Load data ---------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2021-03-23') 11 | unvotes <- tuesdata$unvotes 12 | issues <- tuesdata$issues 13 | roll_calls <- tuesdata$roll_calls 14 | 15 | # Analysis and plotting ---------- 16 | issues %>% 17 | # join all data together 18 | left_join(unvotes) %>% left_join(roll_calls) %>% 19 | # select countries 20 | filter(country %in% c("United States","Russia","France","China","Germany","Australia")) %>% 21 | # wrap/edit label text 22 | mutate(country = str_wrap(country, 10), issue = str_wrap(issue, 15), 23 | vote = str_to_sentence(vote)) %>% 24 | # start plotting 25 | ggplot(aes(x = issue, y = country, color = vote)) + 26 | # panel for country vs issue 27 | facet_grid(country~issue, scales = "free", space = "free") + 28 | # add points 29 | geom_jitter(alpha = 0.6, size = 3) + 30 | # define colors 31 | scale_color_manual(values = c("grey40","salmon1","darkturquoise")) + 32 | # change global theme 33 | theme_ipsum() + 34 | # edit theme 35 | theme(legend.position = "top", legend.text = element_text(size = 18), 36 | plot.title = element_text(size = 30, hjust = 0.5), plot.caption = element_text(size = 12), 37 | axis.text.x = element_blank(), axis.ticks.x = element_blank(), 38 | axis.text.y = element_text(hjust = 0.5, face="bold", size = 15), 39 | strip.text.x = element_text(hjust = 0.5, face="bold", size = 22), 40 | strip.text.y = element_blank(), panel.spacing = unit(0, "lines")) + 41 | # add those labels 42 | labs(x = NULL, y = NULL, color = NULL, 43 | title = "UN Votes of select countries by category", 44 | caption = "data from Harvard Dataverse | plot by @rjstevick for #TidyTuesday") 45 | 46 | # Saving ------------------------- 47 | ggsave("UNVotes_plot.png", bg = "transparent", width = 14, height = 8, dpi = 400) 48 | -------------------------------------------------------------------------------- /2021/20210330_MakeupShades/MakeupShades_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210330_MakeupShades/MakeupShades_plot.png -------------------------------------------------------------------------------- /2021/20210330_MakeupShades/README.md: -------------------------------------------------------------------------------- 1 | ![MakeupShades_plot.png](MakeupShades_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210330_MakeupShades/tidytuesday_20210330.R: -------------------------------------------------------------------------------- 1 | # Makeup Shades 2 | # TidyTuesday 2021 week 14 3 | # Rebecca Stevick updated 3/30/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(patchwork) 8 | 9 | # Load data ---------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2021-03-30') 11 | allShades <- tuesdata$allShades # use allShades file 12 | 13 | # Analysis and plotting ---------- 14 | 15 | # Make overall palette with one square for each foundation color available 16 | paletteplot <- allShades %>% 17 | # remove the random blue shade? is this for avatar? 18 | filter(hex != "#4460F3") %>% 19 | # count up number of products per hex, then make a row for each using uncount 20 | group_by(hex, lightness) %>% count() %>% uncount(n) %>% ungroup() %>% 21 | # arrange by lightness of the hue 22 | arrange(desc(lightness)) %>% 23 | # make a waffle guide for the tiles, based on 62 rows 24 | mutate(num = row_number(), x_pos = (num - 1) %/% 62, y_pos = 62 - (num - 1) %% 62 - 1) %>% 25 | # time to plot 26 | ggplot(aes(x = x_pos, y = y_pos, fill = hex)) + 27 | # add tiles outlined in white 28 | geom_tile(color = "white", lwd = 0.6) + 29 | # color by hex code and remove extra space on x-axis 30 | scale_fill_identity() + scale_x_continuous(expand = c(0, 0)) + 31 | # change global theme, remove legend, edit caption text 32 | theme_void() + theme(legend.position = "none", plot.caption = element_text(size = 14, family = "Avenir")) + 33 | # add caption 34 | labs(caption = "data from The Pudding | plot by @rjstevick for #TidyTuesday") 35 | 36 | # Make header palette with randomly selected (average/representative) palette 37 | header <- allShades %>% 38 | # select the darkest shade 39 | arrange(desc(lightness)) %>% slice_head(n = 1) %>% 40 | # join with the lighest shade 41 | full_join(allShades %>% arrange(desc(lightness)) %>% slice_tail(n = 1)) %>% 42 | # join with 1% of randomly selected shades 43 | full_join(allShades %>% filter(hex != "#4460F3") %>% sample_frac(size = 0.01)) %>% 44 | # pick only hex and lightness columns, and arrange based on lightness of the hue 45 | select(hex, lightness) %>% arrange(desc(lightness)) %>% 46 | # add the row number as variable `num` 47 | mutate(num = row_number()) %>% 48 | # time to plot 49 | ggplot() + 50 | # add tiles sorted by lightness, with black outline 51 | geom_tile(aes(x = num, y = 1, fill = hex), color = "black", lwd = 1.2) + 52 | # add hex code labels, colored in the reverse direction 53 | geom_text(aes(x = num, y = 1, label = hex, color=rev(hex)), angle=90)+ 54 | # add title with "shadow" over the plot as text 55 | annotate(geom = "text", x = 35.1, y = 0.98, label = "beauty bias palette", family = "Avenir Black", size = 17, color = "black") + 56 | annotate(geom = "text", x = 35, y = 1, label = "beauty bias palette", family = "Avenir Black", size = 17, color = "white") + 57 | # color tiles and text by hex code, and remove extra white space on the x-axis 58 | scale_fill_identity() + scale_color_identity() + scale_x_discrete(expand = c(0, 0)) + 59 | # change global theme, edit caption/subtitle text 60 | theme_void() + theme(plot.caption = element_text(hjust = 0.5, family = "Avenir", size = 14)) + 61 | # add subtitle/caption 62 | labs(caption = "Representation of 6,815 foundation shades available from Sephora or Ulta US. Lighter shades have more diversity and availability.") 63 | 64 | # display header over palette and adjust heights of panels 65 | header/paletteplot+plot_layout(heights=c(1,6)) 66 | 67 | # Saving ------------------------- 68 | ggsave("MakeupShades_plot.png", width = 14, height = 8, dpi = 400) 69 | -------------------------------------------------------------------------------- /2021/20210406_GlobalDeforestation/GlobalDeforestation_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210406_GlobalDeforestation/GlobalDeforestation_plot.png -------------------------------------------------------------------------------- /2021/20210406_GlobalDeforestation/README.md: -------------------------------------------------------------------------------- 1 | ![GlobalDeforestation_plot.png](GlobalDeforestation_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210406_GlobalDeforestation/tidytuesday_20210406.R: -------------------------------------------------------------------------------- 1 | # Deforestation in Brazil 2 | # TidyTuesday 2021 week 15 3 | # Rebecca Stevick updated 4/6/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(ggstream) # remotes::install_github("davidsjoberg/ggstream") 8 | library(nationalparkcolors) 9 | library(scales) 10 | 11 | # Load data ---------------------- 12 | tuesdata <- tidytuesdayR::tt_load('2021-04-06') 13 | brazil_loss <- tuesdata$brazil_loss 14 | 15 | # Analysis and plotting ---------- 16 | brazil_loss %>% 17 | # put all causes into long form per year 18 | pivot_longer(commercial_crops:small_scale_clearing) %>% 19 | # select top 5 causes and assign all others to "Other" 20 | mutate(nameother = fct_lump_n(name, w = value, n = 5)) %>% 21 | # remove underscores and capitalize 22 | mutate(nameother = str_to_sentence(str_replace_all(nameother, "_"," "))) %>% 23 | # group all Others into one name and add up the values per year 24 | group_by(year, nameother) %>% summarise(sumvalue = sum(value)) %>% 25 | # start plotting 26 | ggplot(aes(x = year, y = sumvalue, fill = reorder(nameother, desc(sumvalue)))) + 27 | geom_stream(color = "white", alpha = 0.7, type = "ridge", bw = 0.9) + 28 | geom_stream_label(aes(label = nameother), type = "ridge", family = "Krungthep") + 29 | scale_fill_manual(values = c("#092215", rev(park_palette("Acadia")))) + 30 | scale_x_continuous(breaks = breaks_pretty(), expand = c(0,0)) + 31 | scale_y_continuous(labels = label_number(suffix = " million ha", scale = 1e-6, accuracy = 1), expand = c(0,0)) + 32 | theme_minimal() + 33 | theme(legend.position = "none", text = element_text(family = "American Typewriter"), 34 | plot.title = element_text(size = 22, family = "Krungthep"), axis.ticks = element_line(size = 0.2), 35 | panel.grid.minor = element_blank(), panel.grid.major.x = element_blank()) + 36 | labs(title = "Causes of forest loss in Brazil", 37 | subtitle = "Annual forest loss due to deforestion or degradation from 2001-2013, measured in hectares", 38 | x = NULL, y = NULL, caption = "data from Our World in Data | plot by @rjstevick for #TidyTuesday") 39 | 40 | # Saving ------------------------- 41 | ggsave("GlobalDeforestation_plot.png", bg = "transparent", width = 10, height = 6, dpi = 400) 42 | -------------------------------------------------------------------------------- /2021/20210413_USPostOffices/README.md: -------------------------------------------------------------------------------- 1 | ![USPostOffices_plot.gif](USPostOffices_plot.gif) 2 | ![USPostOffices_plot.png](USPostOffices_plot.png) 3 | -------------------------------------------------------------------------------- /2021/20210413_USPostOffices/USPostOffices_plot.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210413_USPostOffices/USPostOffices_plot.gif -------------------------------------------------------------------------------- /2021/20210413_USPostOffices/USPostOffices_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210413_USPostOffices/USPostOffices_plot.png -------------------------------------------------------------------------------- /2021/20210413_USPostOffices/tidytuesday_20210413.R: -------------------------------------------------------------------------------- 1 | # US Post offices 2 | # TidyTuesday 2021 week 16 3 | # Rebecca Stevick updated 4/14/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(gganimate) 8 | library(magick) 9 | # download font from https://famfonts.com/united-states-postal-service/ 10 | 11 | # Load data ---------------------- 12 | tuesdata <- tidytuesdayR::tt_load('2021-04-13') 13 | 14 | # Analysis and plotting ---------- 15 | # clean up data 16 | post_offices_clean <- tuesdata$post_offices %>% 17 | drop_na(established, longitude, latitude) %>% 18 | filter(established >= 1600) %>% # remove random dates 19 | filter(longitude <= 0) # remove point errors 20 | 21 | # generate static plot 22 | plot <- post_offices_clean %>% 23 | ggplot(aes(y = latitude, x = longitude)) + 24 | geom_point(aes(color = established), size = 0.4, shape = 19, alpha = 0.2) + 25 | theme_void() + coord_fixed(1.3) + 26 | scale_color_gradient(low = "midnightblue", high = "firebrick4") + 27 | theme(legend.position = "none", plot.title.position = "plot", 28 | plot.title = element_text(hjust = 1, family = "Postmaster", size = 35, color = "midnightblue"), 29 | plot.subtitle = element_text(family = "Postmaster", size = 18, color = "grey40", hjust = 1), 30 | plot.caption = element_text(margin = margin(t = -20, b=0), family = "Silom", size = 14)) + 31 | labs(title = "You've got mail!", subtitle = "US post offices established 1639 - 2000", 32 | caption = "data from Cameron Blevins and Richard W. Helbock | plot by @rjstevick for #TidyTuesday") 33 | 34 | # animate plot by year 35 | plotanimate <- plot + transition_manual(frames = established, cumulative = TRUE) + 36 | labs(subtitle = "\n {current_frame}. US post offices established since 1639.") 37 | 38 | # render animation 39 | animate(plot = plotanimate, renderer = magick_renderer(), 40 | nframes = length(unique(post_offices_clean$established)), 41 | height = 650, width = 1000, end_pause = 15, res = 100) 42 | 43 | # Saving ------------------------- 44 | anim_save("USPostOffices_plot.gif") 45 | # save static plot too 46 | ggsave(plot = plot, "USPostOffices_plot.png", bg = "transparent", width = 10, height = 6, dpi = 400) 47 | -------------------------------------------------------------------------------- /2021/20210420_NetflixTitles/NetflixTitles_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210420_NetflixTitles/NetflixTitles_plot.png -------------------------------------------------------------------------------- /2021/20210420_NetflixTitles/README.md: -------------------------------------------------------------------------------- 1 | ![NetflixTitles_plot.png](NetflixTitles_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210420_NetflixTitles/tidytuesday_20210420.R: -------------------------------------------------------------------------------- 1 | # Netflix Shows 2 | # TidyTuesday 2021 week 17 3 | # Rebecca Stevick updated 4/20/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(hrbrthemes) 8 | library(ggimage) 9 | library(ggtext) 10 | # download font from https://fontmeme.com/fonts/bebas-neue-font/ 11 | 12 | # Load data ---------------------- 13 | tuesdata <- tidytuesdayR::tt_load('2021-04-20') 14 | # store cartoon TV image as a dataframe 15 | images <- tibble(image=c("https://i.pinimg.com/originals/87/9f/35/879f354dfe3834de15865303aa22995a.png")) 16 | 17 | # Analysis and plotting ---------- 18 | tuesdata$netflix %>% 19 | # select only TV shows 20 | filter(type=="TV Show") %>% 21 | # separate the number of seasons column into 2, since there's some text 22 | separate(duration, into = c("seasons", "duration")) %>% 23 | # make a row for each category listed per show, then remove broad category 24 | separate_rows(listed_in, sep = ", ") %>% filter(listed_in!="TV Shows") %>% 25 | # make the number of seasons a numeric variable, and clean up some of the names 26 | mutate(seasons = as.numeric(seasons), 27 | listed_in = recode(listed_in, "Spanish-Language TV Shows" = "Spanish-Language", 28 | "Stand-Up Comedy & Talk Shows" = "Stand-Up Comedy & Talk", 29 | "International TV Shows" = "International TV")) %>% 30 | # start plotting, make a panel for each category in 6 columns 31 | ggplot(aes(y=0, x=0)) + facet_wrap(.~listed_in, ncol = 6) + 32 | # add TV pngs to each panel background 33 | geom_image(data = images, aes(x=0.056, y=0.053, image = image), size = 1.3, by="height")+ 34 | # add black background to each TV screen 35 | annotate("rect", xmin=-0.38, ymin=-0.29, xmax=0.37, ymax=0.28, fill = "black", color = "black")+ 36 | # add points jittered 37 | geom_jitter(aes(y = -0.05, size = seasons, color = seasons), shape = 20, width = 0.35, height = 0.2) + 38 | # add titles of each category at the top of the TV screens 39 | stat_summary(aes(color = seasons, x = 0, y = 0.23, label = listed_in), fun = "mean", geom = "text", 40 | size = 4.4, family = "Bebas Neue", color = "red2", lineheight = 0.8) + 41 | # define color scheme for points 42 | scale_color_gradient(low="grey65", high="white") + 43 | # define size scheme for points 44 | scale_size_continuous(range = c(0.5, 3)) + 45 | # define limits for x and y-axis so we can fit the TV in the background 46 | scale_x_continuous(limits = c(-0.4, 0.4)) + scale_y_continuous(limits = c(-0.4, 0.4)) + 47 | # add text/caption at bottom right, set to the right of the TV Thrillers panel 48 | geom_text(data = data.frame(listed_in = c("TV Thrillers")), x = 3.6, y = -0.2, color = "white", 49 | size = 2.8, hjust = 1, family = "Monaco", 50 | label = "Each point represents one TV show per category. 51 | The size of each point corresponds to the\n number of seasons per TV show (1-16).\n 52 | data from Shivam Bansal via Kaggle | plot by @rjstevick for #TidyTuesday") + 53 | # set global theme and make sure the plot panel isn't cut off 54 | theme_ft_rc() + coord_cartesian(clip = 'off') + 55 | # edit the theme 56 | theme(legend.position = "none", panel.spacing = unit(1.2, "lines"), strip.text = element_blank(), 57 | panel.grid.major = element_blank(), panel.grid.minor = element_blank(), 58 | axis.text.x = element_blank(), axis.text.y = element_blank(), 59 | plot.title = element_markdown(hjust = 0.5, family = "Bebas Neue", size = 46, color = "white")) + 60 | # add the title 61 | labs(title = "What's on **Netflix** tonight?", x = NULL, y = NULL) 62 | 63 | # Saving ------------------------- 64 | ggsave("NetflixTitles_plot.png", width = 12, height = 7.5, dpi = 400) 65 | -------------------------------------------------------------------------------- /2021/20210427_CEODepartures/CEODepartures_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210427_CEODepartures/CEODepartures_plot.png -------------------------------------------------------------------------------- /2021/20210427_CEODepartures/README.md: -------------------------------------------------------------------------------- 1 | ![CEODepartures_plot.png](CEODepartures_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210427_CEODepartures/tidytuesday_20210427.R: -------------------------------------------------------------------------------- 1 | # CEO Departures 2 | # TidyTuesday 2021 week 18 3 | # Rebecca Stevick updated 4/27/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(hrbrthemes) 8 | 9 | # Load data ---------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2021-04-27') 11 | departures <- tuesdata$departures 12 | 13 | # Analysis and plotting ---------- 14 | departures %>% 15 | filter(fyear <= 2016 & fyear >= 1990) %>% 16 | mutate(reason = case_when(departure_code == 1 ~ "Involuntary", 17 | departure_code == 2 ~ "Involuntary", 18 | departure_code == 3 ~ "Involuntary", 19 | departure_code == 4 ~ "Involuntary", 20 | departure_code == 5 ~ "Voluntary", 21 | departure_code == 6 ~ "Voluntary", 22 | departure_code == 7 ~ "Other Reason", 23 | departure_code == 8 ~ "Missing", 24 | departure_code == 9 ~ "Other Reason", 25 | TRUE ~ "Missing"), 26 | reason = factor(reason, levels = c("Voluntary", "Involuntary", "Other Reason", "Missing"))) %>% 27 | group_by(fyear, reason) %>% count() %>% 28 | ggplot(aes(x = fyear, y = n, fill = as.factor(reason)))+ 29 | geom_col(position = "fill", alpha = 0.8)+ 30 | scale_fill_manual(values = c("darkslategray4", "peachpuff3", "gray40", "black"))+ 31 | scale_x_continuous(breaks = scales::breaks_width(5))+ 32 | scale_y_continuous(labels = scales::label_percent(), expand = c(0,0))+ 33 | theme_ipsum()+ 34 | theme(legend.position = "bottom", panel.grid.minor = element_blank())+ 35 | # add those labels 36 | labs(title = "Turnover at the Top: voluntary DEO departures have decreased since 1992", 37 | subtitle = "CEO departures from S&P 1500 firms, 1992 - 2016", 38 | x = NULL, y = NULL, fill = NULL, 39 | caption = "data from Gentry et al. 2021 https://doi.org/10.1002/smj.3278 | plot by @rjstevick for #TidyTuesday") 40 | 41 | # Saving ------------------------- 42 | ggsave("CEODepartures_plot.png", bg = "transparent", width = 10, height = 6, dpi = 400) 43 | -------------------------------------------------------------------------------- /2021/20210504_WaterAccessPoints/README.md: -------------------------------------------------------------------------------- 1 | ![WaterAccessPoints_plot.png](WaterAccessPoints_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210504_WaterAccessPoints/WaterAccessPoints_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210504_WaterAccessPoints/WaterAccessPoints_plot.png -------------------------------------------------------------------------------- /2021/20210504_WaterAccessPoints/tidytuesday_20210504.R: -------------------------------------------------------------------------------- 1 | # Water access points 2 | # TidyTuesday 2021 week 19 3 | # Rebecca Stevick updated 5/6/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(spData) 8 | library(sf) 9 | 10 | # Load data ---------------------- 11 | tuesdata <- tidytuesdayR::tt_load('2021-05-04') 12 | water <- tuesdata$water 13 | 14 | # Analysis and plotting ---------- 15 | water %>% 16 | filter(lon_deg>=-20 & lon_deg<=50 & lat_deg>=-30 & lat_deg<=40) %>% 17 | replace_na(list(water_source="Unknown")) %>% 18 | mutate(water_source = case_when( 19 | str_detect(water_source, "Spring") ~ "Spring", 20 | str_detect(water_source, "Shallow Well") ~ "Shallow Well", 21 | str_detect(water_source, "Surface Water") ~ "Surface Water", 22 | TRUE ~ water_source)) %>% 23 | ggplot()+ 24 | geom_sf(data = world %>% filter(continent == "Africa", !is.na(iso_a2)), 25 | aes(geometry=geom), fill = "grey90", color="white")+ 26 | geom_hex(aes(x = lon_deg, y = lat_deg, fill = water_source), 27 | bins = 80, alpha = 0.6)+ 28 | theme_void() + 29 | scale_fill_brewer(palette = "Set3") + 30 | theme(legend.position = c(0.15, 0.25), title = element_text(family = "Baloo"), 31 | plot.title = element_text(size = 26))+ 32 | # add those labels 33 | labs(title = "Water sources in Africa installed since 1900", fill = "Water Source", 34 | caption = "data from Water Point Data Exchange | plot by @rjstevick for #TidyTuesday") 35 | 36 | # Saving ------------------------- 37 | ggsave("WaterAccessPoints_plot.png", bg = "transparent", width = 8, height = 8, dpi = 400) 38 | -------------------------------------------------------------------------------- /2021/20210511_USBroadband/README.md: -------------------------------------------------------------------------------- 1 | ![USBroadband_plot.png](USBroadband_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210511_USBroadband/USBroadband_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210511_USBroadband/USBroadband_plot.png -------------------------------------------------------------------------------- /2021/20210511_USBroadband/tidytuesday_20210511.R: -------------------------------------------------------------------------------- 1 | # US broadband access 2 | # TidyTuesday 2021 week 20 3 | # Rebecca Stevick updated 5/20/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(geofacet) 8 | 9 | # Load data ---------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2021-05-11') 11 | broadband <- tuesdata$broadband 12 | 13 | # Analysis and plotting ---------- 14 | broadband %>% 15 | drop_na(`BROADBAND AVAILABILITY PER FCC`) %>% 16 | mutate(availability = as.numeric(`BROADBAND AVAILABILITY PER FCC`)) %>% 17 | # time to plot 18 | ggplot(aes(x=1, y=1)) + 19 | geom_jitter(aes(color = availability), alpha=0.8) + 20 | geom_text(data = broadband %>% distinct(ST), 21 | aes(label = ST), size=8, family = "Copperplate")+ 22 | # make a panel for each state in its geographical location (relatively) 23 | facet_geo(~ST) + 24 | # edit color scale 25 | scale_color_viridis_c(option ="B", labels = scales::label_percent()) + 26 | # change global theme 27 | theme_void() + 28 | # edit theme 29 | theme(text=element_text(size=18, family = "Andale Mono"), 30 | plot.title=element_text(face="bold", size=30), plot.subtitle = element_text(size = 14), 31 | strip.text = element_blank(), legend.direction = "horizontal", 32 | panel.background = element_rect(fill="snow2", color="transparent"), 33 | panel.spacing = unit(0.2, "lines"), plot.margin = margin(10, 10, 10, 10), 34 | legend.position=c(0.2, 0.95), legend.text=element_text(size=16), 35 | legend.key.width = unit(1.3, "cm")) + 36 | guides(color = guide_colourbar(title.position="top")) + 37 | # add those labels 38 | labs(title = "Broadband Availability in the US", 39 | subtitle = "Each point represents a county, colored by percent of people per county with access to \nfixed terrestrial broadband at speeds of 25 Mbps/3 Mbps as of the end of 2017\n", 40 | color = NULL, 41 | caption = "\ndata from Microsoft GitHub \nplot by @rjstevick for #TidyTuesday") 42 | 43 | # Saving ------------------------- 44 | ggsave("USBroadband_plot.png", bg = "transparent", width = 12, height = 8, dpi = 400) 45 | -------------------------------------------------------------------------------- /2021/20210518_SalarySurvey/README.md: -------------------------------------------------------------------------------- 1 | ![SalarySurvey_plot.png](SalarySurvey_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210518_SalarySurvey/SalarySurvey_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210518_SalarySurvey/SalarySurvey_plot.png -------------------------------------------------------------------------------- /2021/20210518_SalarySurvey/tidytuesday_20210518.R: -------------------------------------------------------------------------------- 1 | # Ask a Manager Salary Survey 2 | # TidyTuesday 2021 week 21 3 | # Rebecca Stevick updated 5/27/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(hrbrthemes) 8 | 9 | # Load data ---------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2021-05-18') 11 | survey <- tuesdata$survey 12 | 13 | # Analysis and plotting ---------- 14 | survey %>% 15 | # remove data without gender or with likely erroneous salaries 16 | drop_na(gender) %>% filter(annual_salary<3e7) %>% 17 | # fix and reorder data 18 | mutate(gender = recode(gender, "Prefer not to answer" = "Other or prefer not to answer"), 19 | gender = factor(gender, levels = c("Man", "Woman", "Non-binary", "Other or prefer not to answer")), 20 | years = factor(overall_years_of_professional_experience, 21 | levels = c("1 year or less", "2 - 4 years", "5-7 years", "8 - 10 years", 22 | "11 - 20 years", "21 - 30 years", "31 - 40 years", "41 years or more"))) %>% 23 | # start plotting 24 | ggplot(aes(x = years, y = annual_salary, color = gender)) + 25 | stat_summary(fun = "mean", geom = "point", position = position_dodge(width = 1)) + 26 | stat_summary(fun = "mean", geom = "segment", 27 | aes(yend = 0, xend = years), position = position_dodge(width = 1)) + 28 | scale_y_continuous(labels = scales::label_dollar()) + 29 | scale_color_manual(values = PNWColors::pnw_palette("Cascades", n=4)) + 30 | # set and edit theme 31 | theme_ipsum() + theme(legend.position = c(0.75, 1.05), legend.direction = "horizontal") + 32 | # add those labels 33 | labs(title = "Annual salaries increase with years of experience", 34 | subtitle = "But, men always make more money than women at all stages", 35 | y = "Average annual salary", x = NULL, color = NULL, 36 | caption = "data from Ask a Manager Salary Survey | plot by @rjstevick for #TidyTuesday") 37 | 38 | # Saving ------------------------- 39 | ggsave("SalarySurvey_plot.png", bg = "transparent", width = 10, height = 5, dpi = 400) 40 | -------------------------------------------------------------------------------- /2021/20210525_MarioKart/MarioKart_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210525_MarioKart/MarioKart_plot.png -------------------------------------------------------------------------------- /2021/20210525_MarioKart/README.md: -------------------------------------------------------------------------------- 1 | ![MarioKart_plot.png](MarioKart_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210525_MarioKart/tidytuesday_20210525.R: -------------------------------------------------------------------------------- 1 | # Mario Kart World Records 2 | # On which track does the shortcut save the most time? 3 | # TidyTuesday 2021 week 22 4 | # Rebecca Stevick updated 5/26/2021 5 | 6 | # Load libraries ----------------- 7 | library(tidyverse) 8 | library(ggalt) 9 | library(hrbrthemes) 10 | library(ggtext) 11 | 12 | # Load data ---------------------- 13 | tuesdata <- tidytuesdayR::tt_load('2021-05-25') 14 | records <- tuesdata$records 15 | 16 | # Analysis and plotting ---------- 17 | records %>% 18 | # select only 3-lap times 19 | filter(type == "Three Lap") %>% 20 | # calculate the average time per track per shortcut/not 21 | group_by(shortcut, track) %>% summarise(meantime = mean(time)) %>% 22 | # put shortcut or not into their own columns 23 | pivot_wider(names_from = shortcut, values_from = meantime) %>% 24 | # calculate the difference between shortcut/not 25 | mutate(diff = Yes - No) %>% drop_na(diff) %>% 26 | # start plotting 27 | ggplot(aes(y = reorder(track, -diff), x = Yes, xend = No, color = diff)) + 28 | # add the dumbell 29 | geom_dumbbell(size = 5, colour_xend = "red3", colour_x = "dodgerblue") + 30 | # add vertical start and finish lines 31 | geom_vline(aes(xintercept = 0), color = "white") + geom_vline(aes(xintercept = 400), color = "white") + 32 | # define gradient for dumbbell bar fill 33 | scale_color_gradient(low = "grey90", high = "grey30") + 34 | # change global theme 35 | theme_ft_rc() + 36 | # edit theme 37 | theme(plot.title = element_text(size = 24), plot.subtitle = element_markdown(lineheight = 1.1), 38 | panel.grid.major.y = element_line(linetype = "dashed", color = "grey90"), 39 | axis.text.y = element_text(color = "white", size = 14), axis.text.x = element_text(color = "white", size = 14), 40 | axis.title.x = element_text(color = "grey90", size=12), legend.position = "none") + 41 | # add those labels 42 | labs(title = "The Mario Kart shortcut always saves time", 43 | subtitle = "World records that **take the shortcut** are 44 | always faster than records that **take the long road**. 45 |
Shortcuts save an average of 58 seconds on a 3-lap course. 46 | The most time saved by **taking the shortcut** 47 | is on the Wario Stadium track.", 48 | fill = NULL, color = NULL, y = NULL, x = "Average record time for a 3-lap course (seconds)", 49 | caption = "data from Mario Kart World Records | plot by @rjstevick for #TidyTuesday") 50 | 51 | # Saving ------------------------- 52 | ggsave("MarioKart_plot.png", bg = "transparent", width = 12, height = 7, dpi = 400) 53 | -------------------------------------------------------------------------------- /2021/20210601_SurvivorTVShow/README.md: -------------------------------------------------------------------------------- 1 | ![SurvivorTVShow_plot.png](SurvivorTVShow_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210601_SurvivorTVShow/SurvivorTVShow_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210601_SurvivorTVShow/SurvivorTVShow_plot.png -------------------------------------------------------------------------------- /2021/20210601_SurvivorTVShow/tidytuesday_20210601.R: -------------------------------------------------------------------------------- 1 | # Survivor TV Show 2 | # TidyTuesday 2021 week 23 3 | # Rebecca Stevick updated 6/25/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | 8 | # Load data ---------------------- 9 | tuesdata <- tidytuesdayR::tt_load('2021-06-01') 10 | summary <- tuesdata$summary 11 | 12 | # Analysis and plotting ---------- 13 | summary %>% 14 | # count seasons per country 15 | group_by(country) %>% count(sort = TRUE) %>% 16 | # join with map data 17 | left_join(map_data("world"), by=c("country" = "region")) %>% 18 | # start plotting 19 | ggplot() + 20 | # add background map 21 | geom_polygon(data=map_data("world"), aes(x = long, y = lat, group = group), fill="grey90") + 22 | # add filled country counts 23 | geom_polygon(aes(x = long, y = lat, group = group, fill = n), color = "white", lwd=0.5) + 24 | # highlight Fiji with star, arrow, and label 25 | geom_point(aes(x = 175, y = -21), shape = 8, color = "darkgoldenrod1") + 26 | geom_text(aes(x = 170, y = 8, label = "Fiji hosted the \nmost seasons (9)"), 27 | colour = "darkgoldenrod2", family = "Roboto Condensed", hjust = 0.5, vjust = 0, size = 3) + 28 | geom_curve(aes(x = 170, y = 5, xend = 175, yend = -19), colour = "darkgoldenrod2", size = 0.5, 29 | curvature = -0.2, arrow = arrow(length = unit(0.02, "npc"))) + 30 | # edit fill color scheme 31 | scale_fill_viridis_c(option = "magma", breaks = scales::breaks_width(2)) + 32 | # set global theme and fix coordinates 33 | theme_void() + coord_fixed(1.3) + 34 | # edit theme 35 | theme(plot.title = element_text(family = "Survivant", size = 20, hjust = 0.5, color = "purple4"), 36 | text = element_text(family = "Roboto Condensed"), 37 | legend.position = c(0.15,0.2), legend.direction = "horizontal") + 38 | # put legend label on top 39 | guides(fill = guide_colourbar(title.position="top")) + 40 | # add those labels 41 | labs(title = "Survivor Filming locations", 42 | fill = "Number of seasons", 43 | caption = "data from survivorR R package via Daniel Oehm | plot by @rjstevick for #TidyTuesday") 44 | 45 | # Saving ------------------------- 46 | ggsave("SurvivorTVShow_plot.png", bg = "transparent", width = 8, height = 5.6, dpi = 400) 47 | -------------------------------------------------------------------------------- /2021/20210608_GreatLakesFish/GreatLakesFish_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210608_GreatLakesFish/GreatLakesFish_plot.png -------------------------------------------------------------------------------- /2021/20210608_GreatLakesFish/README.md: -------------------------------------------------------------------------------- 1 | ![GreatLakesFish_plot.png](GreatLakesFish_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210608_GreatLakesFish/tidytuesday_20210608.R: -------------------------------------------------------------------------------- 1 | # Great Lakes Fish 2 | # TidyTuesday 2021 week 24 3 | # Rebecca Stevick updated 6/25/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(hrbrthemes) 8 | 9 | # Load data ---------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2021-06-08') 11 | fishing <- tuesdata$fishing 12 | stocked <- tuesdata$stocked 13 | 14 | # Analysis and plotting ---------- 15 | fishing %>% 16 | # fix some names 17 | mutate(species = recode(species, 18 | "Amercian Eel" = "American Eel", 19 | "White bass" = "White Bass", 20 | "Bullheads" = "Bullhead", 21 | "Channel catfish" = "Channel Catfish", 22 | "Cisco and chubs" = "Cisco and Chubs", 23 | "Cisco and Chub" = "Cisco and Chubs", 24 | "Pacific salmon" = "Pacific Salmon", 25 | "Crappies" = "Crappie")) %>% 26 | # pick most abundant species 27 | group_by(species) %>% mutate(sum = sum(grand_total, na.rm = TRUE)) %>% 28 | filter(sum > 5000000) %>% 29 | # remove summary regions 30 | filter(!grepl("Total", region)) %>% 31 | # remove absent data 32 | drop_na(grand_total, year) %>% 33 | # start plotting 34 | ggplot(aes(x = year, y = grand_total, color = species)) + 35 | geom_point(size = 0.5) + 36 | geom_smooth(alpha = 0.2) + 37 | facet_wrap(.~region) + 38 | scale_color_manual(values = PNWColors::pnw_palette("Cascades", n = 4)) + 39 | theme_ipsum() + 40 | theme(legend.position = "top", legend.justification = "left") + 41 | # add those labels 42 | labs(x = NULL, y = "Total observations", color = NULL, 43 | title = "Time-series of 4 most abundant fish species in the Great Lakes", 44 | caption = "data from Great Lakes Fishery Commission | plot by @rjstevick for #TidyTuesday") 45 | 46 | # Saving ------------------------- 47 | ggsave("GreatLakesFish_plot.png", bg = "transparent", width = 12, height = 7, dpi = 400) 48 | -------------------------------------------------------------------------------- /2021/20210615_WEBduBois/README.md: -------------------------------------------------------------------------------- 1 | ![WEBduBois_plot.png](WEBduBois_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210615_WEBduBois/WEBduBois_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210615_WEBduBois/WEBduBois_plot.png -------------------------------------------------------------------------------- /2021/20210615_WEBduBois/tidytuesday_20210615.R: -------------------------------------------------------------------------------- 1 | # WEB Du Bois challenge tweet locations 2 | # TidyTuesday 2021 week 25 3 | # Rebecca Stevick updated 8/3/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(hrbrthemes) 8 | library(emojifont) 9 | 10 | # Load data ---------------------- 11 | tuesdata <- tidytuesdayR::tt_load('2021-06-15') 12 | tweets <- tuesdata$tweets 13 | 14 | # Analysis and plotting ---------- 15 | ggplot() + 16 | # creat world map 17 | geom_polygon(data=map_data("world"), aes(x = long, y = lat, group = group), 18 | fill = "grey80", color = "gray90", lwd = 0.3) + 19 | # add a blue twitter bird per tweet, with white outline 20 | geom_text(data=tweets, aes(x = long, y = lat), color = "white", 21 | family = 'fontawesome-webfont', label = fontawesome("fa-twitter"), size = 2.5) + 22 | geom_text(data=tweets, aes(x = long, y = lat), color = "dodgerblue", 23 | family = 'fontawesome-webfont', label = fontawesome("fa-twitter"), size = 2) + 24 | # set global theme and fix coordinates 25 | theme_ft_rc() + coord_fixed(1.3) + 26 | # edit theme 27 | theme(plot.title = element_text(size=12), 28 | axis.text.x = element_blank(), axis.text.y = element_blank()) + 29 | # add those labels 30 | labs(x = NULL, y = NULL, 31 | title = "Locations of tweets for the #DuBoisChallenge in 2021", 32 | caption = "data from #DuBoisChallenge tweets | plot by @rjstevick for #TidyTuesday") 33 | 34 | # Saving ------------------------- 35 | ggsave("WEBduBois_plot.png", bg = "transparent", width = 8, height = 5, dpi = 400) 36 | -------------------------------------------------------------------------------- /2021/20210622_PublicParkAccess/PublicParkAccess_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210622_PublicParkAccess/PublicParkAccess_plot.png -------------------------------------------------------------------------------- /2021/20210622_PublicParkAccess/README.md: -------------------------------------------------------------------------------- 1 | ![PublicParkAccess_plot.png](PublicParkAccess_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210622_PublicParkAccess/tidytuesday_20210622.R: -------------------------------------------------------------------------------- 1 | # Public Park Access challenge tweets 2 | # TidyTuesday 2021 week 26 3 | # Rebecca Stevick updated 8/4/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(hrbrthemes) 8 | 9 | # Load data ---------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2021-06-22') 11 | parks <- tuesdata$parks 12 | 13 | # Analysis and plotting ---------- 14 | parks %>% 15 | filter(year == 2020) %>% 16 | filter(pct_near_park_points >75) %>% 17 | ggplot(aes(y=pct_near_park_points, x=reorder(str_wrap(city,10),pct_near_park_points), fill=pct_near_park_points))+ 18 | geom_col(color = "white")+ 19 | coord_polar(clip = "off")+ 20 | scale_y_continuous(limits=c(0,100))+ 21 | scale_fill_viridis_c(option="B", labels = scales::label_percent(scale=1, accuracy=1))+ 22 | theme_modern_rc()+ 23 | theme(plot.title = element_text(hjust = 0.5), plot.caption = element_text(hjust = 0.5), 24 | legend.position = "bottom", axis.text.y = element_blank(), legend.key.width = unit(2, "cm"))+ 25 | # add those labels 26 | labs(title = "Cities with >75% of residents within \na 10-minute walk of a park (2020)", 27 | x = NULL, y = NULL, fill = NULL, 28 | caption = "data from The Trust for Public Land | plot by @rjstevick for #TidyTuesday") 29 | 30 | # Saving ------------------------- 31 | ggsave("PublicParkAccess_plot.png", bg = "transparent", width = 8, height = 10, dpi = 400) 32 | -------------------------------------------------------------------------------- /2021/20210629_AnimalRescues/AnimalRescues_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210629_AnimalRescues/AnimalRescues_plot.png -------------------------------------------------------------------------------- /2021/20210629_AnimalRescues/README.md: -------------------------------------------------------------------------------- 1 | ![AnimalRescues_plot.png](AnimalRescues_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210629_AnimalRescues/tidytuesday_20210629.R: -------------------------------------------------------------------------------- 1 | # London Animal Rescues 2 | # TidyTuesday 2021 week 27 3 | # Rebecca Stevick updated 8/4/2021 4 | 5 | # Load libraries --------------- 6 | library(tidyverse) # for general data manipulation 7 | library(ggtext) # to add colored text to the plot 8 | library(nationalparkcolors) # for discrete color schemes 9 | library(waffle) # for geom_pictogram 10 | library(hrbrthemes) # for the overall theme 11 | library(extrafont) # for loading the pictogram font 12 | loadfonts() # load fonts into the R session (works on Mac, Windows is harder and needs extra steps) 13 | 14 | # Load data ---------------------- 15 | tuesdata <- tidytuesdayR::tt_load('2021-06-29') 16 | animal_rescues <- tuesdata$animal_rescues 17 | 18 | # Analysis and plotting ---------- 19 | animal_rescues %>% 20 | # clean up animal category 21 | mutate(animal_group_parent = case_when(animal_group_parent == "cat" ~ "Cat", 22 | grepl("Unknown", animal_group_parent) ~ "Unknown", 23 | TRUE ~ animal_group_parent)) %>% 24 | # count number of animals per year 25 | group_by(cal_year, animal_group_parent) %>% count() %>% 26 | # filter only animals with more than 10 rescued total 27 | filter(sum(n)>10) %>% 28 | # divide counts by 10 for the waffle 29 | mutate(n10=ceiling(n/10)) %>% ungroup() %>% 30 | ggplot(aes(label=animal_group_parent, values=n10, color=animal_group_parent))+ 31 | geom_pictogram(n_rows = 8, size = 3.5, flip = TRUE, family = "FontAwesome5Free-Solid")+ 32 | # separate plots by month 33 | facet_wrap(.~cal_year, ncol=5)+ 34 | # add pictogram for each animal type 35 | scale_label_pictogram(name = NULL, values = c("crow", "cat", "leaf", "dog", 36 | "certificate", "horse", "tree", "question")) + 37 | # define color palette using nationalparkcolors 38 | scale_color_manual(name = NULL, values = c(rev(park_palette("ChannelIslands", n=6)), "brown", "darkgrey"))+ 39 | # set themes 40 | theme_ipsum(grid="") + theme_enhance_waffle()+ 41 | theme(legend.position = c(0.8,0.15), legend.text = element_text(size = 15, margin = margin(t = 5, b = 15, r = 10)), 42 | panel.spacing = unit(0.2, "lines"), plot.margin = margin(10, 10, 10, 10), 43 | strip.text = element_text(face="bold", size=18), plot.title = element_text(size = 24))+ 44 | # put legend items in 2 columns 45 | guides(label = guide_legend(ncol = 3, override.aes = list(size=8))) + 46 | # add those labels 47 | labs(title = "Most Common Animal Rescues in London, UK", 48 | subtitle = "Each animal represents up to 10 rescues. Cats are the most commonly rescued animal every year", 49 | caption = "data from The London Fire Brigade via london.gov | plot by @rjstevick for #TidyTuesday") 50 | 51 | # Saving ------------------------- 52 | ggsave("AnimalRescues_plot.png", bg = "antiquewhite", width = 11, height = 7, dpi = 400) 53 | -------------------------------------------------------------------------------- /2021/20210706_IndependenceDays/IndependenceDays_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210706_IndependenceDays/IndependenceDays_plot.png -------------------------------------------------------------------------------- /2021/20210706_IndependenceDays/README.md: -------------------------------------------------------------------------------- 1 | ![IndependenceDays_plot.png](IndependenceDays_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210706_IndependenceDays/tidytuesday_20210706.R: -------------------------------------------------------------------------------- 1 | # International Independence Days 2 | # TidyTuesday 2021 week 28 3 | # Rebecca Stevick updated 8/5/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(ggstream) 8 | library(hrbrthemes) 9 | 10 | # Load data ---------------------- 11 | tuesdata <- tidytuesdayR::tt_load('2021-07-06') 12 | holidays <- tuesdata$holidays 13 | 14 | # Analysis and plotting ---------- 15 | holidays %>% 16 | filter(year > 1750) %>% drop_na(year) %>% 17 | # select top 8 countries and group all others into an "Others" category 18 | mutate(independenceother = fct_lump_n(independence_from, 8)) %>% 19 | # count number of countries per year and independence from 20 | group_by(year, independenceother) %>% count() %>% 21 | # start plotting 22 | ggplot(aes(x=year, y=n, fill=independenceother)) + 23 | geom_stream(color = "grey20", lwd = 0.1, alpha = 0.7, bw = 0.2, type = "ridge") + 24 | scale_fill_manual(values = c(PNWColors::pnw_palette("Shuksan", 4), PNWColors::pnw_palette("Lake", 4), "grey")) + 25 | theme_ipsum() + 26 | theme(legend.position = c(0.35,0.8), plot.title = element_text(hjust=0.5), plot.subtitle = element_text(hjust=0.5), 27 | panel.grid.minor = element_blank(), panel.grid.major.y = element_blank()) + 28 | guides(fill = guide_legend(ncol = 3)) + 29 | # add those labels 30 | labs(title = "World Independence Days since 1750", 31 | subtitle = "an overview of when countries celebrate their independence days, and from whom they obtained independence", 32 | fill = "Independence from...", x = NULL, y = "Number of countries per year", 33 | caption = "data from Wikipedia | plot by @rjstevick for #TidyTuesday") 34 | 35 | # Saving ------------------------- 36 | ggsave("IndependenceDays_plot.png", bg = "transparent", width = 9, height = 5, dpi = 400) 37 | -------------------------------------------------------------------------------- /2021/20210713_ScoobyDoo/README.md: -------------------------------------------------------------------------------- 1 | ![ScoobyDoo_plot.png](ScoobyDoo_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210713_ScoobyDoo/ScoobyDoo_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210713_ScoobyDoo/ScoobyDoo_plot.png -------------------------------------------------------------------------------- /2021/20210713_ScoobyDoo/tidytuesday_20210713.R: -------------------------------------------------------------------------------- 1 | # US Scooby Doo 2 | # TidyTuesday 2021 week 29 3 | # Rebecca Stevick updated 8/3/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(hrbrthemes) 8 | 9 | # Load data ---------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2021-07-13') 11 | scoobydoo <- tuesdata$scoobydoo 12 | 13 | # Analysis and plotting ---------- 14 | scoobydoo %>% 15 | # probably the long way to do this... but get all the data organized. 16 | select(index, caught_fred:unmask_scooby) %>% 17 | pivot_longer(caught_fred:caught_scooby, names_to="caught", values_to="valuecaught") %>% 18 | pivot_longer(captured_fred:captured_scooby, names_to="captured", values_to="valuecaptured") %>% 19 | pivot_longer(unmask_fred:unmask_scooby, names_to="unmask", values_to="valuemask") %>% 20 | pivot_longer(c(caught, captured, unmask), names_to="type", values_to="charactername") %>% 21 | pivot_longer(c(valuecaught, valuecaptured, valuemask)) %>% 22 | # make new column with just character name 23 | separate(charactername, into=c("type2", "charactername"), sep="_") %>% 24 | # count number of actions per character 25 | group_by(type, charactername) %>% count(value) %>% filter(value == "TRUE") %>% 26 | # format the names and actions as sentence case 27 | mutate(charactername = str_to_sentence(charactername), 28 | type = str_to_sentence(type)) %>% 29 | # start plotting 30 | ggplot(aes(x=n, y=charactername, fill=charactername))+ 31 | # make a panel per action type 32 | facet_grid(.~type)+ 33 | # add segment for lollipop 34 | geom_segment(aes(x = 0, y = reorder(charactername,-n), xend = n, yend = reorder(charactername,-n)), 35 | color = "bisque2", alpha = 0.6, lwd = 2)+ 36 | # add point at end of lollipop 37 | geom_point(aes(color=charactername), size = 5, alpha = 0.9)+ 38 | # edit color palette 39 | scale_color_manual(values=c("#128a84", "#79af30", "#bb5c37", "#4b0055", "#8e6345"))+ 40 | # change global theme 41 | theme_ipsum()+ 42 | # edit theme 43 | theme(legend.position = "none", panel.grid.major.y = element_blank(), 44 | strip.text = element_text(hjust = 0.5, face = "bold"))+ 45 | # add those labels 46 | labs(x = NULL, y = NULL, 47 | title = "Caught, Captured, Unmasked: \nWho is the best ghost hunter in Mystery Inc?", 48 | subtitle = "Number of times each character was captured, caught the monster, or unmasked the culprit", 49 | caption = "data from Kaggle | plot by @rjstevick for #TidyTuesday") 50 | 51 | # Saving ------------------------- 52 | ggsave("ScoobyDoo_plot.png", bg = "transparent", width = 9, height = 5, dpi = 400) 53 | -------------------------------------------------------------------------------- /2021/20210720_USDroughts/README.md: -------------------------------------------------------------------------------- 1 | ![USDroughts_plot.png](USDroughts_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210720_USDroughts/USDroughts_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210720_USDroughts/USDroughts_plot.png -------------------------------------------------------------------------------- /2021/20210720_USDroughts/tidytuesday_20210720.R: -------------------------------------------------------------------------------- 1 | # US droughts 2 | # TidyTuesday 2021 week 30 3 | # Rebecca Stevick updated 8/5/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(extrafont) 8 | 9 | # Load data ---------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2021-07-20') 11 | drought <- tuesdata$drought 12 | 13 | # Analysis and plotting ---------- 14 | drought %>% 15 | filter(state_abb=="CA") %>% 16 | ggplot(aes(y = area_pct, x=valid_start, fill=drought_lvl))+ 17 | geom_col(position="fill")+ 18 | scale_fill_manual(values=c(PNWColors::pnw_palette("Sunset", 5), "grey80"))+ 19 | scale_y_continuous(labels = scales::label_percent(), expand=c(0,0))+ 20 | scale_x_date(labels = scales::label_date(format="%m/%Y"), breaks = scales::date_breaks("2 years"), expand = c(0,0))+ 21 | theme_minimal()+ 22 | theme(text = element_text(family="Montserrat"), legend.position = c(0.8, 0.14), 23 | legend.background = element_rect(fill = alpha("white", 0.5), color = "transparent"), 24 | plot.title = element_text(face = "bold", size = 24, family = "Montserrat Black", 25 | vjust = -10, hjust = 0.1, color = "white"), 26 | axis.title.y = element_text(hjust=1))+ 27 | guides(fill = guide_legend(nrow = 1)) + 28 | # add those labels 29 | labs(title = "Calfornia drought status since 2001", 30 | x = NULL, y = "Percent of state per category", fill = "Drought Category", 31 | caption = "data from U.S. Drought Monitor | plot by @rjstevick for #TidyTuesday") 32 | 33 | # Saving ------------------------- 34 | ggsave("USDroughts_plot.png", bg = "transparent", width = 11, height = 5, dpi = 400) 35 | -------------------------------------------------------------------------------- /2021/20210727_OlympicMedals/OlympicMedals_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210727_OlympicMedals/OlympicMedals_plot.png -------------------------------------------------------------------------------- /2021/20210727_OlympicMedals/README.md: -------------------------------------------------------------------------------- 1 | ![OlympicMedals_plot.png](OlympicMedals_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210727_OlympicMedals/tidytuesday_20210727.R: -------------------------------------------------------------------------------- 1 | # Olympic Medals 2 | # TidyTuesday 2021 week 31 3 | # Rebecca Stevick updated 7/27/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(ggtext) 8 | 9 | # Load data ---------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2021-07-27') 11 | olympics <- tuesdata$olympics 12 | 13 | # Analysis and plotting ---------- 14 | olympics %>% 15 | # filter only USA data since 1999 16 | filter(noc=="USA" & year > 1999) %>% 17 | # count number of each medal type per season/year 18 | group_by(year, season, medal) %>% drop_na(medal) %>% count() %>% 19 | # reorder the medal category 20 | mutate(medal=factor(medal, levels=c("Gold", "Silver", "Bronze"))) %>% 21 | # start plotting, make a panel per season/year 22 | ggplot() + facet_grid(season~year)+ 23 | # add barplot 24 | geom_col(aes(y=n, x=1, fill=medal), position="fill", color="white")+ 25 | # add year to the center of the barplot 26 | geom_text(aes(x=-3, y=0, label=year, color=season), size=10)+ 27 | # turn into donut plot 28 | coord_polar(theta="y", clip="off") + xlim(c(-3, 2))+ 29 | # define colors for rings and years 30 | scale_fill_manual(values = c("#c9b037", "#b4b4b4", "#ad8a56"))+ 31 | scale_color_manual(values=c("coral2", "navy"))+ 32 | # add global theme 33 | theme_void()+ 34 | # edit theme 35 | theme(text = element_text(family = "Avenir"), strip.text = element_blank(), 36 | # change panel spacing so the rings overlap 37 | panel.spacing = unit(-8, "lines"), 38 | legend.position = "none", plot.title = element_text(hjust=0.5, size=28), 39 | plot.subtitle = element_markdown(lineheight=1.4, hjust=0.5), 40 | plot.caption = element_text(hjust=0.5))+ 41 | # add those labels 42 | labs(title = "USA Olympic Medals", 43 | subtitle = "Each ring shows the percent of each medal type earned per **SUMMER** or **WINTER** olympic games since 2000.
44 | Most medals earned at the summer games are **GOLD**, and **SILVER** is the most commonly earned medal at the winter games.", 45 | caption = "data from Kaggle | plot by @rjstevick for #TidyTuesday") 46 | 47 | # Saving ------------------------- 48 | ggsave("OlympicMedals_plot.png", bg = "transparent", width = 10, height = 6, dpi = 400) 49 | -------------------------------------------------------------------------------- /2021/20210803_ParalympicMedals/ParalympicMedals_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210803_ParalympicMedals/ParalympicMedals_plot.png -------------------------------------------------------------------------------- /2021/20210803_ParalympicMedals/README.md: -------------------------------------------------------------------------------- 1 | ![ParalympicMedals_plot.png](ParalympicMedals_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210803_ParalympicMedals/tidytuesday_20210803.R: -------------------------------------------------------------------------------- 1 | # Paralympic Medals 2 | # TidyTuesday 2021 week 32 3 | # Rebecca Stevick updated 8/3/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(ggtext) 8 | library(hrbrthemes) 9 | library(waffle) 10 | library(extrafont) 11 | loadfonts() 12 | 13 | # Load data ---------------------- 14 | tuesdata <- tidytuesdayR::tt_load('2021-08-03') 15 | athletes <- tuesdata$athletes 16 | 17 | # Analysis and plotting ---------- 18 | athletes %>% 19 | # filter only USA data since 1999 20 | filter(abb=="USA") %>% 21 | # count each medal type per year 22 | group_by(medal, year) %>% drop_na(medal) %>% count() %>% 23 | # reorder the medal as a factor 24 | mutate(medal=factor(medal, levels=c("Gold", "Silver", "Bronze"))) %>% 25 | # divide counts by 5 for the waffle 26 | mutate(n5=ceiling(n/5)) %>% ungroup() %>% 27 | # start plotting 28 | ggplot(aes(values=n5, color=medal, label=medal))+ 29 | # add pictograms 30 | geom_pictogram(n_rows = 6, size = 3.5, flip = TRUE, family = "FontAwesome5Free-Solid") + 31 | # make a panel per year 32 | facet_grid(~year, switch="x")+ 33 | # define color and pictogram icon 34 | scale_color_manual(values = c("#c9b037", "#b4b4b4", "#ad8a56"))+ 35 | scale_label_pictogram(values = c("medal", "medal", "medal")) + 36 | # change global theme 37 | theme_ipsum(grid="") + theme_enhance_waffle()+ 38 | # edit theme 39 | theme(legend.position="none", panel.grid.major.x = element_blank(), 40 | plot.subtitle = element_markdown(lineheight=1.1), plot.title = element_text(size=22), 41 | panel.spacing.x = unit(-0.01, "lines"), strip.text=element_text(face="bold", size=18))+ 42 | # add those labels 43 | labs(title = "USA Paralympic Medals", 44 | subtitle = "Number of **GOLD**, **SILVER**, and 45 | **BRONZE** medals earned at each paralympic games since 1980. Each medal icon represents 5 medals.", 46 | x = NULL, y = "Number of medals", 47 | caption = "data from International Paralympic Committee | plot by @rjstevick for #TidyTuesday") 48 | 49 | # Saving ------------------------- 50 | ggsave("ParalympicMedals_plot.png", bg = "transparent", width = 10, height = 5, dpi = 400) 51 | 52 | -------------------------------------------------------------------------------- /2021/20210810_BEAInfrastructure/BEAInfrastructure_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210810_BEAInfrastructure/BEAInfrastructure_plot.png -------------------------------------------------------------------------------- /2021/20210810_BEAInfrastructure/README.md: -------------------------------------------------------------------------------- 1 | ![BEAInfrastructure_plot.png](BEAInfrastructure_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210810_BEAInfrastructure/tidytuesday_20210810.R: -------------------------------------------------------------------------------- 1 | # BEA Infrastructure Investment 2 | # TidyTuesday 2021 week 33 3 | # Rebecca Stevick updated 8/17/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(ggstream) 8 | 9 | # Load data ---------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2021-08-10') 11 | investment <- tuesdata$investment 12 | 13 | # Analysis and plotting ---------- 14 | investment %>% 15 | filter(meta_cat=="Transportation" & 16 | category %in% c("Highways and streets", "Air transportation", "Water transportation", 17 | "Rail transportation", "Transit") & 18 | gross_inv > 0) -> cleaninvest 19 | 20 | # plotting 21 | ggplot()+ 22 | geom_area(data=cleaninvest, aes(x=year, y=gross_inv, fill=reorder(category, -gross_inv)), 23 | alpha = 0.7, color = "white", position="fill")+ 24 | geom_text(aes(x=c(2015, 1986, 2002, 1955, 2003.5), y=c(0.8, 0.25, .15, .1, .02), 25 | label=c("Highways and streets", "Transit", "Air", "Rail", "Water")), 26 | color=c("black","black","black","black","grey80"), 27 | hjust=1, family="Copperplate", size=5)+ 28 | scale_x_continuous(expand=c(0,0))+ 29 | scale_y_continuous(expand=c(0,0), labels = scales::label_percent())+ 30 | scale_fill_manual(values=wesanderson::wes_palette("Darjeeling2", 5))+ 31 | theme_void()+ 32 | theme(text = element_text(family = "Copperplate"), 33 | axis.text.y = element_text(inherit.blank = FALSE, size=12, hjust=1), 34 | axis.text.x = element_text(inherit.blank = FALSE, size=16), 35 | panel.grid.major.y = element_line(inherit.blank = FALSE), 36 | plot.title = element_text(hjust=0.5, size=24), 37 | plot.subtitle = element_text(hjust=0.5), 38 | legend.position = "none")+ 39 | # add those labels 40 | labs(title = "Transportation Investments in the US since 1960", 41 | subtitle = "Rail transportation investments decreased in 1960, and were replaced by transit and air transportation. \n", 42 | fill = NULL, 43 | caption = "data from Bureau of Economic Analysis | plot by @rjstevick for #TidyTuesday") 44 | 45 | # Saving ------------------------- 46 | ggsave("BEAInfrastructure_plot.png", bg = "transparent", width = 9, height = 4, dpi = 400) 47 | -------------------------------------------------------------------------------- /2021/20210817_StarTrekVoice/README.md: -------------------------------------------------------------------------------- 1 | ![StarTrekVoice_plot.png](StarTrekVoice_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210817_StarTrekVoice/StarTrekVoice_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjstevick/TidyTuesday/5d79327785171be6d56b11fd6b2893451b44ebe3/2021/20210817_StarTrekVoice/StarTrekVoice_plot.png -------------------------------------------------------------------------------- /2021/20210817_StarTrekVoice/tidytuesday_20210817.R: -------------------------------------------------------------------------------- 1 | # Star Trek Voice Commands 2 | # TidyTuesday 2021 week 34 3 | # Rebecca Stevick updated 8/17/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | library(tidytext) 8 | library(ggtext) 9 | 10 | # Load data ---------------------- 11 | tuesdata <- tidytuesdayR::tt_load('2021-08-17') 12 | computer <- tuesdata$computer 13 | 14 | # Analysis and plotting ---------- 15 | computer %>% 16 | # separate each interaction by word 17 | unnest_tokens(word, interaction) %>% 18 | # group by word and remove stop words 19 | group_by(word, char_type) %>% anti_join(stop_words) %>% 20 | # count number of times each word occurs, then select just the top 10 21 | count(sort=TRUE) %>% group_by(char_type) %>% slice_max(n=10, order_by=n) %>% 22 | # start plotting 23 | ggplot() + 24 | # make a panel per computer or person 25 | facet_grid(.~char_type)+ 26 | # add bars and text 27 | geom_col(aes(x=reorder(word,n), y=n, fill=char_type)) + 28 | geom_text(aes(x=reorder(word,n), label=word, y=n, color=char_type), 29 | family="Andale Mono", size=6, hjust=0) + 30 | # add line at 0 31 | geom_hline(yintercept=0, color="white", lwd=2)+ 32 | # change color scheme 33 | scale_fill_manual(values=c("cyan", "green1"))+ 34 | scale_color_manual(values=c("cyan", "green1"))+ 35 | # switch axes and add theme 36 | coord_flip() + theme_minimal() + 37 | scale_y_continuous(limits=c(0,1300), breaks = c(0, 400, 800, 1200))+ 38 | # edit the theme 39 | theme(axis.text.y = element_blank(), axis.text.x = element_text(color="white"), 40 | axis.title.x=element_text(hjust=1), legend.position="none", 41 | panel.grid.minor = element_blank(), panel.grid.major.y = element_blank(), 42 | panel.grid.major.x = element_line(color="grey50"), 43 | text = element_text(family="Silom", color="grey70"), 44 | plot.background = element_rect(fill="grey15"), 45 | strip.text = element_blank(), 46 | plot.caption = element_text(color="grey40"), 47 | plot.title = element_markdown(halign=1, hjust=1, size=18, color="grey40"))+ 48 | # add those labels 49 | labs(y="Number of times word was said", x=NULL, 50 | title="**Star Trek:** Commands
51 | Most common words used in voice commands by a **computer** or **person**", 52 | caption = "data from SpeechInteraction.org | plot by @rjstevick for #TidyTuesday") 53 | 54 | # Saving ------------------------- 55 | ggsave("StarTrekVoice_plot.png", width = 10, height = 6, dpi = 400) 56 | -------------------------------------------------------------------------------- /2021/20210824_Lemurs/README.md: -------------------------------------------------------------------------------- 1 | ![Lemurs_plot.png](Lemurs_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210824_Lemurs/tidytuesday_20210824.R: -------------------------------------------------------------------------------- 1 | # Lemurs 2 | # TidyTuesday 2021 week 35 3 | # Rebecca Stevick updated 8/24/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | 8 | 9 | # Load data ---------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2021-08-24') 11 | lemurs <- tuesdata$lemurs 12 | 13 | # Analysis and plotting ---------- 14 | lemurs %>% 15 | 16 | 17 | 18 | # add those labels 19 | labs( 20 | caption = "data from Duke Lemur Center Data via Kaggle | plot by @rjstevick for #TidyTuesday") 21 | 22 | # Saving ------------------------- 23 | ggsave("Lemurs_plot.png", width = 10, height = 6, dpi = 400) 24 | -------------------------------------------------------------------------------- /2021/20210831_BirdBaths/README.md: -------------------------------------------------------------------------------- 1 | ![BirdBaths_plot.png](BirdBaths_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210831_BirdBaths/tidytuesday_20210831.R: -------------------------------------------------------------------------------- 1 | # Lemurs 2 | # TidyTuesday 2021 week 36 3 | # Rebecca Stevick updated 8/31/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | 8 | 9 | # Load data ---------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2021-08-31') 11 | bird_baths <- tuesdata$bird_baths 12 | 13 | # Analysis and plotting ---------- 14 | bird_baths %>% 15 | 16 | 17 | 18 | # add those labels 19 | labs( 20 | caption = "data from Cleary et al. 2016 | plot by @rjstevick for #TidyTuesday") 21 | 22 | # Saving ------------------------- 23 | ggsave("BirdBaths_plot.png", width = 10, height = 6, dpi = 400) 24 | -------------------------------------------------------------------------------- /2021/20210907_Formula1Races/README.md: -------------------------------------------------------------------------------- 1 | ![Formula1Races_plot.png](Formula1Races_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210907_Formula1Races/tidytuesday_20210907.R: -------------------------------------------------------------------------------- 1 | # Formula 1 Races 2 | # TidyTuesday 2021 week 37 3 | # Rebecca Stevick updated 9/16/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | 8 | 9 | # Load data ---------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2021-09-07') 11 | circuits <- tuesdata$circuits 12 | races <- tuesdata$races 13 | results <- tuesdata$results 14 | drivers <- tuesdata$drivers 15 | 16 | # Analysis and plotting ---------- 17 | circuits %>% 18 | 19 | 20 | 21 | # add those labels 22 | labs( 23 | caption = "data from Ergast API | plot by @rjstevick for #TidyTuesday") 24 | 25 | # Saving ------------------------- 26 | ggsave("Formula1Races_plot.png", width = 10, height = 6, dpi = 400) 27 | -------------------------------------------------------------------------------- /2021/20210914_BillboardTop100/README.md: -------------------------------------------------------------------------------- 1 | ![BillboardTop100_plot.png](BillboardTop100_plot.png) 2 | -------------------------------------------------------------------------------- /2021/20210914_BillboardTop100/tidytuesday_20210914.R: -------------------------------------------------------------------------------- 1 | # Billboard Top 100 2 | # TidyTuesday 2021 week 38 3 | # Rebecca Stevick updated 9/16/2021 4 | 5 | # Load libraries ----------------- 6 | library(tidyverse) 7 | 8 | 9 | # Load data ---------------------- 10 | tuesdata <- tidytuesdayR::tt_load('2021-09-14') 11 | billboard <- tuesdata$billboard 12 | 13 | # Analysis and plotting ---------- 14 | billboard %>% 15 | 16 | 17 | 18 | # add those labels 19 | labs( 20 | caption = "data from Data.World via Billboard.com & Spotify | plot by @rjstevick for #TidyTuesday") 21 | 22 | # Saving ------------------------- 23 | ggsave("BillboardTop100_plot.png", width = 10, height = 6, dpi = 400) 24 | --------------------------------------------------------------------------------