0

我想为基本图形图后面的背景构建一个网格对象。绘制时，它应该简单地将背景着色为灰色，并在此背景上放置一个红色网格/格栅。下面显示了一个试验，但网格显然没有看到正确的“窗口”/视口......这如何实现？

require(grid)
require(gridBase)

## function to compute a "background grob" (gray background with red 'grid')
bgGrob <- function(v, h, col, fill, default.units="npc", vp=NULL)
{
    ## background
    br <- rectGrob(gp=gpar(col=NA, fill=fill), vp=vp) # background rectangle

    ## grid: construct grobs
    vl <- segmentsGrob(x0=v, y0=0, x1=v, y1=1, # vertical lines
                       default.units=default.units, gp=gpar(col=col), vp=vp)
    hl <- segmentsGrob(x0=0, y0=h, x1=1, y1=h, # horizontal lines
                       default.units=default.units, gp=gpar(col=col), vp=vp)
    ## grid: pack grobs
    fg <- frameGrob(vp=vp) # set up basic frame grob (for packing)
    u1 <- unit(1, units=default.units)
    fg <- packGrob(fg, br, col=1, row=1, # background rectangle
                   width=u1, height=u1, force.width=TRUE)
    fg <- packGrob(fg, vl, col=1, row=1, # vertical lines
                   width=u1, height=u1, force.width=TRUE)
    fg <- packGrob(fg, hl, col=1, row=1, # horizontal lines
                   width=u1, height=u1, force.width=TRUE)
    fg
}

## data
x <- 1:10
y <- rev(x)

## layout
grid.newpage()
gl <- grid.layout(nrow=1, ncol=1, widths=0.8, heights=0.8,
                  default.units="npc")
pushViewport(viewport(layout=gl))
vp <- viewport(layout.pos.row=1, layout.pos.col=1)
pushViewport(vp)

par(plt=gridPLT())
par(new=TRUE)

## set up coordinate system
plot.window(range(x), range(y), log="y")

v <- axTicks(1, axp=par("xaxp"), log=par("xlog")) # x values of vertical lines (2, 4, 6, 8, 10)
h <- axTicks(2, axp=par("yaxp"), log=par("ylog")) # y values of horizontal lines (1, 2, 5, 10)
## => correct values

## background
## trial 1
grid.draw(bgGrob(v=v, h=h, col="red", fill="gray90", default.units="native",
                 vp=grid::dataViewport(x, y)))
## trial 2
## grid.draw(bgGrob(v=v, h=h, col="red", fill="gray90", default.units="native"))

## trial 3
## grid.draw(bgGrob(v=v, h=h, col="red", fill="gray90", vp=vp, default.units="native"))

## plot
plot(x, y, type="b", log="y")

popViewport()

更新

基于 Baptiste 的第一个答案，这里有一个更完整的最小示例（使用“Q”解决后续问题）：

require(grid)
require(gridBase)

bgGrob <- function(v, h, gp=gpar(fill="grey90", col="red"), vp=NULL)
    grobTree(rectGrob(),
             segmentsGrob(v, unit(0, "npc"), v, unit(1, "npc")),
             segmentsGrob(unit(0, "npc"), h, unit(1, "npc"), h),
             vp=vp, gp=gp)

## data
x <- 1:10
y <- rev(x)

## layout, par (for using base graphics)
plot.new()
gl <- grid.layout(nrow=1, ncol=1, widths=0.8, heights=0.8,
                  default.units="npc")
pushViewport(viewport(layout=gl))
vp <- viewport(layout.pos.row=1, layout.pos.col=1)
pushViewport(vp)
par(plt=gridPLT(), new=TRUE)

## set up coordinate system
plot.window(range(x), range(y), log="y")

## get tick locations
v <- axTicks(1, axp=par("xaxp"), log=par("xlog")) # x values of vertical lines
h <- axTicks(2, axp=par("yaxp"), log=par("ylog")) # y values of horizontal lines

## draw background
grid.draw(bgGrob(v=v, h=h, vp=viewport(width=1, height=1))) # Q: where are the red grill lines?

## draw base graphics on top of the background
plot(x, y, type="b", log="y")

## (check +) finalize
grid.rect(gp=gpar("blue")) # Q: why is nothing drawn?
popViewport()
4

1 回答 1

1

我最初认为您需要baseViewports()，但它似乎par("usr")为您提供了足够的信息来设置网格视口，其坐标系对应于轴。请注意，对数秤需要格外小心。我仍然认为这是一个坏主意；一旦您放置非平凡的基本图形，它可能会立即中断。通常最好不要混合这两个系统。

require(grid)
require(gridBase)

bgGrob <- function(v, h, gp=gpar(fill="grey90", col="red"), vp=NULL, def="native")
  grobTree(rectGrob(),
           segmentsGrob(v, unit(0, "npc"), v, unit(1, "npc"), def=def),
           segmentsGrob(unit(0, "npc"), h, unit(1, "npc"), h, def=def),
           vp=vp, gp=gp)

grid.bg = function(...)
  grid.draw(bgGrob(...))

## data
x <- 1:10
y <- rev(x)

## layout, par (for using base graphics)
grid.newpage()
plot.new()
gl <- grid.layout(nrow=1, ncol=1, widths=0.8, heights=0.8,
                  default.units="npc")
pushViewport(viewport(layout=gl))
vp <- viewport(layout.pos.row=1, layout.pos.col=1)
pushViewport(vp)
par(plt=gridPLT(), new=TRUE)

## set up coordinate system
plot.window(range(x), range(y), log="y")
# suppressWarnings(base <- baseViewports())
## get tick locations
v <- axTicks(1, axp=par("xaxp"), log=par("xlog")) # x values of vertical lines
h <- axTicks(2, axp=par("yaxp"), log=par("ylog")) # y values of horizontal lines

if(par("xlog")) v <- log10(v)
if(par("ylog")) h <- log10(h)

usr <- par("usr")
## draw background
grid.bg(v=v, h=h, vp=viewport(xscale=usr[1:2], yscale=usr[3:4]))

## draw base graphics on top of the background
plot(x, y, type="b", log="y")

截屏

于 2013-09-01T12:26:49.910 回答