geom_tile 中每个 x 的独占比例

Question

我试图制作一个热图，其中每一列都有自己 scale_fill_discrete。

以下都是我的尝试。

我希望每个 key 共享相同的情节，但有自己的规模，我能做的最接近的是最后一次尝试。

library(tidyverse)
library(patchwork)
library(ggsci)
library(ggnewscale)


mtcars %>%
  rownames_to_column("rnames") %>% 
  as_tibble() %>% 
  mutate_all(as_factor) %>%
  select(rnames, vs, am, gear, carb) %>% 
  gather(key = "key", value = "value", -rnames) -> temp
#> Warning: attributes are not identical across measure variables;
#> they will be dropped


ggplot(
  temp, 
  aes(x = key, y=rnames)
) +
  geom_tile(aes(fill = value)) +
  facet_wrap(. ~ key)


temp %>% 
  pull(key) %>% 
  unique() %>% 
  map(
    ~ ggplot(
      temp %>% filter(key ==.x), 
      aes(x = key, y=rnames)
    ) +
      geom_tile(aes(fill = value))
  ) -> p

p[[1]] <- p[[1]] +
  scale_fill_tron()
p[[2]] <- p[[2]] + 
  scale_fill_futurama() +
  theme(axis.title = element_blank(), axis.ticks = element_blank(), axis.text.y = element_blank())
p[[3]] <- p[[3]] + 
  scale_fill_simpsons() +
  theme(axis.title = element_blank(), axis.ticks = element_blank(), axis.text.y = element_blank())
p[[4]] <- p[[4]] + 
  scale_fill_rickandmorty() +
  theme(axis.title = element_blank(), axis.ticks = element_blank(), axis.text.y = element_blank())

Reduce(`|`, p) + 
  wrap_elements() + 
  plot_layout(guides = "collect") & theme(legend.position = 'bottom')


ggplot() + 
  geom_tile(
    data = temp %>% filter(key=="vs") %>% droplevels, 
    aes(key, rnames, fill=value)
  ) + 
  scale_fill_simpsons() + 
  new_scale_fill() + 
  geom_tile(
    data = temp %>% filter(key=="am") %>% droplevels, 
    aes(key, rnames, fill=value)
  ) + 
  scale_fill_rickandmorty() +
  new_scale_fill() + 
  geom_tile(
    data = temp %>% filter(key=="gear") %>% droplevels, 
    aes(key, rnames, fill=value)
  ) + 
  scale_fill_futurama() +
  new_scale_fill() + 
  geom_tile(
    data = temp %>% filter(key=="carb") %>% droplevels, 
    aes(key, rnames, fill=value)
  ) + 
  scale_fill_tron()

^{由 reprex package (v0.3.0)}

于 2020-11-29 创建

如您所见，即使是最后一次尝试也有问题。

非常感谢您的帮助。提前致谢

Answer 1

The solution provide by the author of ggnewscale, Eliot Campitelli.

更多详情请见 https://github.com/tidyverse/ggplot2/issues/4280

library(tidyverse)
library(ggsci)
library(ggnewscale)

data(mtcars)
mtcars %>%
  rownames_to_column("rnames") %>% 
  as_tibble() %>% 
  mutate_all(as_factor) %>%
  select(rnames, vs, am, gear, carb) %>% 
  gather(key = "key", value = "value", -rnames) -> temp
#> Warning: attributes are not identical across measure variables;
#> they will be dropped
#> Warning: attributes are not identical across measure variables;
#> they will be dropped


ggplot() + 
  geom_tile(
    data = temp %>% filter(key=="vs") %>% droplevels, 
    aes(key, rnames, fill=value)
  ) + 
  scale_fill_simpsons(name = "simpsns") + 
  new_scale_fill() + 
  geom_tile(
    data = temp %>% filter(key=="am") %>% droplevels, 
    aes(key, rnames, fill=value)
  ) + 
  scale_fill_rickandmorty(name ="rick") +
  new_scale_fill() + 
  geom_tile(
    data = temp %>% filter(key=="gear") %>% droplevels, 
    aes(key, rnames, fill=value)
  ) + 
  scale_fill_futurama(name ="futurama") +
  new_scale_fill() + 
  geom_tile(
    data = temp %>% filter(key=="carb") %>% droplevels, 
    aes(key, rnames, fill=value)
  ) + 
  scale_fill_tron(name ="tron") +
  theme(legend.position="bottom")

^{由 reprex package (v0.3.0)}

于 2020-12-03 创建

问候

geom_tile 中每个 x 的独占比例

exclusive scale to each x in geom_tile

r

scale

heatmap

ggplot2

geom-tile