Соответствие цвета текста легенды в 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
Я уверен, что это просто исправить. Любые предложения или ссылки на предыдущие посты помогут. Я не нашел ничего конкретного для этого.
3 ответа
Следуя приведенному выше комментарию Джорана, вы можете редактировать гробов напрямую. Это довольно некрасивый код, поэтому извиняюсь [будет гораздо более элегантный способ сделать это, используя grid команды - и, надеюсь, кто-то опубликует.
library(grid)
gglabcol <-
function(plot1)
{
g <- ggplotGrob(plot1)
# legend grobs
g.b <- g[["grobs"]][[which(g$layout$name=="guide-box")]]
l <- g.b[["grobs"]][[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 <- l[sapply(l, function(i) grepl("guide.label", i))]
# get change colour of labels to colour of symbols
for(i in seq_along(lg)) {
lb[[i]]$gp$col <- lg[[i]]$gp$col
g.b[["grobs"]][[1]][["grobs"]][sapply(g.b[["grobs"]][[1]][["grobs"]],
function(i) grepl("guide.label", i))][[i]] <- lb[[i]]
}
# overwrite original legend
g[["grobs"]][[which(g$layout$name=="guide-box")]] <- g.b
grid.draw(g)
invisible(g)
}
участок
gglabcol(p1)
Иногда проще редактировать гроб используя 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" является символом на графике, и это символ в ключе легенды. Это не простое редактирование, как выше. Мне нужен точечный гроб, чтобы занять место текстового гроба. Я рисую гробы в видовых экранах, но если я смогу найти имена соответствующих видовых экранов, внести изменения будет просто.
# Find the names of the relevant viewports
current.vpTree() # Scroll out to the right to find he relevant 'key' viewports.
область просмотра [ключ-4-1-1.5-2-5-2], область просмотра [ключ-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
Затем, как и прежде, измените цвет текста легенды.
Вот решение, которое использует ggtextи избегает непосредственного редактирования гробов. (Это действительно связано с извлечением цветов из графика, но последующие шаги более удобны для пользователя.)
# Original code, but with a stripped-down call to `scale_color_hue` (since
# we're going to replace it).
library(ggplot2)
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(breaks=c("one", "two"))
# Load the `ggtext` library, which lets us style (parts of) text labels.
library(ggtext)
# Build the plot so we can extract the colors that were actually used. (If you
# supply colors manually instead, this step isn't necessary.)
g1 = ggplot_build(p1)
# Add a scale with labels that are colored appropriately, using <span> tags.
# Also specify that legend labels should be processed with `element_markdown`.
p1 +
scale_color_hue(name = "colors should match",
breaks = c("one", "two"),
labels = paste("<span style='color:",
unname(unlist(unique(g1$data[[1]]["colour"]))),
"'>",
c("should be pink", "should be blue"),
"</span>",
sep = "")) +
theme(legend.text = element_markdown())
Цвета на графике такие же, как и в легенде, но шрифт легенды остается простым, даже если вы установите жирный шрифт (или курсив) для шрифта символа графика. Я не уверен, если это упущение в дизайне ggplot2 или предполагаемое поведение. Для некоторых цветов жирный шрифт выглядит более насыщенным, чем обычный шрифт, что делает его похожим на другой цвет.
В любом случае, вот клудж, который намного проще, чем возиться с гробами, но он может дать вам то, что вы хотите. использование 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")
Этот ответ основан на ответах Mike H.. из вопроса здесь и user20650 из этого вопроса.
Чтобы получить цвета:
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объект. Это ошибка Mike H.., и я ее исправляю.
Спасибо.
