Изменить цвет текста на основе порога

Question

У меня есть некоторые данные, которые я хочу использовать для создания тепловой карты.

library(tidyverse)
library(viridisLite)

f<-tibble::tribble(
           ~wday, ~hour,              ~WR,
      "Saturday",   "9", 54.7272727272727,
      "Saturday",  "10",           69.125,
      "Saturday",  "11",             81.8,
      "Saturday",  "12", 70.0833333333333,
      "Saturday",  "13", 68.1176470588235,
      "Saturday",  "14", 73.0769230769231,
      "Saturday",  "15", 83.0714285714286,
      "Saturday",  "16", 75.5555555555556,
      "Saturday",  "17",             90.9,
      "Saturday",  "18",               98,
      "Saturday",  "19",            88.75,
        "Friday",   "6",           31.375,
        "Friday",   "7", 55.3333333333333,
        "Friday",   "8", 65.8888888888889,
        "Friday",   "9", 70.3636363636364,
        "Friday",  "10", 87.5833333333333,
        "Friday",  "11", 107.818181818182,
        "Friday",  "12", 118.153846153846,
        "Friday",  "13", 119.545454545455,
        "Friday",  "14",              122,
        "Friday",  "15", 139.583333333333,
        "Friday",  "16", 132.538461538462,
        "Friday",  "17",            126.9,
        "Friday",  "18", 110.055555555556,
        "Friday",  "19",             73.4,
      "Thursday",   "6",             27.2,
      "Thursday",   "7", 55.6666666666667,
      "Thursday",   "8", 63.7272727272727,
      "Thursday",   "9", 77.8461538461538,
      "Thursday",  "10",             83.8,
      "Thursday",  "11", 100.214285714286,
      "Thursday",  "12", 110.785714285714,
      "Thursday",  "13", 105.285714285714,
      "Thursday",  "14", 116.428571428571,
      "Thursday",  "15",           116.75,
      "Thursday",  "16", 150.333333333333,
      "Thursday",  "17",           154.75,
      "Thursday",  "18", 133.363636363636,
      "Thursday",  "19",           114.25,
      "Thursday",  "20", 97.7333333333333,
      "Thursday",  "21",            101.5,
      "Thursday",  "22",            53.75,
     "Wednesday",   "6",             22.6,
     "Wednesday",   "7",            54.25,
     "Wednesday",   "8",             65.1,
     "Wednesday",   "9", 79.3636363636364,
     "Wednesday",  "10",             96.1,
     "Wednesday",  "11", 107.333333333333,
     "Wednesday",  "12", 110.416666666667,
     "Wednesday",  "13", 120.888888888889,
     "Wednesday",  "14", 116.363636363636,
     "Wednesday",  "15",           134.25,
     "Wednesday",  "16",            140.4,
     "Wednesday",  "17", 138.333333333333,
     "Wednesday",  "18",              118,
     "Wednesday",  "19",               97,
     "Wednesday",  "20", 107.076923076923,
     "Wednesday",  "21",             93.7,
     "Wednesday",  "22", 99.1666666666667,
       "Tuesday",   "6", 26.8333333333333,
       "Tuesday",   "7", 53.1111111111111,
       "Tuesday",   "8", 66.1818181818182,
       "Tuesday",   "9", 73.6666666666667,
       "Tuesday",  "10", 85.9090909090909,
       "Tuesday",  "11", 114.818181818182,
       "Tuesday",  "12", 112.909090909091,
       "Tuesday",  "13", 106.583333333333,
       "Tuesday",  "14",            109.5,
       "Tuesday",  "15", 107.909090909091,
       "Tuesday",  "16",          123.375,
       "Tuesday",  "17", 128.428571428571,
       "Tuesday",  "18",            141.9,
       "Tuesday",  "19", 110.090909090909,
       "Tuesday",  "20", 102.692307692308,
       "Tuesday",  "21", 91.8571428571429,
       "Tuesday",  "22",             84.4,
        "Monday",   "6",            29.75,
        "Monday",   "7", 63.6153846153846,
        "Monday",   "8", 72.8571428571429,
        "Monday",   "9",            74.75,
        "Monday",  "10",            91.25,
        "Monday",  "11", 102.923076923077,
        "Monday",  "12", 130.071428571429,
        "Monday",  "13", 133.818181818182,
        "Monday",  "14", 129.916666666667,
        "Monday",  "15", 139.076923076923,
        "Monday",  "16", 149.923076923077,
        "Monday",  "17", 146.272727272727,
        "Monday",  "18", 139.545454545455,
        "Monday",  "19", 121.666666666667,
        "Monday",  "20",            120.2,
        "Monday",  "21",             91.9,
        "Monday",  "22", 92.6666666666667,
        "Sunday",   "9", 47.1111111111111,
        "Sunday",  "10", 55.9166666666667,
        "Sunday",  "11", 67.1818181818182,
        "Sunday",  "12",          64.4375,
        "Sunday",  "13", 67.7777777777778,
        "Sunday",  "14", 67.8571428571429,
        "Sunday",  "15", 73.6923076923077,
        "Sunday",  "16", 83.3636363636364,
        "Sunday",  "17", 71.3333333333333,
        "Sunday",  "18", 71.5384615384615,
        "Sunday",  "19",               67,
        "Sunday",  "20", 66.5833333333333,
        "Sunday",  "21", 74.2857142857143,
        "Sunday",  "22",             58.8,
        "Sunday",  "23",                9
     )

Я делаю тепловую карту, используя следующие команды

f %>% 
  ggplot(aes(hour, wday, fill = WR))+
  geom_tile(size = 1, color = 'black')+
  geom_text(aes(label = round(WR)))+
  coord_equal()+
  scale_fill_viridis_c()+
  theme_minimal()+
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank())

Полученный текст из geom_text в некоторых случаях слишком темный и скрыт темными цветами выбранной мной цветовой карты. Смотрите график ниже.

Как я могу создать новый столбец в f, который меняет цвет текста на белый, когда соответствующий цвет в карте цветов запутывает текст?

Answer 1

Небольшая модификация существующего кода может справиться с этим, не изменяя базовый фрейм данных:

f %>% 
  ggplot(aes(hour, wday, fill = WR))+
  geom_tile(size = 1, color = 'black')+

  # Vary text color based on WR value. Change the threshold from 50 to some other value,
  # if desired.
  geom_text(aes(label = round(WR),
                color = ifelse(WR < 50,
                               "white", "black")))+

  coord_equal()+
  scale_fill_viridis_c()+

  # Tell ggplot2 to use the colors defined above directly, as aesthetic values, without 
  # further mapping. By default, this scale will not generate a legend.
  scale_color_identity() +

  theme_minimal()+
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank())

Используемые данные:

# sort x & y axis values to match the plot in the question
f <- f %>%
  mutate(hour = factor(as.integer(hour)),
         wday = factor(wday,
                       levels = c("Saturday", "Friday", "Thursday", "Wednesday", 
                                  "Tuesday", "Monday", "Sunday")))