I have a large Shiny application that has a number of prompts, then generates tables and plot based on those inputs. I don't use rmarkdown or knitr or anything to format the output. I just use the standard Shiny elements (sidebarPanel, mainPanel, etc.). For the plots and tables I use the standard reactive renderPlot and renderTable objects.
I'm looking for an easy way to have a button called "Export to PDF" that exports the elements on the page to a PDF document.
I've looked into using knitr and rmarkdown to generate a document with some fancy formatting (see here and here for examples).
The problem is that it appears that I'll need to regenerate the tables and plots either within the Rmd file or the server.R within a downloadHandler object, and I'd like to avoid that.
Is there any way to output the page as a pdf more easily. More specifically, is there any way to directly reference the output tables and plots (i.e. the output$ objects) from within the Rmd file so that plots and tables don't need to be generated twice.
Edit: Here is some simplified code. Note getDataset() is a reactive function that queries a database based on the inputs.
My goal is to simply add an "Export" button that exports the already-generated plots and table. (Also as a side note, is there any way I can get a reactive dataset that is shared among all reactive elements? i.e. not need to have ds <- getDataset() in every object?)
Server
output$hist <- renderPlot({
ds <- getDataset()
# do data transformations
ggplot(ds, aes(val)) +
geom_histogram(binwidth = binSize, aes(fill = ..count..)) +
labs(title = "val dist", x = "val", y = "Count") +
scale_fill_gradient("Count", low = "green", high = "red", guide = FALSE) +
scale_x_continuous(limits = c(min(ds$val), quantile(ds$val, 0.99))) +
geom_hline(yintercept=maxY, linetype=3)
})
output$time <- renderPlot({
ds <- getDataset()
# do data transformations
ggplot(ds, aes(as.POSIXlt(unixTime, origin="1970-01-01", tz="UTC"), val), colour = val) +
scale_y_continuous(limits = c(min(ds$val), quantile(ds$val, 0.99))) +
labs(title = "Val Over Time", x = "Time (UTC)", y = "val (ms)") +
geom_point(alpha = 0.3, size = 0.7) +
geom_smooth()
})
output$stats <- renderTable({
statsDf = getDataset()
# do data transformations
statsDf
})
UI
ui <- fluidPage(
titlePanel("Results"),
sidebarLayout(
sidebarPanel(
dateInput("startDateTime", "Start Date:", value = "2016-10-21"),
textInput("startTime", "Start Time", "00:00:00"),
br(),
dateInput("endDateTime", "End Date:", value = "2016-10-21"),
textInput("endTime", "End Time", value = "02:00:00"),
br(),
submitButton("Submit")
),
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Plots",
plotOutput("hist"),
plotOutput("time"),
tabPanel("Statistics", tableOutput("stats"))
)
)
)
)
First of all , you should really produce a reproducible example not just a sample of your code. We should copy and paste your code and it will run.
The idea
Since you are using ggplot2 which is king of grid plots, I think one easy option to save plots/tables is to use gridExtra package. Using grid.arrange or arrangeGrobs you can save your grobs to predefined device. Then, downloadhandler will do the download.
To not regenerate all the plots each time, I think one solution is to save them in a global variable that you update each time you change the plot. Here reactiveValues come in rescue to store plots and tables ad dynamic variable.
Solution
ui.R
library(shiny)
shinyUI(fluidPage(
# Application title
titlePanel("Save ggplot plot/table without regenration"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
downloadButton('export')
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("p1"),
plotOutput("p2"),
tableOutput("t1")
)
)
))
server.R
library(shiny)
library(ggplot2)
library(gridExtra)
shinyServer(function(input, output) {
## vals will contain all plot and table grobs
vals <- reactiveValues(p1=NULL,p2=NULL,t1=NULL)
## Note that we store the plot grob before returning it
output$p1 <- renderPlot({
vals$p1 <- qplot(speed, dist, data = cars)
vals$p1
})
output$p2 <- renderPlot({
vals$p2 <- qplot(mpg, wt, data = mtcars, colour = cyl)
vals$p2
})
## same thing for th etable grob
output$t1 <- renderTable({
dx <- head(mtcars)
vals$t1 <- tableGrob(dx)
dx
})
## clicking on the export button will generate a pdf file
## containing all grobs
output$export = downloadHandler(
filename = function() {"plots.pdf"},
content = function(file) {
pdf(file, onefile = TRUE)
grid.arrange(vals$p1,vals$p2,vals$t1)
dev.off()
}
)
})
Related
I am developing a package in R and its plotting functions include a line with pdf() or png() to save the figure. However, when I tried to create a Shiny app from this package the plots did not appear on the app. I verified that the pdf() function prevents the plot from being displayed. Is there a way to show the plots without changing the whole package? I was thinking about saving the image and rendering it, but maybe there is a more efficient answer.
I created a sample code just to illustrates the problem. The test_plot function shows an example of the structure of the functions in my package.
test_plot <- function(){
data=head(mtcars, 30)
g1 <- ggplot(data, aes(x=wt, y=mpg)) +
geom_point() + # Show dots
geom_text(
label=rownames(data),
nudge_x = 0.25, nudge_y = 0.25,
check_overlap = T
)
pdf(file = 'test.pdf', width = 5, height = 5)
print(g1)
}
The renderPlot just calls the test_plot. If I remove the pdf() from the code the figure is displayed correctly.
server <- function(input, output) {
output$distPlot <- renderPlot({
test_plot()
})
}
Perhaps try separating the renderPlot() from the PNG file itself, and allow the user to download the PNG with a downloadHandler():
library(shiny)
library(tidyverse)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput(
inputId = "n", label = "Select rows",
min = 1, max = nrow(mtcars),
value = 20, round = TRUE
),
downloadButton(outputId = "download")),
# Show a plot of the generated distribution
mainPanel(plotOutput("plot"))
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
# render plot
plot_reactive <- reactive({
p <- head(mtcars, input$n) %>%
ggplot(aes(x = wt, y = mpg)) +
geom_point()
})
output$plot <- renderPlot(print(plot_reactive()))
# download plot
output$download <- downloadHandler(
filename = function(){ paste0(input$n, "_mtcars.png") },
content = function(file){ ggsave(file, plot_reactive()) }
)
}
# Run the application
shinyApp(ui = ui, server = server)
I wasted hours to find out why my plot is automatically updating itself when I change inputs while it was supposed to wait for the Run button but it simply ignored that step and I ended up finally finding ggplot as the trouble maker!!! This is my minimal code:
library(ggplot2)
library(tidyverse)
varnames <- names(cars)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fluidRow(
column(
width = 12,
# Variables Inputs:
varSelectInput("variables", "Select Input Variables", cars, multiple = TRUE),
selectizeInput("outvar", "Select Output Variable", choices = varnames, "speed", multiple = F),
# Run Button
actionButton(inputId = "run", label = "Run")
)
)
),
# Main panel for displaying outputs ----
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output, session) {
df <- reactive({
cars %>% dplyr::select(!!!input$variables, input$outvar)
})
plt <- eventReactive(input$run, {
#Just creating lm formula
current_formula <- paste0(input$outvar, " ~ ", paste0(input$variables, collapse = " + "))
current_formula <- as.formula(current_formula)
#Fitting lm
fit <- lm(current_formula, data = df())
pred <- predict(fit, newdata = df())
#Plotting
ggplot(df(), aes(df()[, input$outvar], pred)) +
labs(x = "Observed", y = "Predicted") +
geom_point() +
theme_bw()
#plot(df()[, input$outvar], pred) #This one works fine!!!!
})
output$plot <- renderPlot({
plt()
})
}
# Run the application
shinyApp(ui = ui, server = server)
If you run this, you'll notice that ggplot doesn't care anymore about the Run button after the 1st run and it keeps updating as you change the inputs!! However, if you use the simple base plot function (which I put in a comment in the code) there wouldn't be any problems and that works just fine! Sadly I need ggplot in my app because base plot is ugly. I am seeing suggestion for using isolate() to solve this issue but I have no clue where isolate() should be put to fix my problem also it doesn't make sense to use isolate() when base plot function works fine without it and it's the ggplot that makes the problem. Any explanation would be appreciated.
The issue is that ggplot aesthetics are lazy evaluated. You really want to put symbols into the aes() rather that reactive data values. Change your plotting code to
ggplot(df(), aes(.data[[input$outvar]], pred)) +
labs(x = "Observed", y = "Predicted") +
geom_point() +
theme_bw()
With ggplot you use the .data pronoun to access the current data source rather than trigger the reactive df() object again.
I am learning how to use renderUI to dynamically generate multiple plots. Here is an example app I designed (https://yuchenw.shinyapps.io/Format_UI_Example/). The idea is to design an app that allows users to select one or more parameters in the mtcars data set and plot the row index and the value as a scatter plot dynamically.
The example app works, but all the plots are aligned in one column. As the users selected more parameters, the number of plots increases, and the length of the web page also increases. In addition, there are lots of white space. If possible, I would like to arrange or align the multiple plots as a two columns or three columns structure to reduce the length of the web page and to reduce the white space.
I usually used the column function and set the width argument to achieve this. But I don't how to do it using renderUI. I would appreciate any help.
Here is the code.
### This script creates an R shiny app that plot mpg, disp, and hp, from the mtcars data set
# Load packages
library(shiny)
library(tidyverse)
# Load data
data("mtcars")
# Add row id
mtcars2 <- mtcars %>% mutate(ID = 1:n())
# ui
ui <- fluidPage(
sidebarPanel(
selectInput(inputId = "sel", label = "Select one or more parameters",
choices = names(mtcars), multiple = TRUE)
),
mainPanel(
uiOutput("plots")
)
)
# server
server <- function(input, output, session){
# Create plot tag list
output$plots <- renderUI({
plot_output_list <- lapply(input$sel, function(par) {
plotname <- paste("plot", par, sep = "_")
plotOutput(plotname)
})
do.call(tagList, plot_output_list)
})
# Dynamically generate the plots based on the selected parameters
observe({
req(input$sel)
lapply(input$sel, function(par){
output[[paste("plot", par, sep = "_")]] <- renderPlot({
ggplot(mtcars2, aes_string(x = "ID", y = par)) +
geom_point() +
ggtitle(paste("Plot: ", par))
},
width = 250,
height = 250)
})
})
}
# Run app
shinyApp(ui, server)
Try this :
plotOutput(plotname, height = '250px', inline=TRUE)
It will give you the following output:
I have an r script includes a Identify_IP() that returns a list of dataframe and a ggplot. I want to call the script and render both the dataframe and the plot.
This is Identify_IP() function. I took off unrelative code and kept only the plot, lines and ggplot code to give a clear example of my type of ggplot.
library(ggplot2)
library(matrixStats)
library(fda.usc)
#df <- read.table("name.XLS", header = FALSE)
Identify_IP = function(df1){
mlearn <- df1[,'V7']
formul <- plot(blue_curve$x, blue_curve$y * 30, type = 'l', col = 'blue')
formula_deriv <- lines(blue_curve$x, red_curve$y1 * 30, col = 'red')
p <- ggplot(df1, aes(blue_curve$x)) +
geom_line(aes(y = blue_curve$y, colour = "0 Deriv")) +
geom_line(aes(y = red_curve$y1, colour = "1st Deriv")) +
geom_vline(xintercept = x_loc) + geom_hline(yintercept = 0)
return(list(df1,p))
}
Now, this is a modified Shiny code based on amrr and micstr suggestion.
source('InflectionP2.R', local = TRUE)
library(ggplot2)
library(shiny)
runApp(
list(
ui = fluidPage(
titlePanel("Upload your file"),
sidebarLayout(
sidebarPanel(
fileInput('file1', 'Choose xls file',
accept = c(".XLS")),
actionButton("btn", "Update Table"),
actionButton("btn1", "Display Plot")
),
mainPanel(
tableOutput('what'),
plotOutput('pl'))
)
)
,
server = function(input, output, session){
dataOP <- reactive({
inFile <- input$file1
if (is.null(input$file1))
return(NULL)
dfs <- Identify_IP(read.table(inFile$datapath))
return(dfs)
})
observeEvent(input$btn, output$what <- renderTable({
dataOP()[[1]]
}))
observeEvent(input$btn1, output$pl <- renderPlot({
pp <- dataOP()
pp[[2]]
}))
}))
This was really helpful in teaching me how to call r script in reactive(). And it makes sense to me. Yet, it render the table but the Display Plot button is not rendering the plot. Does my ggplot in Identify_IP function has anything to do with not being able to display the plot? I also tried print(ggplot(pp[[2]])) and still the same.
I managed to get this working.
Note I used the internal data set iris and made a toy Identify_IP function as I do not have your code.
Note you still need to choose a file to trigger the events but it will ignore that file and use iris data.
Workaround I used [[1]] to get the table not dataOP()$tble
CODE
library(shiny)
library(ggplot2)
# source('InflectionP2.R', local = TRUE)
# MAKE TEST FUNCTION
Identify_IP <- function(mydata) {
#shrink data
tble <- head(mydata)
plt <- ggplot(data = head(mydata),
mapping = aes(y = Sepal.Length,
x = Petal.Length)) + geom_point()
return(list(tble, plt))
}
runApp(
list(
ui = fluidPage(
titlePanel("Upload your file"),
sidebarLayout(
sidebarPanel(
fileInput('file1', 'Choose xls file',
accept = c(".XLS")),
actionButton("btn", "Update Table"),
actionButton("btn1", "Display Plot")
),
mainPanel(
tableOutput('what'),
plotOutput('pl'))
)
)
,
server = function(input, output, session){
dataOP <- reactive({
inFile <- input$file1
if (is.null(input$file1))
return(NULL)
# ORIGINAL dfs <- Identify_IP(read.table(inFile$datapath))
# using internal dataset for example
dfs <- Identify_IP(iris)
# ORIGINAL list(tble = dfs, plt = dfs)
# lets just return your dfs, its already a list in code above
return(dfs)
})
observeEvent(input$btn, output$what <- renderTable({
#print(dataOP()) # debug line that led to [[1]] idea
# ORIGINAL dataOP()$tble
# just say first in list
dataOP()[[1]]
}))
observeEvent(input$btn1, output$pl <- renderPlot({
#ggplot(dataOP()$plt)
# since already a plot just need to index it
# I found [[2]] worked better than explicit dataOP()$plt
pp <- dataOP()
pp[[2]]
}))
}))
RESULT
Voila!
1) Try print (ggplot(dataOP()$plt))
Take a look at this answer I wrote.
2) Sorry its hard to interpret without your ggplot code bit and data. Given #amrrs questions can you try debug in your Shiny code with print() and str() temporary lines to see what your data is returning. i.e.
print(dataOP()$plt)
str(dataOP())
Worse case, try split your code in two. So Identify_IP code to do the data leg and then make a Print_IP with the ggplot code that just returns the plot. It might rule out your chart is not the problem.
3) Take a look at reactiveValues()
https://shiny.rstudio.com/reference/shiny/0.11/reactiveValues.html
It "bakes" a result that was reactive. The type coming out of your chart may be a reactive type not a chart type. Perhaps share any error messages you are getting.
I am trying to create Shiny App which is able to display interactive plot title (dependent on the choosen value for x axis)
Very simple example:
library(shiny)
library(DT)
library(ggplot2)
x <- as.numeric(1:1000000)
y <- as.numeric(1:1000000)
z <- as.numeric(1:1000000)
data <- data.frame(x,y, z)
shinyApp(
ui = fluidPage(selectInput(inputId = "yaxis",
label = "Y-axis",
choices = list("x","y","z"),
selected = c("x")),
dataTableOutput('tableId'),
plotOutput('plot1')),
server = function(input, output) {
output$tableId = renderDataTable({
datatable(data, options = list(pageLength = 10, lengthMenu=c(10,20,30)))
})
output$plot1 = renderPlot({
filtered_data <- data[input$tableId_rows_all, ]
ggplot(data=filtered_data, aes_string(x="x",y=input$yaxis)) + geom_line()
})
}
)
I have tried this code:
ggtitle("Line plot of x vs",input$yaxis)
It was not working, plot has not been displayed, giving me an Error:
Warning: Error in ggtitle: unused argument (input$yaxis)
[IMPORTANT]
using ggtitle(input$yaxis) gives me an interactive title, however i need to build up a sentence (like: Line plot of x vs input$yaxis), in which the reactive argument (input$yaxis) is a part of it!
Thanks for any help!
Cheers
Change:
ggtitle("Line plot of x vs",input$yaxis)
To
ggtitle(paste("Line plot of x vs",input$yaxis))
As the error suggests, you have too many arguments passed to the ggtitle function, paste will create a single character out of your two inputs, with a space in between. You can vary the separation between the two with sep =.