class: logo-slide --- class: title-slide ## Visualizing in the Tidyverse ### Applications of Data Science - Class 4 ### Giora Simchoni #### `gsimchoni@gmail.com and add #dsapps in subject` ### Stat. and OR Department, TAU ### 2019-12-15 --- layout: true <div class="my-footer"> <span> <a href="https://dsapps-2020.github.io/Class_Slides/" target="_blank">Applications of Data Science </a> </span> </div> --- class: section-slide # Welcome to `ggplot2` #### Heavily inspired by datascienceinabox.org / @minebocek --- ## `ggplot()` - **ggplot2** is tidyverse's data visualization package - The `gg` in "ggplot2" stands for Grammar of Graphics - It is inspired by the book [Grammar of Graphics](https://www.springer.com/gp/book/9780387245447) by Leland Wilkinson - A grammar of graphics is a tool that enables us to concisely describe the components of a graphic <center><img src = "images/grammar-of-graphics.png" style="width: 50%"></center> --- ### Remember the Force, Luke! ```r sw_tables <- read_rds("../data/sw_tables.rds") characters <- sw_tables$characters planets <- sw_tables$planets films <- sw_tables$films glimpse(characters) ``` ``` ## Observations: 173 ## Variables: 14 ## $ character_id <int> 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3... ## $ name <chr> "Luke Skywalker", "Luke Skywalker", "Luke Skywalk... ## $ gender <chr> "male", "male", "male", "male", "male", NA, NA, N... ## $ homeworld_id <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 8, 8, 8, 8, 8, 8... ## $ height <dbl> 172, 172, 172, 172, 172, 167, 167, 167, 167, 167,... ## $ mass <dbl> 77, 77, 77, 77, 77, 75, 75, 75, 75, 75, 75, 32, 3... ## $ hair_color <chr> "blond", "blond", "blond", "blond", "blond", NA, ... ## $ skin_color <chr> "fair", "fair", "fair", "fair", "fair", "gold", "... ## $ eye_color <chr> "blue", "blue", "blue", "blue", "blue", "yellow",... ## $ birth_year <dbl> 19.0, 19.0, 19.0, 19.0, 19.0, 112.0, 112.0, 112.0... ## $ film_id <dbl> 1, 2, 3, 6, 7, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6... ## $ species <list> ["http://swapi.co/api/species/1/", "http://swapi... ## $ vehicles <list> [<"http://swapi.co/api/vehicles/14/", "http://sw... ## $ starships <list> [<"http://swapi.co/api/starships/12/", "http://s... ``` --- What are the functions doing the plotting? What is the dataset being plotted? Which variable is on the x-axis and which variable is on the y-axis? What does the warning mean? ```r ggplot(data = characters, mapping = aes(x = height, y = mass)) + geom_point() + labs(title = "Mass vs. Height of Starwars characters", x = "Height (cm)", y = "Weight (kg)") ``` <pre style="color: red;"><code>## Warning: Removed 36 rows containing missing values (geom_point). </code></pre><img src="images/Mass-Height1-1.png" width="70%" /> --- What does `geom_smooth()` do? What else changed between the previous plot and this one? ```r ggplot(data = characters, mapping = aes(x = height, y = mass)) + geom_point() + * geom_smooth() + labs(title = "Mass vs. Height of Starwars characters", x = "Height (cm)", y = "Weight (kg)") ``` <img src="images/Mass-Height2-1.png" width="70%" /> --- ## Who dis! - `ggplot()` is the main function in ggplot2 and plots are constructed in layers - The structure of the code for plots can often be summarized as ```r ggplot + geom_xxx ``` or, more precisely ```r ggplot(data = [dataset], mapping = aes(x = [x-variable], y = [y-variable])) + geom_xxx() + other options ``` - To use ggplot2 functions, first load tidyverse ```r library(tidyverse) ``` - For help with the ggplot2, see [ggplot2.tidyverse.org](http://ggplot2.tidyverse.org/) --- ## Mass vs. Height ```r ggplot(characters, aes(height, mass)) + geom_point() ``` <img src="images/Ggplot2-1.png" width="70%" /> How would you describe this relationship? What other variables would help us understand data points that don't follow the overall trend? Who is the not so tall but really chubby character? --- ## Jabba! <img src = "images/JabbaPlot-1.png" style="width: 90%"> --- ### But seriously, Luke <center><img src = "images/luke-skywalker.png" style="width: 90%"></center> --- ## Additional variables We can map additional variables to various features of the plot: - aesthetics - shape - colour - size - alpha (transparency) - faceting: small multiples displaying different subsets --- class: section-slide # Aesthetics --- ## Aesthetics options Visual characteristics of plotting characters that can be **mapped to a specific variable** in the data are - `color` - `fill` - `size` - `shape` - `alpha` (transparency) --- ### Mass vs. Height + Gender ```r ggplot(data = characters, mapping = aes(x = height, y = mass, color = gender)) + geom_point() ``` <img src="images/Ggplot3-1.png" width="70%" /> --- ### Mass vs. Height + Gender + Birth Year Let's map the size to `birth_year`: ```r ggplot(data = characters, mapping = aes(x = height, y = mass, color = gender, * size = birth_year)) + geom_point() ``` <img src="images/Aes1-1.png" width="70%" /> --- ### Mass vs. Height + Gender Let's now increase the size of all points **not** based on the values of a variable in the data: ```r ggplot(data = characters, mapping = aes(x = height, y = mass, color = gender)) + * geom_point(size = 2) ``` <img src="images/Aes2-1.png" width="70%" /> --- ## Aesthetics Summary - Continuous variable are measured on a continuous scale - Discrete variables are measured (or often counted) on a discrete scale aesthetics | discrete | continuous ------------- | ------------------------ | ------------ color | rainbow of colors | gradient size | discrete steps | linear mapping between radius and value shape | different shape for each | shouldn't (and doesn't) work - Use aesthetics for mapping features of a plot to a variable, define the features in the geom for customization **not** mapped to a variable --- class: section-slide # Faceting --- ### Faceting options - Smaller plots that display different subsets of the data - Useful for exploring conditional relationships and large data ```r ggplot(data = characters, mapping = aes(x = height, y = mass)) + * facet_grid(. ~ gender) + geom_point() + labs(title = "Mass vs. Height of Starwars characters", * subtitle = "Faceted by Gender", x = "Height (cm)", y = "Weight (kg)") ``` <img src="images/Facet1-1.png" width="100%" /> --- ### Many ways to facet ```r ggplot(data = characters, mapping = aes(x = height, y = mass)) + geom_point() + facet_grid(gender ~ .) ``` <img src="images/Facet2-1.png" width="50%" /> --- ```r ggplot(data = characters, mapping = aes(x = height, y = mass)) + geom_point() + facet_wrap(. ~ gender, scales = "free") ``` <img src="images/Facet3-1.png" width="100%" /> --- ```r ggplot(data = characters, mapping = aes(x = height, y = mass)) + geom_point() + facet_wrap(~ eye_color) ``` <img src="images/Facet4-1.png" width="60%" /> --- ## Facet summary - `facet_grid()`: - 2d grid - `rows ~ cols` - use `.` for no split - `facet_wrap()`: 1d ribbon wrapped into 2d --- class: section-slide # Take Control --- ```r okcupid_lgbt_relig <- okcupid %>% group_by(religion2) %>% summarise(pct_lgbt = mean(orientation %in% c("gay", "bisexual"))) %>% mutate(religion = fct_reorder(religion2, desc(pct_lgbt))) okcupid_lgbt_relig ``` ``` ## # A tibble: 7 x 3 ## religion2 pct_lgbt religion ## <chr> <dbl> <fct> ## 1 atheist 0.152 atheist ## 2 buddhist 0.210 buddhist ## 3 christian 0.0974 christian ## 4 hindu 0.0778 hindu ## 5 jewish 0.117 jewish ## 6 muslim 0.101 muslim ## 7 NA 0.146 NA ``` --- ```r okcupid_lgbt_relig %>% ggplot(aes(religion, pct_lgbt)) + geom_bar(stat="identity") ``` <img src="images/Control2-1.png" width="60%" /> .font80percent[Meh.] --- ## Pimp my plot ```r p <- ggplot(okcupid_lgbt_relig, aes(religion, pct_lgbt)) + geom_bar(stat="identity", fill="#f68060", alpha=.6, width=.4) + labs(x = "", y = "", title = "OkCupid: %Reported LGBTQ+ by Religion") + theme(text = element_text(size = 14, color = "#163f59", family = "mono"), axis.text.y = element_text(size = 14)) + scale_y_continuous(breaks = seq(0.05, 0.2, 0.05), labels=scales::percent_format(accuracy = 1)) + coord_flip() p ``` --- ## Pimp my plot <img src="images/Control4-1.png" width="100%" /> --- ## Annotate, Add lines ```r p + geom_hline(yintercept = 0.139, lty = 2, color = "#163f59") + annotate("text", x = 5, y = 0.139 + 0.03, label = "Overall %", color = "#163f59", family = "mono") + annotate(geom = "curve", x = 5, y = 0.15, xend = 4, yend = 0.139 + 0.001, curvature = .3, arrow = arrow(length = unit(2, "mm")), color = "#163f59") ``` <img src="images/Control5-1.png" width="90%" /> --- class: section-slide # Themes --- ```r p + theme_classic() ``` <img src="images/Themes1-1.png" width="100%" /> --- ```r p + theme_light() ``` <img src="images/Themes2-1.png" width="100%" /> --- ```r p + theme_dark() ``` <img src="images/Themes3-1.png" width="100%" /> --- ```r p + theme_linedraw() ``` <img src="images/Themes4-1.png" width="100%" /> --- ```r library(tvthemes) # import_simpsons() extrafont::loadfonts(device="win") p + theme_simpsons(title.font = "Akbar", text.font = "Akbar", axis.text.size = 12) ``` <img src="images/Themes5-1.png" width="100%" /> --- ```r ggplot(okcupid_lgbt_relig, aes(religion, pct_lgbt)) + geom_bar(aes(fill = pct_lgbt), stat="identity", alpha=.6, width=.4) + labs(x = "", y = "", title = "This was supposed to be GoT...") + scale_y_continuous(breaks = seq(0.05, 0.2, 0.05), labels=scales::percent_format(accuracy = 1)) + coord_flip() + scale_fill_westeros(palette = "Tyrell", type = "continuous") + theme_minimal() + theme(text = element_text(family = "Cinzel", size = 12), title = element_text(family = "Cinzel", size = 14)) + guides(fill=FALSE) ``` <img src="images/Themes6-1.png" width="100%" /> --- class: section-slide # Common Plots à la GG --- ## Line Plot ```r library(hrbrthemes) characters %>% group_by(film_id) %>% summarise(n_char = n_distinct(character_id)) %>% ggplot(aes(film_id, n_char)) + * geom_line(lwd = 2) + labs(x = "", y = "No. of Characters", title = "Star Wars Films No. of Unique Characters") + scale_x_continuous(breaks = 1:7, labels = films$title) + theme_ipsum() + theme(axis.text.x = element_text(angle = 45, hjust = 1)) ``` --- <img src="images/Line2-1.png" width="100%" /> --- ## Histogram ```r library(scales) sex_names <- list( "m" = "men", "f" = "women" ) sex_labeller <- function(variable, value){ return(sex_names[value]) } p2 <- okcupid %>% ggplot(aes(income)) + facet_wrap(. ~ sex, labeller = sex_labeller) + scale_x_log10(breaks = trans_breaks("log10", function(x) 10^x), labels = trans_format("log10", math_format(10^.x))) + labs(x = "", y = "", title = "OkCupid: Annual Income Dist. by Gender", caption = "Income is presented as log10(Income)") + theme_ipsum() *p2 + geom_histogram() ``` --- <img src="images/Hist2-1.png" width="100%" /> --- ## Density Plot ```r p2 + geom_density() ``` <img src="images/Dens-1.png" width="100%" /> --- ## Box Plot ```r p3 <- okcupid %>% sample_n(5000) %>% ggplot(aes(sex, income)) + scale_y_log10(breaks = trans_breaks("log10", function(x) 10^x), labels = trans_format("log10", math_format(10^.x))) + labs(x = "", y = "", title = "OkCupid: Annual Income Dist. by Gender", caption = "Income is presented as log10(Income)") + scale_x_discrete(labels = c("women", "men")) + theme_ipsum() *p3 + geom_boxplot() ``` --- <img src="images/Boxplot1-1.png" width="80%" /> --- ## Violin Plot ```r p3 + geom_violin(fill = "darkgreen", alpha = 0.6) ``` <img src="images/Violin-1.png" width="80%" /> --- ## Swarm Plot ```r p3 + ggbeeswarm::geom_quasirandom(aes(color = sex)) + guides(color=FALSE) ``` <img src="images/Swarm-1.png" width="80%" /> --- ## Bar Plot ```r p + theme_ipsum() ``` <img src="images/Bar-1.png" width="100%" /> --- ## Segmented Bar Plots: Counts ```r p4 <- ggplot( okcupid %>% mutate(orientation = recode(orientation, "gay" = "lgbt", "bisexual" = "lgbt"), religion = fct_relevel(religion2, count(okcupid, religion2, sort = TRUE)$religion2)), aes(religion, fill = orientation) ) + labs(x = "", y = "", title = "OkCupid: Orientation by Religion") + scale_y_continuous(breaks = seq(0, 25000, 5000)) + coord_flip() + theme_ipsum() + theme(text = element_text(size = 14)) ``` --- ```r p4 + geom_bar(alpha=.6, width=.4) ``` <img src="images/Bar-Segmented2-1.png" width="100%" /> --- ## Segmented Bar Plots: Proportions ```r p4 + geom_bar(position = "fill", alpha=.6, width=.4) ``` <img src="images/Bar-Segmented3-1.png" width="100%" /> .font80percent[ Hoping you can see why this is worse than our original plot. ] --- ## Mosaic Plots ```r library(ggmosaic) okcupid %>% mutate(orientation = recode(orientation, "gay" = "lgbt", "bisexual" = "lgbt"), religion = fct_relevel(religion2, count(okcupid, religion2, sort = TRUE)$religion2)) %>% ggplot() + * geom_mosaic(aes(x = product(orientation, religion), fill=orientation)) + labs(x = "", y = "", title = "OkCupid: Orientation by Religion") + guides(fill=FALSE) + theme_ipsum() + theme(axis.text.y = element_text(size = 14), axis.text.x = element_text(angle = 90, vjust = 0.5, size = 12)) ``` --- <img src="images/Mosaic2-1.png" width="100%" /> --- ## Radar Chart ```r okcupid %>% group_by(religion2) %>% summarise(drugs = mean(drugs %in% c("sometimes", "often"), na.rm = TRUE), smokes = mean(smokes == "yes", na.rm = TRUE), overweight = mean(body_type == "overweight", na.rm = TRUE), drinks = mean(drinks %in% c("often", "very often", "desperately")) ) -> okcupid_radar okcupid_radar ``` ``` ## # A tibble: 7 x 5 ## religion2 drugs smokes overweight drinks ## <chr> <dbl> <dbl> <dbl> <dbl> ## 1 atheist 0.201 0.0473 0.0110 0.141 ## 2 buddhist 0.160 0.0302 0.00494 0.0775 ## 3 christian 0.0649 0.0352 0.00994 0.0759 ## 4 hindu 0.0733 0.0236 0.00725 0.0689 ## 5 jewish 0.128 0.0197 0.00467 0.0607 ## 6 muslim 0.180 0.136 0.0155 0.115 ## 7 NA 0.126 0.0427 0.00634 0.0911 ``` --- ```r library(ggradar) ggradar(okcupid_radar, grid.max = 0.201, grid.mid = 0.10, values.radar = c("0%", "10%", "20%"), plot.title = "OkCupid: Health Indicators by Religion") + theme(plot.title = element_text(size = 18)) ``` <img src="images/Radar3-1.png" width="90%" /> --- ## Sankey Diagram (Alluvial Plot) ```r library(ggalluvial) g7 <- c("canada", "france", "germany", "italy", "japan", "united_kingdom", "united_states_of_america") migration_2019 <- read_rds("../data/migration.rds") %>% pivot_longer(cols = -c(1:4), names_to = "country_orig", values_to = "n_migrants") %>% filter(year == 2019) %>% filter_at(c("country_orig", "country_dest"), ~.x %in% g7) %>% mutate_at(c("country_orig", "country_dest"), ~case_when(.x == "united_kingdom" ~ "uk", .x == "united_states_of_america" ~ "usa", TRUE ~ .x)) %>% group_by(country_orig, country_dest) %>% summarise(n_migrants = sum(n_migrants)) migration_2019 %>% head(4) ``` ``` ## # A tibble: 4 x 3 ## # Groups: country_orig [1] ## country_orig country_dest n_migrants ## <chr> <chr> <dbl> ## 1 canada canada 0 ## 2 canada france 28339 ## 3 canada germany 18211 ## 4 canada italy 25716 ``` --- ```r ggplot(migration_2019, aes(y = n_migrants, axis1 = country_orig, axis2 = country_dest)) + * geom_alluvium(aes(fill = country_orig)) + geom_stratum(width = 1/12, fill = "black", color = "grey") + geom_label(stat = "stratum", infer.label = TRUE) + scale_x_discrete(limits = c("Origin", "Destination"), expand = c(.05, .05)) + scale_fill_brewer(type = "qual", palette = "Set1") + guides(fill = FALSE) + labs(y = "", title = "G7 Cross-Country Migration 2019") + scale_y_comma() + theme_ipsum() ``` --- <img src="images/Sankey3-1.png" width="100%" /> --- ## Heatmap ```r gender_age_height_drink <- okcupid %>% mutate(age_group = case_when( age < 30 ~ "19-29", age < 40 ~ "30-39", age < 50 ~ "40-49", age < 60 ~ "50-59", TRUE ~ "60+"), height_group = case_when( height_cm < 150 ~ "149-", height_cm < 160 ~ "150-159", height_cm < 170 ~ "160-169", height_cm < 180 ~ "170-179", height_cm < 190 ~ "180-189", TRUE ~ "190+")) %>% group_by(sex, age_group, height_group) %>% summarise(n = n(), drinks = mean(drinks %in% c("often", "very often", "desperately"))) ``` --- ```r gender_age_height_drink ``` ``` ## # A tibble: 58 x 5 ## # Groups: sex, age_group [10] ## sex age_group height_group n drinks ## <chr> <chr> <chr> <int> <dbl> ## 1 f 19-29 149- 163 0.0920 ## 2 f 19-29 150-159 1963 0.102 ## 3 f 19-29 160-169 5620 0.110 ## 4 f 19-29 170-179 3113 0.130 ## 5 f 19-29 180-189 310 0.145 ## 6 f 19-29 190+ 19 0.474 ## 7 f 30-39 149- 80 0.0625 ## 8 f 30-39 150-159 1293 0.0673 ## 9 f 30-39 160-169 4109 0.0810 ## 10 f 30-39 170-179 2231 0.0852 ## # ... with 48 more rows ``` --- ```r heat <- ggplot(gender_age_height_drink, aes(age_group, height_group, fill = drinks)) + * geom_tile(aes(text = str_c(percent(drinks, 1), " of ", n, " "))) + facet_wrap(. ~ sex, labeller = sex_labeller) + labs(x = "Age", y = "Height", title = "OkCupid: %Reported Drinking by Age and Height") + scale_fill_gradient(labels = percent_format(accuracy = 1)) + theme_ipsum() heat ``` <img src="images/Heatmap2-1.png" width="100%" /> --- ## An Actual Heat Map ```r clean_country_name <- function(name) { str_replace_all(str_replace_all(str_to_lower(name), " |-", "_"), "'|,|\\(|\\)", "") } world <- as_tibble(map_data("world")) world <- world %>% mutate(region = clean_country_name(region)) ggplot(world %>% left_join(migration_total, "region"), aes(x = long, y = lat, group = group)) + geom_polygon(aes(fill = n_migrants), colour = "white") + scale_fill_gradient(labels = comma, name = "N Migrants", high = "#132B43", low = "#56B1F7") + labs(x = "", y = "", title = "No. of Migrants by Country in 2019") + theme_ipsum() ``` --- <img src="images/Heatmap5-1.png" width="100%" /> --- class: section-slide # Amazing Extensions --- ## `patchwork` ```r library(patchwork) p1 <- ggplot(okcupid %>% filter(between(age, 18, 70))) + geom_density(aes(age, fill = sex)) + labs(y = "") + guides(fill = FALSE) + theme_ipsum() p2 <- ggplot(okcupid %>% filter(between(height_cm, 140, 200))) + geom_density(aes(height_cm, fill = sex)) + labs(y = "") + guides(fill = FALSE) + theme_ipsum() p3 <- ggplot(okcupid) + geom_mosaic(aes(x = product(sex, religion2), fill = sex)) + labs(x = "", y = "") + theme_ipsum() + theme(axis.text.x = element_text(angle = 90)) ``` --- Watch this: ```r (p1 | p2) / p3 ``` <img src="images/Patchwork2-1.png" width="100%" /> --- ## `plotly` Remember those heatmaps? They're now interactive! ```r library(plotly) ggplotly(heat, tooltip = "text") ``` <div id="htmlwidget-598d54a2dde26e34576d" style="width:100%;height:420px;" class="plotly html-widget"></div> <script type="application/json" data-for="htmlwidget-598d54a2dde26e34576d">{"x":{"data":[{"x":[1,2,3,4,5],"y":[1,2,3,4,5,6],"z":[[0.194274028629857,0.131944444444444,0,0.351851851851852,0],[0.215090281315447,0.1420469193091,0.058641975308642,0.085972850678733,0.0608974358974359],[0.232898378805852,0.171087855926016,0.102947550931946,0.0699043414275203,0.053072625698324],[0.2739765142592,0.179789830170825,0.112561963486882,0.0628306878306878,0.0422222222222222],[0.306451612903226,0.240994419076611,0.158333333333333,0.0811965811965812,0.263888888888889],[1,0.791666666666667,0,0,null]],"text":[["9% of 163 ","6% of 80 ","0% of 39 ","17% of 12 ","0% of 9 "],["10% of 1963 ","7% of 1293 ","3% of 432 ","4% of 221 ","3% of 104 "],["11% of 5620 ","8% of 4109 ","5% of 1538 ","3% of 755 ","3% of 358 "],["13% of 3113 ","9% of 2231 ","5% of 919 ","3% of 336 ","2% of 150 "],["15% of 310 ","11% of 219 ","8% of 80 ","4% of 26 ","12% of 8 "],["47% of 19 ","38% of 8 ","0% of 1 ","0% of 1 ",null]],"colorscale":[[0,"#132B43"],[0.0422222222222222,"#16304A"],[0.053072625698324,"#16314B"],[0.058641975308642,"#17324C"],[0.0608974358974359,"#17324D"],[0.0628306878306878,"#17324D"],[0.0699043414275203,"#17334E"],[0.0811965811965812,"#183550"],[0.085972850678733,"#183551"],[0.102947550931946,"#193753"],[0.112561963486882,"#1A3855"],[0.131944444444444,"#1B3B58"],[0.1420469193091,"#1C3C5A"],[0.158333333333333,"#1D3E5D"],[0.171087855926016,"#1D405F"],[0.179789830170825,"#1E4160"],[0.194274028629857,"#1F4263"],[0.215090281315447,"#204566"],[0.232898378805852,"#214769"],[0.240994419076611,"#22486A"],[0.263888888888889,"#234B6E"],[0.2739765142592,"#244C70"],[0.306451612903226,"#265176"],[0.351851851851852,"#29567E"],[0.791666666666667,"#4793CE"],[1,"#56B1F7"]],"type":"heatmap","showscale":false,"autocolorscale":false,"showlegend":false,"xaxis":"x","yaxis":"y","hoverinfo":"text","frame":null},{"x":[1,2,3,4,5],"y":[1,2,3,4,5,6],"z":[[0.714285714285714,1,0,0,null],[0.288461538461538,0.171428571428571,0.428571428571429,0.375,0],[0.268896321070234,0.301354401805869,0.198606271777003,0.205882352941176,0.171428571428571],[0.332834806254249,0.283073367995378,0.257462686567164,0.184251968503937,0.169354838709677],[0.380520016508461,0.355424143556281,0.218091009988901,0.157185628742515,0.152073732718894],[0.390154298310066,0.428571428571429,0.293103448275862,0.290322580645161,0.206896551724138]],"text":[["24% of 21 ","33% of 6 ","0% of 2 ","0% of 3 ",null],["10% of 52 ","6% of 35 ","14% of 14 ","12% of 8 ","0% of 3 "],["9% of 1495 ","10% of 886 ","7% of 287 ","7% of 102 ","6% of 35 "],["11% of 7355 ","9% of 5193 ","9% of 1876 ","6% of 635 ","6% of 248 "],["13% of 7269 ","12% of 4904 ","7% of 1802 ","5% of 668 ","5% of 217 "],["13% of 1361 ","14% of 882 ","10% of 348 ","10% of 93 ","7% of 29 "]],"colorscale":[[0,"#132B43"],[0.152073732718894,"#193854"],[0.157185628742515,"#1A3855"],[0.169354838709677,"#1A3956"],[0.171428571428571,"#1A3956"],[0.184251968503937,"#1B3A58"],[0.198606271777003,"#1B3C59"],[0.205882352941176,"#1C3C5A"],[0.206896551724138,"#1C3C5A"],[0.218091009988901,"#1C3D5C"],[0.257462686567164,"#1E4160"],[0.268896321070234,"#1F4262"],[0.283073367995378,"#1F4363"],[0.288461538461538,"#1F4464"],[0.290322580645161,"#204464"],[0.293103448275862,"#204465"],[0.301354401805869,"#204566"],[0.332834806254249,"#214769"],[0.355424143556281,"#22496C"],[0.375,"#234B6E"],[0.380520016508461,"#244C6F"],[0.390154298310066,"#244D70"],[0.428571428571429,"#265075"],[0.714285714285714,"#336A98"],[1,"#4186BE"]],"type":"heatmap","showscale":false,"autocolorscale":false,"showlegend":false,"xaxis":"x2","yaxis":"y","hoverinfo":"text","frame":null},{"x":[1],"y":[1],"name":"99_6483cd1065baf6b9f5c14655830368b1","type":"scatter","mode":"markers","opacity":0,"hoverinfo":"skip","showlegend":false,"marker":{"color":[0,1],"colorscale":[[0,"#132B43"],[0.0526315789473684,"#16314B"],[0.105263157894737,"#193754"],[0.157894736842105,"#1D3E5C"],[0.210526315789474,"#204465"],[0.263157894736842,"#234B6E"],[0.315789473684211,"#275277"],[0.368421052631579,"#2A5980"],[0.421052631578947,"#2E608A"],[0.473684210526316,"#316793"],[0.526315789473684,"#356E9D"],[0.578947368421053,"#3875A6"],[0.631578947368421,"#3C7CB0"],[0.684210526315789,"#3F83BA"],[0.736842105263158,"#438BC4"],[0.789473684210526,"#4792CE"],[0.842105263157895,"#4B9AD8"],[0.894736842105263,"#4EA2E2"],[0.947368421052632,"#52A9ED"],[1,"#56B1F7"]],"colorbar":{"bgcolor":null,"bordercolor":null,"borderwidth":0,"thickness":23.04,"title":"drinks","titlefont":{"color":"rgba(0,0,0,1)","family":"Arial Narrow","size":15.2760481527605},"tickmode":"array","ticktext":["0%","10%","20%","30%","40%"],"tickvals":[0,0.211111111111111,0.422222222222222,0.633333333333333,0.844444444444445],"tickfont":{"color":"rgba(0,0,0,1)","family":"Arial Narrow","size":12.2208385222084},"ticklen":2,"len":0.5}},"xaxis":"x","yaxis":"y","frame":null}],"layout":{"margin":{"t":122.268161062682,"r":39.8505603985056,"b":97.4678289746783,"l":109.090909090909},"font":{"color":"rgba(0,0,0,1)","family":"Arial Narrow","size":15.2760481527605},"title":{"text":"<b> OkCupid: %Reported Drinking by Age and Height <\/b>","font":{"color":"rgba(0,0,0,1)","family":"Arial Narrow","size":23.9103362391034},"x":0,"xref":"paper"},"xaxis":{"domain":[0,0.458857142857143],"automargin":true,"type":"linear","autorange":false,"range":[0.4,5.6],"tickmode":"array","ticktext":["19-29","30-39","40-49","50-59","60+"],"tickvals":[1,2,3,4,5],"categoryorder":"array","categoryarray":["19-29","30-39","40-49","50-59","60+"],"nticks":null,"ticks":"","tickcolor":null,"ticklen":3.81901203819012,"tickwidth":0,"showticklabels":true,"tickfont":{"color":"rgba(77,77,77,1)","family":"Arial Narrow","size":15.2760481527605},"tickangle":-0,"showline":false,"linecolor":null,"linewidth":0,"showgrid":true,"gridcolor":"rgba(204,204,204,1)","gridwidth":0.265670402656704,"zeroline":false,"anchor":"y","title":"","hoverformat":".2f"},"annotations":[{"text":"Age","x":0.5,"y":-0.0447725790191544,"showarrow":false,"ax":0,"ay":0,"font":{"color":"rgba(0,0,0,1)","family":"Arial Narrow","size":11.9551681195517},"xref":"paper","yref":"paper","textangle":-0,"xanchor":"center","yanchor":"top","annotationType":"axis"},{"text":"Height","x":-0.0677815335349582,"y":0.5,"showarrow":false,"ax":0,"ay":0,"font":{"color":"rgba(0,0,0,1)","family":"Arial Narrow","size":11.9551681195517},"xref":"paper","yref":"paper","textangle":-90,"xanchor":"right","yanchor":"center","annotationType":"axis"},{"text":"list(f = \"women\")","x":0.229428571428571,"y":1,"showarrow":false,"ax":0,"ay":0,"font":{"color":"rgba(26,26,26,1)","family":"Arial Narrow","size":15.9402241594022},"xref":"paper","yref":"paper","textangle":-0,"xanchor":"center","yanchor":"bottom"},{"text":"list(m = \"men\")","x":0.770571428571429,"y":1,"showarrow":false,"ax":0,"ay":0,"font":{"color":"rgba(26,26,26,1)","family":"Arial Narrow","size":15.9402241594022},"xref":"paper","yref":"paper","textangle":-0,"xanchor":"center","yanchor":"bottom"}],"yaxis":{"domain":[0,1],"automargin":true,"type":"linear","autorange":false,"range":[0.4,6.6],"tickmode":"array","ticktext":["149-","150-159","160-169","170-179","180-189","190+"],"tickvals":[1,2,3,4,5,6],"categoryorder":"array","categoryarray":["149-","150-159","160-169","170-179","180-189","190+"],"nticks":null,"ticks":"","tickcolor":null,"ticklen":3.81901203819012,"tickwidth":0,"showticklabels":true,"tickfont":{"color":"rgba(77,77,77,1)","family":"Arial Narrow","size":15.2760481527605},"tickangle":-0,"showline":false,"linecolor":null,"linewidth":0,"showgrid":true,"gridcolor":"rgba(204,204,204,1)","gridwidth":0.265670402656704,"zeroline":false,"anchor":"x","title":"","hoverformat":".2f"},"shapes":[{"type":"rect","fillcolor":null,"line":{"color":null,"width":0,"linetype":[]},"yref":"paper","xref":"paper","x0":0,"x1":0.458857142857143,"y0":0,"y1":1},{"type":"rect","fillcolor":null,"line":{"color":null,"width":0,"linetype":[]},"yref":"paper","xref":"paper","x0":0,"x1":0.458857142857143,"y0":0,"y1":28.1610626816106,"yanchor":1,"ysizemode":"pixel"},{"type":"rect","fillcolor":null,"line":{"color":null,"width":0,"linetype":[]},"yref":"paper","xref":"paper","x0":0.541142857142857,"x1":1,"y0":0,"y1":1},{"type":"rect","fillcolor":null,"line":{"color":null,"width":0,"linetype":[]},"yref":"paper","xref":"paper","x0":0.541142857142857,"x1":1,"y0":0,"y1":28.1610626816106,"yanchor":1,"ysizemode":"pixel"}],"xaxis2":{"type":"linear","autorange":false,"range":[0.4,5.6],"tickmode":"array","ticktext":["19-29","30-39","40-49","50-59","60+"],"tickvals":[1,2,3,4,5],"categoryorder":"array","categoryarray":["19-29","30-39","40-49","50-59","60+"],"nticks":null,"ticks":"","tickcolor":null,"ticklen":3.81901203819012,"tickwidth":0,"showticklabels":true,"tickfont":{"color":"rgba(77,77,77,1)","family":"Arial Narrow","size":15.2760481527605},"tickangle":-0,"showline":false,"linecolor":null,"linewidth":0,"showgrid":true,"domain":[0.541142857142857,1],"gridcolor":"rgba(204,204,204,1)","gridwidth":0.265670402656704,"zeroline":false,"anchor":"y","title":"","hoverformat":".2f"},"showlegend":false,"legend":{"bgcolor":null,"bordercolor":null,"borderwidth":0,"font":{"color":"rgba(0,0,0,1)","family":"Arial Narrow","size":12.2208385222084}},"hovermode":"closest","barmode":"relative"},"config":{"doubleClick":"reset","showSendToCloud":false},"source":"A","attrs":{"465070c871ad":{"text":{},"x":{},"y":{},"fill":{},"type":"heatmap"}},"cur_data":"465070c871ad","visdat":{"465070c871ad":["function (y) ","x"]},"highlight":{"on":"plotly_click","persistent":false,"dynamic":false,"selectize":false,"opacityDim":0.2,"selected":{"opacity":1},"debounce":0},"shinyEvents":["plotly_hover","plotly_click","plotly_selected","plotly_relayout","plotly_brushed","plotly_brushing","plotly_clickannotation","plotly_doubleclick","plotly_deselect","plotly_afterplot"],"base_url":"https://plot.ly"},"evals":[],"jsHooks":[]}</script> --- ## `rayshader` Or rotatable 3D... ```r library(rayshader) plot_gg(heat) ``` <img src = "images/rayshader.png" style="width: 70%"> --- ## `gganimate` Take a plot and make it better: ```r library(gganimate) characters %>% group_by(film_id) %>% summarise(n_char = n_distinct(character_id)) %>% ggplot(aes(film_id, n_char)) + geom_line(lwd = 2) + geom_point(aes(group = seq_along(film_id)), size = 5) + labs(x = "", y = "No. of Characters", title = "No. of Unique Characters: {films$title[frame %/% 15 + 1]}") + scale_x_continuous(breaks = 1:7, labels = films$title) + theme_ipsum() + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + * transition_reveal(along = film_id) + ease_aes("cubic-in-out") ``` --- <img src = "images/gganimate.gif" style="height: 50%"> --- ## `magick` That Jabba Plot was NOT made by Photoshop... ```r library(magick) jabba <- image_read("images/jabba.png") fig <- image_graph(width = 2400, height = 1200, res = 300) ggplot(data = characters, mapping = aes(x = height, y = mass)) + geom_point(size = 1.5) + labs(title = "Mass vs. Height of Starwars characters", x = "Height (cm)", y = "Weight (kg)") fig %>% image_composite(jabba, offset = "+1000+30") ``` <img src="images/JabbaPlot-1.png" width="50%" /> --- ## `tidygraph` + `ggraph` ```r library(tidygraph) characters_2_plus <- characters %>% add_count(name) %>% filter(n > 1) %>% select(name, film_id) %>% mutate(id = group_indices(., name)) # for some reason 1:n ID nodes <- characters_2_plus %>% count(id, name) edges <- characters_2_plus %>% inner_join(characters_2_plus, "film_id") %>% rename(from = id.x, to = id.y) %>% count(from, to) %>% rename(weight = n) %>% filter(from != to) graph <- tbl_graph(nodes = nodes, edges = edges, directed = FALSE) ``` --- ```r library(ggraph) ggraph(graph, layout = "fr") + geom_edge_fan(aes(alpha = weight), show.legend = FALSE) + geom_node_point(aes(size = n), color = "lightblue") + geom_node_label(aes(label = name), color = "blue", repel = TRUE, fill = "white", size = 3) + theme_graph(background = "white") + labs(size = "N Films", title = "Star Wars: Characters Network", caption = "An Edge between two characters means they appeared in the same film \nEdge transparency means how many films") ``` <img src="images/Ggraph-1.png" width="100%" /> --- ## `ggwithimages` ```r library(ggwithimages) annapurna <- png::readPNG(system.file("extdata", "annapurna.png", package = "ggwithimages")) sky <- png::readPNG(system.file("extdata", "sky.png", package = "ggwithimages")) kathmandu_hourly_aqi <- readr::read_csv(system.file("extdata", "kathmandu_hourly_aqi.csv", package = "ggwithimages")) ggplot(kathmandu_hourly_aqi, aes(hour, aqi)) + geom_line_with_image(annapurna, sky) + labs(title = "Air Quality Index in the Thamel, Kathmandu, Nepal", subtitle = "Measured in PM2.5 by the US Embassy in Kathmandu", y = "Hourly Mean AQI [PM2.5]", x = "Hour") + ylim(c(50, 200)) + theme_ipsum() ``` --- <img src="images/Ggwithimages2-1.png" width="100%" /> --- ## `brickr`... ```r library(brickr) okcupid %>% count(religion2) %>% filter(religion2 != "NA") %>% mutate(religion = fct_relevel(religion2, c("atheist", "christian", "jewish", "buddhist", "hindu", "muslim"))) %>% ggplot(aes(religion, n)) + geom_brick_col(aes(fill = religion)) + scale_fill_brick() + coord_brick() + theme_brick() ``` --- .pull-left[ <img src="images/Brickr2-1.png" width="100%" /> ] .pull-right[ And... it can get a lot more fun: <img src = "images/golden_girls.png" style = "width: 100%"> Get the legos you need with `build_instructions()` 🙀 ]