如何在textGrob对象周围创建一个紧密的边界框?
library(grid)
grid.newpage()
fg <- frameGrob()
fg <- packGrob(fg, textGrob("Hi there"))
grid.draw(fg)
添加另一个标签
grid.newpage()
fg <- frameGrob()
tg <- textGrob(label = rep("Hi there",2),x = c(0.25,0.75),y=c(0.5,0.5))
rg <- rectGrob(x = tg$x, y = tg$y, width = grobWidth(tg) + unit(1,"mm"),
height = grobHeight(tg) + unit(2,"mm"))
fg <- packGrob(fg, rg)
fg <- packGrob(fg, tg)
使用grid::xDetail
和grid::yDetails
找到文本的外壳(但仅适用于不在多个标签上的indiv grobTexts
tg_a <- textGrob(label = c("Hi there"),x = c(0.25),y=c(0.5),rot=0)
tg_b <- textGrob(label = c('something very long'),x = c(0.4),y=c(0.5),rot=0)
tg_list_in <- list(
list(tg=tg_a,rot=0),
list(tg=tg_b,rot=0),
list(tg=tg_a,rot=45),
list(tg=tg_b,rot=45),
list(tg=tg_a,rot=90),
list(tg=tg_b,rot=90)
)
tg_list <- lapply(tg_list_in,function(tgl){
tg <- tgl$tg
tg$rot <- tgl$rot
data.frame(
x=sapply(seq(0,270,90),function(x) convertUnit(grid::xDetails(tg,x),unitTo = 'native')),
y=sapply(seq(0,270,90),function(x) convertUnit(grid::yDetails(tg,x),unitTo = 'native'))
)
})
min_dims <- apply(do.call('rbind',tg_list),2,min)
max_dims <- apply(do.call('rbind',tg_list),2,max)
op <- par(mfrow = c(3, 2))
rots <- unlist(sapply(tg_list_in,'[',2))
for(idx in 1:length(tg_list)){
plot(c(min_dims[1], max_dims[1]), c(min_dims[2],max_dims[2]), type = "n",
xlab='',ylab='',main=sprintf('%s : rotate %s',tg_list_in[[idx]]$tg$label,rots[idx]))
polygon(tg_list[[idx]])
}
par(op)
答案 0 :(得分:1)
使用与您相同的设置(使用packGrob
和frameGrob
),您可以这样做:
grid.newpage()
fg <- frameGrob()
tg <- textGrob(label = rep("Hi there",2),x = c(0.25,0.75),y=c(0.5,0.5))
rg <- rectGrob(x = tg$x, y = tg$y, width = stringWidth(tg$label) + unit(1,"mm"),
height = stringHeight(tg$label) + unit(2,"mm"))
fg <- packGrob(fg, rg)
fg <- packGrob(fg, tg)
grid.draw(fg)