2

I'll use the mtcars dataset as an example. I'd like to transition between one variable (cyl) and another variable (hp) for the same data points based on fill color. However, the scale is set for the entire range between 4:335. Thus, when cyl is shown all the points look the same because their color is "squashed", for lack of a better term, by the upper bound of hp. What I'd like to have happen is that the color scale while cyl is being filled is 4:8 and when hp is being shown is 52:335. Here's a minimal example

library(ggplot2)
library(gganimate)
library(RColorBrewer)
library(grDevices)

myPalette <- colorRampPalette(rev(brewer.pal(11, "Spectral")))

anim <- ggplot(mtcars, aes(mpg, disp)) +
  geom_point(shape = 21, colour = "black", size = 3, stroke = 0.5, show.legend = T, aes(fill = cyl)) +
  geom_point(shape = 21, colour = "black", size = 3, stroke = 0.5, show.legend = T, aes(fill = hp)) +
  scale_fill_gradientn(colours = myPalette(100))+
  transition_layers(layer_length = 1, transition_length = 2) +
  enter_fade() + enter_grow()

anim

mtcars gif

Stephen Williams
  • 561
  • 4
  • 12

2 Answers2

2

Here's another method. More pre-processing required here, but I think there's still some value to this approach, as it's more amenable to transitioning between >2 variables for a broader use case.

Define new dataset with gathered columns & fill values scaled to a common range (0-1):

library(dplyr)

# modify dataset
mtcars2 <- mtcars %>%
  select(mpg, disp, cyl, hp) %>%
  tidyr::gather(key, value, -mpg, -disp) %>%
  group_by(key) %>%
  mutate(scaled.value = (value - min(value)) / diff(range(value))) %>%
  ungroup()

> head(mtcars2)
# A tibble: 6 x 5
    mpg  disp key   value scaled.value
  <dbl> <dbl> <chr> <dbl>        <dbl>
1  21     160 cyl       6          0.5
2  21     160 cyl       6          0.5
3  22.8   108 cyl       4          0  
4  21.4   258 cyl       6          0.5
5  18.7   360 cyl       8          1  
6  18.1   225 cyl       6          0.5

Since the same legend scale will apply to different values during animation, we need different labels for them. We can include additional geom layers in the plot to simulate this, while suppressing the actual fill legend.

# may need further tweaking, depending on the actual plot's dimensions; this worked
# sufficiently for me
legend.position <- c("xmin" = max(mtcars2$mpg) - 0.05 * diff(range(mtcars2$mpg)),
                     "xmax" = max(mtcars2$mpg) - 0.02 * diff(range(mtcars2$mpg)),
                     "ymin" = max(mtcars2$disp) - 0.2 * diff(range(mtcars2$disp)),
                     "ymax" = max(mtcars2$disp) - 0.01 * diff(range(mtcars2$disp)))

Generate plot:

anim1 <- ggplot(mtcars2, aes(mpg, disp)) +
  geom_point(aes(fill = scaled.value, group = interaction(mpg, disp, scaled.value)),
             shape = 21, colour = "black", size = 3, stroke = 0.5) +

  # pseudo legend title
  geom_text(aes(x = legend.position[["xmin"]],
                y = legend.position[["ymax"]],
                label = key),
            vjust = -1, hjust = 0, check_overlap = TRUE) +
  # pseudo legend labels (tweak number of breaks, font size, etc., as needed)
  geom_text(data = . %>%
              group_by(key) %>%
              summarise(y = list(modelr::seq_range(scaled.value, n = 5)),
                        label = list(modelr::seq_range(value, n = 5))) %>%
              ungroup() %>%
              tidyr::unnest() %>%
              mutate(y = legend.position[["ymin"]] + 
                       y * (legend.position[["ymax"]] - legend.position[["ymin"]])),            
            aes(x = legend.position[["xmax"]], y = y, label = as.character(round(label))),
            hjust = 0, nudge_x = 0.5, size = 3, check_overlap = TRUE) +
  # pseudo colour bar
  annotation_custom(grob = grid::rasterGrob(rev(myPalette(100)),
                                            width = unit(1, "npc"), height = unit(1, "npc")),
                    xmin = legend.position[["xmin"]],
                    xmax = legend.position[["xmax"]],
                    ymin = legend.position[["ymin"]],
                    ymax = legend.position[["ymax"]]) +

  scale_fill_gradientn(colours = myPalette(100), guide = FALSE) +
  labs(title = "{closest_state}") +
  transition_states(key) +
  enter_fade() +
  enter_grow()

# reducing nframes to speed up the animation, since there are only two states anyway
animate(anim1, nframes = 20)

plot

Z.Lin
  • 28,055
  • 6
  • 54
  • 94
1

One option is to use fill for one variable, and colour for the other, using the fact that some point shapes use fill and the others colour. I'm not 100% happy with the result, it may need some tweaking to get the point sizes to match up:

anim <- ggplot(mtcars, aes(mpg, disp)) +
    geom_point(shape = 16,  size = 3, show.legend = T, aes(colour = cyl)) +
    geom_point(shape = 21, size = 3, stroke = 0, show.legend = T, aes(fill = hp)) +
    scale_fill_gradientn(colours = myPalette(100))+
    scale_colour_gradientn(colours = myPalette(100))+
    transition_layers(layer_length = 1, transition_length = 2) +
    enter_fade() + enter_grow()
Marius
  • 58,213
  • 16
  • 107
  • 105
  • The other method I thought of was to create the colours yourself and use `scale_fill_identity`, as shown in my answer here: https://stackoverflow.com/a/51433851/1222578. It does make it tough to create a legend though. – Marius Apr 10 '19 at 00:10
  • This is great! Got me 99% of the way and I'm pretty sure I can figure out the fine details later. – Stephen Williams Apr 10 '19 at 03:58