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).
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 have a shiny application that takes a file upload, calls a script that processes the uploaded file, and writes 4 csvs as output. The app works but as the title suggests, the file upload takes ~5 seconds on my end, but the intended end user is waiting 40 minutes for the same 32 MB file to upload. How do I reduce this upload time for them?
I am attaching my code, but here are some additional points that may be relevant:
The shiny code, the script it calls, and the file to be uploaded are all on a shared drive.
I am accessing their system through a virtual desktop, while the end user has a company computer.
Thanks in advance.
library(shiny)
source([removed for confidentiality])
# Define UI for dataset viewer app ----
ui <- fluidPage(
# App title ----
titlePanel("DFM File Conversion"),
# Sidebar layout with a input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Selector for choosing dataset ----
textInput(inputId = "exportname1",
label = "Credit Detail [003 Record] Output Name",
value = ""),
textInput(inputId = "exportname2",
label = "Location Bank Deposit [013 Record] Output Name",
value = ""),
textInput(inputId = "exportname3",
label = "Batch Summary [025 Record] Output Name",
value = ""),
textInput(inputId = "exportname4",
label = "Rejected Transactions [029 Record] Output Name",
value = ""),
fileInput("file1", "Please upload a file")
),
# Main panel for displaying outputs ----
mainPanel(
verbatimTextOutput("summary") #shows what files were converted
,h3(textOutput("caption"))
,tableOutput("view") # shows which records are not present in uploaded file
,h3(textOutput("caption2"))
,tableOutput("headdf") #shows first 5 rows of uploaded file
)
)
)
server <- function(input, output) {
options(shiny.maxRequestSize=60*1024^2)
# This reads in the uploaded file from the UI and outputs the first 5 rows
# Then it uses the export name entered by the user to convert the file
# using the conversion script.
output$view <- renderTable({
req(input$file1)
df <- read.delim(input$file1$datapath,header = FALSE, stringsAsFactors = FALSE)
converted <- convertdfm(df, input$exportname1, input$exportname2, input$exportname3, input$exportname4)
# this populates which records are not present in uploaded data
return(converted$output)
})
# this prints the first 4 rows of the file
output$headdf <- renderTable({
req(input$file1)
df1 <- read.delim(input$file1$datapath,header = FALSE, stringsAsFactors = FALSE)
head(df1)})
# this creates the first caption
output$caption <- renderText({
req(input$file1)
print("Checking Input Files for Unavailable Records")
})
# this creates the second caption
output$caption2 <- renderText({
req(input$file1)
print("First 5 Rows of Raw Data")
})
# this shows what files were converted
output$summary <- renderPrint({
req(input$file1)
if (file.exists(input$exportname1))
{print("003 Converted")} else
{print("003 Not Converted")}
if (file.exists(input$exportname2))
{print("013 Converted")} else
{print("013 Not Converted")}
if (file.exists(input$exportname3))
{print("025 Converted")} else
{print("025 Not Converted")}
if (file.exists(input$exportname4))
{print("029 Converted")} else
{print("029 Not Converted")}
}
)
}
# Create Shiny app ----
shinyApp(ui = ui, server = 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 want to upload updated csv file daily basis. Once the csv file get uploaded, the upload icon should disappear and valueBox should display with relevant value. Here is the below code:
library(shiny)
library(shinydashboard)
# Define UI for application that draws a histogram
ui <- dashboardPage(
dashboardHeader(title = "Upload Stats"),
dashboardSidebar(),
dashboardBody(
box(
title = "UPTIME:", width = 12,
div(column(width = 4, fileInput(inputId = "file", label = "import", accept = ".csv")),
column(width = 8, valueBoxOutput("stats"))
)
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$stats <- renderValueBox({
req(input$file)
data <- read.csv(input$file$datapath)
valueBox("scr1", sum(data[,2]), width = 12)
})
}
# Run the application
shinyApp(ui = ui, server = server)
The above code accepting csv file each time visiting the shinydashboard. Currently it showing the upload icon each time someone opens the URL/dashboard. I want the upload icon should shown till csv file not uploaded into shinyApp. Once uploaded, it should disappear and should display 'valueBox()' with values depend on the uploaded file.
Can someone help me how to write that control code?
Since your application is going to be used by multiple people who can access the URL, the simple way would be to create a global .rds file accessible by all the users whenever the .csv file is imported.
data <- read.csv(input$file$datapath)
# Create a folder named srcdata under www folder in your app directory
# Save the data object as a .rds file with system date appended to the file name
saveRDS(data,paste0("www/srcdata/data_",Sys.Date()))
However, we would need to create this .rds file only once per day. If a file already exists for the current date, we can
1. Skip this step and read the file directly
2. Hide the input field from the UI
So the code becomes
filePresent <- list.files("www/srcdata/", pattern = paste0("data_",Sys.Date()))
# if file is present, disable the input field and read from the saved .rds
# if file is not present, show the input field
if(length(filePresent)==1){
data <- readRDS(paste0("www/srcdata/data_",Sys.Date()))
filedata$notPresent <- FALSE
}else{
shinyjs::show("file")
}
Here, we are using shinyjs to show and hide the fields. So you would need to install that package (if not already) and call it in your code. Also, this code should run every time the app gets initialized so that the users either get presented with data (if there is a saved file) or sees a input field to import the file.
I have updated the code to implement this
library(shiny)
library(shinydashboard)
library(shinyjs)
# Define UI for application that draws a histogram
ui <- dashboardPage(
dashboardHeader(title = "Upload Stats"),
dashboardSidebar(),
dashboardBody(
useShinyjs(),
box(
title = "UPTIME:", width = 12,
div(column(width = 4, hidden(fileInput(inputId = "file", label = "import", accept = ".csv"))),
column(width = 8, valueBoxOutput("stats"))
)
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
filedata <- reactiveValues(notPresent = TRUE)
observeEvent(filedata$notPresent,{
if(filedata$notPresent){
filePresent <- list.files("www/srcdata/", pattern = paste0("data_",Sys.Date()))
if(length(filePresent)==1){
data <- readRDS(paste0("www/srcdata/data_",Sys.Date()))
filedata$notPresent <- FALSE
}else{
shinyjs::show("file")
}
}
})
output$stats <- renderValueBox({
req(input$file)
data <- read.csv(input$file$datapath)
saveRDS(data,paste0("www/srcdata/data_",Sys.Date()))
valueBox("scr1", sum(data[,2]), width = 12)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Hope this helps!
I'm trying to build an application that takes a csv file from the user, uploads it, then the user fill some text boxes that will fill specific columns in the data frame later on, clicks a button 'GO', some scripts run in the background and we have a data frame ready for download. The thing is the whole reactive architecture makes it difficult to set up a step by step algorithm. Could you help me with setting up the framework for doing that? Ideally it would look like follows
shinyUI(fluidPage(
titlePanel("Uploading Files"),
fileInput('file1', 'Choose file to upload',
accept = c('text/csv',
'text/comma-separated-values',
'text/tab-separated-values',
'text/plain','.csv','.tsv')),
dateInput('date',"Select when the file was uploaded",
value = NULL,
format = 'yyyy-mm-dd'),
textInput('text1','Type what will be in column 6'),
textInput('text2','Type what will be in column 7'),
actionButton('go','go'),
tableOutput('readytable')
And now having that front i would like to: 1. Load the dataframe from csv of the user 2. Wait for the user to fill other input boxes 3. After clicking 'go' run bunch of functions on the data frame with the inputs that the user have inserted as for example df$column6 <- input$text1 and after that i'm left with a data frame that is ready to be written as a csv file once again. Thanks in advance for any links/suggestions
You can use reactive variables to control reactivity on shiny. Here is an example for your problem. Please note that the download button doesn't works on the RStudio viewer, so launch the app in a browser if you want to use the download button.
library(shiny)
runApp(list(
ui = shinyUI(pageWithSidebar(
headerPanel('Uploading Files'),
sidebarPanel(
fileInput('file1', 'Choose file to upload',
accept = c('text/csv',
'text/comma-separated-values',
'text/tab-separated-values',
'text/plain','.csv','.tsv')),
uiOutput('buttonsUI'), br(),
uiOutput('downloadUI')
),
mainPanel(
tableOutput('readytable')
)
)),
server = shinyServer(function(input, output) {
# variables to control the sequence of processes
controlVar <- reactiveValues(fileReady = FALSE, tableReady = FALSE)
# to keep the data upload
dat <- NULL
# handle the file reading
observeEvent(input$file1, {
controlVar$fileReady <- FALSE
if (is.null(input$file1))
return()
inFile <- input$file1
dat <<- read.csv(inFile$datapath)
if(!is.data.frame(dat))
return()
controlVar$fileReady <- TRUE
})
# show buttons only when file is uploaded
output$buttonsUI <- renderUI({
if (controlVar$fileReady)
div(
dateInput('date','Select when the file was uploaded',
value = NULL,
format = 'yyyy-mm-dd'),
textInput('text1','Type what will be in column 6'),
textInput('text2','Type what will be in column 7'),
actionButton('go','go')
)
})
# show a download button only if data is ready
output$downloadUI <- renderUI({
if (controlVar$tableReady)
downloadButton('downloadData', 'Download')
})
# add columns to dat and run some script on it
observeEvent(input$go, {
controlVar$tableReady <- FALSE
if (!is.null(input$text1))
dat$column6 <<- input$text1
if (!is.null(input$text2))
dat$column7 <<- input$text2
# simulate running a cool script on dat
Sys.sleep(2)
controlVar$tableReady <- TRUE
})
# render table after uploading file or running the script
output$readytable <- renderTable({
input$go
if (controlVar$fileReady || controlVar$tableReady)
dat
})
# handle the download button
output$downloadData <- downloadHandler(
filename = function() { 'newData.csv' },
content = function(file) {
write.csv(dat, file)
}
)
})
))