Изменить geom_text default "a" легенда для самой метки

Подобно этому вопросу, я хочу изменить по умолчанию "а" в легенде, но вместо того, чтобы полностью удалить его, я хочу заменить его самими ярлыками. То есть, первая строка легенды должна иметь цветной значок с надписью "se" с полным именем "setosa" справа.

iris$abbrev = substr( iris$Species, 1, 2 )

ggplot(data = iris, aes(x = Sepal.Length, y=Sepal.Width, shape =
Species, colour = Species)) +  geom_text(aes(label = abbrev))

enter image description here

Ответ 1

Вы можете изменить функцию генерации условных обозначений. Это по-прежнему требует небольшого ручного вмешательства, но, возможно, меньше, чем использование грызунов.

library(ggplot2)
library(grid)

data(iris)
iris$abbrev = substr( iris$Species, 1, 2 )

oldK <- GeomText$draw_key # to save for later

# define new key
# if you manually add colours then add vector of colours 
# instead of 'scales::hue_pal()(length(var))'
GeomText$draw_key <- function (data, params, size, 
                               var=unique(iris$abbrev), 
                               cols=scales::hue_pal()(length(var))) {

    # sort as ggplot sorts these alphanumerically / or levels of factor
    txt <- if(is.factor(var)) levels(var) else sort(var)
    txt <- txt[match(data$colour, cols)]

    textGrob(txt, 0.5, 0.5,  
             just="center", 
             gp = gpar(col = alpha(data$colour, data$alpha), 
                       fontfamily = data$family, 
                       fontface = data$fontface, 
                       fontsize = data$size * .pt))
}

ggplot(data=iris, aes(x=Sepal.Length, y=Sepal.Width, 
                      shape=Species, colour=Species)) +  
  geom_text(aes(label = abbrev))


# reset key
GeomText$draw_key <- oldK

enter image description here

Ответ 2

Вы можете работать на гнидах следующим образом:

p <- ggplot(data = iris, aes(x = Sepal.Length, y=Sepal.Width, shape =
Species, colour = Species)) +  geom_text(aes(label = abbrev))

g <- ggplotGrob(p)
lbls <- unique(iris$abbrev)
g$grobs[[15]][[1]][[1]]$grobs[[4]]$label <- lbls[1]
g$grobs[[15]][[1]][[1]]$grobs[[6]]$label <- lbls[2]
g$grobs[[15]][[1]][[1]]$grobs[[8]]$label <- lbls[3]

library(grid)
grid.draw(g)

enter image description here