I would like to ask a question about the pdf download of pivot table using rpivotTable package with the refreshed adjustment.
I am very close to what I want but just need the final step.
Here is my code:
Shiny app: 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)
My markdown for 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)
```
The text output on the top of pivot table is the right parameter inputs of rPivotTable package so the only thing I need to do is to put them into the parameter input area. I try writeLines() but it is not working.
Everything else has already been well set and the only problem is how to put the parameter ##### Replace "pivotRefresh2()" Here!
Thank you so much!
Best regards!
do.call will be the solution if I understand correctly. Instead of trying to pass arguments as the stringified list, we should use the list. Below is the code with changes that I think accomplish your objective. You will see comments with changes to plug this into your entire example. I assigned rp as a global, so that you can insure all is working correctly. You will want to remove that assignment, and change the enclosing observe back to 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)
Please let me know if you have any additional questions.