1

我试图做一个每列都有自己的热图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 包(v0.3.0)于 2020 年 11 月 29 日创建

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

我很感激任何帮助。提前致谢

4

1 回答 1

0

该解决方案ggnewscaleEliot 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 包(v0.3.0)于 2020-12-03 创建

问候

于 2020-12-03T15:59:27.163 回答