Conditional Heatmap in R ggplot-CodePudding

I am attempting to create a heatmap in ggplot based on a condition with this dataset. The dataset records rankings of 4 players over a period of time.

       Player 1  Player 2  Player 3  Player 4
1        3          1           4       2
2        3          4           2       1
3        2          3           4       1
4        4          2           1       3          
5        1          4           3       2

If a player places higher in row n 1, I would like the color to be green. If a player places lower in row n 1, I would like the color to be red. If they place the same, then I would like the color to be gray.

For example, player 1 placed the same in row 2 as he did in row 1, so I would like the color in row 2 column 1 to be gray. Player 4 placed higher in row 2 than he did in row 1, so I would like the color in row 2 column 4 to be green.

How can I achieve this in ggplot?

CodePudding user response：

# your data:
df <- structure(list(Year = c(1, 2, 3, 4, 5), `Player 1` = c(3, 3, 
2, 4, 1), `Player 2` = c(1, 4, 3, 2, 4), `Player 3` = c(4, 2, 
4, 1, 3), `Player 4` = c(2, 1, 1, 3, 2)), row.names = c(NA, -5L
), class = "data.frame")

# solution:
library(tidyverse)
change_long <- df %>% mutate(across(starts_with("Player"), ~ sign(. - lag(.)))) %>%
  pivot_longer(starts_with("Player"), names_to = "Player", values_to = "Change") %>%
  drop_na()

ggplot(change_long, aes(Year, Player, fill = factor(Change)))  
  geom_tile()   scale_fill_manual(values = c("red", "grey", "green"))

CodePudding user response：

Reshape your data into long format, add a Week column, calculate the sign of the diff of the score and use that for the fill:

library(tidyverse)

df %>%
  pivot_longer(everything(), names_to = "Player", values_to = "Score") %>%
  group_by(Player) %>%
  mutate(Change = factor(c(0, sign(diff(Score)))),
         Week = factor(seq_along(Change), rev(seq_along(Change)))) %>%
  ggplot(aes(Player, Week, fill = Change))  
  geom_tile(color = "black")  
  geom_text(aes(label = Score), color = "white", size = 8)  
  scale_x_discrete(position = "top")  
  scale_fill_manual(values = c("red3", "gray30", "green4"))  
  coord_equal()  
  theme_minimal(base_size = 16)  
  theme(axis.title.x.top = element_blank(),
        legend.position = "none")

Or for a paler version,

df %>%
  pivot_longer(everything(), names_to = "Player", values_to = "Score") %>%
  group_by(Player) %>%
  mutate(Change = factor(c(0, sign(diff(Score)))),
         Week = factor(seq_along(Change), rev(seq_along(Change)))) %>%
  ggplot(aes(Player, Week, fill = Change))  
  geom_tile(color = "black")  
  geom_text(aes(label = Score), size = 8)  
  scale_x_discrete(position = "top")  
  scale_fill_manual(values = c("#F06675", "gray90", "#86E075"))  
  coord_equal()  
  theme_minimal(base_size = 16)  
  theme(axis.title.x.top = element_blank(),
        legend.position = "none")

^{Created on 2022-06-23 by the reprex package (v2.0.1)}