создавать различные шкалы заливки в слоях изображения

Question

Я буду использовать набор данных mtcars в качестве примера.Я хотел бы перейти между одной переменной (цил) и другой переменной (л.с.) для тех же точек данных на основе цвета заливки.Однако масштаб устанавливается для всего диапазона от 4: 335.Таким образом, когда цил показан, все точки выглядят одинаково, потому что их цвет «сдавлен», из-за отсутствия лучшего термина, верхней границей hp.Я хотел бы, чтобы цветовая шкала при заполнении цилиндра составляла 4: 8, а при отображении hp - 52: 335.Вот минимальный пример

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

Answer 1

Вот еще один метод. Здесь требуется дополнительная предварительная обработка, но я думаю, что в этом подходе все еще есть некоторая ценность, поскольку он более поддается переходу между> 2 переменными для более широкого варианта использования.

Определение нового набора данных с собранными столбцами и значениями заполнения, масштабированными до общего диапазона (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

Поскольку один и тот же масштаб легенды будет применяться к разным значениям во время анимации, нам нужны разные метки для них. Мы можем включить дополнительные слои geom в график, чтобы смоделировать это, одновременно подавляя фактическую легенду заливки.

# 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)))

Создать сюжет:

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)

Answer 2

Один из вариантов - использовать заливку для одной переменной и цвет для другой, используя тот факт, что некоторые точечные фигуры используют заливку, а другие - цвет.Я не на 100% доволен результатом, может потребоваться некоторая подстройка, чтобы размеры очков соответствовали:

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()