在R

时间:2017-11-22 15:09:50

标签: r

如何在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::xDetailgrid::yDetails找到文本的外壳(但仅适用于不在多个标签上的indiv grobTexts

enter image description here

  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)

1 个答案:

答案 0 :(得分:1)

使用与您相同的设置(使用packGrobframeGrob),您可以这样做:

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)

enter image description here