geom_*(stat = StatCustom) notes

[EvaMaeRey]

So in #26 I exploring geom_*(stat = ) this direction for 'express' use of Stats.

Sometimes paths that you imagine might work fail, like with geom_vline (no stat argument). Here documentng geom_col() failing for the same reason - but geom_bar works fine. I feel slightly more surprised by geom_col() not having the stat argument than geom_vline.

library(ggplot2)
compute_group_square <- function(data,scales){
  
  data.frame(x = 1, y = 1) |> 
    dplyr::mutate(xmin = x - .5, 
           xmax = x + .5,
           ymin = y - .5,
           ymax = y + .5)
  
}


StatSquare <- ggproto("StatSquare", 
                      Stat,
                      compute_group = compute_group_square)

ggplot(cars) + 
  geom_point(stat = StatSquare)

ggplot(cars) + 
  geom_rect(stat = StatSquare)

ggplot(cars) + 
  geom_bar(stat = StatSquare)

ggplot(cars) + 
  geom_col(stat = StatSquare)
#> Warning in geom_col(stat = StatSquare): Ignoring unknown parameters: `stat`
#> Error in `geom_col()`:
#> ! Problem while setting up geom.
#> ℹ Error occurred in the 1st layer.
#> Caused by error in `compute_geom_1()`:
#> ! `geom_col()` requires the following missing aesthetics: x and y.

ggplot(cars) + 
  layer(geom = GeomCol, 
        stat = StatSquare,
        position = "identity")

^{Created on 2024-07-31 with reprex v2.1.0}

[EvaMaeRey]

From #14, trying to use this approach, but fails. I don't have a clear sense of why yet. group/category fussiness?

library(tidyverse)
compute_panel_multi_response <- function(data, 
                                         scales, 
                                         cat_levels, 
                                         sep = ";"){
  
  # data = data.frame(responses = survey$q09)
  nrespondents <- nrow(data)

  data %>%
    summarise(responses = paste0(responses, collapse = sep)) %>% 
    mutate(response = str_split(responses, sep)) %>% 
    select(-responses) %>% 
    unnest(response) %>% 
    filter(response != "NA") %>% 
    count(response) %>%
    mutate(x = factor(response, cat_levels) %>% 
             as.numeric %>% as.double()) %>%
    mutate(y = as.double(n)) %>% 
    mutate(num_respondents = nrespondents)
  
}


fruit_cats <- c("apple", "banana", "pear", "orange" )


data.frame(selected_fruit = 
             c("banana;apple;pear", 
               "apple;pear", 
               "banana;pear")) %>%
  select(responses = selected_fruit) %>% 
  compute_panel_multi_response(cat_levels = fruit_cats)
#> # A tibble: 3 × 5
#>   response     n     x     y num_respondents
#>   <chr>    <int> <dbl> <dbl>           <int>
#> 1 apple        2     1     2               3
#> 2 banana       2     2     2               3
#> 3 pear         3     3     3               3

StatMulticat <- ggplot2::ggproto(`_class` = "StatMulticat",
                        `_inherit` = ggplot2::Stat,  
                        compute_panel = compute_panel_multi_response,
                        default_aes = aes(label = ggplot2::after_stat(paste0(n, "/", num_respondents))))

Fails

data.frame(fruit_selections = c("banana;apple;pear", "apple;pear", "pear")) %>% 
  ggplot() +  
  aes(responses = fruit_selections) +
  geom_bar(stat = StatMulticat, cat_levels = fruit_cats)
#> Error in `geom_bar()`:
#> ! Problem while computing position.
#> ℹ Error occurred in the 1st layer.
#> Caused by error in `-data$group`:
#> ! invalid argument to unary operator

Works

data.frame(fruit_selections = c("banana;apple;pear", "apple;pear", "pear")) %>% 
  ggplot() +  
  aes(responses = fruit_selections) + 
  layer(geom = "bar", stat = StatMulticat, position = "identity",
         params = list(cat_levels = fruit_cats)) + 
  layer(geom = "label", stat = StatMulticat, position = "identity",
        params = list(cat_levels = fruit_cats, 
                      hjust = 0,
                      alpha = 0,
                      label.size = 0)) +
  aes(fill = after_scale(x)) +
  coord_flip() + 
  labs(title = "Number of respondents selecting each fruit when asked\n'Which of the following fruits do you like to eat?'",
       subtitle = "Three people were surveyed")

^{Created on 2024-07-31 with reprex v2.1.0}

[EvaMaeRey]

Defining layer_2way (geom_point/stat_identity adapted to let you modify geom and stat) before layer definition may give you a similar feel to a geom_*(stat = StatMyCustom, ...).

library(tidyverse)
layer_2way = function (mapping = NULL, data = NULL, geom = GeomPoint, 
                         stat = StatIdentity, position = "identity", 
                         ..., na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) 
{
    layer(data = data, mapping = mapping, stat = stat, geom = geom, 
        position = position, show.legend = show.legend, inherit.aes = inherit.aes, 
        params = rlang::list2(na.rm = na.rm, ...))
}

library(ggplot2)
c_xmean <- function(data, ...){data |> dplyr::summarise(xintercept = mean(x))}

StatXmean <- ggplot2::ggproto("StatXmean", ggplot2::Stat, 
                              compute_group = c_xmean,
                              required_aes = "x", 
                              dropped_aes = c("x", "y"))

geom_xmean <- function(...){layer_2way(stat = StatXmean, geom = GeomVline, ...)}

ggplot(cars) + 
  aes(speed, dist) + 
  geom_point() +
  geom_xmean(color = "green") 

last_plot() + 
  aes(linetype = speed > 15)

^{Created on 2024-09-05 with reprex v2.1.0}