Download multiple plotly plots to PDF Shiny - r

My Shiny App displays a plotly plot for whatever input the user selects. I want a download button that saves ALL the plots inside a PDF file on the user's system. I'm using R markdown for knitting a PDF report and then donwloading it using downloadHandler in Shiny. As of now, I can create each plot individually in my Shiny code and then pass them as a list of parameters to my r markdown file. Since I have a large number of plots (>25) in my actual project, I want to do it in a loop. Here's a reprodcuible example of what I have so far:
library(shiny)
dummy.df <- structure(list(
Tid = structure(
1:24, .Label = c("20180321-032-000001",
"20180321-032-000003", "20180321-032-000004", "20180321-032-000005",
"20180321-032-000006", "20180321-032-000007", "20180321-032-000008",
"20180321-032-000009", "20180321-032-000010", "20180321-032-000011",
"20180321-032-000012", "20180321-032-000013", "20180321-032-000014",
"20180321-032-000015", "20180321-032-000016", "20180321-032-000017",
"20180321-032-000018", "20180321-032-000020", "20180321-032-000021",
"20180321-032-000022", "20180321-032-000024", "20180321-032-000025",
"20180321-032-000026", "20180321-032-000027"), class = "factor"),
Measurand1 = c(4.1938661428, 4.2866076398, 4.2527368322,
4.1653403962, 4.27242291066667, 4.16539040846667, 4.34047710253333,
4.22442363773333, 4.19234076866667, 4.2468291332, 3.9844897884,
4.22141039866667, 4.20227445513333, 4.33310654473333, 4.1927596214,
4.15925140273333, 4.11148968806667, 4.08674611913333, 4.18821475666667,
4.2206477116, 3.48470470453333, 4.2483107466, 4.209376197,
4.04040350253333),
Measurand2 = c(240.457556634854, 248.218468503733,
251.064523520989, 255.454918894609, 250.780599536337, 258.342398843477,
252.343710644105, 249.881670507113, 254.937548700795, 257.252509533017,
258.10699153634, 252.191362744656, 246.944795528771, 247.527116069484,
261.060987461132, 257.770850218767, 259.844790397474, 243.046373553637,
247.026385356368, 254.288899315579, 233.51454714355, 250.556819253509,
255.8242909112, 254.938735944406),
Measurand3 = c(70.0613216684803,
70.5004961457819, 70.8382322052776, 69.9282599322167, 68.3045749634227,
71.5636835352475, 69.1173532716941, 71.3604764318073, 69.5045949393461,
71.2211656142532, 72.5716638087178, 69.2085312787522, 70.7872214372161,
70.7247180047809, 69.9466984209057, 71.8433220247599, 72.2055956743742,
71.0348320947071, 69.3848050049961, 69.9884660785462, 73.160638501285,
69.7524898841488, 71.1958302879424, 72.6060886025082)),
class = "data.frame", row.names = c(NA, 24L)
)
# Define UI for application
ui <- fluidPage(
titlePanel("Download Demo"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "variable",
label = "Plot Measurand",
choices = colnames(dummy.df)[2:11]
),
hr(),
downloadButton("downloadplot1", label = "Download plots")
),
mainPanel(
plotlyOutput("myplot1")
)
)
)
# Define server logic
server <- function(input, output) {
# Output graph
output$myplot1 <- renderPlotly({
plot_ly(dummy.df, x = c(1:nrow(dummy.df)), y = ~get(input$variable), type = 'scatter',
mode = 'markers') %>%
layout(title = 'Values',
xaxis = list(title = "Points", showgrid = TRUE, zeroline = FALSE),
yaxis = list(title = input$variable, showgrid = TRUE, zeroline = FALSE))
})
# Creating plots individually and passing them as a list of parameters to RMD
# Example for the first two measurands
test.plot1 <- reactive({
plot_ly(dummy.df, x = c(1:nrow(dummy.df)), y = ~Measurand1, type = 'scatter', mode = 'markers')
})
test.plot2 <- reactive({
plot_ly(dummy.df, x = c(1:nrow(dummy.df)), y = ~Measurand2, type = 'scatter', mode = 'markers')
})
output$downloadplot1 <- downloadHandler(
filename = "plots.pdf",
content = function(file){
tempReport <- file.path(tempdir(), "report1.Rmd")
file.copy("download_content.Rmd", tempReport, overwrite = TRUE)
# Set up parameters to pass to Rmd document
params <- list(n = test.plot1(), k = test.plot2())
rmarkdown::render(tempReport, output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
And my RMD file:
---
title: "Report"
output: pdf_document
always_allow_html: yes
params:
n: NA
k: NA
---
```{r,echo=FALSE}
library(plotly)
tmpFile <- tempfile(fileext = ".png")
export(params$n, file = tmpFile)
export(params$k, file = tmpFile)
```
What I want to do is pass ALL the plots as a parameterized list to rmd, where each of the plot will be plotted in the knitted PDF document and then downloaded.
Something along the lines of:
# IN server
# Generate plots in a loop
list.of.measurands <- c("Measurand1", "Measurand2") #....all my measurands
plots.gen <- lapply(list.of.measurands, function(msrnd){
plot_ly(dummy.df, x = c(1:nrow(dummy.df)), y = ~msrnd, type = 'scatter', mode = 'markers')
})
Pass this list as the parameters to Rmd:
# Inside downloadHandler
params <- list(n = plots.gen)
And plot all plots in a loop in the rmd file:
---
title: "Report"
output: pdf_document
always_allow_html: yes
params:
n: NA
k: NA
---
```{r,echo=FALSE}
library(plotly)
tmpFile <- tempfile(fileext = ".png")
for (item in params$n){
export(item, file = tmpFile)
}
```
This creates a blank report. What am I missing?
Update
Following Gregor de Cillia's comment, I changed my plot_ly function to have y = dummy.df[[msrnd]]. I have also tried as_widget() but no success in getting plots in my report.
plots.gen <- lapply(list.of.measurands, function(msrnd){
as_widget(plot_ly(dummy.df, x = c(1:nrow(dummy.df)), y = dummy.df[[msrnd]],
type = 'scatter', mode = 'markers'))
})

The Problem
Okay, so after spending a decent amount of time playing around with plotly and knitr, I'm pretty sure that there's a problem with printing plotly graphs in a loop while inside a knitr report. I will file an issue at the plotly repository, because there must be some kind of bug. Even when exporting the graph as .png, then importing it again and displaying it in the knitr report, only one graph at a time can be shown. Weird.
The Solution
Anyhow, I found a solution without using knitr to get a pdf of all graphs that are produced in your Shiny Application. It relies on the staplr package to combine PDF files, so you have to install that package and also install the pdftk toolkit.
Afterwards, use the following code I wrote while adapting your Shiny App:
library(shiny)
library(plotly)
library(staplr)
dummy.df <- structure(list(
Tid = structure(
1:24, .Label = c("20180321-032-000001",
"20180321-032-000003", "20180321-032-000004", "20180321-032-000005",
"20180321-032-000006", "20180321-032-000007", "20180321-032-000008",
"20180321-032-000009", "20180321-032-000010", "20180321-032-000011",
"20180321-032-000012", "20180321-032-000013", "20180321-032-000014",
"20180321-032-000015", "20180321-032-000016", "20180321-032-000017",
"20180321-032-000018", "20180321-032-000020", "20180321-032-000021",
"20180321-032-000022", "20180321-032-000024", "20180321-032-000025",
"20180321-032-000026", "20180321-032-000027"), class = "factor"),
Measurand1 = c(4.1938661428, 4.2866076398, 4.2527368322,
4.1653403962, 4.27242291066667, 4.16539040846667, 4.34047710253333,
4.22442363773333, 4.19234076866667, 4.2468291332, 3.9844897884,
4.22141039866667, 4.20227445513333, 4.33310654473333, 4.1927596214,
4.15925140273333, 4.11148968806667, 4.08674611913333, 4.18821475666667,
4.2206477116, 3.48470470453333, 4.2483107466, 4.209376197,
4.04040350253333),
Measurand2 = c(240.457556634854, 248.218468503733,
251.064523520989, 255.454918894609, 250.780599536337, 258.342398843477,
252.343710644105, 249.881670507113, 254.937548700795, 257.252509533017,
258.10699153634, 252.191362744656, 246.944795528771, 247.527116069484,
261.060987461132, 257.770850218767, 259.844790397474, 243.046373553637,
247.026385356368, 254.288899315579, 233.51454714355, 250.556819253509,
255.8242909112, 254.938735944406),
Measurand3 = c(70.0613216684803,
70.5004961457819, 70.8382322052776, 69.9282599322167, 68.3045749634227,
71.5636835352475, 69.1173532716941, 71.3604764318073, 69.5045949393461,
71.2211656142532, 72.5716638087178, 69.2085312787522, 70.7872214372161,
70.7247180047809, 69.9466984209057, 71.8433220247599, 72.2055956743742,
71.0348320947071, 69.3848050049961, 69.9884660785462, 73.160638501285,
69.7524898841488, 71.1958302879424, 72.6060886025082)),
class = "data.frame", row.names = c(NA, 24L)
)
# Define UI for application
ui <- fluidPage(
titlePanel("Download Demo"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "variable",
label = "Plot Measurand",
choices = colnames(dummy.df)[2:11]
),
hr(),
downloadButton("downloadplot1", label = "Download plots")
),
mainPanel(
plotlyOutput("myplot1")
)
)
)
# Define server logic
server <- function(input, output) {
# Output graph
output$myplot1 <- renderPlotly({
plot_ly(dummy.df, x = c(1:nrow(dummy.df)), y = ~get(input$variable), type = 'scatter',
mode = 'markers') %>%
layout(title = 'Values',
xaxis = list(title = "Points", showgrid = TRUE, zeroline = FALSE),
yaxis = list(title = input$variable, showgrid = TRUE, zeroline = FALSE))
})
# Creating plots individually and passing them as a list of parameters to RMD
# Example for the first two measurands
test.plot1 <- reactive({
plot_ly(dummy.df, x = c(1:nrow(dummy.df)), y = ~Measurand1, type = 'scatter', mode = 'markers')
})
test.plot2 <- reactive({
plot_ly(dummy.df, x = c(1:nrow(dummy.df)), y = ~Measurand2, type = 'scatter', mode = 'markers')
})
output$downloadplot1 <- downloadHandler(
filename = "plots.pdf",
content = function(file){
# Set up parameters to pass to Rmd document
plots <- list(test.plot1(), test.plot2())
# Plot indices
ind_vec <- seq_along(plots)
# Create tempfiles for all plots
tfiles <- sapply(ind_vec, FUN = function(x)
return(tempfile(fileext = ".pdf")))
# create tempfiles for the plots with the second page deleted
tfiles_repl <- sapply(ind_vec, FUN = function(x)
return(tempfile(fileext = ".pdf")))
# Save the objects as .pdf files
for (i in ind_vec) {
# Export files
export(plots[[i]], tfiles[[i]])
# Remove second page bc for some reason it is whitespace
staplr::remove_pages(2, input_filepath = tfiles[[i]],
output_filepath = tfiles_repl[[i]])
}
# Combine the plots into one pdf
staplr::staple_pdf(input_files = tfiles_repl, output_filepath = file)
# Remove .pdf files
lapply(tfiles, FUN = file.remove)
lapply(tfiles_repl, FUN = file.remove)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
I only adapted the code inside the downloadHandler() function. This code basically produces .pdf files of all plots that are inside the plots list (where you later have to specify all your 25 plots, I would do this in a loop). Then, it combines all plots into one .pdf, before deleting the second page of each .pdf, which is necessary because for some reason export() produces a PDF with the second page being completely blank.
My Suggestion
If I were you, I would want to get rid of plotly at all, and replace it with ggplot2 graphs. It would be way easier to do exactly what you want (including the knitr solution). Graphs created with plotly create an extra layer of complexity, because they are web objects that first have to be converted to static files.

I think #Stanislaus Stadlmann is on point. For some reason, plotly::export does not work inside a loop of a rmarkdown file. I suspect it is for the same reason knitr::include_graphic does not work inside a loop. A workaround is to use the markdown syntax to insert your images. Here is the rmarkdown file that works:
---
title: "Report"
output: pdf_document
always_allow_html: yes
params:
n: NA
---
```{r,echo=FALSE,warning=FALSE, results="asis"}
library(plotly)
for (item in params$n) {
tmpFile <- tempfile(fileext = ".png")
export(item, file = tmpFile)
cat("![](",tmpFile,")\n")
}
```
And this is my downloadplot1 function:
output$downloadplot1 <- downloadHandler(
filename = "plots.pdf",
content = function(file){
tempReport <- file.path(tempdir(), "report1.Rmd")
file.copy("download_content.Rmd", tempReport, overwrite = TRUE)
list.of.measurands <- c("Measurand1", "Measurand2") #....all my measurands
plots.gen <- lapply(list.of.measurands, function(msrnd){
plot_ly(dummy.df, x = c(1:nrow(dummy.df)), y = ~get(msrnd), type = 'scatter', mode = 'markers')
})
params <- list(n = plots.gen)
rmarkdown::render(tempReport, output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
}
)

Related

I am having trouble multiple keywords separated by comma which can be used as a successful input in the function - does anyone have ideas?

This is UMAP function and by entering the colors names you can color the clusters but it is not working. It says that it sees only one color and 20 are needed. This is Seurat package.
This is the function that I used originally without shiny and it works
DimPlot(data, reduction = "umap", cols = c(colors[30], colors[1], colors[2], colors[28], colors[3],
colors[4], colors[5], "mistyrose", "lightpink4", colors[21], "grey", colors[7], colors[9], colors[11], colors[24], colors[26], "magenta" ,"gold", "mistyrose2"), split.by = "orig.ident")
This code below if from the shiny app I am making
server <- function(input, output) {
col = renderText({ input$label.color })
cols <- reactive({input$cols})
output$value <- renderText({ input$cols})
output$tsneplot<-renderPlot({
input$ts
if (input$spl == "NULL") {
isolate(DimPlot(data, seed = input$seed.use,reduction = "tsne",pt.size=input$pt.size, label = T, repel = T, label.size = input$label.size, cells = NULL, cols = NULL, label.color = "red"))
} else {
isolate(DimPlot(data, reduction = "tsne",pt.size= input$pt.size, split.by = input$spl ,cells = NULL, cols = c(cols()), label = T, label.size = input$label.size, label.color = col(), repel = T ))
}
})
}
I have seen the output value of text cols it shows exactly in the upper portion of the code below but for some reason while it is in the app and running the dimplot function it thinks it is only one string. Without the concept of shiny it works the code is tested but in the shiny platform it is not.
enter image description here
To examine what value cols() actually returns in your app, you can include a console-like output in your test version:
ui <- fluidPage(
## ...
verbatimTextOutput('log')
## ...
)
server <- function(input, output, session) {
## ...
output$log <- renderPrint(cols())
## ...
}

Passing a dataframe as a parameter from Shiny app to RMarkdown

I'm still struggling with some aspects of a Shiny app I'm working on. The intention is that the user uploads a csv file of data, which is then processed to generate a report (from a .Rmd template), which the user can then download as an editable Word .doc.
The .Rmd works fine if I render it in a normal R session. However, if done from my Shiny app, I get the following error:
Warning: Error in unique: object 'report.data' not found
[No stack trace available]
report.data should be the dataframe produced by reading the input .csv file. Confusingly, the app does sometimes work (I think this occurs if report.data is already available in the global environment.).
I've tried defining the params in the header of the .Rmd file (see the commented out lines below.) - if I do this then the code runs without an error, but the resulting word document is blank, except for the title.
Can anyone see where I'm going wrong? Thank you, as ever, for your time in reading this and replying.
And apologies, I feel like I'm making a lot of threads asking for help with what seem to be quite basic things in Shiny, but I do search for similar questions and never find things that are quite right! But once I have these basic things in place I should be able to make progress by myself.
Code to generate a .csv file of example input for report.data:
library(dplyr)
set.seed(1234)
product1.parameter1.location1 <- data.frame(
result = rnorm(25, mean = 2.5, sd = 0.2),
product = c("Red Aeroplanes"),
parameter = c("Parameter 1"),
sample.no = c(1:25),
location = c("Factory 1")
)
product1.parameter1.location2 <- data.frame(
result = rnorm(25, mean = 2.6, sd = 0.1),
product = c("Red Aeroplanes"),
parameter = c("Parameter 1"),
sample.no = c(1:25),
location = c("Factory 2")
)
product1 <- rbind(product1.parameter1.location1, product1.parameter1.location2)
product2.parameter1.location1 <- data.frame(
result = rnorm(25, mean = 10, sd = 2),
product = c("Blue Trollies"),
parameter = c("Parameter 1"),
sample.no = c(1:25),
location = c("Factory 1")
)
product2.parameter1.location2 <- data.frame(
result = rnorm(25, mean = 9.5, sd = 0.75),
product = c("Blue Trollies"),
parameter = c("Parameter 1"),
sample.no = c(1:25),
location = c("Factory 2"))
product2.parameter1 <- rbind(product2.parameter1.location1, product2.parameter1.location2)
product2.parameter2.location1 <- data.frame(
result = rnorm(25, mean = 30, sd = 1.8),
product = c("Blue Trollies"),
parameter = c("Parameter 2"),
sample.no = c(1:25),
location = c("Factory 1")
)
product2.parameter2.location2 <- data.frame(
result = rnorm(25, mean = 25, sd = 0.75),
product = c("Blue Trollies"),
parameter = c("Parameter 2"),
sample.no = c(1:25),
location = c("Factory 2"))
product2.parameter2 <- rbind(product2.parameter2.location1, product2.parameter2.location2)
product2 <- rbind(product2.parameter1, product2.parameter2)
product3.parameter1.location1 <- data.frame(
result = rnorm(35, mean = 2, sd = 0.2),
product = c("Brown Carriages"),
parameter = c("Parameter 1"),
sample.no = c(1:35),
location = c("Factory 1")
)
product3.parameter1.location2 <- data.frame(
result = rnorm(35, mean = 1.9, sd = 0.15),
product = c("Brown Carriages"),
parameter = c("Parameter 1"),
sample.no = c(1:35),
location = c("Factory 2"))
product3.parameter1 <- rbind(product3.parameter1.location1, product3.parameter1.location2)
product3.parameter2.location1 <- data.frame(
result = rnorm(35, mean = 4, sd = 0.4),
product = c("Brown Carriages"),
parameter = c("Parameter 2"),
sample.no = c(1:35),
location = c("Factory 1")
)
product3.parameter2.location2 <- data.frame(
result = rnorm(35, mean = 3.8, sd = 0.5),
product = c("Brown Carriages"),
parameter = c("Parameter 2"),
sample.no = c(1:35),
location = c("Factory 2"))
product3.parameter2 <- rbind(product3.parameter2.location1, product3.parameter2.location2)
product3.parameter3.location1 <- data.frame(
result = rnorm(35, mean = 10, sd = 1.8),
product = c("Brown Carriages"),
parameter = c("Parameter 3"),
sample.no = c(1:35),
location = c("Factory 1")
)
product3.parameter3.location2 <- data.frame(
result = rnorm(35, mean = 10, sd = 2),
product = c("Brown Carriages"),
parameter = c("Parameter 3"),
sample.no = c(1:35),
location = c("Factory 2"))
product3.parameter3 <- rbind(product3.parameter3.location1, product3.parameter3.location2)
product3 <- rbind(product3.parameter1, product3.parameter2, product3.parameter3)
write.csv(product1, "product1.csv", row.names = FALSE)
write.csv(product2, "product2.csv", row.names = FALSE)
write.csv(product3, "product3.csv", row.names = FALSE)
report.data <- rbind(product1, product2, product3) %>% mutate(identifier = paste(product, parameter, sep = " "))
write.csv(report.data, "all.data.csv", row.names = FALSE)
The app.R code:
#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("R Shiny app"),
# Sidebar with file input
sidebarLayout(
sidebarPanel(
fileInput(
inputId = "file1",
label = "Select file(s)",
multiple = TRUE,
accept = NULL,
width = NULL,
buttonLabel = "Browse...",
placeholder = "No file(s) selected"
),
downloadButton("report", "Generate report")
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$report <- downloadHandler(
reactive(file <- input$file1),
# For PDF output, change this to "report.pdf"
filename = "report.doc",
content = function(file) {
# Copy the report file to a temporary directory before processing it, in
# case we don't have write permissions to the current working dir (which
# can happen when deployed).
tempReport <- file.path(tempdir(), "wordreport.Rmd")
file.copy("wordreport.Rmd", tempReport, overwrite = TRUE)
# Knit the document, passing in the `params` list, and eval it in a
# child of the global environment (this isolates the code in the document
# from the code in this app).
params <- list(report.data = input$file1)
rmarkdown::render(tempReport, output_file = "wordreport.doc",
params = params,
envir = new.env(parent = globalenv()))
file.copy("wordreport.doc", file)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
The .Rmd file (with the lines relating to params declaration commented out):
---
title: "Comparison Report for [CATEGORY] in [MONTH/YEAR]"
output: word_document
toc: yes
#params:
#report.data: report.data
---
```{r setup, include=FALSE, comment = "", results = 'asis', echo = FALSE}
library(dplyr)
library(ggplot2)
library(purrr)
knitr::opts_chunk$set(echo = FALSE)
```
#report.data <- params$report.data
```
my_plot <- function(df) {
ggplot(df, aes(x = sample.no, y = result)) +
geom_point(aes(colour = location)) +
geom_hline(aes(yintercept = mean(result)), colour = "black", linetype = "dotted") +
geom_hline(aes(yintercept = mean(result) + 1.96 * sd(result)), colour = "red", linetype = "dashed") +
geom_hline(aes(yintercept = mean(result) - 1.96 * sd(result)), colour = "red", linetype = "dashed") +
theme_classic() +
theme(legend.title = element_blank()) +
labs(
title = paste0("Comparison for ", unique(df$identifier)),
x = "Sample number",
y = "Result") +
#caption = paste0("Caption here.")) +
expand_limits(y = 0) +
coord_cartesian(xlim = c(0, max(df$sample.no) + 2)) +
theme(
plot.caption=element_text(size=12, hjust = 0, margin = margin(t=20)),
plot.margin = margin(b=50)
)
}
```
```{r, comment = "", results = 'asis', echo = FALSE}
purrr::map(unique(report.data$identifier),
function(x) {
#section heading
cat("#", (x), "\n")
cat("\n\n")
# filter data before passing it to the plot function
report.data %>%
dplyr::filter(identifier == x) %>%
my_plot() %>% print()
cat("\n\n")
no.outofbounds <- report.data %>%
dplyr::filter(identifier == x) %>%
mutate(outofbounds = ifelse(result > mean(result)+1.96*sd(result)|result < mean(result)-1.96*sd(result), TRUE, FALSE)) %>%
dplyr::filter(outofbounds == TRUE) %>%
nrow()
ifelse(no.outofbounds > 0, paste(cat(no.outofbounds), " results greater than 1.96 standard deviations away from the mean."), "All results within 1.96 standard deviations of the mean.") %>%
cat()
cat("\n\n")
CV <- report.data %>%
dplyr::filter(identifier == x) %>%
summarise(CV = sd(result)/mean(result) * 100) %>%
round(2)
cat("\n\n")
paste("The all-site/factor CV for this parameter is ", CV, "%.") %>%
cat()
cat("\n\n")
cat("APPROVED/REJECTED.")
cat("\n\n")
}
) -> results
```
There are several issues with your code. I'll go over them one by one
Invalid parameter in downloadHandler()
You are passing an object of class reactive to the contentType parameter of downloadHandler().
downloadHandler(
reactive(file <- input$file1), ## <--- here
filename = "report.doc",
content = function(file) {
# ...
}
)
It seems that this messes up the whole logic of downloadHandler() and leads to "server error" messages on the client side with no errors or warnings from shiny.
This line needs to be removed in order to download files successfully
Reference the Rmd-parameter correctly
When you want to access the parameter from the Rmd report, you will need to use params$report.data. Just using report.data will lead to the following error: object 'report.data' not found.
---
output: word_document
params:
report.data: NULL
---
```{r}
report.data <- params$report.data
# ...
```
Fix the path to the generated file
You are knitting the Rmd inside the temporary directory, which is generally a good idea. However, getting the paths right is not always that easy. In your case, I used the following
rendered_report <- rmarkdown::render(
tempReport, output_file = "wordreport.doc",
params = params,
envir = new.env(parent = globalenv())
)
file.copy(rendered_report, file)
The reason your version didn't work is that the generated report is created inside the temporary directory alogside tmpReport. See the reference documentation of ?rmarkdown::render for more details.
I used the return value of rmarkdown::render() instead which holds an absolute path to the generated file. This is less error prone and especially useful if you do not know the file extension of the generated file in advance
Use read.csv to convert the uploaded file into a data.frame
Shiny doesn't automatically convert uploaded csv files into dataframes. You need to define a parsing logic to do that.
params <- list(report.data = read.csv(input$file1$datapath))
One final word
Try to get more organized with your coding projects and limit the scope of future SO questions to one issue at a time. Creating "minimal reproducible examples" might seem tedious at first, but there are several advantages in doing that
Other people can read the questions and answers and reuse them in their own projects easily without dissecting a wall of code
It is much easier to answer those questions. With questions like this, the SO community usually only provides comments because answering them properly requires a lot of effort
Minimizing and isolating problems is a skill that will help you to figure out issues in your future coding projects much more easily

How to solve the error in highcharOutput in shiny tool?

I'm working on cancer data from TCGA.
Im new to shiny and creating web applications (learning it!!)
I'm working on a shiny tool to plot the volcanoplot using highcharter package.
sometimes I'm successfully able to plot the volcanoplot in the UI. but sometimes it fails to plot it and throws an error saying,
"An error has occurred!
could not find function "highchartOutput"
and one warning message is given for the error;
Listening on http://127.0.0.1:5335
Warning: Error in highchartOutput: could not find function "highchartOutput"
83: dots_list
82: div
81: tabPanel
I think there is some problem with the tabset panel.
is this error has anything to do with indentation? (wherever I adjust the brackets it works magically. not sure how it works for sometimes.)
I am attaching the UI and server files with this post.
code is attached for one type of comparison
UI file below:
library(shiny)
# Define UI for application
shinyUI(fluidPage(
# Application title
titlePanel("miR-Gyn-Explorer"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
## select the count matrix
selectInput("file", label = h3("Count Matrix"),
choices = list("Stage I - Normal" = list("TCGA-BRCA" = "Data/TCGA-BRCASI_NT.rda", "TCGA-UCEC" = "Data/TCGA-UCECSI_NT.rda"))),
## select the phenodata of samples
selectInput("phenofile", label = h3("Sample Phenodata"),
choices = list("Stage I - Normal" = list("TCGA-BRCA" = "Data/TCGA-BRCA_phenoSI_NT.rda", "TCGA-UCEC" = "Data/TCGA-UCEC_phenoSI_NT.rda"))),
submitButton("Update View")
),
# Show a plot of the generated distribution
mainPanel(
tabsetPanel(
tabPanel("DEmiRNA", DT::dataTableOutput("DEmiRNA"),
"Volcano-Plot", highchartOutput("volcanoPlot", height = "500px"))
#tabPanel("miRNA-Targets", DT::dataTableOutput('miRTarget'),
#plotOutput("GO"))
)
)
)
)
)
server file:
library(shiny)
library(R.utils)
##function to find the DEmiRNA by edgeR method
library(limma)
library(edgeR)
library(DT)
library(dplyr)
library(multiMiR)
library(miRBaseConverter)
library(ggplot2)
#library(ggrepel)
library(tidyverse)
library(highcharter)
library(org.Hs.eg.db)
library(clusterProfiler)
library(purrr)
gdcDEmiRNA <- function(counts, groups, comparison, filter=TRUE) {
## method = edgeR
dge = DGEList(counts = counts, samples = groups)
group <- factor(groups$group)
design <- model.matrix(~0+group)
colnames(design) <- levels(group)
contrast.matrix <- makeContrasts(contrasts=comparison,
levels=design)
keep = filterByExpr(dge,design)
dge <- dge[keep,,keep.lib.sizes = TRUE]
dge <- calcNormFactors(dge)
dge <- estimateDisp(dge, design)
fit <- glmFit(dge, design)
lrt <- glmLRT(fit, contrast=contrast.matrix)
DEGAll <- lrt$table
DEGAll$FDR <- p.adjust(DEGAll$PValue, method = 'fdr')
o <- order(DEGAll$FDR)
DEGAll <- DEGAll[o,]
return (DEGAll)
}
# Define server logic required to perform the DEmiRNA analysis
server <- function(input, output) {
d <- reactive({
#DEmiRNA calculation
file <- load(input$file)
phenofile <- load(input$phenofile)
if(file == "SI_NT"){
if(phenofile == "phenoSI_NT"){
DEmiRNA <- gdcDEmiRNA(counts = SI_NT, groups = phenoSI_NT,
comparison = 'StageI-Normal')
}
}
})
output$DEmiRNA <- DT::renderDataTable({
mir <- d()
#mir <- mir[mir$FDR < input$FDR,]
})
output$volcanoPlot <- renderHighchart({
x <- d()
x$mirna <- rownames(x)
x$sig <- ifelse(x$PValue < 0.05 & abs(x$logFC) > 0.57, "DEmiRNA", "Not Regulated")
hc <- highchart() %>%
hc_add_series(x, "scatter", hcaes(logFC, -log10(PValue), group = sig, value = mirna),
color = c('rgba(67, 67, 72, 0.6)', 'rgba(124, 181, 236, 0.6)'),
enableMouseTracking = c(TRUE, TRUE),
showInLegend = TRUE, marker = list(radius = 4)) %>%
hc_tooltip(pointFormat = "{point.value}", headerFormat = "") %>%
hc_xAxis(title = list(text = "Log fold change"), gridLineWidth = 1,
tickLength = 0, startOnTick = "true", endOnTick = "true", min = -6, max = 6) %>%
hc_yAxis(title = list(text = "-Log10(p-value)")) %>%
hc_chart(zoomType = "xy", width=700) %>%
hc_exporting(enabled = TRUE, filename = "volcano")
hc
})
}
any comment and help from you guys is appreciated
Thank you in advance!
-Ankita

How to export R plots to multipage PDF with renderPlot() in Shiny?

I am forced to output multiple plots not in the static device. But I dynamically create variable number of plots in Shiny with renderPlot. I can successfully create separate pdf files for each device using the function pdf() within the renderPlot.
I have tried to make multipage pdf file as it is specified here and in other similar posts. However in my case the created pdf file has the damaged contents (size of 7 kb) and can't be open. My code after simplification looks as follows.
for (PlotI in 1:PlotN)
{
poObject <- plotOutput(outputId = PlotI)
insertUI(selector = '#AnyPlaceHolder', where = "beforeBegin",
ui = poObject, multiple = FALSE, immediate = FALSE)
} # for PlotI
fnPDF <- paste0(tempdir(), '\\', 'plot.pdf')
pdf(file = fnPDF, width = 7, height = 4, onefile = TRUE, title = 'R output',
paper = 'a4', pointsize = 1/PlotResolution, compress = TRUE)
for (PlotI in 1:PlotN)
{
local(
{
PlotJ <- PlotI
output[[PlotJ]] <- renderPlot(
{
opar <- par(no.readonly = TRUE)
par(mar = c(2,4,2,0.5))
plot(AnyTimeSeries[[PlotJ]])
par(opar)
}
) # renderPlot
}
) # local
} # for PlotI
dev.off()
What is wrong?

Extract all click event plots from Shiny, Plotly - R

In the following shiny app, the plotly package is used to create an interactive correlation heat map. When individual tiles are clicked, the corresponding scatter plot appears. One can then download the individual scatters by clicking download plot as png. But is there a way to download all the possible scatter plots at once without having to click each individual tile and save each individual one? Thank you
library(plotly)
library(shiny)
# compute a correlation matrix
correlation <- round(cor(mtcars), 3)
nms <- names(mtcars)
ui <- fluidPage(
mainPanel(
plotlyOutput("heat"),
plotlyOutput("scatterplot")
),
verbatimTextOutput("selection")
)
server <- function(input, output, session) {
output$heat <- renderPlotly({
plot_ly(x = nms, y = nms, z = correlation,
key = correlation, type = "heatmap", source = "heatplot") %>%
layout(xaxis = list(title = ""),
yaxis = list(title = ""))
})
output$selection <- renderPrint({
s <- event_data("plotly_click")
if (length(s) == 0) {
"Click on a cell in the heatmap to display a scatterplot"
} else {
cat("You selected: \n\n")
as.list(s)
}
})
output$scatterplot <- renderPlotly({
s <- event_data("plotly_click", source = "heatplot")
if (length(s)) {
vars <- c(s[["x"]], s[["y"]])
d <- setNames(mtcars[vars], c("x", "y"))
yhat <- fitted(lm(y ~ x, data = d))
plot_ly(d, x = ~x) %>%
add_markers(y = ~y) %>%
add_lines(y = ~yhat) %>%
layout(xaxis = list(title = s[["x"]]),
yaxis = list(title = s[["y"]]),
showlegend = FALSE)
} else {
plotly_empty()
}
})
}
shinyApp(ui, server)
You can use webshot to capture a static image of Plotly's HTML output using the instructions here: https://plot.ly/r/static-image-export/
An example for loop below generates random scatter plots from mtcars.
library(plotly)
library(webshot)
## You'll need to run the function the first time if you dont't have phantomjs installed
#webshot::install_phantomjs()
ColumnOptions <- colnames(mtcars)
for (i in seq_len(5)){
xCol <- sample(ColumnOptions,1)
yCol <- sample(ColumnOptions,1)
ThisFileName <- paste0("Scatter_",xCol,"_vs_",yCol,".png")
plot_ly(x = mtcars[[xCol]], y = mtcars[[yCol]], type = "scatter", mode = "markers") %>%
export(., file = ThisFileName)
}
However, if you're going to be potentially doing this dozens of times, the amount of computation required to go through the following steps really adds up.
Generate a JSON plotly object from R
Use htmlwidgets/htmltoolsto generate a self-contained HTML web page
Render that HTML as a browser would see it with an external program --webshot
Use webshot to render an image of that HTML and save it as a PNG
This isn't really a reflection of plotly being slow, but to make an analogy it's kind've like using an airplane to travel half a mile -- the plane gets you there, but if you need to make that trip more than a few times you should probably consider a car.
The plotly loop above takes 27 seconds to render 5 PNG images, but the alternative method below using ggplot2 takes 1.2 seconds.
library(ggplot2)
ColumnOptions <- colnames(mtcars)
for (i in seq_len(5)){
xCol <- sample(ColumnOptions,1)
yCol <- sample(ColumnOptions,1)
ThisFileName <- paste0("ggplot2_Scatter_",xCol,"_vs_",yCol,".png")
ggplot() +
geom_point(aes(x = mtcars[[xCol]], y = mtcars[[yCol]])) +
labs(x = xCol, y = yCol) -> ThisPlot
ggsave(plot = ThisPlot, filename = ThisFileName)
}

Resources