I've built an extensive Shiny app which relies heavily on Highcharter for its graphics. Now I'm trying to make a download button that allows the user to download a ZIP file with multiple PDF files, each having a different chart.
I managed to get it to work with ggPlot (hat-tip to Shiny R Zip multiple PDFS for download), but cannot seem to figure it out with Highcharts. I know part of the problem is because Highcharts doesn't output an image, but rather an SVG(? or perhaps JSON?). So I'm stuck on how to convert, within R/Shiny code, the chart to a PDF, since it's not rendered or displayed in the browser.
I tried first to render as SVG, then use rsvg_pdf() (from library rsvg) to convert to PDF, but to render as SVG we need to open a rendering device and close it with dev.off(), which saves the file. I couldn't find a way to capture this in-between and then pass it to rsvg_pdf().
Instead, would the solution lie in invoking the (unix) command-line, and do conversion there? Is there a way to pass a chart to the Highcharts exporting module without it showing up for the end-user?
Thanks a lot for your help!
See below for a reproducible example:
ui.R
library(shiny)
shinyUI(
fluidPage(
headerPanel(title="testing Downloadhandler"),
sidebarLayout(
sidebarPanel(
selectInput("ngear", "Select the gear number", c("Cylinders" = "cyl", "Transmission" = "am", "Gears" = "gear")),
submitButton("Update!"),br(),
),
mainPanel(
tabsetPanel(type="tab",
tabPanel("Plot", plotOutput("plot"),
downloadButton("downloadZippedPlots", "Download Zipped Plot")
)
)
)
)
)
)
Server.R
library(shiny)
library(highcharter)
shinyServer(function(input,output){
mtreact <- reactive({
mtcars[,c("mpg", input$ngear)]
})
output$plot <- renderPlot({
boxplot(mtreact())
})
output$downloadZippedPlots <- downloadHandler(
filename = function(){
paste("mtcars-plots-zipped", "zip", sep=".")
},
content = function(fname){
fs <- c()
tmpdir <- tempdir()
setwd(tempdir())
for (column in c("cyl", "am", "gear")) {
path <- paste(column, "pdf", sep=".")
fs <- c(fs, path)
# --- This works ---
pdf(paste(column, "pdf", sep="."))
boxplot(mtcars[,c("mpg", column)])
dev.off()
# --- This doesn't work ---
hchart(mtcars, "bar", hcaes(x=mpg, y=!!column))
# --- This also doesn't work ---
this_chart <- hchart(mtcars, "bar", hcaes(x=mpg, y=!!column))
print(this_chart)
dev.off()
}
zip(zipfile=fname, files=fs)
},
contentType = "zip"
)
})
Related
When I use pdf_ocr_text from pdftools for example:text1 <- pdf_ocr_text("0.pdf", dpi = 300), it will show the status in the R console like below.
Converting page 1 to 0_1.png... done!
Converting page 2 to 0_2.png... done!
Converting page 3 to 0_3.png... done!
Converting page 4 to 0_4.png... done!
But how can I show this status when I use this in Shiny app? Because I want the user to see it's being processed rather than nothing is showing when they click the button (it can take a while for this to finish)?
Reproducible codes below, you can import any pdf files in there, but you will need to create a folder that's called www which should be in the same folder of your R file. Also run the app in external browser, otherwise don't work well.
library(tidyverse)
library(shiny)
library(pdftools)
library(tesseract)
library(tidytext)
library(reactable)
library(shinyFeedback)
library(shinyjs)
library(shinyalert)
ui <- shinyUI(fluidPage(
useShinyjs(),
useShinyalert(),
shinyFeedback::useShinyFeedback(),
sidebarLayout(
sidebarPanel(
titlePanel("Demo"),
fileInput("file_import", "Upload Files ( . pdf format only)",
multiple = T, accept = ".pdf"),
disabled(actionButton("ocr_button","OCR (click this when nothing shows up)",
class = "btn-danger",
icon=icon("fa-sharp fa-solid fa-triangle-exclamation",
lib = "font-awesome"))),
textOutput("sometext"),
tableOutput("files")
),
mainPanel(
uiOutput("pdfview"),
reactableOutput("test")
)
)
))
server <- function(input, output, session) {
### display the pdf ########################################################
x = reactiveVal(1)
observeEvent(input$file_import,{
enable("ocr_button")
file.rename(input$file_import$datapath[x()], "0.pdf")
file.copy("0.pdf","www", overwrite = T)
output$pdfview <- renderUI({
tags$iframe(style="height:1200px; width:100%", src="0.pdf")
})
})
observeEvent(input$ocr_button, {
### OCR ###########################################################
text1 <- reactive({pdf_ocr_text("0.pdf", dpi = 300)})
######################################################################
output$sometext = renderText({
text1()
})
})
}
shinyApp(ui, server)
I want to create an app where the user can input a link or some text and download the corresponding QR code as a pdf.
I have already the fundamental building blocks, but I cannot glue them together.
For instance, for the pure QR code generation part
library(qrcode)
qr <- qr_code("https://www.wikipedia.org/")
pdf("qr_code.pdf")
plot(qr)
dev.off()
#> png
#> 2
Created on 2022-01-04 by the reprex package (v2.0.1)
for inputting text in Shiny
library(shiny)
ui <- fluidPage(
textInput("caption", "Caption", "Your link/text here"),
verbatimTextOutput("value")
)
server <- function(input, output) {
output$value <- renderText({ input$caption })
}
shinyApp(ui, server)
#> PhantomJS not found. You can install it with webshot::install_phantomjs(). If it is installed, please make sure the phantomjs executable can be found via the PATH variable.
Shiny applications not supported in static R Markdown documents
Created on 2022-01-04 by the reprex package (v2.0.1)
and for saving a plot as a pdf in Shiny
library(shiny)
library(tidyverse)
df <- tibble(x=seq(10), y=seq(10))
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
downloadButton("save", "Download plot"),
),
mainPanel(
plotOutput("tplot" )
)
)
)
server <- function(input, output) {
tplot <- reactive({
plot(df$x, df$y)
})
output$tplot <- renderPlot({
tplot()
})
# downloadHandler contains 2 arguments as functions, namely filename, content
output$save <- downloadHandler(
filename = function() {
paste("myplot.pdf")
},
# content is a function with argument file. content writes the plot to the device
content = function(file) {
pdf(file) # open the pdf device
plot(x=df$x, y=df$y) # draw the plot
dev.off() # turn the device off
}
)
}
shinyApp(ui = ui, server = server)
#> PhantomJS not found. You can install it with webshot::install_phantomjs(). If it is installed, please make sure the phantomjs executable can be found via the PATH variable.
Shiny applications not supported in static R Markdown documents
Created on 2022-01-04 by the reprex package (v2.0.1)
Can anyone help me put all of this together?
Thanks!
Here's how you can do this:
UI:
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
textInput("link", "Enter Link here", "www.google.com"),
downloadButton("save", "Download QR")
),
mainPanel(
plotOutput("tplot" )
)
)
)
textInput takes arguments inputId, label, and value.
inputId is what you'll refer to the input inside your code.
label tells what will be written over the input field. It is something that user can see and identify what to enter in the field.
'value` is the default value that your input field will have. It can be blank.
Server:
server <- function(input, output) {
tplot <- reactive({
qr <- qr_code(input$link)
plot(qr)
})
output$tplot <- renderPlot({
tplot()
})
# downloadHandler contains 2 arguments as functions, namely filename, content
output$save <- downloadHandler(
filename = function() {
paste("myplot.pdf")
},
# content is a function with argument file. content writes the plot to the device
content = function(file) {
pdf(file) # open the pdf device
plot(qr_code(input$link)) # draw the plot
dev.off() # turn the device off
}
)
}
Notice that I've used qr_code inside the reactive field so that you can use it further in output.
The shiny app will now, show the QR code as you keep typing inside the input field. Since it is reactive, it reacts to your input.
The download functionality also works as expected.
I am trying to use the diffR function to accept two .R files to compare the differences in a shiny app. Where someone can upload two R files and then it will utilize diffR to output.
I can run my code locally where I define my file one and file two as directories locally and then I'll get a side by side output of the code to show the differences. It highlights differences and then adjustments can be made.
server <- function(input, output, session) {
output$contents <- renderPrint({
info_old <- input$old_file
if(is.null(info_old))
return(null)
df_old <- readLines(info_old$datapath)
df_old
})
output$new_contents <- renderPrint({
info_new <- input$new_file
if(is.null(info_new)){return()}
df_new <- readLines(info_new$datapath)
df_new
})
output$exdiff <- renderDiffr({
diffr(info_old(), info_new(), wordWrap = input$wordWrap,
before = "Original_File", after = "New File")
})
}
I know this simple where both the old_file and the new_file are generated side. This stack answer shows exactly what I am looking for:
In R, find whether two files differ
Where the diffr package is used. I just want the user to have the ability to upload the two R files so do the side by side comparison instead of defining file a and b globally.
You can use the datapath given by the uploaded files: input$files[[1, 'datapath']].
If you like, a small remark on your (good) attempt. The diffr() function demands the connection to the file not the content itself. I ran into the same trap as well. So if you remove the readLines() in your code you should be pretty close.
You might want to include a test, that the length of uploaded files is not smaller or greater than 2, to ensure the app doesnt crash if e.g. only one file is given.
Reproducible example:
write.csv2(
x = "diff same",
file = "test.csv"
)
write.csv2(
x = "diffhere same",
file = "test2.csv"
)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput(
inputId = "files",
label = "Choose CSV File",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")
)
),
mainPanel(
tableOutput("contents"),
diffrOutput("exdiff")
)
)
)
server <- function(input, output) {
output$exdiff <- renderDiffr({
req(input$files)
diffr(
file1 = input$files[[1, 'datapath']],
file2 = input$files[[2, 'datapath']],
wordWrap = TRUE,
before = "f1",
after = "f2"
)
})
}
shinyApp(ui, server)
I am trying to setup a shiny app that can download html plots from the googleViz package. The code works on my machine, but when I move it to the server I get the following message when testing the download...
"The requested URL was rejected. Please consult with your administrator."
I am struggling to figure out what the IT staff, that set up the server, need to do to fix the problem - I know nothing about servers and they know nothing about R.
I built a small example app here to demonstrate the problem, based on the following ui.R
library(shiny)
library(googleVis)
# user interface
shinyUI(pageWithSidebar(
headerPanel("googleVis on Shiny"),
sidebarPanel(
selectInput("dataset", label = "Choose a dataset:",
choices = c("rock", "pressure", "cars")),
downloadButton('download_gvis', label = 'Download')
),
mainPanel(
htmlOutput("view")
)
))
and server.R
library(googleVis)
library(webshot)
shinyServer(function(input, output) {
# data set from user
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,
"cars" = cars)
})
# plot of data set from user
my_plot <- reactive({
gvisScatterChart(datasetInput(),
options=list(title=paste('Data:',input$dataset)))
})
# render plot of data set from user
output$view <- renderGvis({
my_plot()
})
# download plot of data set from user
output$download_gvis <- downloadHandler(
filename = "test.png",
content = function(file) {
g <- my_plot()
# print to html file
print(g, file = "gg.html")
# take a webshot of html file and save as png
webshot(
url = "gg.html",
file = "output.png",
delay = 2
)
# send output file to downloadHandler
file.copy("output.png", file)
# delete files
file.remove("gg.html")
file.remove("output.png")
}
)
})
I think the code breaks at print(g, file = "gg.html") in the server script. Thegg.html file never appears in the server directory (on my local machine I see it pop up in the directory view of RStudio).
Is it possible to adjust the output of the Excel output?
I would like to be able to do the following things in descending urgency.
Add a Header to the table that includes some text "This table is based on the iris dataset and uses input$width as minimum"
Add an Thick bottom border to the column names header
Add a left border after the first column
Add an empty row above the header
Where I could write stuff into some merged cells, i.e. I would like to write "Petal Sizes" above the four columns of length, width,...
Thats a MWE using the button extension. I found some information for the original javascrtip DT here, but that is a bit too hard for me to transfer into R.
rm(list=ls())
library(shiny)
library(datasets)
library(DT)
library(data.table)
DT<-data.table(iris)
server<-shinyServer(function(input, output) {
output$view <- DT::renderDataTable(
DT[Sepal.Width<=input$width,.SD],extensions = c( 'FixedHeader','Buttons'),
options=list(pageLength=60,fixedHeader = TRUE,dom = 'Bfrtip',buttons = c( 'csv', 'excel' )))
})
ui<-shinyUI(fluidPage(
titlePanel("Shiny MWE"),
sidebarLayout(
sidebarPanel(
sliderInput("width", label = h3("Min width"),
min=min(DT$Sepal.Width), max=max(DT$Sepal.Width), value=mean(DT$Sepal.Width),
)),
mainPanel(
DT::dataTableOutput("view")
)
)
))
runApp(list(ui=ui,server=server))
I also realized that I had to abandon the 'button' extension, for other reasons as well. For instance, the excel download button only exports the view on the app, not the whole data set. (which can be fixed with the option server=FALSE, which is too slow for larger data sets)
I opted for the openxlsx package, which needs Rtools to be installed, which I had some difficulties with (found a solution to add it to the windows path ([Error: zipping up workbook failed when trying to write.xlsx)
So my posted code mostly does what I wanted or I can continue using the openxlsx commands. There are alternatives with the xlsx package or others, which I also had trouble installing.
rm(list=ls())
library(shiny)
library(datasets)
library(DT)
library(data.table)
library(openxlsx)
DT<-data.table(iris)
# Style created for openxlsx see help
hs <- createStyle(textDecoration = "BOLD", fontColour = "#FFFFFF", fontSize=12,
fgFill = "#177B57",border="Bottom",borderStyle=c("thick"))
#Server
server<-shinyServer(function(input, output) {
output$view <- DT::renderDataTable(
DT[Sepal.Width<=input$width,.SD],extensions = c( 'FixedHeader'),
options=list(pageLength=20,fixedHeader = TRUE,dom = 'frtip'))
#Include DownloadHandler
output$downloadData <- downloadHandler(
filename = function() { paste0("test.xlsx") },
content = function(file) {
wb<-createWorkbook() # Create wb in R
addWorksheet(wb,sheetName="Output") #create sheet
#Creates a Data Table in Excel if you want, otherwhise only use write Data
writeDataTable(wb,1, DT[Sepal.Width<=input$width,.SD], colNames = TRUE, headerStyle = hs,startRow=2,tableStyle = "TableStyleLight1")
mergeCells(wb,sheet = "Output", cols=1:5, rows=1)
writeData(wb,1, "Include text also based on reactive function and in merged cells" )
saveWorkbook(wb, file = file, overwrite = TRUE)
},
contentType= "excel/xlsx")
})
ui<-shinyUI(fluidPage(
titlePanel("Shiny MWE"),
sidebarLayout(
sidebarPanel(
sliderInput("width", label = h3("Min width"),
min=min(DT$Sepal.Width), max=max(DT$Sepal.Width), value=mean(DT$Sepal.Width),
),
downloadButton('downloadData', 'Download')),
mainPanel(
DT::dataTableOutput("view")
)
)
))
runApp(list(ui=ui,server=server),launch.browser=T) # Download button only works in browser