Search code examples
rggplot2scaleheatmapgeom-tile

exclusive scale to each x in geom_tile

I was trying to do a heatmap where each column has itself scale_fill_discrete.

Below all my tentative.

I'd like each key sharing the same plot but with itself scale, the closest I could do was the last tentative.

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

Created on 2020-11-29 by the reprex package (v0.3.0)

As you can see, even the last try has issues.

I'm grateful for any assistance. Thanks in advance

Solution

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

    Further details at 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")

    Created on 2020-12-03 by the reprex package (v0.3.0)

    Greetings