R Shiny,renderPlot中的自定义网格grob

时间:2016-08-18 07:38:05

标签: r shiny

我正在尝试在Shiny中绘制自定义网格grob对象。

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

什么都没有被绘制,我也没有得到任何错误。当然,我已经检查过它是否适用于R。

有什么想法吗?

在下面的代码中,我尝试绘制3个图:

  • 一个现成的grob对象&#39; gridPlot1&#39; (确实有效),
  • 自定义grob对象&#39; gridPlot2&#39; (不起作用),
  • 直接打电话给 渲染部分自定义grob对象&#39; gridPlot3&#39; (确实有效)

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)
  })      
})

1 个答案:

答案 0 :(得分: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)