Можем ли мы связать три графика, используя rbind_gtable на блестящей панели инструментов, чтобы загрузить все графики вместе? - PullRequest
Новая
       11

Можем ли мы связать три графика, используя rbind_gtable на блестящей панели инструментов, чтобы загрузить все графики вместе?

1 голос
/ 17 января 2020

Проблема с объединением нескольких блестящих графиков и загрузкой одним щелчком мыши.

Код ниже - ответ здесь: Решение Я попробовал это решение. Он отлично работает для двух графиков, но как только я добавляю другой график, он возвращает только информацию о графике, но не сам график.

Комбинация двух графиков работает нормально.

Я также пробовал другие решения, но оба реализованных решения возвращают текстовый файл вместо поврежденного файла pdf или pdf.
Решение1 Решение2

Любое предложение будет по достоинству оценено. Спасибо!

Код 

  library(ggplot2)
  ui <- shinyUI(fluidPage(
  titlePanel("Test app"),
  fluidRow(
    column(4,
           wellPanel(
             downloadButton('download',label="Download plot as png")
           )
    ),
    column(8,
           plotOutput("plot")
    )  
  )
))
server <- function(input,output) {

  plotting<- reactive({

    data1=data.frame(x=rnorm(50),y=rnorm(50))
    data2=data.frame(x=rexp(50),y=rexp(50))
    data3=data.frame(x=rexp(50),y=rexp(50))


    plot1=ggplot(data1,aes(x,y))+geom_point()
    plot2=ggplot(data2,aes(x,y))+geom_point()
    plot3=ggplot(data3,aes(x,y))+geom_point()

    gb1=ggplot_build(plot1)
    gb2=ggplot_build(plot2)
    gb3=ggplot_build(plot3)

    gA <- ggplot_gtable(gb1)
    gB <- ggplot_gtable(gb2)
    gC <- ggplot_gtable(gb3)

    both <- gtable:::rbind_gtable(gA, gB, "last")
    all <- gtable:::rbind_gtable(both, gC, "last")
    return(all)
  })

  output$plot <- renderPlot({
    grid.newpage()
    grid.draw(plotting())
  })

  output$download <- downloadHandler(
    filename <- "shinytestplot.png",

  # Changes:
  content <- function(file){ ## file = NULL --> file
    png(file) # filename --> file
    grid.newpage()
    grid.draw(plotting())
    dev.off()
  }
  ) 
}
shinyApp(server=server,ui=ui)

1 Ответ

1 голос
/ 20 января 2020

Ваш пример отлично работает для меня. Тем не менее, я бы рекомендовал против привязки участков. Вместо этого используйте пакет с пэчворком. 

library(ggplot2)
library(shiny)
library(patchwork)

ui <- shinyUI(fluidPage(
  titlePanel("Test app"),
  fluidRow(
    column(4,
           wellPanel(
             downloadButton('download',label="Download plot as png")
           )
    ),
    column(8,
           plotOutput("plot")
    )  
  )
))
server <- function(input,output) {

  plotting<- reactive({

    data1=data.frame(x=rnorm(50),y=rnorm(50))
    data2=data.frame(x=rexp(50),y=rexp(50))
    data3=data.frame(x=rexp(50),y=rexp(50))


    plot1=ggplot(data1,aes(x,y))+geom_point()
    plot2=ggplot(data2,aes(x,y))+geom_point()
    plot3=ggplot(data3,aes(x,y))+geom_point()

    # stack the plots on top of one another with patchwork
    plot1 / plot2 / plot3
  })

  output$plot <- renderPlot({
    print(plotting())
  })

  output$download <- downloadHandler(
    filename <- "shinytestplot.png",

    # Changes:
    content <- function(file){ 
      ggsave(file, plotting())
    }
  ) 
}
shinyApp(server=server,ui=ui)
...