renderPlot中闪闪发光的定制网格grob

Question

我试图在闪亮中绘制自定义网格grob对象。

boxGrob <- function(labels, x=.5, y=.5) {
    grob(labels=labels, x=x, y=y, cl="box")
}

任何事情都不会被策划，我也不会有任何错误。当然，我已经检查过它在R.

有什么想法吗？

在下面的代码中，我试图绘制3个情节：

• 一个现成的grob对象'gridPlot1‘(确实有用)，
• 自定义grob对象“gridPlot2”(不工作)，
• 直接调用自定义grob对象'gridPlot3‘的呈现部分(确实有效)

ui.R

library(shiny)

# Define UI for application that draws a histogram
shinyUI(fluidPage(

    # Show a plot of the generated distribution
    mainPanel(
      h1("gridPlot1: linesGrob"),
      plotOutput("gridPlot1"),
      h1("gridPlot2: custom grob 'boxGrob' (uses 'tableBox')"),
      plotOutput("gridPlot2"),
      h1("gridPlot3: direct call to 'tableBox'"),
      plotOutput("gridPlot3")
    )


))

和server.R

library(shiny)
library("grid") 

shinyServer(function(input, output) {

  # ########################### #
  # BEGIN Custom grid functions #
  # ########################### #
  tableBox <- function(labels, x=.5, y=.5) {
    nlabel <- length(labels)
    tablevp <-
      viewport(x=x, y=y,
              width=max(stringWidth(labels)) +
                unit(4, "mm"),
              height=unit(nlabel, "lines"))
    pushViewport(tablevp)
    grid.rect()
    if (nlabel > 1) {
      for (i in 1:(nlabel - 1)) {
        # fill <- c("white", "grey")[i %% 2 + 1]
        fill <- c("white")
        grid.clip(y=unit(i, "lines"), just="bottom")
        grid.rect(gp=gpar(fill=fill))
      }
    }
    grid.clip()
    grid.text(labels,
              x=unit(2, "mm"), y=unit(nlabel:1 - .5, "lines"),
              just="left")
    popViewport()
  }
  boxGrob <- function(labels, x=.5, y=.5) {
    grob(labels=labels, x=x, y=y, cl="box")
  }
  drawDetails.box <- function(x, ...) {
    tableBox(x$labels, x$x, x$y)
  }
  xDetails.box <- function(x, theta) {
    nlines <- length(x$labels)
    height <- unit(nlines, "lines")
    width <- unit(4, "mm") + max(stringWidth(x$labels))
    grobX(roundrectGrob(x=x$x, y=x$y, width=width, height=height),
          theta)
  }
  yDetails.box <- function(x, theta) {
    nlines <- length(x$labels)
    height <- unit(nlines, "lines")
    width <- unit(4, "mm") + max(stringWidth(x$labels))
    grobY(rectGrob(x=x$x, y=x$y, width=width, height=height),
          theta)
  }

  # ########################### #
  # ENDOF Custom grid functions #
  # ########################### #



  output$gridPlot1 <- renderPlot({
#     plot.new()
    l <- linesGrob()
    # Draw it
    grid.draw(l)
  })

  output$gridPlot2 <- renderPlot({
#     plot.new()
    total_size <- 1000
    boxInitalSize <- boxGrob(c("Hello world"),
                  x = 0.2,y = 0.95)
    grid.draw(boxInitalSize)
  })


  output$gridPlot3 <- renderPlot({
#     plot.new()
    tableBox(c("ISBN", "title",
    "author", "pub"),
    x=0.5, y=0.7)
  })      
})

Answer 1

你试过使用plot()而不是grid.draw()吗？下面是一个简单的例子：

sample <- data.table(x = 1:10, y_1 = seq(2,20,2), y_2 = seq(3,30,3))
simple_plot <- function(){
   a <-   ggplot(data = sample, aes(x, y_1)) + geom_line()
   b <-   ggplot(data = sample, aes(x, y_2)) + geom_line()
   a <- ggplotGrob(a)
   b <- ggplotGrob(b)

   both <- arrangeGrob(a, b, nrow=2)
   return(plot(both))
}

UI <- fluidPage(

    # Show a plot of the generated distribution
    mainPanel(
        h1("gridPlot1: linesGrob"),
        plotOutput("gridPlot1"),
    )

)

SERVER <- function(input, output) {
    output$gridPlot1 <- renderPlot({ simple_plot() })
}

shinyApp(UI, SERVER)