用ggplot2装盒geom_text [英] Boxed geom_text with ggplot2
本文介绍了用ggplot2装盒geom_text的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我正在开发一个ggplot2图形，其中我需要在其他图形元素上叠加文本。根据文本底层元素的颜色，可能难以阅读文本。有没有办法在半透明背景的边界框中绘制geom_text？
我可以用plotrix来做到这一点：
library（plotrix）
标签< -c（Alabama，Alaska，Arizona，Arkansas）
SampleFrame< ; - data.frame（X = 1:10，Y = 1:10）
TextFrame< - data.frame（X = 4：7，Y = 4：7，LAB = Labels）
### plotrix ###
plot（SampleFrame，pch = 20，cex = 20）
boxed.labels（TextFrame $ X，TextFrame $ Y，TextFrame $ LAB，
bg = ＃ffffff99，border = FALSE，
xpad = 3/2，ypad = 3/2）
但我不知道如何用ggplot2实现类似的结果：
### ggplot2 ###
library（ggplot2）
Plot < - ggplot（data = SampleFrame，
aes（x = X，y = Y））+ geom_point（size = 20）
Plot< - Plot + geom_text（data = TextFrame，
aes（x = X，y = Y，label = LAB））
print（Plot）
正如您所看到的，黑色文本标签是不合格的可以感知它们在背景中与黑色geom_points重叠的位置。 解析方法
试试这个从GeomText稍微修改的geom。
GeomText2< - proto（GeomText，{
objname< - text2
draw< ;函数（。，data，scale，coordinates，...，parse = FALSE，
expand = 1.2，bgcol =grey50，bgfill = NA，bgalpha = 1）{
lab< - data $ label
if（parse）{
lab < - parse（text = lab）
}
with（coordinates $ transform（data，scales） ，{
tg < - do.call（mapply，
c（function（...）{
tg < - with（list（...），textGrob（lab ，default =native，rot = angle，gp = gpar（fontsize = size * .pt）））
list（w = grobWidth（tg），h = grobHeight（tg））
}，data））
gList（rectGrob（x，y，
width = do.call（unit.c，tg [w，]）* expand，
height = do。 call（unit.c，tg [h，]）* expand，
gp = gpar（col = alpha（bgcol，bgalpha），fill = alpha（bgfill，bgalpha））），
。超级$ draw（。，data，s cales，coordinates，...，parse））
}）
}
}）
geom_text2< - GeomText2 $ build_accessor（）
标签< -c（阿拉巴马，阿拉斯加，亚利桑那，阿肯色州）
SampleFrame< - data.frame（X = 1:10，Y = 1:10） b $ TextFrame< - data.frame（X = 4：7，Y = 4：7，LAB =标签）
绘图< - ggplot（data = SampleFrame，aes（x = X ，y = Y））+ geom_point（size = 20）
Plot <--Plot + geom_text2（data = TextFrame，aes（x = X，y = Y，label = LAB），
size = 5，expand = 1.5，bgcol =green，bgfill =skyblue，bgalpha = 0.8）
print（Plot）
改进了BUG和代码
GeomText2< - proto （GeomText，{
objname< - text2
draw< - function（。，data，scales，coordinates，...，parse = FALSE，
expand = 1.2，bgcol =grey50，bgfill = NA，bgalpha = 1）{
lab < - data $ label
if（parse）{
la （坐标$ transform（data，scale），{
sizes< - llply（1：nrow（data），$ b）的b <-parse（text = lab）
} $ b函数（i）with（data [i，]，{
grobs< - textGrob（lab [i]，default.units =native，rot = angle，gp = gpar（fontsize = size * ）
list（w = grobWidth（grobs），h = grobHeight（grobs））
}））
gList（rectGrob（x，y，
width = do.call（unit.c，lapply（sizes，[[，w））* expand，
height = do.call（unit.c，lapply（sizes，[[ ，h））* expand，
gp = gpar（col = alpha（bgcol，bgalpha），fill = alpha（bgfill，bgalpha））），
.super $ draw（。，data， ...）
}）
}
}）
geom_text2< - GeomText2 $ build_accessor（）
I am developing a graphic with ggplot2 wherein I need to superimpose text over other graphical elements. Depending on the color of the elements underlying the text, it can be difficult to read the text. Is there a way to draw geom_text in a bounding box with a semi-transparent background?
I can do this with plotrix:
library(plotrix)
Labels <- c("Alabama", "Alaska", "Arizona", "Arkansas")
SampleFrame <- data.frame(X = 1:10, Y = 1:10)
TextFrame <- data.frame(X = 4:7, Y = 4:7, LAB = Labels)
### plotrix ###
plot(SampleFrame, pch = 20, cex = 20)
boxed.labels(TextFrame$X, TextFrame$Y, TextFrame$LAB,
bg = "#ffffff99", border = FALSE,
xpad = 3/2, ypad = 3/2)
But I do not know of a way to achieve similar results with ggplot2:
### ggplot2 ###
library(ggplot2)
Plot <- ggplot(data = SampleFrame,
aes(x = X, y = Y)) + geom_point(size = 20)
Plot <- Plot + geom_text(data = TextFrame,
aes(x = X, y = Y, label = LAB))
print(Plot)
As you can see, the black text labels are impossible to perceive where they overlap the black geom_points in the background.
解决方案
Try this geom, which is slightly modified from GeomText.
GeomText2 <- proto(GeomText, {
objname <- "text2"
draw <- function(., data, scales, coordinates, ..., parse = FALSE,
expand = 1.2, bgcol = "grey50", bgfill = NA, bgalpha = 1) {
lab <- data$label
if (parse) {
lab <- parse(text = lab)
}
with(coordinates$transform(data, scales), {
tg <- do.call("mapply",
c(function(...) {
tg <- with(list(...), textGrob(lab, default.units="native", rot=angle, gp=gpar(fontsize=size * .pt)))
list(w = grobWidth(tg), h = grobHeight(tg))
}, data))
gList(rectGrob(x, y,
width = do.call(unit.c, tg["w",]) * expand,
height = do.call(unit.c, tg["h",]) * expand,
gp = gpar(col = alpha(bgcol, bgalpha), fill = alpha(bgfill, bgalpha))),
.super$draw(., data, scales, coordinates, ..., parse))
})
}
})
geom_text2 <- GeomText2$build_accessor()
Labels <- c("Alabama", "Alaska", "Arizona", "Arkansas")
SampleFrame <- data.frame(X = 1:10, Y = 1:10)
TextFrame <- data.frame(X = 4:7, Y = 4:7, LAB = Labels)
Plot <- ggplot(data = SampleFrame, aes(x = X, y = Y)) + geom_point(size = 20)
Plot <- Plot + geom_text2(data = TextFrame, aes(x = X, y = Y, label = LAB),
size = 5, expand = 1.5, bgcol = "green", bgfill = "skyblue", bgalpha = 0.8)
print(Plot)
BUG FIXED AND CODE IMPROVED
GeomText2 <- proto(GeomText, {
objname <- "text2"
draw <- function(., data, scales, coordinates, ..., parse = FALSE,
expand = 1.2, bgcol = "grey50", bgfill = NA, bgalpha = 1) {
lab <- data$label
if (parse) {
lab <- parse(text = lab)
}
with(coordinates$transform(data, scales), {
sizes <- llply(1:nrow(data),
function(i) with(data[i, ], {
grobs <- textGrob(lab[i], default.units="native", rot=angle, gp=gpar(fontsize=size * .pt))
list(w = grobWidth(grobs), h = grobHeight(grobs))
}))
gList(rectGrob(x, y,
width = do.call(unit.c, lapply(sizes, "[[", "w")) * expand,
height = do.call(unit.c, lapply(sizes, "[[", "h")) * expand,
gp = gpar(col = alpha(bgcol, bgalpha), fill = alpha(bgfill, bgalpha))),
.super$draw(., data, scales, coordinates, ..., parse))
})
}
})
geom_text2 <- GeomText2$build_accessor()
这篇关于用ggplot2装盒geom_text的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
