rpivotTable: динамическое скачивание pdf сводной таблицы shinyapp с обновленной настройкой

Question

Я хотел бы задать вопрос о загрузке сводной таблицы в формате PDF с помощью rpivotTable пакет с обновленной настройкой.

Я очень близок к тому, что я хочу, но просто нужен последний шаг.

Вот мой код:

Блестящее приложение: app.r:

library(rpivotTable)
library(shiny)
library(htmlwidgets)

list_to_string <- function(obj, listname) {
if (is.null(names(obj))) {
paste(listname, "=", list(obj) )
} else {
paste(listname, "=", list( obj ),
      sep = "", collapse = ",")
}
}

server <- function(input, output) {


output$pivotRefresh <- renderText({

cnames <- list("cols","rows","vals", "exclusions","aggregatorName",   "rendererName")
# Apply a function to all keys, to get corresponding values
allvalues <- lapply(cnames, function(name) {
  item <- input$myPivotData[[name]]
  if (is.list(item)) {
    list_to_string(item, name)
  } else {
    paste(name,"=","'",item,"'")
  }
 })
 paste(allvalues, collapse = ",")
 })



pivotRefresh2 <- reactive({
cnames <- list("cols","rows","vals", "exclusions","aggregatorName", "rendererName")
# Apply a function to all keys, to get corresponding values
allvalues <- lapply(cnames, function(name) {
  item <- input$myPivotData[[name]]
  if (is.list(item)) {
    list_to_string(item, name)
  } else {
    paste(name,"=","'",item,"'")
  }
 })
 paste(allvalues, collapse = ",")

 })


 PivotTable<-reactive({
 rpivotTable(data=cars, onRefresh=htmlwidgets::JS("function(config) {  Shiny.onInputChange('myPivotData', config); }"))
 })

 PivotTable2<-reactive({

rpivotTable(data=cars, 
##### Replace "pivotRefresh2()" Here
writeLines(pivotRefresh2()  )
)

})

output$mypivot = renderRpivotTable({
PivotTable()
})

output$report = downloadHandler(
filename<- function(){
  paste("Demo_Data_Analysis",Sys.Date(),".pdf",sep = "")
},
content = function(file) {
  src <- normalizePath('Apply.Rmd')

  # temporarily switch to the temp dir, in case you do not have write
  # permission to the current working directory
  owd <- setwd(tempdir())
  on.exit(setwd(owd))
  file.copy(src, 'Apply.Rmd', overwrite = TRUE)

  library(rmarkdown)
  out <- render('Apply.Rmd', pdf_document())
  file.rename(out, file)
 },
 contentType = 'application/pdf'
 )

 }

 ui <- shinyUI(fluidPage(
 fluidRow(column(6,verbatimTextOutput("pivotRefresh")),
       column(6, rpivotTableOutput("mypivot") )),
 downloadButton('report',"Download this plot")
 )
 )

 shinyApp(ui = ui, server = server) 

Моя уценка для PDF: Rmd:

---
title: "Untitled"
author: "Statistician"
date: "December 3, 2016"
output: pdf_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
```


```{r Time_Single, out.width = "500px"}

saveWidget( PivotTable2(), file= 'temp_Time_single123.html')
respivot123 =  webshot::webshot('temp_Time_single123.html','my-  screenshotime_single123.png')
knitr::include_graphics(respivot123)

```

Текстовый вывод в верхней части сводной таблицы - это правильный вход параметров rPivotTable пакет, поэтому единственное, что мне нужно сделать, это поместить их в область ввода параметров. я попробую writeLines() Но это не работает.

Все остальное уже хорошо установлено, и единственная проблема заключается в том, как поставить параметр ##### Replace "pivotRefresh2()" Here!

Спасибо вам большое!

С наилучшими пожеланиями!

Answer 1

наш друг до звонка

do.call будет решением, если я правильно понимаю. Вместо того, чтобы пытаться передать аргументы в виде строкового списка, мы должны использовать этот список. Ниже приведен код с изменениями, которые, я думаю, достигают вашей цели. Вы увидите комментарии с изменениями, чтобы включить это во весь ваш пример. Я назначил rp как глобальный, так что вы можете убедиться, что все работает правильно. Вы захотите удалить это назначение и изменить вложение observe вернуться к reactive,

library(rpivotTable)
library(shiny)
library(htmlwidgets)

list_to_string <- function(obj, listname) {
  if (is.null(names(obj))) {
    paste(listname, "=", list(obj) )
  } else {
    paste(listname, "=", list( obj ),
          sep = "", collapse = ",")
  }
}

server <- function(input, output) {


  output$pivotRefresh <- renderText({

    cnames <- list("cols","rows","vals", "exclusions","aggregatorName",   "rendererName")
    # Apply a function to all keys, to get corresponding values
    allvalues <- lapply(cnames, function(name) {
      item <- input$myPivotData[[name]]
      if (is.list(item)) {
        list_to_string(item, name)
      } else {
        paste(name,"=","'",item,"'")
      }
    })
    paste(allvalues, collapse = ",")
  })



  pivotRefresh2 <- reactive({
    items <- input$myPivotData[c("cols","rows","vals", "exclusions","aggregatorName", "rendererName")]

    # need to remove the outside list container
    #  for rows and cols
    #  did not test thoroughly but these seemed to be
    #  the only two that require this
    items$cols <- unlist(items$cols,recursive=FALSE)
    items$rows <- unlist(items$rows,recursive=FALSE)

    items
  })

  PivotTable<-reactive({
    rpivotTable(data=cars, onRefresh=htmlwidgets::JS("function(config) {  Shiny.onInputChange('myPivotData', config); }"))
  })


  ########## add this to demo ###############
  ### what we are getting ###################
  observe({str(pivotRefresh2())})

  ########## change this back to reactive ##
  PivotTable2<-observe({
    ### do ugly global assign ################
    ### after done with Shiny ################
    ### rp available to inspect ##############
    rp <<- do.call(rpivotTable,c(list(data=cars),pivotRefresh2()))
  })

  output$mypivot = renderRpivotTable({
    PivotTable()
  })

  output$report = downloadHandler(
    filename<- function(){
      paste("Demo_Data_Analysis",Sys.Date(),".pdf",sep = "")
    },
    content = function(file) {
      src <- normalizePath('Apply.Rmd')

      # temporarily switch to the temp dir, in case you do not have write
      # permission to the current working directory
      owd <- setwd(tempdir())
      on.exit(setwd(owd))
      file.copy(src, 'Apply.Rmd', overwrite = TRUE)

      library(rmarkdown)
      out <- render('Apply.Rmd', pdf_document())
      file.rename(out, file)
    },
    contentType = 'application/pdf'
  )

}

ui <- shinyUI(fluidPage(
  fluidRow(column(6,verbatimTextOutput("pivotRefresh")),
           column(6, rpivotTableOutput("mypivot") )),
  downloadButton('report',"Download this plot")
)
)

shinyApp(ui = ui, server = server) 

следовать за

Пожалуйста, дайте мне знать, если у вас есть дополнительные вопросы.