36-315-Lec10

class: inverse, center, middle

# 36-315: Statistical Graphics and Visualization
## Lecture 10

Meghan Hall Department of Statistics & Data Science Carnegie Mellon University June 14, 2021

---
layout: true
<div class="my-footer">cmu-36315.netlify.app</div>
---

# From last time

.large[More details]
 
.medium[colors, fonts, annotations]

.large[Putting it all together with themes]
 
.medium[built-in, external options, custom]

---

# Schedule going forward

.large[Lab 7 tomorrow]
 
.medium[HW 3 due too]

.large[Midterm review lecture on Wednesday]

.large[Midterm on Thursday]
 
.medium[no lab on Thursday *or* lecture on Friday]

.large[HW 4 due *next* Tuesday]

---

# Tips on debugging code

.large[Always code iteratively]
 
.medium[build graphs piece by piece]

.large[Debug that way too]
 
.medium[get down to the minimum chunk that works]

---

# Today

.large[Extensions to `ggplot2`]
 
.medium[in addition to the ones we've already covered]

.large[New plot types *and* new techniques for details]

---

# Already covered

.large[`ggridges`]
 
.medium[building ridgeline plots]
 
.medium[viewing/comparing distributions]
 
 
--
 
.large[`ggbeeswarm`]
 
.medium[beeswarm plots to visualize distributions]
 
.medium["smart" jittering]
 
 
--
 
.large[For details]
 
.medium[`ggtext`, `ggrepel`, `scico`]
 
.medium[`ggthemes`, `ggdark`, `hrbrthemes`]

---

# `ggforce`

.large["Accelerating `ggplot2`"]
 
.medium[[ggforce.data-imaginist.com](https://ggforce.data-imaginist.com/reference/index.html)]
 
 
--
 
.large[`geom_sina`]
 
.medium[keeps jittered points restricted within the violin]

---

# `ggforce`

---

.h1[# `ggforce`]

.tiny[

```r
txhousing %>% 
  filter(year >= 2010) %>% 
  ggplot(aes(x = as.character(year), y = median)) +
  geom_violin(draw_quantiles = c(0.25, 0.5, 0.75)) +
  # replace this
  # geom_jitter(alpha = .25, width = .3, size = 0.5, color = "#bb0000") +
  scale_y_continuous(labels = dollar, breaks = seq(100000, 300000, 50000)) +
  labs(title = "The distribution of median home prices by city in Texas") +
  # with this
* geom_sina(alpha = 0.25, width = .3, size = 0.5, color = "#bb0000") +
  theme(axis.title = element_blank(),
        panel.background = element_blank(),
        panel.grid.major.y = element_line(color = "grey90", size = 0.2),
        panel.border = element_rect(color = "black", fill = NA, size = 0.5),
        axis.ticks = element_blank(),
        axis.text = element_text(size = 10, face = 2),
        plot.title.position = "plot")
```
]

---

# `ggforce`

---

# `ggforce`

.large["Accelerating `ggplot2`"]
 
.medium[[ggforce.data-imaginist.com](https://ggforce.data-imaginist.com/reference/index.html)]
 
 
 
.large[`geom_sina`]
 
.medium[keeps jittered points restricted within the violin]
 
 
 
.large[`geom_mark_circle` (and related `geom`s)]
 
.medium[circle and label points within a group]

---

# `ggforce`

---

.h1[# `ggforce`]

.tiny[

```r
penguins %>% 
  filter(!is.na(body_mass_g) & !is.na(flipper_length_mm) & 
           species != "Chinstrap") %>% 
  ggplot(aes(x = body_mass_g, y = flipper_length_mm)) +
* geom_mark_circle(aes(fill = species, label = species)) +
  geom_point() +
  scale_x_continuous(limits = c(2240, 6500)) +
  scale_y_continuous(limits = c(160, 250)) +
  labs(y = "Flipper Length (mm)",
       x = "Body Mass (g)",
       title = "Gentoo penguins tend to be heavier and have longer flippers",
       caption = "Data from the palmerpenguins package") +
  theme(legend.position = "none",
        panel.background = element_blank(),
        panel.grid.major = element_line(color = "grey90", size = 0.2),
        axis.ticks = element_line(color = "grey90", size = 0.2),
        legend.key = element_rect(fill = "transparent"))
```
]

---

# `ggforce`

---

# `ggwaffle`

.large[For waffle charts]
 
.medium[[https://liamgilbey.github.io/ggwaffle/](https://liamgilbey.github.io/ggwaffle/)]
 
 
 
.large[Another option for showing parts of a whole]
 
.medium[when overall *n* and # of categories is small]
 
 
 
.large[`waffle_iron` to get data prepped]
 
 
 
.large[`geom_waffle` and `theme_waffle` to make the plot]

---

# `ggwaffle`

```r
penguins$species <- 
 as.character(penguins$species)

penguin_waffle <- 
 waffle_iron(penguins, aes_d(group = species))
```

<table class="table" style="font-size: 16px; width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
 <tr>
 <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> y </th>
 <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> x </th>
 <th style="text-align:left;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> group </th>
 </tr>
 </thead>
<tbody>
 <tr>
 <td style="text-align:right;"> 1 </td>
 <td style="text-align:right;"> 1 </td>
 <td style="text-align:left;"> Adelie </td>
 </tr>
 <tr>
 <td style="text-align:right;"> 2 </td>
 <td style="text-align:right;"> 1 </td>
 <td style="text-align:left;"> Adelie </td>
 </tr>
 <tr>
 <td style="text-align:right;"> 3 </td>
 <td style="text-align:right;"> 1 </td>
 <td style="text-align:left;"> Adelie </td>
 </tr>
 <tr>
 <td style="text-align:right;"> 4 </td>
 <td style="text-align:right;"> 1 </td>
 <td style="text-align:left;"> Adelie </td>
 </tr>
 <tr>
 <td style="text-align:right;"> 5 </td>
 <td style="text-align:right;"> 1 </td>
 <td style="text-align:left;"> Adelie </td>
 </tr>
</tbody>
</table>

---

.h1[# `ggwaffle`]

.tiny[

```r
penguin_waffle %>% 
  ggplot(aes(x, y, fill = group)) + 
  geom_waffle() +  
  coord_equal() + 
  theme_waffle() +
  scale_fill_brewer(type = "qual") +
  theme(legend.position = "bottom",
        axis.title.x = element_blank(),
        axis.title.y = element_blank(),
        legend.title = element_blank())
```

<img src="figs/Lec10/waffle-3-1.png" width="6in" style="display: block; margin: auto;" />
]

---

# `ggwaffle`

---

# `ggExtra`

.large[For adding marginal distributions]
 
.medium[[https://cran.r-project.org/web/packages/ggExtra/vignettes/ggExtra.html](https://cran.r-project.org/web/packages/ggExtra/vignettes/ggExtra.html)]
 
.medium[helpful to add context to a scatter plot, especially if *n* is high]
 
 
 
.large[`ggMarginal`]
 
.medium[defaults to a very plain density curve]
 
.medium[add `groupFill = TRUE` to color by group to match plot]
 
.medium[add `type = "histogram"` to show a density plot instead]
 
.medium[same alpha/size/color aesthetics apply]

---

# `ggExtra`

---

.h1[# `ggExtra`]

.tiny[

```r
*plot <- penguins %>%
 ggplot(aes(x = flipper_length_mm, y = body_mass_g, color = species)) +
 geom_point(alpha = 0.5, size = 3) +
 scale_color_brewer(palette = "Set2", name = NULL) + 
 labs(x = "Flipper Length (mm)",
 y = "Body Mass (g)",
 caption = "Data from the palmerpenguins package") +
 theme(legend.position = c(0.2, 0.8),
 panel.background = element_blank(),
 panel.grid.major = element_line(color = "grey90", size = 0.2),
 axis.ticks = element_line(color = "grey90", size = 0.2),
 legend.key = element_rect(fill = "transparent"),
 legend.background = element_rect(fill = "transparent"),
 plot.caption.position = "plot",
 plot.caption = element_text(hjust = 0, face = "italic"))

*ggMarginal(plot, groupFill = TRUE)
```
]

---

# `ggExtra`

---

.h1[# `ggExtra`]

.tiny[

*ggMarginal(plot, type = "histogram", alpha = 0.5)
```

<img src="figs/Lec10/extra-3-1.png" width="6in" style="display: block; margin: auto;" />
]

---

# `ggExtra`

---

# `ggtext`

.large[For any kind of text manipulation]
 
.medium[[https://github.com/wilkelab/ggtext](https://github.com/wilkelab/ggtext)]
 
.medium[using simple HTML]
 
 
 
--
.large[Already saw an example to color the title to match groups]
 
.medium[another option to get rid of legends]
 
.medium[just add `element_markdown()` in the `theme` layer for that element]

---

# `ggtext`

---

# `ggtext`

.large[For any kind of text manipulation]
 
.medium[[https://github.com/wilkelab/ggtext](https://github.com/wilkelab/ggtext)]
 
.medium[using simple HTML]
 
 
 
.large[Already saw an example to color the title to match groups]
 
.medium[another option to get rid of legends]
 
.medium[just add `element_markdown()` in the `theme` layer for that element]
 
 
 
.large[Also useful for text boxes]

---

.h1[# `ggtext`]

.tiny[

```r
economics %>% 
 ggplot(aes(x = date, y = unemploy, color = recession, group = 1)) + 
 geom_line(size = 1) +
 scale_color_manual(values = c("dark grey","#bb0000")) +
 labs(y = "Unemployed (in thousands)",
 x = NULL,
 title = "The number of unemployed people tends to increase during a **recession**") +
 theme(panel.background = element_blank(),
 panel.grid.major = element_line(color = "grey90", size = 0.3),
 panel.border = element_rect(color = "black", fill = NA, size = 0.5),
 axis.ticks = element_blank(),
 # plot.title = element_markdown(), #no longer need this line
 plot.title.position = "plot",
 legend.position = "none",
* plot.title = element_textbox_simple(size = 13, lineheight = 1,
* padding = margin(5.5, 5.5, 5.5, 5.5),
* margin = margin(0, 0, 5.5, 0),
* fill = "#d4d4d4", r = grid::unit(8, "pt")))
```
]

---

# `ggtext`

---

# `ggtext`

---

.h1[# `ggtext`]

.tiny[

```r
penguins %>% 
  ggplot(aes(x = body_mass_g, y = ..count..)) +
  geom_density_line(data = select(penguins, -species), 
                    aes(fill = "all penguins"), color = "transparent") +
  geom_density_line(aes(fill = "species"), color = "transparent") +
  facet_wrap(~species, nrow = 1) +
  scale_fill_manual(values = c("grey","#0C8346"), name = NULL,
                    guide = guide_legend(direction = "horizontal")) +
  labs(x = "Body Mass (g)",
       title = "Comparing the distribution of body mass by penguin species",
       subtitle = "Gentoo penguins tend to be the heaviest") +
  theme(legend.position = "bottom",
        panel.background = element_blank(),
        panel.grid.major = element_line(color = "grey90", size = 0.3),
        strip.background = element_blank(),
*       strip.text = element_textbox(
*         size = 11,
*         color = "white", fill = "#0C8346", box.color = "#4A618C",
*         halign = 0.5, linetype = 1, r = unit(5, "pt"), width = unit(1, "npc"),
*         padding = margin(2, 0, 1, 0), margin = margin(3, 3, 3, 3)),
        panel.border = element_rect(color = "black", fill = NA, size = 0.5),
        axis.ticks = element_blank(),
        plot.title.position = "plot")
```
]

---

# `ggtext`

---

# `gghighlight`

.large[Very useful for highlighting certain groups & applying aesthetics]
 
.medium[[https://cran.r-project.org/web/packages/gghighlight/vignettes/gghighlight.html](https://cran.r-project.org/web/packages/gghighlight/vignettes/gghighlight.html)]
 
.medium[to avoid spaghetti graphs]
 
 
--
 
.large[Easy to highlight/label based on specific values]
 
.medium[or a specific number (e.g., top 5)]
 
.medium[can control aesthetics of unhighlighted categories]

---

# `gghighlight`

---

.h1[# `gghighlight`]

.tiny[

```r
constructor_pts %>% 
 filter(year == 2020) %>% 
 ggplot(aes(x = round, y = points, color = name, group = name)) + 
 geom_line() +
* gghighlight(max(points) > 180 & max(points) < 250,
* label_params = list(size = 4.5)) +
 scale_x_continuous(breaks = seq(1, 17, 1)) +
 scale_color_manual(values = c("#E0610E","#F596C8",
 "#FFF500","dark grey")) +
 labs(title = "The race for third place during the 2020 F1 season",
 subtitle = "While Mercedes and Red Bull ran off with the first two placings, three teams battled all year long for third place",
 x = "Race Round",
 y = "Accumulated Points") +
 theme(legend.position = "none",
 panel.background = element_blank(),
 panel.grid.major.y = element_line(color = "grey90", size = 0.2),
 axis.ticks = element_blank(),
 panel.border = element_rect(color = "black", fill = NA, size = 0.5))
```
]

---

.h1[# `gghighlight`]

.tiny[

```r
constructor_pts %>% 
  filter(year == 2020) %>% 
  ggplot(aes(x = round, y = points, color = name, group = name)) + 
  geom_line() +
* gghighlight(max(points), max_highlight = 5L) +
  scale_x_continuous(breaks = seq(1, 17, 1)) +
  labs(title = "The race for third place during the 2020 F1 season",
       subtitle = "While Mercedes and Red Bull ran off with the first two placings, three teams battled all year long for third place",
       x = "Race Round",
       y = "Accumulated Points") +
  theme(legend.position = "none",
        panel.background = element_blank(),
        panel.grid.major.y = element_line(color = "grey90", size = 0.2),
        axis.ticks = element_blank(),
        panel.border = element_rect(color = "black", fill = NA, size = 0.5))
```
]

---

# `gghighlight`

---

.h1[# `gghighlight`]

.tiny[

```r
constructor_pts %>% 
 filter(year == 2020) %>% 
 ggplot(aes(x = round, y = points, color = name, group = name)) + 
 geom_line() +
* gghighlight(max(points) > 180 & max(points) < 250,
* unhighlighted_params = list(linetype = "dotted", alpha = 0.8)) +
 scale_x_continuous(breaks = seq(1, 17, 1)) +
 scale_color_manual(values = c("#E0610E","#F596C8",
 "#FFF500","dark grey")) +
 labs(title = "The race for third place during the 2020 F1 season",
 subtitle = "While Mercedes and Red Bull ran off with the first two placings, three teams battled all year long for third place",
 x = "Race Round",
 y = "Accumulated Points") +
 theme(legend.position = "none",
 panel.background = element_blank(),
 panel.grid.major.y = element_line(color = "grey90", size = 0.2),
 axis.ticks = element_blank(),
 panel.border = element_rect(color = "black", fill = NA, size = 0.5))
```
]

---

# `gghighlight`

---

# `cowplot`

.large[Useful functions for manipulating graphs]
 
.medium[[https://wilkelab.org/cowplot/articles/introduction.html](https://wilkelab.org/cowplot/articles/introduction.html)]
 
.medium[adding images to plots, arranging plots]
 
.medium[adding joint titles and joint legends]
 
 
 
.large[Also includes themes]

---

# `cowplot`

---

.h1[# `cowplot`]

.medium[**adding an image to a plot**]

.tiny[

```r
*p <- penguins %>%
 filter(species != "Gentoo") %>% 
 mutate(label = case_when(flipper_length_mm == 192 & 
 body_mass_g == 2700 ~ "Chinstrap",
 flipper_length_mm == 184 & 
 body_mass_g == 4650 ~ "Adelie")) %>% 
 ggplot(aes(x = flipper_length_mm, y = body_mass_g, 
 size = bill_length_mm, color = species)) +
 ...

*ggdraw() +
* draw_plot(p) +
* draw_image("https://allisonhorst.github.io/palmerpenguins/reference/figures/palmerpenguins.png",
*            x = 1, y = 0.35, hjust = 1, vjust = 1, halign = 1, valign = 1, width = 0.15)
```
]

---

# `cowplot`

---

# `cowplot`

`scatter`

---

# `cowplot`

`bar`

---

# `cowplot`

**creating an inset plot**

```r
ggdraw(scatter) +
  draw_plot(bar, x = .55, y = .55, width = .4, height = .4) +
  draw_plot_label(c("A.", "B."), x = c(0, 0.45),
                  y = c(0.95, 0.95), size = 12)
```

---

# `cowplot`

---

# `cowplot`

```r
plot_grid(scatter, bar, labels = c("A.", "B."), label_size = 12)
```

---

# `cowplot`

```r
plot_grid(scatter, bar, labels = c("A.", "B."), label_size = 12, 
          align = "h")
```

---

# `cowplot`

```r
plot_grid(scatter, bar, labels = c("A.", "B."), label_size = 12, 
          align = "h", rel_widths = c(2, 1))
```

---

# `cowplot`

**sharing titles among plots**

```r
plots <- plot_grid(scatter, bar, labels = c("A.", "B."), 
 label_size = 12, align = "h")

title <- ggdraw() + 
 draw_label("Gentoo penguins tend to be heavier, with longer and shallower bills",
 fontface = 'bold',
 x = 0,
 hjust = 0) +
 theme(plot.margin = margin(0, 0, 0, 5))

plot_grid(title, plots, ncol = 1,
          # necessary so that the title is small
          rel_heights = c(0.1, 1)) 
```

---

# `cowplot`

---

# `cowplot`

**sharing legends among plots**

```r
plots_shared_legend <- 
 plot_grid(scatter + 
 theme(legend.position="none"),
 bar,
 labels = c("A.", "B."), label_size = 12, align = "h")

legend <- 
 get_legend(scatter + 
 theme(legend.position = "top"))

plot_grid(title, legend, plots_shared_legend, 
          ncol = 1, rel_heights = c(.1, .05, 1))
```

---

# `cowplot`

---

# `cowplot`

---

# `cowplot`

---

# `corrplot`

.large[Easy way to create a correlation matrix]
 
.medium[[https://cran.r-project.org/web/packages/corrplot/vignettes/corrplot-intro.html](https://cran.r-project.org/web/packages/corrplot/vignettes/corrplot-intro.html)]
 
.medium[aka a correlogram]
 
 
 
.large[Most useful when you represent correlations as color as well as size]
 
.medium[but always examine the raw data as well]

---

# `corrplot`

```r
corr <- 
 cor(penguins %>% 
 select(`Bill Length` = bill_length_mm,
 `Bill Depth` = bill_depth_mm,
 `Flipper Length` = flipper_length_mm,
 `Body Mass` = body_mass_g) %>% 
 drop_na())

corrplot(corr, method = "circle")
```

---

# `corrplot`

---

# `corrplot`

```r
corrplot(corr, method = "number")
```

---

# `corrplot`

---

# `corrplot`

```r
corrplot(corr, method = "color")
```

---

# `corrplot`

---

# `corrplot`

```r
diag(corr) = NA # changes diagonal corrleations to NA

corrplot(corr, type = "lower", tl.srt = 45, # controls angle of text
         # controls color palette
         col = brewer.pal(n = 8, name = "RdGy"), 
         # gets rid of background grid
         addgrid.col = NA, 
         # controls text color
         tl.col = "black", 
         # controls label of NA values
         na.label = "x") 
```

---

# `corrplot`

---

# `ggalt`

.large[Very easy to make a dumbbell plot]
 
.medium[[https://github.com/hrbrmstr/ggalt](https://github.com/hrbrmstr/ggalt)]
 
.medium[various miscellaneous functions]
 
 
--
 
.large[Dumbbell plots]
 
.medium[great way to show specific change over two points in time]
 
.medium[encoded by position, so axis doesn't have to start at zero]
 
.medium[can handle many categories as bars are narrow (similar to lollipop)]

---

# `ggalt`

**What's the increase in median listing price, by city, from 2006 to 2015?**

<table class="table" style="font-size: 16px; width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
 <tr>
 <th style="text-align:left;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> city </th>
 <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> year </th>
 <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> month </th>
 <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> sales </th>
 <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> volume </th>
 <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> median </th>
 <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> listings </th>
 <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> inventory </th>
 <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> date </th>
 </tr>
 </thead>
<tbody>
 <tr>
 <td style="text-align:left;"> Abilene </td>
 <td style="text-align:right;"> 2000 </td>
 <td style="text-align:right;"> 1 </td>
 <td style="text-align:right;"> 72 </td>
 <td style="text-align:right;"> 5380000 </td>
 <td style="text-align:right;"> 71400 </td>
 <td style="text-align:right;"> 701 </td>
 <td style="text-align:right;"> 6.3 </td>
 <td style="text-align:right;"> 2000.000 </td>
 </tr>
 <tr>
 <td style="text-align:left;"> Abilene </td>
 <td style="text-align:right;"> 2000 </td>
 <td style="text-align:right;"> 2 </td>
 <td style="text-align:right;"> 98 </td>
 <td style="text-align:right;"> 6505000 </td>
 <td style="text-align:right;"> 58700 </td>
 <td style="text-align:right;"> 746 </td>
 <td style="text-align:right;"> 6.6 </td>
 <td style="text-align:right;"> 2000.083 </td>
 </tr>
 <tr>
 <td style="text-align:left;"> Abilene </td>
 <td style="text-align:right;"> 2000 </td>
 <td style="text-align:right;"> 3 </td>
 <td style="text-align:right;"> 130 </td>
 <td style="text-align:right;"> 9285000 </td>
 <td style="text-align:right;"> 58100 </td>
 <td style="text-align:right;"> 784 </td>
 <td style="text-align:right;"> 6.8 </td>
 <td style="text-align:right;"> 2000.167 </td>
 </tr>
 <tr>
 <td style="text-align:left;"> Abilene </td>
 <td style="text-align:right;"> 2000 </td>
 <td style="text-align:right;"> 4 </td>
 <td style="text-align:right;"> 98 </td>
 <td style="text-align:right;"> 9730000 </td>
 <td style="text-align:right;"> 68600 </td>
 <td style="text-align:right;"> 785 </td>
 <td style="text-align:right;"> 6.9 </td>
 <td style="text-align:right;"> 2000.250 </td>
 </tr>
 <tr>
 <td style="text-align:left;"> Abilene </td>
 <td style="text-align:right;"> 2000 </td>
 <td style="text-align:right;"> 5 </td>
 <td style="text-align:right;"> 141 </td>
 <td style="text-align:right;"> 10590000 </td>
 <td style="text-align:right;"> 67300 </td>
 <td style="text-align:right;"> 794 </td>
 <td style="text-align:right;"> 6.8 </td>
 <td style="text-align:right;"> 2000.333 </td>
 </tr>
</tbody>
</table>

---

# `ggalt`

**What's the increase in median listing price, by city, from 2006 to 2015?**

---

# `ggalt`

**What's the increase in median listing price, by city, from 2006 to 2015?**

---

# `ggalt`

---

.h1[# `ggalt`]

.tiny[

```r
txhousing %>% 
  filter((year == 2006 | year == 2015) & 
           !(city %in% c("South Padre Island", "Kerrville"))) %>% 
  group_by(city, year) %>% 
  summarize(median = mean(median, na.rm = TRUE)) %>% 
  pivot_wider(names_from = year, values_from = median) %>% 
* ggplot(aes(x = `2006`, xend = `2015`, y = reorder(city, `2015`), group = city)) +
* geom_dumbbell(size = 1.5, color = "#d4d4d4",
*               colour_x = "#BA95DB", colour_xend = "#693498",
*               dot_guide = TRUE, dot_guide_size = 0.25) +
  scale_x_continuous(labels = dollar) +
  labs(title = "Median listing price increases from 2006 to 2015") +
  theme_linedraw() +
  theme(axis.ticks = element_blank(),
        panel.grid.minor = element_blank(),
        panel.grid.major.y = element_blank(),
        axis.title = element_blank())
```
]

---

# `ggalt`

**which cities saw the greatest increase in this time?**

---

# `ggalt`

**which cities saw the greatest increase in this time?**

---

.h1[# `ggalt` + `ggtext`]

.tiny[

```r
txhousing %>% 
 filter((year == 2006 | year == 2015) & 
 !(city %in% c("South Padre Island", "Kerrville"))) %>% 
 group_by(city, year) %>% 
 summarize(median = mean(median, na.rm = TRUE)) %>% 
 pivot_wider(names_from = year, values_from = median) %>% 
* mutate(color = ifelse(city %in% c("Midland","Odessa"), "#bb0000", "black"),
* name = ifelse(city %in% c("Midland","Odessa"),
* glue("{city}"), city)) %>%
 ggplot(aes(x = `2006`, xend = `2015`, y = reorder(name, `2015`), group = city)) +
 geom_dumbbell(size = 1.5, color = "#d4d4d4", 
 colour_x = "#BA95DB", colour_xend = "#693498",
 dot_guide = TRUE, dot_guide_size = 0.25) +
 scale_x_continuous(labels = dollar) +
 labs(title = "Median listing price increases from 2006 to 2015",
* subtitle = "Midland & Odessa saw the largest increase over this time") +
 theme_linedraw() +
 theme(axis.ticks = element_blank(),
 panel.grid.minor = element_blank(),
 panel.grid.major.y = element_blank(),
 axis.title = element_blank(),
* axis.text.y = element_markdown(),
 plot.subtitle = element_text(margin = margin(-5, 0, 5, 0)))
```
]

---

# `ggalt` + `ggtext`

<img src="figs/Lec10/dumbbell-2-1.png" width="504" style="display: block; margin: auto;" />
]

---

# Bullet graph

.large[Useful for showing progress toward a goal]
 
.medium[using bars of varying widths]
 
.medium[can also show performance compared to a baseline]
 
.medium[or even a change over time, as appropriate]
 
 
--
 
.large[No easy package solution, so time for DIY]
 
.medium[using `geom_col`]

---

# Bullet graph

**did SUV manufacturers improve on their highway mpg from 1999 to 2008?**

```r
mpg %>% 
  filter(class == "suv") %>% 
  group_by(manufacturer, year) %>% 
  summarize(mean = mean(hwy))
```

---

# Bullet graph

**did SUV manufacturers improve on their highway mpg from 1999 to 2008?**

```r
*mpg_bullet <- mpg %>%
 filter(class == "suv") %>% 
 group_by(manufacturer, year) %>% 
 summarize(mean = mean(hwy)) %>% 
* mutate(year = as.character(year),
* width = ifelse(year == "1999", 0.9, 0.5))
```

---

# Bullet graph

```r
mpg_bullet %>% 
* mutate(manufacturer = str_to_title(manufacturer)) %>%
* ggplot(aes(x = mean, y = manufacturer, fill = year)) +
* geom_col(width = mpg_bullet$width) +
  scale_fill_manual(values = c("grey", "#098641"), name = NULL) +
  scale_alpha_manual(values = c(0.3, 1),
                     guide = FALSE)
```

---

# Bullet graph

---

# Bullet graph

**changes to make?**

- remove x-axis title and adjust y-axis title
- clean up background, lines, etc.
- add a good title
- find a way to take care of the legend
- take the bars all the way to the axis
- reorder bars in a meaningful way

---

.h1[# Bullet graph]

.tiny[

```r
mpg_bullet %>% 
 mutate(manufacturer = str_to_title(manufacturer)) %>% 
 ggplot(aes(x = mean, y = manufacturer, fill = year)) +
 geom_col(width = mpg_bullet$width) +
 scale_fill_manual(values = c("grey", "#098641"), name = NULL) +
 scale_alpha_manual(values = c(0.3, 1),
 guide = FALSE) +
* scale_x_continuous(expand = expansion(mult = c(0, 0.1))) +
 labs(subtitle = "Jeep only manufacturer to show negative change",
 title = "The highway mpg among SUVs, by manufacturer, in **1999** and **2008**",
 x = "Highway miles per gallon") +
 theme_linedraw() +
 theme(panel.grid.minor = element_blank(),
 panel.grid.major.y = element_blank(),
* plot.title = element_markdown(),
 axis.ticks = element_blank(),
 axis.title.y = element_blank(),
 legend.position = "none")
```
]

---

# Bullet graph

---

# Bullet graph

**changes to make?**

- remove x-axis title and adjust y-axis title
- clean up background, lines, etc.
- add a good title
- find a way to take care of the legend
- take the bars all the way to the axis
- **reorder bars in a meaningful way**

---

# Bullet graph

**to reorder the bars**

```r
mpg_bullet %>% 
  group_by(manufacturer) %>% 
  mutate(max = max(mean)) 
```

---

.h1[# Bullet graph]

.tiny[

```r
mpg_bullet %>% 
 mutate(manufacturer = str_to_title(manufacturer)) %>% 
 group_by(manufacturer) %>% 
 mutate(max = max(mean)) %>% 
* ggplot(aes(x = mean, y = reorder(manufacturer, max), fill = year)) +
 geom_col(width = mpg_bullet$width) +
 scale_fill_manual(values = c("grey", "#098641"), name = NULL) +
 scale_alpha_manual(values = c(0.3, 1),
 guide = FALSE) +
* scale_x_continuous(expand = expansion(mult = c(0, 0.1))) +
 labs(subtitle = "Jeep only manufacturer to show negative change",
 title = "The highway mpg among SUVs, by manufacturer, in **1999** and **2008**",
 x = "Highway miles per gallon") +
 theme_linedraw() +
 theme(panel.grid.minor = element_blank(),
 panel.grid.major.y = element_blank(),
* plot.title = element_markdown(),
 axis.ticks = element_blank(),
 axis.title.y = element_blank(),
 legend.position = "none")
```
]

---

# Bullet graph

---

# Upcoming

.large[Lecture 11 on Wednesday June 16 **midterm review**]

.large[Homework 3 due Tuesday June 15]

.large[Lab 7 on Tuesday June 15]