Easy Geom Recipes (Exploded version)

class: inverse, middle
background-image: url(https://images.unsplash.com/photo-1592173376801-185310a68dea?ixlib=rb-1.2.1&ixid=MnwxMjA3fDB8MHxwaG90by1wYWdlfHx8fGVufDB8fHx8&auto=format&fit=crop&w=1286&q=80)
background-size: cover

# Easy geom_*() recipes, 2024

###Gina Reynolds and Morgan Brown

@media print {
  .has-continuation {
    display: block;
  }
}

code.r.hljs.remark-code{
  position: relative;
  overflow-x: hidden;
}

code.r.hljs.remark-code:hover{
  overflow-x:visible;
  width: 500px;
  border-style: solid;
}
</style>

---

### Using ggplot2 has been described as writing 'graphical poems'.

### But we may feel at a loss for words when functions we'd like to have don't exist.  The ggplot2 extension system allows us to build new 'vocabulary' for fluent expression.

### An exciting extension mechanism that allows more plotting fluidity is to create new, custom 'Stats' and combine them with existing 'Geoms' (GeomPoint, GeomText, GeomSegment, etc)into new geom\_\* or stat\_\* functions.

---

### By the way, you might only be familiar with the user-facing geom_point(), geom_text(), geom_segment() layer functions that use the more primitive GeomPoint, GeomText, and GeomSegment under the hood, and that's okay.  You might also have a feel for existing stats like StatCount and StatBin, specify computation in user-facing functions like geom_bar() and geom_histogram().

---

### To get your feet wet in this world and give you a taste of patterns for new-Stat-plus-existing-Geom extension, we provide three *introductory* recipes (A, B, and C) for geom\_\* functions that make use of newly defined 'Stats' and *existing* 'Geoms' along with three practice exercises: *Easy geom\_() recipes*

---

### With your new geom\_\*() function, calculation is done under the hood by the ggplot2 system; with these geom\_\*() functions, you can write graphical poems with concise new language you've tailored for goals!

---

### This tutorial is intended for individuals who already have a working knowledge of the grammar of ggplot2, but may like to build a richer vocabulary for themselves.

### Grab an .Rmd worksheet version [here](https://raw.githubusercontent.com/EvaMaeRey/mytidytuesday/master/2022-01-03-easy-geom-recipes/easy_geom_recipes_2024.Rmd).

### or you can browse the rendered version of that [here](https://evamaerey.github.io/mytidytuesday/2022-01-03-easy-geom-recipes/easy_geom_recipes_2024.html).

---

## *Recipes Form Preview:*

## **Step 0. Get the job done with 'base' ggplot2.**

## **Step 1. Use base build experience to help define compute and test.**

## **Step 2. Use compute definition to define a new Stat and test.**

## **Step 3. Use your new Stat to define a user-facing geom\_\*() function and test.**

---
class: inverse, middle, center

# Recipe A.

## `geom_medians()`

---
class: inverse, middle, center

## Step 0: use base ggplot2 to get the job done

### *Clarify what needs to happen without getting into the extension architecture.*

---

```r
*library(tidyverse)
*library(palmerpenguins)

*penguins <- remove_missing(penguins)

*penguins
```
]
 
.panel2-penguins-user[

```
# A tibble: 333 × 8
   species island    bill_length_mm bill_depth_mm flipper_length_mm body_mass_g sex     year
   <fct>   <fct>              <dbl>         <dbl>             <int>       <int> <fct>  <int>
 1 Adelie  Torgersen           39.1          18.7               181        3750 male    2007
 2 Adelie  Torgersen           39.5          17.4               186        3800 female  2007
 3 Adelie  Torgersen           40.3          18                 195        3250 female  2007
 4 Adelie  Torgersen           36.7          19.3               193        3450 female  2007
 5 Adelie  Torgersen           39.3          20.6               190        3650 male    2007
 6 Adelie  Torgersen           38.9          17.8               181        3625 female  2007
 7 Adelie  Torgersen           39.2          19.6               195        4675 male    2007
 8 Adelie  Torgersen           41.1          17.6               182        3200 female  2007
 9 Adelie  Torgersen           38.6          21.2               191        3800 male    2007
10 Adelie  Torgersen           34.6          21.1               198        4400 male    2007
11 Adelie  Torgersen           36.6          17.8               185        3700 female  2007
12 Adelie  Torgersen           38.7          19                 195        3450 female  2007
13 Adelie  Torgersen           42.5          20.7               197        4500 male    2007
14 Adelie  Torgersen           34.4          18.4               184        3325 female  2007
15 Adelie  Torgersen           46            21.5               194        4200 male    2007
16 Adelie  Biscoe              37.8          18.3               174        3400 female  2007
17 Adelie  Biscoe              37.7          18.7               180        3600 male    2007
18 Adelie  Biscoe              35.9          19.2               189        3800 female  2007
19 Adelie  Biscoe              38.2          18.1               185        3950 male    2007
20 Adelie  Biscoe              38.8          17.2               180        3800 male    2007
21 Adelie  Biscoe              35.3          18.9               187        3800 female  2007
22 Adelie  Biscoe              40.6          18.6               183        3550 male    2007
23 Adelie  Biscoe              40.5          17.9               187        3200 female  2007
24 Adelie  Biscoe              37.9          18.6               172        3150 female  2007
25 Adelie  Biscoe              40.5          18.9               180        3950 male    2007
26 Adelie  Dream               39.5          16.7               178        3250 female  2007
27 Adelie  Dream               37.2          18.1               178        3900 male    2007
28 Adelie  Dream               39.5          17.8               188        3300 female  2007
29 Adelie  Dream               40.9          18.9               184        3900 male    2007
30 Adelie  Dream               36.4          17                 195        3325 female  2007
31 Adelie  Dream               39.2          21.1               196        4150 male    2007
32 Adelie  Dream               38.8          20                 190        3950 male    2007
33 Adelie  Dream               42.2          18.5               180        3550 female  2007
34 Adelie  Dream               37.6          19.3               181        3300 female  2007
35 Adelie  Dream               39.8          19.1               184        4650 male    2007
36 Adelie  Dream               36.5          18                 182        3150 female  2007
37 Adelie  Dream               40.8          18.4               195        3900 male    2007
38 Adelie  Dream               36            18.5               186        3100 female  2007
39 Adelie  Dream               44.1          19.7               196        4400 male    2007
40 Adelie  Dream               37            16.9               185        3000 female  2007
41 Adelie  Dream               39.6          18.8               190        4600 male    2007
42 Adelie  Dream               41.1          19                 182        3425 male    2007
43 Adelie  Dream               36            17.9               190        3450 female  2007
44 Adelie  Dream               42.3          21.2               191        4150 male    2007
45 Adelie  Biscoe              39.6          17.7               186        3500 female  2008
46 Adelie  Biscoe              40.1          18.9               188        4300 male    2008
47 Adelie  Biscoe              35            17.9               190        3450 female  2008
48 Adelie  Biscoe              42            19.5               200        4050 male    2008
49 Adelie  Biscoe              34.5          18.1               187        2900 female  2008
50 Adelie  Biscoe              41.4          18.6               191        3700 male    2008
51 Adelie  Biscoe              39            17.5               186        3550 female  2008
52 Adelie  Biscoe              40.6          18.8               193        3800 male    2008
53 Adelie  Biscoe              36.5          16.6               181        2850 female  2008
54 Adelie  Biscoe              37.6          19.1               194        3750 male    2008
55 Adelie  Biscoe              35.7          16.9               185        3150 female  2008
# ℹ 278 more rows
```
]

---
count: false

```r
library(tidyverse)
library(palmerpenguins)

penguins <- remove_missing(penguins)

penguins %>%
* summarize(bill_length_mm_median =
*             median(bill_length_mm),
*           bill_depth_mm_median =
*             median(bill_depth_mm))
```
]
 
.panel2-penguins-user[

```
# A tibble: 1 × 2
  bill_length_mm_median bill_depth_mm_median
                  <dbl>                <dbl>
1                  44.5                 17.3
```
]

---
count: false

```r
library(tidyverse)
library(palmerpenguins)

penguins <- remove_missing(penguins)

penguins %>%
  summarize(bill_length_mm_median =
              median(bill_length_mm),
            bill_depth_mm_median =
              median(bill_depth_mm)) ->
*penguins_medians
```
]
 
.panel2-penguins-user[

]

---
count: false

```r
library(tidyverse)
library(palmerpenguins)

penguins <- remove_missing(penguins)

penguins %>%
  summarize(bill_length_mm_median =
              median(bill_length_mm),
            bill_depth_mm_median =
              median(bill_depth_mm)) ->
penguins_medians

*penguins %>%
* ggplot() +
* aes(x = bill_depth_mm) +
* aes(y = bill_length_mm) +
* geom_point()
```
]
 
.panel2-penguins-user[
![](easy_geom_recipes_flipbook_2024_files/figure-html/penguins_user_04_output-1.png)
]

---
count: false

```r
library(tidyverse)
library(palmerpenguins)

penguins <- remove_missing(penguins)

penguins %>%
  summarize(bill_length_mm_median =
              median(bill_length_mm),
            bill_depth_mm_median =
              median(bill_depth_mm)) ->
penguins_medians

penguins %>%
  ggplot() +
  aes(x = bill_depth_mm) +
  aes(y = bill_length_mm) +
  geom_point() +
* geom_point(data = penguins_medians,
*            color = "red",
*            size = 4,
*            aes(x = bill_depth_mm_median,
*                y = bill_length_mm_median))
```
]
 
.panel2-penguins-user[
![](easy_geom_recipes_flipbook_2024_files/figure-html/penguins_user_05_output-1.png)
]

---
count: false

```r
library(tidyverse)
library(palmerpenguins)

penguins <- remove_missing(penguins)

penguins %>%
  summarize(bill_length_mm_median =
              median(bill_length_mm),
            bill_depth_mm_median =
              median(bill_depth_mm)) ->
penguins_medians

penguins %>%
  ggplot() +
  aes(x = bill_depth_mm) +
  aes(y = bill_length_mm) +
  geom_point() +
  geom_point(data = penguins_medians,
             color = "red",
             size = 4,
             aes(x = bill_depth_mm_median,
                 y = bill_length_mm_median))

# Have a quick look at the layer_data medians layer
*layer_data(plot = last_plot(), i = 2)
```
]
 
.panel2-penguins-user[
![](easy_geom_recipes_flipbook_2024_files/figure-html/penguins_user_06_output-1.png)

```
     x    y PANEL group shape colour size fill alpha stroke
1 17.3 44.5     1    -1    19    red    4   NA    NA    0.5
```
]

---
class: inverse, middle, center

## Step 1: Define Compute and test.

### *Define the compute that will transform your input data before rendering it. Try it out.*

---

```r
*compute_group_medians <- function(data,
*                                    scales){
* data %>%
*   summarize(x = median(x),
*             y = median(y))
*} 
```
]
 
.panel2-compute_group_medians-auto[

]

---
count: false

```r
compute_group_medians <- function(data,
                                     scales){
  data %>%
    summarize(x = median(x),
              y = median(y))
}

# And use computation function to test it
*penguins
```
]
 
.panel2-compute_group_medians-auto[

---
count: false

```r
compute_group_medians <- function(data,
                                     scales){
  data %>%
    summarize(x = median(x),
              y = median(y))
}

# And use computation function to test it
penguins %>%
# function requires dataframe
# with columns named x and y
* select(x = bill_depth_mm,
*        y = bill_length_mm)
```
]
 
.panel2-compute_group_medians-auto[

```
# A tibble: 333 × 2
       x     y
   <dbl> <dbl>
 1  18.7  39.1
 2  17.4  39.5
 3  18    40.3
 4  19.3  36.7
 5  20.6  39.3
 6  17.8  38.9
 7  19.6  39.2
 8  17.6  41.1
 9  21.2  38.6
10  21.1  34.6
11  17.8  36.6
12  19    38.7
13  20.7  42.5
14  18.4  34.4
15  21.5  46  
16  18.3  37.8
17  18.7  37.7
18  19.2  35.9
19  18.1  38.2
20  17.2  38.8
21  18.9  35.3
22  18.6  40.6
23  17.9  40.5
24  18.6  37.9
25  18.9  40.5
26  16.7  39.5
27  18.1  37.2
28  17.8  39.5
29  18.9  40.9
30  17    36.4
31  21.1  39.2
32  20    38.8
33  18.5  42.2
34  19.3  37.6
35  19.1  39.8
36  18    36.5
37  18.4  40.8
38  18.5  36  
39  19.7  44.1
40  16.9  37  
41  18.8  39.6
42  19    41.1
43  17.9  36  
44  21.2  42.3
45  17.7  39.6
46  18.9  40.1
47  17.9  35  
48  19.5  42  
49  18.1  34.5
50  18.6  41.4
51  17.5  39  
52  18.8  40.6
53  16.6  36.5
54  19.1  37.6
55  16.9  35.7
# ℹ 278 more rows
```
]

---
count: false

```r
compute_group_medians <- function(data,
                                     scales){
  data %>%
    summarize(x = median(x),
              y = median(y))
}

# And use computation function to test it
penguins %>%
# function requires dataframe
# with columns named x and y
  select(x = bill_depth_mm,
         y = bill_length_mm) %>%
* compute_group_medians()
```
]
 
.panel2-compute_group_medians-auto[

```
# A tibble: 1 × 2
      x     y
  <dbl> <dbl>
1  17.3  44.5
```
]

---
class: inverse, middle, center

## Step 2: define a new Stat

### *Stats, which are ggproto objects, allow your  to get compute done within a ggplot2 build.  You'll use the computation function from Step 1 to define your Stat.*

### *To test out the Stat behavior you can use the generic `ggplot2::layer()` function.  `layer()` lets you combine Stats and Geoms for very flexible expression.  It is used to define the user-facing layer functions that you're familiar with like geom_point, geom_histogram, etc.*

---

```r
# define new Stat
*StatMedians <- ggplot2::ggproto(
# declare new Stat
* `_class` = "StatMedians",
# inherit behavior of generic stat
* `_inherit` = ggplot2::Stat,
# state required variable mappings
* required_aes = c("x", "y"),
# declare computation definition for stat
* compute_group = compute_group_medians
* )
```
]
 
.panel2-StatMedians-user[

]

---
count: false

```r
# define new Stat
StatMedians <- ggplot2::ggproto(
# declare new Stat
  `_class` = "StatMedians",
# inherit behavior of generic stat
  `_inherit` = ggplot2::Stat,
# state required variable mappings
  required_aes = c("x", "y"),
# declare computation definition for stat
  compute_group = compute_group_medians
  )

*# test new stat w ggplot::layer() function  # test new stat w ggplot::layer() function
*penguins %>%
* ggplot() +
* aes(x = bill_depth_mm) +
* aes(y = bill_length_mm) +
* geom_point()
```
]
 
.panel2-StatMedians-user[
![](easy_geom_recipes_flipbook_2024_files/figure-html/StatMedians_user_02_output-1.png)
]

---
count: false

# test new stat w ggplot::layer() function  # test new stat w ggplot::layer() function
penguins %>%
  ggplot() +
  aes(x = bill_depth_mm) +
  aes(y = bill_length_mm) +
  geom_point() +
* layer(geom = GeomPoint,
*       stat = StatMedians,
*       position = "identity",
*       params = list(size = 8))
```
]
 
.panel2-StatMedians-user[
![](easy_geom_recipes_flipbook_2024_files/figure-html/StatMedians_user_03_output-1.png)
]

---
class: inverse, middle, center

## Step 3: define user-facing geom\_\* function

### *For ease of use, we'll wrap the layer function into a familiar `geom` function.*

### *We manage arguments like mapping, data, position, na.rm, show.legend, inherit.aes, etc, so that the new, user-facing function will behave similarly to other user-facing geom functions that you are familiar with.*

---

```r
*geom_medians <- function(
* mapping = NULL, data = NULL,
* position = "identity", na.rm = FALSE,
* show.legend = NA,  inherit.aes = TRUE,
* ...  ){

*ggplot2::layer(
*   stat = StatMedians,
*   geom = ggplot2::GeomPoint,
*   data = data,
*   mapping = mapping,
*   position = position,
*   show.legend = show.legend,
*   inherit.aes = inherit.aes,
*   params = list(na.rm = na.rm, ...)
* )

*} 
```
]
 
.panel2-geom_medians-user[

]

---
count: false

```r
geom_medians <- function(
  mapping = NULL, data = NULL,
  position = "identity", na.rm = FALSE,
  show.legend = NA,  inherit.aes = TRUE,
  ...  ){

ggplot2::layer(
    stat = StatMedians,
    geom = ggplot2::GeomPoint,
    data = data,
    mapping = mapping,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, ...)
  )

}

*penguins %>%
* ggplot() +
* aes(x = bill_depth_mm,
*     y = bill_length_mm) +
* geom_point()
```
]
 
.panel2-geom_medians-user[
![](easy_geom_recipes_flipbook_2024_files/figure-html/geom_medians_user_02_output-1.png)
]

---
count: false

```r
geom_medians <- function(
  mapping = NULL, data = NULL,
  position = "identity", na.rm = FALSE,
  show.legend = NA,  inherit.aes = TRUE,
  ...  ){

}

penguins %>%
  ggplot() +
  aes(x = bill_depth_mm,
      y = bill_length_mm) +
  geom_point() +
* geom_medians(size = 8)
```
]
 
.panel2-geom_medians-user[
![](easy_geom_recipes_flipbook_2024_files/figure-html/geom_medians_user_03_output-1.png)
]

---
class: inverse, middle, center

### And check out group-wise behavior!

---

```r
*last_plot()
```
]
 
.panel2-conditional_penguins-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/conditional_penguins_auto_01_output-1.png)
]

---
count: false

```r
last_plot() +
* aes(color = species)
```
]
 
.panel2-conditional_penguins-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/conditional_penguins_auto_02_output-1.png)
]

---
class: inverse, middle, center
background-image: url(https://images.unsplash.com/photo-1628559225804-71f6e4643f44?ixlib=rb-1.2.1&ixid=MnwxMjA3fDB8MHxwaG90by1wYWdlfHx8fGVufDB8fHx8&auto=format&fit=crop&w=837&q=80)
background-size: cover

---
class: inverse, middle, center

## Now you ...

### Create the function `geom_means()`

---
class: inverse, middle, center

# Recipe B.

## `geom_label_id()`

---
class: inverse, center, middle

## Step 0: use base ggplot2 to get the job done

---

```r
*cars
```
]
 
.panel2-cars-auto[

```
   speed dist
1      4    2
2      4   10
3      7    4
4      7   22
5      8   16
6      9   10
7     10   18
8     10   26
9     10   34
10    11   17
11    11   28
12    12   14
13    12   20
14    12   24
15    12   28
16    13   26
17    13   34
18    13   34
19    13   46
20    14   26
21    14   36
22    14   60
23    14   80
24    15   20
25    15   26
26    15   54
27    16   32
28    16   40
29    17   32
30    17   40
31    17   50
32    18   42
33    18   56
34    18   76
35    18   84
36    19   36
37    19   46
38    19   68
39    20   32
40    20   48
41    20   52
42    20   56
43    20   64
44    22   66
45    23   54
46    24   70
47    24   92
48    24   93
49    24  120
50    25   85
```
]

---
count: false

```r
cars %>%
* mutate(id_number = 1:n())
```
]
 
.panel2-cars-auto[

```
   speed dist id_number
1      4    2         1
2      4   10         2
3      7    4         3
4      7   22         4
5      8   16         5
6      9   10         6
7     10   18         7
8     10   26         8
9     10   34         9
10    11   17        10
11    11   28        11
12    12   14        12
13    12   20        13
14    12   24        14
15    12   28        15
16    13   26        16
17    13   34        17
18    13   34        18
19    13   46        19
20    14   26        20
21    14   36        21
22    14   60        22
23    14   80        23
24    15   20        24
25    15   26        25
26    15   54        26
27    16   32        27
28    16   40        28
29    17   32        29
30    17   40        30
31    17   50        31
32    18   42        32
33    18   56        33
34    18   76        34
35    18   84        35
36    19   36        36
37    19   46        37
38    19   68        38
39    20   32        39
40    20   48        40
41    20   52        41
42    20   56        42
43    20   64        43
44    22   66        44
45    23   54        45
46    24   70        46
47    24   92        47
48    24   93        48
49    24  120        49
50    25   85        50
```
]

---
count: false

```r
cars %>%
  mutate(id_number = 1:n()) %>%
* ggplot()
```
]
 
.panel2-cars-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/cars_auto_03_output-1.png)
]

---
count: false

```r
cars %>%
  mutate(id_number = 1:n()) %>%
  ggplot() +
* aes(x = speed, y = dist)
```
]
 
.panel2-cars-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/cars_auto_04_output-1.png)
]

---
count: false

```r
cars %>%
  mutate(id_number = 1:n()) %>%
  ggplot() +
  aes(x = speed, y = dist) +
* geom_point()
```
]
 
.panel2-cars-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/cars_auto_05_output-1.png)
]

---
count: false

```r
cars %>%
  mutate(id_number = 1:n()) %>%
  ggplot() +
  aes(x = speed, y = dist) +
  geom_point() +
* geom_label(aes(label = id_number),
*            hjust = 1.2)
```
]
 
.panel2-cars-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/cars_auto_06_output-1.png)
]

---
class: inverse, middle, center

## Step 1: define computation

---

```r
# you won't use the scales argument, but ggplot will later
*compute_group_row_number <- function(data,
*                                    scales){

* data %>%
# add an additional column called label
# the geom we inherit from requires the label aesthetic
*   mutate(label = 1:n())

*} 
```
]
 
.panel2-compute_group_row_number-auto[

]

---
count: false

```r
# you won't use the scales argument, but ggplot will later
compute_group_row_number <- function(data,
                                     scales){

data %>%
# add an additional column called label
# the geom we inherit from requires the label aesthetic
    mutate(label = 1:n())

}

# step 1b test the computation function
*cars
```
]
 
.panel2-compute_group_row_number-auto[

---
count: false

```r
# you won't use the scales argument, but ggplot will later
compute_group_row_number <- function(data,
                                     scales){

data %>%
# add an additional column called label
# the geom we inherit from requires the label aesthetic
    mutate(label = 1:n())

}

# step 1b test the computation function
cars %>%
# input must have required aesthetic inputs as columns
* select(x = speed,
*        y = dist)
```
]
 
.panel2-compute_group_row_number-auto[

```
    x   y
1   4   2
2   4  10
3   7   4
4   7  22
5   8  16
6   9  10
7  10  18
8  10  26
9  10  34
10 11  17
11 11  28
12 12  14
13 12  20
14 12  24
15 12  28
16 13  26
17 13  34
18 13  34
19 13  46
20 14  26
21 14  36
22 14  60
23 14  80
24 15  20
25 15  26
26 15  54
27 16  32
28 16  40
29 17  32
30 17  40
31 17  50
32 18  42
33 18  56
34 18  76
35 18  84
36 19  36
37 19  46
38 19  68
39 20  32
40 20  48
41 20  52
42 20  56
43 20  64
44 22  66
45 23  54
46 24  70
47 24  92
48 24  93
49 24 120
50 25  85
```
]

---
count: false

```r
# you won't use the scales argument, but ggplot will later
compute_group_row_number <- function(data,
                                     scales){

data %>%
# add an additional column called label
# the geom we inherit from requires the label aesthetic
    mutate(label = 1:n())

}

# step 1b test the computation function
cars %>%
# input must have required aesthetic inputs as columns
  select(x = speed,
         y = dist) %>%
* compute_group_row_number()
```
]
 
.panel2-compute_group_row_number-auto[

```
    x   y label
1   4   2     1
2   4  10     2
3   7   4     3
4   7  22     4
5   8  16     5
6   9  10     6
7  10  18     7
8  10  26     8
9  10  34     9
10 11  17    10
11 11  28    11
12 12  14    12
13 12  20    13
14 12  24    14
15 12  28    15
16 13  26    16
17 13  34    17
18 13  34    18
19 13  46    19
20 14  26    20
21 14  36    21
22 14  60    22
23 14  80    23
24 15  20    24
25 15  26    25
26 15  54    26
27 16  32    27
28 16  40    28
29 17  32    29
30 17  40    30
31 17  50    31
32 18  42    32
33 18  56    33
34 18  76    34
35 18  84    35
36 19  36    36
37 19  46    37
38 19  68    38
39 20  32    39
40 20  48    40
41 20  52    41
42 20  56    42
43 20  64    43
44 22  66    44
45 23  54    45
46 24  70    46
47 24  92    47
48 24  93    48
49 24 120    49
50 25  85    50
```
]

---
class: inverse, middle, center

## Step 2: define new Stat

---

```r
*StatRownumber <- ggplot2::ggproto(
* `_class` = "StatRownumber",
* `_inherit` = ggplot2::Stat,
* required_aes = c("x", "y"),
* compute_group = compute_group_row_number
* )
```
]
 
.panel2-StatRownumber-auto[

]

---
count: false

```r
StatRownumber <- ggplot2::ggproto(
  `_class` = "StatRownumber",
  `_inherit` = ggplot2::Stat,
  required_aes = c("x", "y"),
  compute_group = compute_group_row_number
  )

## Step 2.b: test
*cars
```
]
 
.panel2-StatRownumber-auto[

---
count: false

```r
StatRownumber <- ggplot2::ggproto(
  `_class` = "StatRownumber",
  `_inherit` = ggplot2::Stat,
  required_aes = c("x", "y"),
  compute_group = compute_group_row_number
  )

## Step 2.b: test
cars %>%
* mutate(id_number = 1:n())
```
]
 
.panel2-StatRownumber-auto[

---
count: false

```r
StatRownumber <- ggplot2::ggproto(
  `_class` = "StatRownumber",
  `_inherit` = ggplot2::Stat,
  required_aes = c("x", "y"),
  compute_group = compute_group_row_number
  )

## Step 2.b: test
cars %>%
  mutate(id_number = 1:n()) %>%
* ggplot()
```
]
 
.panel2-StatRownumber-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/StatRownumber_auto_04_output-1.png)
]

---
count: false

```r
StatRownumber <- ggplot2::ggproto(
  `_class` = "StatRownumber",
  `_inherit` = ggplot2::Stat,
  required_aes = c("x", "y"),
  compute_group = compute_group_row_number
  )

## Step 2.b: test
cars %>%
  mutate(id_number = 1:n()) %>%
  ggplot() +
* aes(x = speed, y = dist)
```
]
 
.panel2-StatRownumber-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/StatRownumber_auto_05_output-1.png)
]

---
count: false

```r
StatRownumber <- ggplot2::ggproto(
  `_class` = "StatRownumber",
  `_inherit` = ggplot2::Stat,
  required_aes = c("x", "y"),
  compute_group = compute_group_row_number
  )

## Step 2.b: test
cars %>%
  mutate(id_number = 1:n()) %>%
  ggplot() +
  aes(x = speed, y = dist) +
* geom_point()
```
]
 
.panel2-StatRownumber-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/StatRownumber_auto_06_output-1.png)
]

---
count: false

```r
StatRownumber <- ggplot2::ggproto(
  `_class` = "StatRownumber",
  `_inherit` = ggplot2::Stat,
  required_aes = c("x", "y"),
  compute_group = compute_group_row_number
  )

## Step 2.b: test
cars %>%
  mutate(id_number = 1:n()) %>%
  ggplot() +
  aes(x = speed, y = dist) +
  geom_point() +
* layer(geom = GeomText,
*       stat = StatRownumber,
*       position = "identity")
```
]
 
.panel2-StatRownumber-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/StatRownumber_auto_07_output-1.png)
]

---
class: inverse, middle, center

## Step 3: define user-facing geom\_\* function

---

```r
geom_label_row_number <- function(
  mapping = NULL,
  data = NULL,
  position = "identity",
  na.rm = FALSE,
  show.legend = NA,
  inherit.aes = TRUE, ...) {

ggplot2::layer(
    stat = StatRownumber,  # proto object from Step 2
    geom = ggplot2::GeomLabel,  # inherit other behavior
    data = data,
    mapping = mapping,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, ...)

)
}
```
]
 
.panel2-geom_label_row_number-1[

]

---
class: inverse, middle, center

## Step 3.b: Enjoy! Use your function

---

```r
*cars
```
]
 
.panel2-enjoy_again-auto[

---
count: false

```r
cars %>%
* ggplot()
```
]
 
.panel2-enjoy_again-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/enjoy_again_auto_02_output-1.png)
]

---
count: false

```r
cars %>%
  ggplot() +
* aes(x = speed, y = dist)
```
]
 
.panel2-enjoy_again-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/enjoy_again_auto_03_output-1.png)
]

---
count: false

```r
cars %>%
  ggplot() +
  aes(x = speed, y = dist) +
* geom_point()
```
]
 
.panel2-enjoy_again-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/enjoy_again_auto_04_output-1.png)
]

---
count: false

```r
cars %>%
  ggplot() +
  aes(x = speed, y = dist) +
  geom_point() +
* geom_label_row_number(hjust = 1.2)  # function in action
```
]
 
.panel2-enjoy_again-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/enjoy_again_auto_05_output-1.png)
]

---
class: inverse, middle, center

### And check out conditionality!

Note: Because computation is *group-wise*, (i.e. computation is done within discrete group-defining variables) row numbers are computed within group, so rows 1, 2, 3 may be present multiple times.

---

```r
*last_plot()
```
]
 
.panel2-conditional_compute-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/conditional_compute_auto_01_output-1.png)
]

---
count: false

```r
last_plot() +
* aes(color = dist > 60)
```
]
 
.panel2-conditional_compute-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/conditional_compute_auto_02_output-1.png)
]

---
class: inverse, middle, center
background-image: url(https://images.unsplash.com/photo-1530751127259-074b0cdc0469?ixlib=rb-1.2.1&ixid=MnwxMjA3fDB8MHxwaG90by1wYWdlfHx8fGVufDB8fHx8&auto=format&fit=crop&w=1413&q=80)
background-size: cover

---
class: inverse, middle, center

## Now you...

### Create the function `geom_text_coordinates()`.

- geom should label point with its coordinates '(x, y)'
- geom should have behavior of geom_text (not geom_label)

Hint: `paste0("(", 1, ", ",3., ")")`

---
class: inverse, middle, center

# Recipe C.

## `geom_point_lm_fitted()`

---

## Step 0: use base ggplot2 to get the job done

---

```r
*model <- lm(formula =
*             bill_length_mm ~ bill_depth_mm,
*           data = penguins)
```
]
 
.panel2-fitted_1-auto[

]

---
count: false

```r
model <- lm(formula =
              bill_length_mm ~ bill_depth_mm,
            data = penguins)

*penguins_w_fitted <- penguins
```
]
 
.panel2-fitted_1-auto[

]

---
count: false

```r
model <- lm(formula =
              bill_length_mm ~ bill_depth_mm,
            data = penguins)

penguins_w_fitted <- penguins %>%
* mutate(fitted = model$fitted.values)
```
]
 
.panel2-fitted_1-auto[

]

---
count: false

```r
model <- lm(formula =
              bill_length_mm ~ bill_depth_mm,
            data = penguins)

penguins_w_fitted <- penguins %>%
  mutate(fitted = model$fitted.values)

*penguins
```
]
 
.panel2-fitted_1-auto[

---
count: false

```r
model <- lm(formula =
              bill_length_mm ~ bill_depth_mm,
            data = penguins)

penguins_w_fitted <- penguins %>%
  mutate(fitted = model$fitted.values)

penguins %>%
* ggplot()
```
]
 
.panel2-fitted_1-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/fitted_1_auto_05_output-1.png)
]

---
count: false

```r
model <- lm(formula =
              bill_length_mm ~ bill_depth_mm,
            data = penguins)

penguins_w_fitted <- penguins %>%
  mutate(fitted = model$fitted.values)

penguins %>%
  ggplot() +
* aes(x = bill_depth_mm, y = bill_length_mm)
```
]
 
.panel2-fitted_1-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/fitted_1_auto_06_output-1.png)
]

---
count: false

```r
model <- lm(formula =
              bill_length_mm ~ bill_depth_mm,
            data = penguins)

penguins_w_fitted <- penguins %>%
  mutate(fitted = model$fitted.values)

penguins %>%
  ggplot() +
  aes(x = bill_depth_mm, y = bill_length_mm) +
* geom_point()
```
]
 
.panel2-fitted_1-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/fitted_1_auto_07_output-1.png)
]

---
count: false

```r
model <- lm(formula =
              bill_length_mm ~ bill_depth_mm,
            data = penguins)

penguins_w_fitted <- penguins %>%
  mutate(fitted = model$fitted.values)

penguins %>%
  ggplot() +
  aes(x = bill_depth_mm, y = bill_length_mm) +
  geom_point() +
* geom_smooth(method = "lm", se = F)
```
]
 
.panel2-fitted_1-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/fitted_1_auto_08_output-1.png)
]

---
count: false

```r
model <- lm(formula =
              bill_length_mm ~ bill_depth_mm,
            data = penguins)

penguins_w_fitted <- penguins %>%
  mutate(fitted = model$fitted.values)

penguins %>%
  ggplot() +
  aes(x = bill_depth_mm, y = bill_length_mm) +
  geom_point() +
  geom_smooth(method = "lm", se = F) +
* geom_point(data = penguins_w_fitted,
*            aes(y = fitted),
*            color = "blue")
```
]
 
.panel2-fitted_1-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/fitted_1_auto_09_output-1.png)
]

---
class: inverse, middle, center

## Step 1: define computation

---

```r
*compute_group_lm_fitted <- function(data,
*                                  scales){
* model<-lm(formula= y ~ x, data = data)
* data %>%
*   mutate(y=model$fitted.values)
*} 
```
]
 
.panel2-fitted_2-auto[

]

---
count: false

```r
compute_group_lm_fitted <- function(data,
                                   scales){
  model<-lm(formula= y ~ x, data = data)
  data %>%
    mutate(y=model$fitted.values)
}

# test out the function
*penguins
```
]
 
.panel2-fitted_2-auto[

---
count: false

```r
compute_group_lm_fitted <- function(data,
                                   scales){
  model<-lm(formula= y ~ x, data = data)
  data %>%
    mutate(y=model$fitted.values)
}

# test out the function
penguins %>%
# select to explicitly state the x and y inputs
* select(x = bill_depth_mm,
*        y = bill_length_mm)
```
]
 
.panel2-fitted_2-auto[

---
count: false

```r
compute_group_lm_fitted <- function(data,
                                   scales){
  model<-lm(formula= y ~ x, data = data)
  data %>%
    mutate(y=model$fitted.values)
}

# test out the function
penguins %>%
# select to explicitly state the x and y inputs
  select(x = bill_depth_mm,
         y = bill_length_mm) %>%
* compute_group_lm_fitted()
```
]
 
.panel2-fitted_2-auto[

```
# A tibble: 333 × 2
       x     y
   <dbl> <dbl>
 1  18.7  43.0
 2  17.4  43.8
 3  18    43.5
 4  19.3  42.6
 5  20.6  41.8
 6  17.8  43.6
 7  19.6  42.4
 8  17.6  43.7
 9  21.2  41.4
10  21.1  41.5
11  17.8  43.6
12  19    42.8
13  20.7  41.7
14  18.4  43.2
15  21.5  41.2
16  18.3  43.3
17  18.7  43.0
18  19.2  42.7
19  18.1  43.4
20  17.2  44.0
21  18.9  42.9
22  18.6  43.1
23  17.9  43.5
24  18.6  43.1
25  18.9  42.9
26  16.7  44.3
27  18.1  43.4
28  17.8  43.6
29  18.9  42.9
30  17    44.1
31  21.1  41.5
32  20    42.2
33  18.5  43.1
34  19.3  42.6
35  19.1  42.8
36  18    43.5
37  18.4  43.2
38  18.5  43.1
39  19.7  42.4
40  16.9  44.2
41  18.8  43.0
42  19    42.8
43  17.9  43.5
44  21.2  41.4
45  17.7  43.7
46  18.9  42.9
47  17.9  43.5
48  19.5  42.5
49  18.1  43.4
50  18.6  43.1
51  17.5  43.8
52  18.8  43.0
53  16.6  44.4
54  19.1  42.8
55  16.9  44.2
# ℹ 278 more rows
```
]

## Step 2: define new Stat

---

```r
StatLmFitted <- ggplot2::ggproto(
  `_class` = "StatLmFitted",
  `_inherit` = ggplot2::Stat,
  required_aes = c("x", "y"),
  compute_group = compute_group_lm_fitted
  )
```
]
 
.panel2-fitted_3-1[

]

## Step 3: define user-facing geom\_\* function

---

```r
geom_point_lm_fitted <- function(
  mapping = NULL, data = NULL,
  position = "identity",
  na.rm = FALSE,
  show.legend = NA,
  inherit.aes = TRUE, ...) {

ggplot2::layer(
    stat = StatLmFitted,  # proto object from step 2
    geom = ggplot2::GeomPoint,  # inherit other behavior
    data = data,
    mapping = mapping,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, ...)
  )

}
```
]
 
.panel2-fitted_4-1[

]

---
class: inverse, middle, center

## Step 3.b: Enjoy! Use your function

---

```r
*penguins
```
]
 
.panel2-fitted_5-auto[

---
count: false

```r
penguins %>%
* ggplot()
```
]
 
.panel2-fitted_5-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/fitted_5_auto_02_output-1.png)
]

---
count: false

```r
penguins %>%
  ggplot() +
* aes(x = bill_depth_mm, y = bill_length_mm)
```
]
 
.panel2-fitted_5-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/fitted_5_auto_03_output-1.png)
]

---
count: false

```r
penguins %>%
  ggplot() +
  aes(x = bill_depth_mm, y = bill_length_mm) +
* geom_point()
```
]
 
.panel2-fitted_5-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/fitted_5_auto_04_output-1.png)
]

---
count: false

```r
penguins %>%
  ggplot() +
  aes(x = bill_depth_mm, y = bill_length_mm) +
  geom_point() +
* geom_smooth(method = "lm", se = F)
```
]
 
.panel2-fitted_5-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/fitted_5_auto_05_output-1.png)
]

---
count: false

```r
penguins %>%
  ggplot() +
  aes(x = bill_depth_mm, y = bill_length_mm) +
  geom_point() +
  geom_smooth(method = "lm", se = F)+
* geom_point_lm_fitted(color = "blue")
```
]
 
.panel2-fitted_5-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/fitted_5_auto_06_output-1.png)
]

---
class: inverse, middle, center

### And check out conditionality

---

```r
*penguins
```
]
 
.panel2-fitted_6-auto[

---
count: false

```r
penguins %>%
* ggplot()
```
]
 
.panel2-fitted_6-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/fitted_6_auto_02_output-1.png)
]

---
count: false

```r
penguins %>%
  ggplot() +
* aes(x = bill_depth_mm,
*     y = bill_length_mm)
```
]
 
.panel2-fitted_6-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/fitted_6_auto_03_output-1.png)
]

---
count: false

```r
penguins %>%
  ggplot() +
  aes(x = bill_depth_mm,
      y = bill_length_mm) +
* geom_point()
```
]
 
.panel2-fitted_6-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/fitted_6_auto_04_output-1.png)
]

---
count: false

```r
penguins %>%
  ggplot() +
  aes(x = bill_depth_mm,
      y = bill_length_mm) +
  geom_point() +
* geom_smooth(method="lm", se= F)
```
]
 
.panel2-fitted_6-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/fitted_6_auto_05_output-1.png)
]

---
count: false

```r
penguins %>%
  ggplot() +
  aes(x = bill_depth_mm,
      y = bill_length_mm) +
  geom_point() +
  geom_smooth(method="lm", se= F) +
* geom_point_lm_fitted()
```
]
 
.panel2-fitted_6-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/fitted_6_auto_06_output-1.png)
]

---
count: false

```r
penguins %>%
  ggplot() +
  aes(x = bill_depth_mm,
      y = bill_length_mm) +
  geom_point() +
  geom_smooth(method="lm", se= F) +
  geom_point_lm_fitted() +
* facet_wrap(facets = vars(species))
```
]
 
.panel2-fitted_6-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/fitted_6_auto_07_output-1.png)
]

---
class: inverse, middle, center
background-image: url(https://images.unsplash.com/photo-1499636136210-6f4ee915583e?ixlib=rb-1.2.1&ixid=MnwxMjA3fDB8MHxwaG90by1wYWdlfHx8fGVufDB8fHx8&auto=format&fit=crop&w=464&q=80)
background-size: cover

---
class: inverse, middle, center

## Now you... Create the function `geom_segment_lm_residuals()`.

### Hint: read about what aesthetics are required for segments.  We'll give you Step 0 this time...

## Step 0: use base ggplot2 to get the job done

---

```r
*model <- lm(formula =
*             bill_length_mm ~ bill_depth_mm,
*           data = penguins)
```
]
 
.panel2-residuals-auto[

]

---
count: false

```r
model <- lm(formula =
              bill_length_mm ~ bill_depth_mm,
            data = penguins)

*penguins_w_fitted <- penguins
```
]
 
.panel2-residuals-auto[

]

---
count: false

```r
model <- lm(formula =
              bill_length_mm ~ bill_depth_mm,
            data = penguins)

penguins_w_fitted <- penguins %>%
* mutate(fitted = model$fitted.values)
```
]
 
.panel2-residuals-auto[

]

---
count: false

```r
model <- lm(formula =
              bill_length_mm ~ bill_depth_mm,
            data = penguins)

penguins_w_fitted <- penguins %>%
  mutate(fitted = model$fitted.values)

*penguins
```
]
 
.panel2-residuals-auto[

---
count: false

```r
model <- lm(formula =
              bill_length_mm ~ bill_depth_mm,
            data = penguins)

penguins_w_fitted <- penguins %>%
  mutate(fitted = model$fitted.values)

penguins %>%
* ggplot()
```
]
 
.panel2-residuals-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/residuals_auto_05_output-1.png)
]

---
count: false

```r
model <- lm(formula =
              bill_length_mm ~ bill_depth_mm,
            data = penguins)

penguins_w_fitted <- penguins %>%
  mutate(fitted = model$fitted.values)

penguins %>%
  ggplot() +
* aes(x = bill_depth_mm, y = bill_length_mm)
```
]
 
.panel2-residuals-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/residuals_auto_06_output-1.png)
]

---
count: false

```r
model <- lm(formula =
              bill_length_mm ~ bill_depth_mm,
            data = penguins)

penguins_w_fitted <- penguins %>%
  mutate(fitted = model$fitted.values)

penguins %>%
  ggplot() +
  aes(x = bill_depth_mm, y = bill_length_mm) +
* geom_point()
```
]
 
.panel2-residuals-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/residuals_auto_07_output-1.png)
]

---
count: false

```r
model <- lm(formula =
              bill_length_mm ~ bill_depth_mm,
            data = penguins)

penguins_w_fitted <- penguins %>%
  mutate(fitted = model$fitted.values)

penguins %>%
  ggplot() +
  aes(x = bill_depth_mm, y = bill_length_mm) +
  geom_point() +
* geom_smooth(method = "lm", se = F)
```
]
 
.panel2-residuals-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/residuals_auto_08_output-1.png)
]

---
count: false

```r
model <- lm(formula =
              bill_length_mm ~ bill_depth_mm,
            data = penguins)

penguins_w_fitted <- penguins %>%
  mutate(fitted = model$fitted.values)

penguins %>%
  ggplot() +
  aes(x = bill_depth_mm, y = bill_length_mm) +
  geom_point() +
  geom_smooth(method = "lm", se = F) +
* geom_segment(data = penguins_w_fitted,
*            aes(yend = fitted, xend = bill_depth_mm),
*            color = "blue")
```
]
 
.panel2-residuals-auto[
![](easy_geom_recipes_flipbook_2024_files/figure-html/residuals_auto_09_output-1.png)
]

---

#### Photo Credits: Thalia Ruiz, Jennifer Pallian, Lisa Hanly, John Dancy, Piper Bchamp

#### More comprehensive extension resources:

- [ggplot2-extension-cookbook: an example-rich Stat-focused resource](https://evamaerey.github.io/ggplot2-extension-cookbook/) Gina Reynolds

- [Extending your ability to extend ggplot2: StatCircle demo and high level overview](https://www.youtube.com/watch?v=uj7A3i2fi54) Thomas Lin Pederson

- [Extending ggplot2 package Vignette: walkthough many extension  mechanisms](https://cran.r-project.org/web/packages/ggplot2/vignettes/extending-ggplot2.html)

- [Extending ggplot2 chapter](https://ggplot2-book.org/extensions.html)