Динамическая отчетность с R и ReporteRs

У меня есть приложение панели инструментов Shiny, которое отображает около 15 диаграмм. Я использую ReporteRs, чтобы позволить пользователю загрузить отчет PowerPoint, содержащий диаграммы; по одному на каждый слайд. Теперь я добавил несколько флажков для каждой диаграммы, и мне было интересно, как я могу сделать генерацию отчета динамической, чтобы, если пользователь проверил одну диаграмму, был создан только один слайд; если они выбирают две диаграммы, создаются два слайда и так далее.

Вот простой пример. У меня есть два графика. Если я отменю выбор одного из них на вкладке загрузки, как мне сообщить ReporteR, что мне нужен только один слайд с выбранной диаграммой? Если я затем проверю оба, ReporteRs выдаст два слайда. Я думаю, что если я смогу решить эту проблему, я просто увеличу масштаб до требуемых 15.

Спасибо, Эндрю

library(shiny)
library(ReporteRs)

# Define UI for application that draws a histogram
#ui <- fluidPage(

ui <- fluidPage(
  titlePanel("Powerpoint Report"),
  mainPanel(
    tabsetPanel(
      tabPanel(
        title = "Plots",
        solidHeader = FALSE,
        HTML("<br /><br /><br />"),
        fluidRow(
          column(width = 6,
                 plotOutput("barPlot1")
                 ),
          column(width = 6,
                 plotOutput("barPlot2")
                 )
          )
        ),
      tabPanel(
        title = "Download",
        solidHeader = FALSE,
        HTML("<br /><br /><br />"),
        checkboxGroupInput("down", "Select Charts",
                     choices = c("Cars Plot" = 1, "Iris Plot" = 2),
                     selected = list(1, 2)),
        HTML("<br /><br />"),
        downloadButton("download", "Download Powerpoint Report")
        )
      )
    )
  )

server <- function(input, output) {


  car <- function(){plot(cars$speed, cars$dist)}

  output$barPlot1 <- renderPlot(
    car()
  )

  iri <- function(){plot(iris$Sepal.Length, iris$Petal.Length)}


  output$barPlot2 <- renderPlot(
    iri()
  )

  output$download <- downloadHandler(
    file = "charts.pptx",
    content = function(file){
      doc = pptx( )
      doc <- addSlide(doc, "Title Slide")
      doc <- addTitle(doc,"How many Charts?")

      doc <- addSlide(doc, "Two Content")
      doc <- addTitle(doc,"Car Charts?")
      doc <- addPlot(doc, fun = function() car())

      doc <- addSlide(doc, "Two Content")
      doc <- addTitle(doc, "Iris Plot")
      doc <- addPlot(doc, fun = function() iri())

      writeDoc(doc, file)
    }
  )

}

# Run the application 
shinyApp(ui = ui, server = server)

person Andrew Scotchmer    schedule 15.09.2017    source источник


Ответы (1)


Вы можете поместить условие if в downloadHandler следующим образом:

server <- function(input, output) {


  car <- function(){plot(cars$speed, cars$dist)}

  output$barPlot1 <- renderPlot(
    car()
  )

  iri <- function(){plot(iris$Sepal.Length, iris$Petal.Length)}


  output$barPlot2 <- renderPlot(
    iri()
  )

  output$download <- downloadHandler(
    file = "charts.pptx",
    content = function(file){
      doc = pptx( )
      doc <- addSlide(doc, "Title Slide")
      doc <- addTitle(doc,"How many Charts?")

      if(any(isolate(input$down) == 1)){
        doc <- addSlide(doc, "Two Content")
        doc <- addTitle(doc,"Car Charts?")
        doc <- addPlot(doc, fun = function() car())
      }

      if(any(isolate(input$down) == 2)){
        doc <- addSlide(doc, "Two Content")
        doc <- addTitle(doc, "Iris Plot")
        doc <- addPlot(doc, fun = function() iri())
      }


      writeDoc(doc, file)
    }
  )

}
person SBista    schedule 24.10.2017