Цвет текста легенды соответствия в geom_text для символа

Я пытаюсь сопоставить текст легенды с цветом текста, созданного факторизованной переменной, с помощью geom_text. Вот минимальный рабочий пример:

df <- data.frame(a=rnorm(10),b=1:10,c=letters[1:10],d=c("one","two"))
p1 <-ggplot(data=df,aes(x=b,y=a))
p1 <- p1 + geom_text(aes(label = c, color=d, fontface="bold"))
p1 <- p1 + scale_color_hue(name="colors should match",breaks=c("one", "two"),
                 labels=c("should be pink", "should be blue"))
p1

enter image description here

Я уверен, что это простое исправление. Любые предложения или ссылки на предыдущие должности помогут. Я не нашел ничего конкретного.

Ответ 1

Исходя из комментария Джорана выше, вы можете редактировать гроб напрямую. Это довольно некрасивый код, поэтому извиняюсь [будет гораздо более элегантный способ сделать это с помощью команд grid - и, надеюсь, кто-то опубликует).

library(grid)

gglabcol <- function(plot1){

         g <- ggplotGrob(plot1)

         # legend grobs
         g.b <- g[["grobs"]][[which(g$layout$name=="guide-box")]]
         l <- g.b[[1]][[1]][["grobs"]]

         # get grobs for legend symbols (extract colour)
         lg <- l[sapply(l, function(i) grepl("GRID.text", i))]

         # get grobs for legend labels 
         lb <- g.b[[1]][[1]][["grobs"]][grepl("label", g.b[[1]][[1]]$layout$name)]

         # get change colour of labels to colour of symbols
         for(i in seq_along(lg)) {

           g.b[[1]][[1]][["grobs"]][grepl("label", g.b[[1]][[1]]$layout$name)][[i]][["children"]][[1]][["children"]][[1]]$gp$col <- lg[[i]]$gp$col

           }

         # overwrite original legend
         g[["grobs"]][[which(g$layout$name=="guide-box")]] <- g.b

         grid.draw(g)

         invisible(g)
   }

участок

gglabcol(p1)

enter image description here

Ответ 2

Иногда легче редактировать grob с помощью функций редактирования grid - если имена соответствующих грызков можно найти. В этом случае они могут быть найдены, а редактирование прост - измените цвет метки с черного на красный или синий.

library(ggplot2)
library(grid)

df <- data.frame(a=rnorm(10),b=1:10,c=letters[1:10],d=c("one","two"))
p1 <-ggplot(data=df,aes(x=b,y=a))
p1 <- p1 + geom_text(aes(label = c, color=d, fontface="bold"))
p1 <- p1 + scale_color_hue(name="colors should match",breaks=c("one", "two"),
                 labels=c("should be salmon", "should be sky blue"))
p1

# Get the ggplot grob
g <- ggplotGrob(p1)

# Check out the grobs
grid.ls(grid.force(g))

Посмотрите список грызунов. Грифы, которые мы хотим отредактировать, относятся к нижней части списка, в наборе глаголов "направляющий ящик" - с именами, начинающимися с "метки". Есть два гна:

Этикетка-3-3.4-4-4-4
Этикетка-4-3.5-4-5-4

# Get names of 'label' grobs.
names.grobs <- grid.ls(grid.force(g))$name 
labels <- names.grobs[which(grepl("label", names.grobs))]

# Get the colours
# The colours are the same as the colours of the plotted points.
# These are available in the ggplot build data.
gt <- ggplot_build(p1)
colours <- unique(gt$data[[1]][, "colour"])

# Edit the 'label' grobs - change their colours
# Use the `editGrob` function
for(i in seq_along(labels)) {
    g <- editGrob(grid.force(g), gPath(labels[i]), grep = TRUE,  
         gp = gpar(col = colours[i]))
}

# Draw it
grid.newpage()
grid.draw(g)

введите описание изображения здесь

Что, если требуется, чтобы ключи были точками, а не буквами? Это может быть полезно, потому что "a" является символом на графике, и это символ в ключе легенды. Это не просто редактирование, как описано выше. Мне нужен точечный гроб, чтобы занять место текстового гроба. Я рисую grobs в видовых экранах, но если я могу найти имена соответствующих видовых экранов, это должно быть просто, чтобы внести изменения.

# Find the names of the relevant viewports
current.vpTree()  # Scroll out to the right to find he relevant 'key' viewports.

viewport [key-4-1-1.5-2-5-2], viewport [key-3-1-1.4-2-4-2],

# Well, this is convenient. The names of the viewports are the same 
# as the names of the grobs (see above). 
# Easy enough to get the names from the 'names.grobs' list (see above). 
# Get the names of 'key' viewports(/grobs)
keys <- names.grobs[which(grepl("key-[0-9]-1-1", names.grobs))]

# Insert points grobs into the viewports:
#    Push to the viewport;
#    Insert the point grob;
#    Pop the viewport.
for(i in seq_along(keys)) {
   downViewport(keys[i])
   grid.points(x = .5, y = .5, pch = 16, gp = gpar(col = colours[i]))
   popViewport()
}
popViewport(0)

# I'm not going to worry about removing the text grobs. 
# The point grobs are large enough to hide them. 

plot = grid.grab()
grid.newpage()
grid.draw(plot)

введите описание изображения здесь

Обновить

Принимая во внимание @user20650 советы по изменению ключа легенды (см. комментарий ниже):

p1 <-ggplot(data=df,aes(x=b,y=a))
p1 <- p1 + geom_text(aes(label = c, color=d, fontface="bold"))
p1 <- p1 + scale_color_hue(name="colors should match",breaks=c("one", "two"),
                 labels=c("should be salmon", "should be sky blue"))

GeomText$draw_key <- function (data, params, size) { 
   pointsGrob(0.5, 0.5, pch = 16, 
   gp = gpar(col = alpha(data$colour, data$alpha), 
   fontsize = data$size * .pt)) }

p1

Затем, как и раньше, измените цвет текста легенды.

Ответ 3

Цвета на графике совпадают с цветами в легенде, но шрифт легенды остается простым, даже когда вы устанавливаете шрифт шрифта графика полужирным (или курсивным). Я не уверен, что это недосмотр в дизайне ggplot2 или предполагаемом поведении. Для некоторых цветов жирный шрифт выглядит более насыщенным, чем простой шрифт, что делает его похожим на другой цвет.

В любом случае, это kludge, который намного легче, чем возиться с grobs, но это может сделать вас тем, что вы хотите. Используйте geom_text с обычным шрифтом, но делайте это два или три раза подряд (или более), чтобы вы получили перепланировку. Это приведет к тому, что символы и легенда будут похожи на полужирный шрифт, потому что оба будут перегружены, а символы легенды всегда будут выглядеть так же, как символы сюжета.

Вот пример:

library(ggplot2)
library(gridExtra)

# Original plot (with larger font size)
p1 <- ggplot(data=df) +
  geom_text(aes(x=b, y=a, label=c, color=d), fontface='bold', size=8)
p1 <- p1 + scale_color_hue(name="colors should match",breaks=c("one", "two"),
                              labels=c("should be pink", "should be blue")) +
           ggtitle("Original Plot with Bold Symbols and Plain Legend")

# New version with overplotting. (You don't need to specify 'plain' fontface. 
# I've just included that to emphasize what the code is doing.)
p1.overplot <- ggplot(data=df) +
  geom_text(aes(x=b, y=a, label=c, color=d), fontface='plain', size=8) +
  geom_text(aes(x=b, y=a, label=c, color=d), fontface='plain', size=8) +
  geom_text(aes(x=b, y=a, label=c, color=d), fontface='plain', size=8)
p1.overplot <- p1.overplot + 
  scale_color_hue(name="colors should match",
                  breaks=c("one", "two"),
                  labels=c("should be pink", "should be blue")) +
  ggtitle("Both symbols and legend are overplotted 3 times")

enter image description here

Ответ 4

Этот ответ основан на ответах, данных Майком Х. из вопроса здесь и пользователем 20650 из этого вопроса.

Чтобы получить цвета:

  pGrob <- ggplotGrob(p1)
  g.b   <- pGrob[["grobs"]][[which(pGrob$layout$name=="guide-box")]]
  l     <- g.b[[1]][[1]][["grobs"]]
  # get grobs for legend symbols (extract colour)
  lg    <- l[sapply(l, function(i) grepl("GRID.text", i))]
  clr   <- mapply(FUN=function(x){x$gp$col},x=lg)

Затем используйте следующие методы

   gb  <- which(grepl("guide-box", pGrob$layout$name))
   gb2 <- which(grepl("guides", pGrob$grobs[[gb]]$layout$name))
   label_text <- which(grepl("label",pGrob$grobs[[gb]]$grobs[[gb2]]$layout$name))

   pGrob$grobs[[gb]]$grobs[[gb2]]$grobs[label_text] <- 
   mapply(FUN = function(x, y) {x[["children"]][[1]][["children"]][[1]]$gp <- gpar(col =y); return(x)},
          x =   pGrob$grobs[[gb]]$grobs[[gb2]]$grobs[label_text],
          y =  clr, SIMPLIFY = FALSE)

После этого вы получите тот же выходной файл

grid.draw(pGrob)

Я даю этот ответ, потому что во втором фрагменте кода аргумент, который назначается для x$gp в функции mapply, должен быть объектом gpar. Это ошибка в ответе Майка Х., и я исправляю ее.

Спасибо.

output pic