1

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

Aureliano Guedes
  • 767
  • 6
  • 22
  • 2
    I don't know if it will do what you want but there's a package for multiple color scales in ggplot2 that might be helpful: https://github.com/eliocamp/ggnewscale – jtr13 Nov 29 '20 at 02:42
  • @jtr13 thanks for your suggestion. Actually, I know this package but it is not exactly what I want. I'd like each value on the x-axis with its color pallet and legend but in the same layer. Each x-axis element is a set of independent values. My last plot does something quite close to `ggnewscale`. – Aureliano Guedes Nov 29 '20 at 20:47
  • 1
    @jtr13 I added your suggestion on the post, ad it was the farthest I could go. – Aureliano Guedes Nov 29 '20 at 21:07
  • You could use one color scale based on value *and* key. A very crude version: replace your first `ggplot` call with: `ggplot(temp, aes(x = key, y=rnames)) + geom_tile(aes(fill = paste(key, value)))` – jtr13 Nov 29 '20 at 22:27

1 Answers1

0

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

Aureliano Guedes
  • 767
  • 6
  • 22