Related
I am trying to create a script to generate heatmaps in R shiny. I attach the script below
library(shiny)
options(shiny.maxRequestSize = 50*1024^2)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput('expression_table','Expression file (xlsx format)'),
selectInput('normalization','Normalize the values with', choices = c('None','CPM','LogCPM','Z-score','Log only')),
fileInput('metadata','Metadata file (xlsx format)'),
textInput('annotcol', 'Annotation column of metadata file', value = NULL),
textInput('gene_list','List of genes to plot (1 gene per line)', value = NULL),
textInput('heatmap_title','Heatmap title', value = 'Heatmap title'),
selectInput('color_scale','Choose your color scale', choices = c('Blue-White-Red',
'Red-White-Blue',
'Green-Black-Purple',
'Purple-Black-Green')
),
sliderInput('colsize','Column labels size', min=0, max=20, step=1, value=8 ),
sliderInput('colkm','Number of Column clusters', min=0, max=10, step=1, value=1 ),
selectInput('coldend','Show column dendrogram', choices = c(TRUE,FALSE)),
sliderInput('rowsize','Row labels size', min=0, max=20, step=1, value=8 ),
sliderInput('rowkm','Number of Row clusters', min=0, max=10, step=1, value=1 ),
selectInput('rowdend','Show row dendrogram', choices = c(TRUE,FALSE)),
actionButton('click','Generate Heatmap')
),
mainPanel(
plotOutput('heatmap')
)
)
)
server <- function(input, output, session) {
library(ComplexHeatmap)
library(circlize)
library(dplyr)
library(openxlsx)
library(edgeR)
library(stringr)
expression <- reactive({
read.xlsx(input$expression_table, rowNames = TRUE, colNames=TRUE)
})
expression_normalized <- reactive({
if(input$normalization == 'CPM'){
as.data.frame(cpm(expression))
} else if(input$normalization == 'LogCPM'){
as.data.frame(log(cpm(expression)+1))
} else if(input$normalization == 'Z-score'){
as.data.frame(t(scale(t(cpm(expression)))))
} else if(input$normalization == 'None'){
read.xlsx(input$expression_table, rowNames = TRUE, colNames=TRUE)
} else if(input$normalization == 'Log only'){
as.data.frame(log(expression + 1))
}
})
metadata <- reactive({
read.xlsx(input$metadata, rowNames = TRUE, colNames=TRUE)
})
expression_isolated <- reactive({
if(!is.null(input$gene_list)){
genes_list <- unlist(strsplit(input$gene_list, split = '\n'))
expression_normalized %>% filter(rownames(.) %in% genes_list)
} else {
expression_normalized
}
})
CS <- reactive({
if(input$color_scale == 'Blue-White-Red'){
colorRamp2(c(min(expression_isolated),0,max(expression_isolated)),
c("steelblue3","white","firebrick3"))
} else if(input$color_scale == 'Red-White-Blue'){
colorRamp2(c(min(expression_isolated),0,max(expression_isolated)),
c("firebrick3","white","steelblue3"))
} else if(input$color_scale == 'Green-Black-Purple'){
colorRamp2(c(min(expression_isolated),0,max(expression_isolated)),
c("olivedrab3","black","mediumorchid3"))
} else if(input$color_scale == 'Purple-Black-Green'){
colorRamp2(c(min(expression_isolated),0,max(expression_isolated)),
c("mediumorchid3","black","olivedrab3"))
}
})
#output
eventReactive(input$click, {
output$heatmap <- renderPlot({
if(!is.null(input$annotcol)) {
Heatmap(as.matrix(expression_isolated),
col = CS,
row_names_gp = gpar(fontsize = input$rowsize),
column_names_gp = gpar(fontsize = input$colsize),
column_km = input$colkm,
row_km= input$rowkm,
show_row_dend = input$rowdend,
show_column_dend = input$coldend,
column_title = input$heatmap_title,
top_annotation = HeatmapAnnotation(Condition = metadata[,input$annotcol], which = 'column')
)
} else {
Heatmap(as.matrix(expression_isolated),
col = CS,
row_names_gp = gpar(fontsize = input$rowsize),
column_names_gp = gpar(fontsize = input$colsize),
column_km = input$colkm,
row_km= input$rowkm,
show_row_dend = input$rowdend,
show_column_dend = input$coldend,
column_title = input$heatmap_title
)
}
})
})
}
shinyApp(ui, server)`
The application runs fine and generates the UI. However, when I upload the excel file with the data and press 'Generate Heatmap' I get no response and no error.
I also used observeEvent instead of eventReactive. When I used observeEvent for the click handling I get the following error:
"Error in as.vector: cannot coerce type 'closure' to vector of type 'any'"
The file input is a standard excel file with rownames in the first column, headers in the first row and numeric values for data, i.e.
SAMPLE1 SAMPLE2 SAMPLE3
IFNI 10 11 13
IFNII 11 16 15
TP53 45 22 56
Anyone know what's going on?
> sessionInfo()
R version 4.2.0 (2022-04-22)
Platform: x86_64-apple-darwin17.0 (64-bit)
Running under: macOS Monterey 12.4
Matrix products: default
LAPACK: /Library/Frameworks/R.framework/Versions/4.2/Resources/lib/libRlapack.dylib
locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
attached base packages:
[1] grid stats graphics grDevices utils datasets methods base
other attached packages:
[1] stringr_1.5.0 edgeR_3.38.4 limma_3.52.4 openxlsx_4.2.5.1
[5] dplyr_1.0.10 circlize_0.4.15 ComplexHeatmap_2.13.1 shiny_1.7.4
loaded via a namespace (and not attached):
[1] Rcpp_1.0.10 locfit_1.5-9.7 lattice_0.20-45 png_0.1-8
[5] assertthat_0.2.1 digest_0.6.31 foreach_1.5.2 utf8_1.2.2
[9] mime_0.12 R6_2.5.1 stats4_4.2.0 pillar_1.8.1
[13] GlobalOptions_0.1.2 rlang_1.0.6 rstudioapi_0.14 jquerylib_0.1.4
[17] S4Vectors_0.36.1 GetoptLong_1.0.5 textshaping_0.3.6 compiler_4.2.0
[21] httpuv_1.6.8 systemfonts_1.0.4 pkgconfig_2.0.3 BiocGenerics_0.44.0
[25] shape_1.4.6 htmltools_0.5.4 tidyselect_1.2.0 tibble_3.1.8
[29] IRanges_2.32.0 codetools_0.2-18 matrixStats_0.63.0 fansi_1.0.4
[33] crayon_1.5.2 later_1.3.0 jsonlite_1.8.4 xtable_1.8-4
[37] lifecycle_1.0.3 DBI_1.1.3 magrittr_2.0.3 zip_2.2.2
[41] cli_3.6.0 stringi_1.7.12 cachem_1.0.6 promises_1.2.0.1
[45] doParallel_1.0.17 bslib_0.4.2 ellipsis_0.3.2 ragg_1.2.5
[49] generics_0.1.3 vctrs_0.5.2 rjson_0.2.21 RColorBrewer_1.1-3
[53] iterators_1.0.14 tools_4.2.0 glue_1.6.2 parallel_4.2.0
[57] fastmap_1.1.0 clue_0.3-63 colorspace_2.1-0 cluster_2.1.4
[61] memoise_2.0.1 sass_0.4.5
BLUF: change input$metadata to input$metadata$datapath.
If you read ?shiny::fileInput and go down to the "Server value:" section, it reads:
Server value:
A 'data.frame' that contains one row for each selected file, and
following columns:
'name' The filename provided by the web browser. This is *not* the
path to read to get at the actual data that was uploaded (see
'datapath' column).
'size' The size of the uploaded data, in bytes.
'type' The MIME type reported by the browser (for example,
'text/plain'), or empty string if the browser didn't know.
'datapath' The path to a temp file that contains the data that was
uploaded. This file may be deleted if the user performs
another upload operation.
By using read.xlsx(input$metadata, ...), you are passing a data.frame to read.xlsx, which obviously doesn't work. There will likely be nothing in the shiny app, since you're not capturing warnings or errors. You should have seen something like:
read.xlsx(data.frame(name="myfile", datapath="myfile.xlsx"))
# Error in file(description = xlsxFile) : invalid 'description' argument
Multiple recommendations:
Change your code to use input$metadata$datapath;
Use req and possible validate/need, since you can avoid trying to read NULL (which can happen due to the order of reactivity) and, if not met, sometimes you can provide clear verbiage in the app interface itself.
Use tryCatch for anything that is even somewhat out of your control. By doing so, you give yourself more information and ability to recover when something goes wrong.
At a minimum, this is your fix.
metadata <- reactive({
read.xlsx(input$metadata$datapath, rowNames = TRUE, colNames=TRUE)
})
But perhaps this app presents the other recommendations clearly:
library(shiny)
shinyApp(
ui = fluidPage(
fileInput("metadata", "MetaData"),
plotOutput("plot")
),
server = function(input, output, session) {
mydata <- reactive({
req(input$metadata)
res <- tryCatch(
openxlsx::read.xlsx(input$metadata$datapath, rowNames = TRUE, colNames = TRUE),
error = function(e) e
)
validate(
need(
!inherits(res, "error"),
paste("There was a problem reading your file:",
paste(conditionMessage(res), collapse = "; "))
)
)
})
output$plot <- renderPlot({
req(mydata())
plot(y ~ x, data = mydata())
})
}
)
The error message is in the place the plot should normally show up. If there are multiple components that use mydata(), the error message in this example will be shown in all of the components (that support validate/need rendering). You can limit this by moving the validate(..) statement out of mydata <- and into one (or more) dependent components, though all components would then need to either check for req(!inherits(mydata(), "error")) or some other way communicate what happened.
In this Shiny app, the user can upload a .csv file, get the results as a table and plot. I want to be able to download the results as PDF document.
Input file
#I created the input .csv file to be used in the app from diamonds data.frame
library(ggplot2)
df <- diamonds[1:5000, ]
head(df)
write.csv(df, "df.csv")
App
library(tidyverse)
library(shiny)
library(rmarkdown)
library(knitr)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(fileInput("file","Upload your file"),
width =2),
mainPanel(
width = 10,
downloadButton("report", "Download report"),
tableOutput("table"),
tags$br(),
tags$hr(),
plotOutput("plot1"),
tags$br(),
tags$hr(),
plotOutput("plot2")
)
)
)
server <- function(input,output){
data <- reactive({
file1 <- input$file
if(is.null(file1)){return()}
read.csv(file1$datapath, header=TRUE, sep=',')
})
output$table <- renderTable({
if (is.null(data())) { return() }
df <- data() %>%
dplyr::select(cut, color, price) %>%
dplyr::group_by(cut, color) %>%
dplyr::summarise_all(funs(min(.), mean(.), median(.),max(.),sd(.), n() ))
})
table_rmd <- reactive({
df <- data() %>%
dplyr::select(cut, color, price) %>%
dplyr::group_by(cut, color) %>%
dplyr::summarise_all(funs(min(.), mean(.), median(.),max(.),sd(.), n() ))
})
output$plot1 <- renderPlot({
if (is.null(data())) { return() }
ggplot(data(), aes (x =carat, y = price, col = color))+
geom_point()+
facet_wrap(~cut)
}
)
plot_rmd <- reactive({
chart <- ggplot(data(), aes (x =carat, y = price, col = color))+
geom_point()+
facet_wrap(~cut)
chart
}
)
#https://shiny.rstudio.com/articles/generating-reports.html
output$report <- downloadHandler(
filename = "report.pdf",
content = function(file) {
tempReport <- file.path(tempdir(), "report.Rmd")
file.copy("report.Rmd", tempReport, overwrite = TRUE)
params <- list(table1 = table_rmd(),
plot1 = plot_rmd())
rmarkdown::render(tempReport, output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
}
)
}
shinyApp(ui=ui, server = server)
report.Rmd
---
title: "Dynamic report"
output: pdf_document
params:
table1: NA
plot1: NA
---
This is the firs plot
```{r}
params$plot1
```
This is the first table
```{r}
kable(params$table1)
```
I have tried different ways to pass the table and the plot from Shiny as params to R Markdown but none worked.
I will highly appreciate your suggestions to fix this.
Update
I have tried #BigDataScientist's answer and I got this error
"C:/Program Files/RStudio/bin/pandoc/pandoc" +RTS -K512m -RTS report.utf8.md --to latex --from markdown+autolink_bare_uris+ascii_identifiers+tex_math_single_backslash --output pandoc20e043232760.tex --template "C:\PROGRA~1\R\R-35~1.2\library\RMARKD~1\rmd\latex\DEFAUL~3.TEX" --highlight-style tango --pdf-engine pdflatex --variable graphics=yes --variable "geometry:margin=1in" --variable "compact-title:yes"
Warning: Error in : Failed to compile C:\Users\user\AppData\Local\Temp\RtmpYvWn8M\file20e042326267.tex. See https://yihui.name/tinytex/r/#debugging for debugging tips.
[No stack trace available]
Here is the sessionInfo()
> sessionInfo()
R version 3.5.2 (2018-12-20)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 7 x64 (build 7601) Service Pack 1
Matrix products: default
locale:
[1] LC_COLLATE=English_New Zealand.1252 LC_CTYPE=English_New Zealand.1252 LC_MONETARY=English_New Zealand.1252 LC_NUMERIC=C
[5] LC_TIME=English_New Zealand.1252
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] bindrcpp_0.2.2 forcats_0.3.0 stringr_1.4.0 dplyr_0.7.8 purrr_0.2.5 readr_1.3.1 tidyr_0.8.2 tibble_2.0.1 tidyverse_1.2.1 ggplot2_3.1.0
[11] shiny_1.2.0
loaded via a namespace (and not attached):
[1] tinytex_0.15.2 tidyselect_0.2.5 xfun_0.9 haven_2.0.0 lattice_0.20-38 colorspace_1.4-0 generics_0.0.2 htmltools_0.3.6 yaml_2.2.0
[10] utf8_1.1.4 rlang_0.4.0 later_0.8.0 pillar_1.3.1 glue_1.3.0 withr_2.1.2 readxl_1.2.0 modelr_0.1.2 bindr_0.1.1
[19] plyr_1.8.4 cellranger_1.1.0 munsell_0.5.0 gtable_0.2.0 rvest_0.3.2 evaluate_0.12 labeling_0.3 knitr_1.21 httpuv_1.4.5.1
[28] fansi_0.4.0 broom_0.5.1 Rcpp_1.0.0 xtable_1.8-3 promises_1.0.1 scales_1.0.0 backports_1.1.3 jsonlite_1.6 mime_0.6
[37] hms_0.4.2 digest_0.6.18 stringi_1.2.4 grid_3.5.2 cli_1.0.1 tools_3.5.2 magrittr_1.5 lazyeval_0.2.1 crayon_1.3.4
[46] pkgconfig_2.0.2 xml2_1.2.0 rsconnect_0.8.13 lubridate_1.7.4 assertthat_0.2.0 rmarkdown_1.11 httr_1.4.0 rstudioapi_0.9.0 R6_2.3.0
[55] nlme_3.1-137 compiler_3.5.2
You can pass an R object as part of the params list to a parametrized Rmd. Here is an example in a regular interactive session (no Shiny). report.Rmd is the same as in the question. df and pl are generated by some R script and are available in your environment. Then you can wrap them in list and pass them as params to render.
library(rmarkdown)
library(ggplot2)
df <- head(iris)
pl <- ggplot(iris, aes(x = Sepal.Width)) + geom_histogram(color = "white")
render(
input = "report.Rmd",
params = list("table1" = df, "plot1" = pl),
output_file = "rendered-from-session.pdf"
)
Screen shot of rendered-from-session.pdf
Whether this is a good strategy is another question. If the code making the tables and plots is the same for the app and Rmd, then it is better to have that in a separate script sourced both by the app and Rmd. That way you only need to edit one document when you want to change table/plot code. In this case, you would pass the arguments to plotting functions rather than the plots themselves. The downside of this is if you have many different plots that require many different parameters to keep track of. Or if the calculations / plotting takes long, so you don't want to do it twice.
Coming back to your Shiny app. In fact, your app code works for me as is through Shiny as well. I can make the pdf (even though table_rmd() reactive is not explicitly returning df). So it most likely is an issue with pandoc or latex not figuring out where the temporary file/folder is. Since you are still testing, I would try to save to a known location rather than a tempdir to see if this isn't some kind of permissions issue.
You could modify your handler like so. Remove the calls to tempdir and give the full path to report.Rmd to render. You could also try to give a full path for output_file. The first case should work just fine. In the second case ("PATH/TO/OUTPUT" instead of file passed to output_file), the browser might give you a download error, but the pdf should still render in the background with the file name you provided.
output$report <- downloadHandler(
filename = "report.pdf",
content = function(file) {
# tempReport <- file.path(tempdir(), "report.Rmd")
# file.copy("report.Rmd", tempReport, overwrite = TRUE)
params <- list(table1 = table_rmd(),
plot1 = plot_rmd())
rmarkdown::render(input = "PATH/TO/report.Rmd",
output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
}
)
This might at least confirm that your code is working, except for the tempdir() stuff. If you have an option, try your app on a linux machine or a mac.
Not sure if you can pass table and plots as parameters in/to rmarkdown. (Please also consider teofil´s answer here).
All standard R types that can be parsed by yaml::yaml.load() can be
included as parameters, including character, numeric, integer, and
logical types.
Source: https://bookdown.org/yihui/rmarkdown/params-declare.html
So you have two options.
Pass the relevant data as a parameter and include the code to produce the plot/table in the markdown template (here: report.Rmd).
if, for some reason, one would insist on defining the code for the plot/table on the shiny side you could send this code as a character and use eval(parse(text = params$...)) to evaluate it on rmarkdown side.
I could imagine you dont want to specify the code for plot/table twice in shiny + rmarkdown, but i guess you would have to choose between both options and the first one is probably cleaner.
(But feel free to leave the question open in case someone else has another idea).
Reproducbile example: (including an example for both options - on the basis of your code)
report.Rmd
---
title: "Dynamic report"
output: pdf_document
params:
plotData: NA
tableData: NA
plotCode: NA
---
```{r}
params$tableData
```
```{r}
eval(parse(text = params$plotCode))
```
```{r}
library(ggplot2)
ggplot(params$plotData, aes (x = carat, y = price, col = color)) +
geom_point() +
facet_wrap(~cut)
```
app.R
library(shiny)
library(ggplot2)
df <- diamonds[1:5000, ]
head(df)
write.csv(df, "df.csv")
#setwd("....") #be sure to be in same directory
shinyApp(
ui = fluidPage(
sliderInput(inputId = "slider", label = "Slider", min = 1, max = 100, value = 50),
fileInput(inputId = "file", label = "Upload your file"),
downloadButton(outputId = "report", label = "Generate report")
),
server = function(input, output) {
data <- reactive({
file1 <- input$file
if(is.null(file1)){return()}
read.csv(file1$datapath, header = TRUE, sep = ',')
})
table_rmd <- reactive({
data() %>%
dplyr::select(cut, color, price) %>%
dplyr::group_by(cut, color) %>%
dplyr::summarise_all(funs(min(.), mean(.), median(.),max(.),sd(.), n() ))
})
output$report <- downloadHandler(
filename = "report.pdf",
content = function(file) {
tempReport <- file.path(tempdir(), "report.Rmd")
file.copy("report.Rmd", tempReport, overwrite = TRUE)
params <- list(plotData = data(), tableData = table_rmd(), plotCode = "plot(1)")
rmarkdown::render(tempReport, output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
}
)
}
)
Using diamonds dataset and the code below
library(dplyr)
library(ggplot2)
diam <- diamonds %>%
dplyr::select(cut, color, carat, price) %>%
dplyr::arrange(cut, color) %>%
dplyr::group_by(cut, color)
diam[c(10:30, 100:140, 300:500, 765:963,1476:1987,2469:3786,5000:6000,
8654:9876, 11000:12670, 21678:23456,35648:37896,
45469:46789,49876:51346), c(3, 4)] <- NA
write.csv(diam, "diam.csv")
I created diam.csv file to be used in the shiny app below
library(dplyr)
library(ggplot2)
library(shiny)
ui <- fluidPage(
titlePanel(
sidebarLayout(
sidebarPanel(
tags$h1(tags$strong("Shiny app")),
fileInput("file", "Upload your file"),
width =2),
mainPanel(width =10,
uiOutput("tb")))))
#server
server <- function(input,output){
data <- reactive({
file1 <- input$file
if(is.null(file1)){return()}
read.csv(file1$datapath, header=TRUE, sep=',')
})
output$sum <- renderTable({
if(is.null(data())){return ()}
df_summary <- data()
df_summary1 <- df_summary %>%
dplyr::select(cut, color, carat, price)
summary(df_summary1)
})
output$table <- renderDataTable({
if(is.null(data())){return ()}
data()
})
output$stats <- renderDataTable({
if(is.null(data())){return ()}
diam1 <- data()
print(
diam_stats <- diam1 %>%
dplyr::select(cut, color, carat) %>%
dplyr::arrange(cut, color) %>%
dplyr::group_by(cut, color) %>%
dplyr::filter(!is.na(carat)) %>%
dplyr::summarise_each(funs(
mean(., na.rm=T),
sd(., na.rm=T),
n()))
)
})
output$tb <- renderUI({
if(is.null(data()))
h5()
else
tabsetPanel(type="tab",
tabPanel(h3("Summary", align="center"),
tableOutput("sum")),
tabPanel(h3("Data"),
dataTableOutput("table")),
tabPanel(h3("Stats"),
dataTableOutput("stats")))
})
}
shinyApp(ui = ui, server = server)
I got this error in the summary tab
no applicable method for 'select_' applied to an object of class "c('standardGeneric', 'genericFunction', 'function', 'OptionalFunction', 'PossibleMethod', 'optionalMethod')"
and this error in the stats tab
argument "funs" is missing, with no default
I'm using dplyr_0.4.3
Any suggestions how to fix these errors?
Update
Below is a print screen of the errors
And here what appears in the console
Listening on http://127.0.0.1:3606
Warning: Error in UseMethod: no applicable method for 'select_' applied to an object of class "c('standardGeneric', 'genericFunction', 'function', 'OptionalFunction', 'PossibleMethod', 'optionalMethod')"
Stack trace (innermost first):
73: select_
72: dplyr::select
71: ..redirect
70: %>%
69: renderTable [C:\R\Shiny\diam_app/app.R#28]
68: func
67: output$sum
1: runApp
Warning: Error in lazyeval::as.lazy_dots: argument "funs" is missing, with no default
Stack trace (innermost first):
83: lazyeval::as.lazy_dots
82: funs_
81: inherits
80: is.fun_list
79: stopifnot
78: colwise_
77: summarise_each_
76: dplyr::summarise_each
75: ..redirect
74: %>%
73: print
72: exprFunc [C:\R\Shiny\diam_app/app.R#42]
71: widgetFunc
70: func
69: renderFunc
68: output$stats
1: runApp
Here is the sessioninfo()
R version 3.2.5 (2016-04-14)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 7 x64 (build 7601) Service Pack 1
locale:
[1] LC_COLLATE=English_New Zealand.1252 LC_CTYPE=English_New Zealand.1252 LC_MONETARY=English_New Zealand.1252 LC_NUMERIC=C
[5] LC_TIME=English_New Zealand.1252
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] lazyeval_0.1.10 EcoHydRology_0.4.12 DEoptim_2.2-3 topmodel_0.7.2-2 operators_0.1-8 plotly_3.4.13 googleVis_0.5.10
[8] tidyr_0.4.1 raster_2.5-2 leaflet_1.0.1 chron_2.3-47 date_1.2-34 scales_0.4.0 dplyr_0.4.3
[15] DT_0.1 ggplot2_2.1.0 pixmap_0.4-11 RgoogleMaps_1.2.0.7 sp_1.2-3 XML_3.98-1.4 shiny_0.13.2
loaded via a namespace (and not attached):
[1] reshape2_1.4.1 lattice_0.20-33 colorspace_1.2-6 htmltools_0.3.5 yaml_2.1.13 base64enc_0.1-3 withr_1.0.1 DBI_0.3.1
[9] plyr_1.8.3 stringr_1.0.0 munsell_0.4.3 gtable_0.2.0 htmlwidgets_0.6 devtools_1.11.1 memoise_1.0.0 labeling_0.3
[17] httpuv_1.3.3 curl_0.9.7 parallel_3.2.5 Rcpp_0.12.4 xtable_1.8-2 jsonlite_0.9.19 mime_0.4 gridExtra_2.2.1
[25] png_0.1-7 digest_0.6.9 stringi_1.0-1 RJSONIO_1.3-0 grid_3.2.5 tools_3.2.5 magrittr_1.5 assertthat_0.1
[33] httr_1.1.0 viridis_0.3.4 R6_2.1.2 git2r_0.14.0
Update May_04
I didn't realize that EcoHydRology_0.4.12 package was the source of this error message. That's why it was not included in the example above.
Thanks to #enpitsu who pointed out the source of the problem and his nice solution through loading EcoHydRology package first then dplyr
Below is an example to reproduce the same error including EcoHydRology_0.4.12.
The example will work fine if you load the packages in this order
library(EcoHydRology)
library(dplyr)
However, if you switch the order, it will return error messages
set.seed(123)
date <- rep (as.Date(seq(as.Date("2003-01-01"), as.Date("2008-05-31"), by = 1), format="%Y-%m-%d"), 2)
siteID <- c(rep("site1", 1978), rep("site2", 1978))
flow <- runif(3956, 48530, 1250365)
df <- data.frame(date, siteID, flow)
library(dplyr)
library(EcoHydRology)
df1 <- df %>%
dplyr::select(siteID, flow) %>%
dplyr::group_by(siteID) %>%
dplyr::do(cbind(., BaseflowSeparation(.$flow, filter_parameter = 0.925, passes = 3)))
summary(df1)
df2 <- df1 %>%
dplyr::select(siteID, flow, bt, qft) %>%
dplyr::group_by(siteID) %>%
dplyr::summarise_each(funs(
mean(., na.rm=T),
sd(., na.rm=T),
n()))
df2
Have now been able to reproduce this error. The package causing the problem is:
EcoHydRology_0.4.12
Unfortunately, detaching this packages with detach("package:EcoHydRology", unload=TRUE) did not get rid of the error. Restarting my R session did fix the problem until I loaded the EcoHydRology package again. One solution is to run this without that package loaded.
UPDATE: I believe I have solved the problem now.
When I ran library(EcoHydRology) and looked carefully at the console messages I noticed that it printed:
The following object is masked from ‘package:dplyr’:
%>%
That is not good and not easy to load by dplyr::%>% (which does not work).
However, if we run library(EcoHydRology) and then run library(dplyr) again after it, the dplyr package will mask %>% from other packages and switch back to its version. Now run the code and we don't get the error.
Originally suggested changing funs() to dplyr::funs(), but that did not solve the problem. (edited to remove extraneous text)
Essentially, we need to check to see if package:EcoHydRology is loaded, detach package:dplyr first, then detach package:EcoHydRology, to enable the reload the package:dplyr...
The solution is to use require(), to check if package:EcoHydRologyis loaded. The advantage of require() over library() is that it returns TRUE or FALSE, enabling us to use it to evaluate the result of its operation.
Thus, if the package:EcoHydRology is already loaded (TRUE), we can specify the detach order in the if construct, to unload the packages in the correct order dplyr, then EcoHydRology.
We are now able to load the required package:dplyr without issue.
#
# 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(dplyr)
library(EcoHydRology)
library(ggplot2)
library(shiny)
if ( require(EcoHydRology) ) {
detach("package:dplyr", unload = TRUE)
detach("package:EcoHydRology", unload = TRUE)
require(dplyr)
}
ui <- fluidPage(
titlePanel(
sidebarLayout(
sidebarPanel(
tags$h1(tags$strong("Shiny app")),
fileInput("file", "Upload your file"),
width =2),
mainPanel(width =10,
uiOutput("tb")))))
#server
server <- function(input,output){
data <- reactive({
file1 <- input$file
if(is.null(file1)){return()}
read.csv(file1$datapath, header=TRUE, sep=',')
})
output$sum <- renderTable({
if(is.null(data())){return ()}
df_summary <- data()
df_summary1 <- df_summary %>%
dplyr::select(cut, color, carat, price)
summary(df_summary1)
})
output$table <- renderDataTable({
if(is.null(data())){return ()}
data()
})
output$stats <- renderDataTable({
if(is.null(data())){return ()}
diam1 <- data()
print(
diam_stats <- diam1 %>%
dplyr::select(cut, color, carat) %>%
dplyr::arrange(cut, color) %>%
dplyr::group_by(cut, color) %>%
dplyr::filter(!is.na(carat)) %>%
dplyr::summarise_each(funs(
mean(., na.rm=T),
sd(., na.rm=T),
n()))
)
})
output$tb <- renderUI({
if(is.null(data()))
h5()
else
tabsetPanel(type="tab",
tabPanel(h3("Summary", align="center"),
tableOutput("sum")),
tabPanel(h3("Data"),
dataTableOutput("table")),
tabPanel(h3("Stats"),
dataTableOutput("stats")))
})
}
shinyApp(ui = ui, server = server)
When I create a sankey diagram in a regular R session the output looks ok. The tooltip shows an arrow between the connections:
require(rCharts)
require(rjson)
links <- matrix(unlist(
rjson::fromJSON(
file = "http://bost.ocks.org/mike/sankey/energy.json"
)$links
),ncol = 3, byrow = TRUE)
nodes <- unlist(
rjson::fromJSON(
file = "http://bost.ocks.org/mike/sankey/energy.json"
)$nodes
)
links <- data.frame(links)
colnames(links) <- c("source", "target", "value")
links$source <- sapply(links$source, FUN = function(x) {return(as.character(nodes[x+1]))}) #x+1 since js starts at 0
links$target <- sapply(links$target, FUN = function(x) {return(nodes[x+1])}) #x+1 since js starts at 0
sankeyPlot <- rCharts$new()
sankeyPlot$setLib('http://timelyportfolio.github.io/rCharts_d3_sankey')
sankeyPlot$set(
data = links,
nodeWidth = 15,
nodePadding = 10,
layout = 32,
width = 960,
height = 500,
units = "TWh",
title = "Sankey Diagram"
)
sankeyPlot
When I create it in shiny, the arrow in the tooltip is replaced by unusual characters. Also below the plot an unusual character is printed. I needed to download the d3_sankey library to make the shiny app version work, so if you want to reproduce it you have to change the path in the setLib statement. How can this be fixed?
require(shiny)
runApp(list(
ui = pageWithSidebar(
headerPanel('Test'),
sidebarPanel( 'Test' ),
mainPanel(
chartOutput("Plot", 'C:/R-3.0.1/library/rCharts/libraries/sankey')
)
),
server = function(input, output, session){
output$Plot <- renderChart2({
sankeyPlot2 <- rCharts$new()
sankeyPlot2$setLib('C:/R-3.0.1/library/rCharts/libraries/sankey')
sankeyPlot2$set(
data = links,
nodeWidth = 15,
nodePadding = 10,
layout = 32,
width = 960,
height = 500,
units = "TWh",
title = "Sankey Diagram"
)
return(sankeyPlot2)
})
}
))
> sessionInfo()
R version 3.0.2 (2013-09-25)
Platform: x86_64-w64-mingw32/x64 (64-bit)
locale:
[1] LC_COLLATE=Dutch_Belgium.1252 LC_CTYPE=Dutch_Belgium.1252
[3] LC_MONETARY=Dutch_Belgium.1252 LC_NUMERIC=C
[5] LC_TIME=Dutch_Belgium.1252
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] shiny_0.8.0.99 rjson_0.2.13 rCharts_0.4.2
loaded via a namespace (and not attached):
[1] bitops_1.0-6 caTools_1.16 digest_0.6.4 grid_3.0.2
[5] httpuv_1.2.1 lattice_0.20-23 plyr_1.8 Rcpp_0.10.6
[9] RCurl_1.95-4.1 RJSONIO_1.0-3 tools_3.0.2 whisker_0.3-2
[13] xtable_1.7-1 yaml_2.1.10
The problem is related to character encoding in multiple files. This is how I resolved the issues on my Windows 7 machine.
Mouseover tooltip issue
An arrow character is used to construct the "link" between source and target. It occurs in these files:
example_build_network_sankey.html
layouts\chart.html
layouts\chart_static_title.html
layouts\chart.html
Replace the arrow with the ASCii characters ->
so the code looks like:
.text(function (d) { return d.source.name + " -> " + d.target.name + "\n" + format(d.value); });
Characters below the chart
 is found in:
\libraries\highlighters\prettify\css\sunburst.css
\layouts\chart.html
\libraries\widgets\d3_sankey\layouts\chart.html
I used the Search and Replace in Files facility in UltraEdit to replace this special character with a blank space. This one is tricky because I could not see the character in the UE editor. If I highlighted the blank space it appears as a backtick. The character is also found in jquery-1.8.2.min.js.
I'm trying to figure out how to use downloadButton to save a plot with shiny. The example in the package demonstrates downloadButton/downloadHandler to save a .csv. I'm going to make a reproducible example based on that.
For ui.R
shinyUI(pageWithSidebar(
headerPanel('Downloading Data'),
sidebarPanel(
selectInput("dataset", "Choose a dataset:",
choices = c("rock", "pressure", "cars")),
downloadButton('downloadData', 'Download Data'),
downloadButton('downloadPlot', 'Download Plot')
),
mainPanel(
plotOutput('plot')
)
))
For server.R
library(ggplot2)
shinyServer(function(input, output) {
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,
"cars" = cars)
})
plotInput <- reactive({
df <- datasetInput()
p <-ggplot(df, aes_string(x=names(df)[1], y=names(df)[2])) +
geom_point()
})
output$plot <- renderPlot({
print(plotInput())
})
output$downloadData <- downloadHandler(
filename = function() { paste(input$dataset, '.csv', sep='') },
content = function(file) {
write.csv(datatasetInput(), file)
}
)
output$downloadPlot <- downloadHandler(
filename = function() { paste(input$dataset, '.png', sep='') },
content = function(file) {
ggsave(file,plotInput())
}
)
})
If you're answering this question, you are probably familiar with this, but to get this working, save the above into separate scripts (ui.R and server.R into a folder (foo) within the working directory. To run the shiny app, run runApp("foo").
Using ggsave, I get an error message indicating that ggsave can't use the filename function (I think). If I use the standard graphics device (like below), the Download Plot works without an error, but it doesn't write the graphic.
Any tips to get downloadHandler working for writing plots would be appreciated.
Not sure if this question is still active but it's the first one that came up when searching for "saving plots in shiny app" so I wanted to quickly add how to get ggsave to work with downloadHandler along the lines of the original question.
The alternative strategies suggested by juba using direct output instead of ggsave and alternative strategy suggested by alexwhan himself both work great, this is just for those who absolutely want to use ggsave in the downloadHandler).
The problem reported by alexwhan is caused by ggsave trying to match the file extension to the correct graphics device. The temporary file, however, doesn't have an extension so the matching fails. This can be remedied by specifically setting the device in the ggsave function call, like so in the original code example (for a png):
output$downloadPlot <- downloadHandler(
filename = function() { paste(input$dataset, '.png', sep='') },
content = function(file) {
device <- function(..., width, height) grDevices::png(..., width = width, height = height, res = 300, units = "in")
ggsave(file, plot = plotInput(), device = device)
}
)
This call basically takes the device function for a png that ggsave assigns internally (you can look at the ggsave function code to see the syntax for jpg, pdf, etc). Perhaps, ideally, one could specify the file extension (if different from the file name - as is the case here for the temporary file) as a ggsave parameter but this option is currently not available in ggsave.
A minimal self-contained working example:
library(shiny)
library(ggplot2)
runApp(list(
ui = fluidPage(downloadButton('foo')),
server = function(input, output) {
plotInput = function() {
qplot(speed, dist, data = cars)
}
output$foo = downloadHandler(
filename = 'test.png',
content = function(file) {
device <- function(..., width, height) {
grDevices::png(..., width = width, height = height,
res = 300, units = "in")
}
ggsave(file, plot = plotInput(), device = device)
})
}
))
sessionInfo()
# R version 3.1.1 (2014-07-10)
# Platform: x86_64-pc-linux-gnu (64-bit)
#
# locale:
# [1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C
# [3] LC_TIME=en_US.UTF-8 LC_COLLATE=en_US.UTF-8
# [5] LC_MONETARY=en_US.UTF-8 LC_MESSAGES=en_US.UTF-8
# [7] LC_PAPER=en_US.UTF-8 LC_NAME=C
# [9] LC_ADDRESS=C LC_TELEPHONE=C
# [11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C
#
# attached base packages:
# [1] stats graphics grDevices utils datasets methods base
#
# other attached packages:
# [1] ggplot2_1.0.0 shiny_0.10.1
#
# loaded via a namespace (and not attached):
# [1] bitops_1.0-6 caTools_1.17 colorspace_1.2-4 digest_0.6.4
# [5] formatR_1.0 grid_3.1.1 gtable_0.1.2 htmltools_0.2.6
# [9] httpuv_1.3.0 labeling_0.2 MASS_7.3-34 munsell_0.4.2
# [13] plyr_1.8.1 proto_0.3-10 Rcpp_0.11.2 reshape2_1.4
# [17] RJSONIO_1.3-0 scales_0.2.4 stringr_0.6.2 tools_3.1.1
# [21] xtable_1.7-3
Update
As of ggplot2 version 2.0.0, the ggsave function supports character input for the device parameter, that means the temporary file created by the downloadHandler can now be saved with a direct call to ggsave by specifying that the extension to be used should be e.g. "pdf" (rather than passing in a device function). This simplifies the above example to the following
output$downloadPlot <- downloadHandler(
filename = function() { paste(input$dataset, '.png', sep='') },
content = function(file) {
ggsave(file, plot = plotInput(), device = "png")
}
)
I didn't manage to make it work with ggsave, but with a standard call to png() it seems to be okay.
I only changed the output$downloadPlot part of your server.R file :
output$downloadPlot <- downloadHandler(
filename = function() { paste(input$dataset, '.png', sep='') },
content = function(file) {
png(file)
print(plotInput())
dev.off()
})
Note that I had some problems with the 0.3 version of shiny, but it works with the latest from Github :
library(devtools)
install_github("shiny","rstudio")
Here's a solution that allows using ggsave for saving shiny plots. It uses a logical checkbox and text input to call ggsave(). Add this to the ui.R file inside sidebarPanel:
textInput('filename', "Filename"),
checkboxInput('savePlot', "Check to save")
Then add this to the server.R file instead of the current output$plot reactivePlot function:
output$plot <- reactivePlot(function() {
name <- paste0(input$filename, ".png")
if(input$savePlot) {
ggsave(name, plotInput(), type="cairo-png")
}
else print(plotInput())
})
A user can then type the desired filename in the textbox (without extension) and tick the checkbox to save in the app directory. Unchecking the box prints the plot again. I'm sure there are neater ways of doing this, but at least I can now use ggsave and cairo in windows for much nicer png graphics.
Please add any suggestions you may have.
This is old, but still the top hit when someone googles "R shiny save ggplot", so I will contribute another workaround. Very simple... call ggsave in the same function that displays your graph, which will save the graph as a file on the server.
output$plot <- renderPlot({
ggsave("plot.pdf", plotInput())
plotInput()
})
Then, use downloadHandler and use file.copy() to write data from the existing file to the "file" parameter.
output$dndPlot <- downloadHandler(
filename = function() {
"plot.pdf"
},
content = function(file) {
file.copy("plot.pdf", file, overwrite=TRUE)
}
)
Works for me.