changing variables of a separate R script in a shiny app - r

I have a set of scripts which are run from below, with aspects of the final output influenced by lines 2-4
setwd()
inputyear = ""
inputmonth = ""
dataType = ""
source("1.R")
source("2.R")
source("3.R")
source("4.R")
source("5.R")
#input required file name
saveWorkbook(wb, "Workbook.xlsx", overwrite = TRUE)
I'd like to be able to change the input year, input month, dataType and the name of the workbook produced by the source() 1-5, from a shiny app, and then run the respective files and generate the excel file.
So far I have the following code, which does not produce any errors, but does not function as desired.
I have only included the 'server' section of the code to save space, and this is the part I need help with if possible;
ui<-shinyUI(fluidPage(theme = shinytheme("flatly"),
tags$head(
tags$style(HTML(
".shiny-output-error-validation {
color; green;
}
"))
),
basicPage(
headerPanel("Workbook"),
sidebarPanel(
selectInput("inputmonth","Select Publication Month",c("JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP","OCT","NOV","DEC")),
selectInput("inputyear","Select Year",c("2018/19","2019/20","2020/21")),
selectInput("dataType","Select Version",c("provisional","final"))),
textInput("WorkBookName","Enter File Name (include .xlsx)"),
actionButton("Generate", "Generate Workbook"))
))
server <- function(input, output, session){
observeEvent(input$Generate, {
validate(need(input$WorkBookName != "", "Please enter file name"))
req(input$inputmonth, input$inputyear, input$dataType, input$WorkBookName)
inputyear = input$inputmonth
inputmonth = input$inputyear
dataType = input$dataType
source("1.R",local = TRUE)
source("2.R", local = TRUE)
source("3.R", local = TRUE)
source("4.R", local = TRUE)
source("5.R", local = TRUE)
saveWorkbook(wb, paste0(input$WorkBookName, ".xlsx"), overwrite = TRUE)
})
}
shinyApp(ui, server)
How can I alter the server script to get the desired functionality?
edit: Full script added, sourced names removed

You'll somehow need to trigger the execution of your reactive code. Reactive code only is executed if it was invalidated. Please see this for further information.
In the following app the code will be executed once the Save Workbook button is clicked.
I don't know your UI and sourced R-scripts, so you might want to replace here accordingly:
library(shiny)
library(openxlsx)
library(shinythemes)
ui <- shinyUI(fluidPage(
theme = shinytheme("flatly"),
tags$head(tags$style(
HTML(".shiny-output-error-validation {
color; green;
}
")
)),
basicPage(
headerPanel("Workbook"),
sidebarPanel(
selectInput(
"inputmonth",
"Select Publication Month",
toupper(month.abb)
),
selectInput("inputyear", "Select Year", c("2018/19", "2019/20", "2020/21")),
selectInput("dataType", "Select Version", c("provisional", "final"))
),
textInput("WorkBookName", "Enter File Name (include .xlsx)"),
actionButton("Generate", "Generate Workbook"),
uiOutput("test")
)
))
server <- function(input, output, session) {
observeEvent(input$Generate, {
req(input$inputmonth,
input$inputyear,
input$dataType,
input$WorkBookName)
inputyear = input$inputmonth
inputmonth = input$inputyear
dataType = input$dataType
# source("1.R", local = TRUE)
# source("2.R", local = TRUE)
# source("3.R", local = TRUE)
# source("4.R", local = TRUE)
# source("5.R", local = TRUE)
#
# saveWorkbook(wb, paste0(input$WorkBookName, ".xlsx"), overwrite = TRUE)
output$test <- renderUI("Everything fine...")
})
}
shinyApp(ui, server)

Related

Specify destination folder for download from an R Shiny app

I'm working on a Shiny app, in which the user uploads a file, which is then processed to generate a report, which the user can download as an editable Word .doc.
It works as intended, other than that although a "Save As" dialogue window appears which seems to allow you to choose the destination directory, the resulting .doc file ends up being saved to a temporary directory with a randomly-generated name (this is under Windows).
I suspect this is due to the use of the tempdir command, which is part of using rmarkdown to generate the downloaded file.
How should the below code be amended to allow the destination folder to be chosen?
#
# 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)
library(knitr)
# Define UI for application that draws a histogram
ui <- fluidPage(
uiOutput('markdown'),
# Application title
titlePanel("Apptitle"),
# 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")
),
)
)
server <- function(input, output) {
output$report <- downloadHandler(
reactive(file <- input$file1),
filename = "wordreport.doc",
content = function(file) {
tempReport <- file.path(tempdir(), "wordreport.Rmd")
file.copy("wordreport.Rmd", tempReport, overwrite = TRUE)
params <- list(report.data = input$file1)
rmarkdown::render(tempReport, output_file = "wordreport.doc",
params = params,
envir = new.env(parent = globalenv()))
})
}
shinyApp(ui = ui, server = server)
Thank you for your help!
EDIT: Fixed, using the solution below, and the code edits suggested here: Passing a dataframe as a parameter from Shiny app to RMarkdown
You're passing reactive(file <- input$file1) as the contentType argument to downloadHandler(), which can't be good. Also, you're not writing anything to the file given as an argument to the content function.
Remove the reactive(file <- input$file1) line, and specify output_file = file in rmarkdown::render(), and your download should work.
As discussed in the comments, you won't be able to have control over the download path though -- that's something the user's web browser and their settings there will decide.
Here's a somewhat more minimal app with a functioning file download, for reference:
library(shiny)
ui <- fluidPage(
sliderInput("value", "Some value", 1, 5, 2),
downloadButton("report", "Generate report")
)
server <- function(input, output) {
output$report <- downloadHandler(
filename = "wordreport.doc",
content = function(file) {
params <- list(value = input$value)
rmarkdown::render(
system.file("examples/knitr-minimal.Rmd", package = "knitr"),
output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
}
)
}
shinyApp(ui, server)

dataTableProxy to data.frame error in R Shiny

I have created a demo app that allows the user to edit an existing df and then download the updated table as a .csv. The app runs almost fine, as when I click the download button, I get the following error:
Warning: Error in as.data.frame.default: cannot coerce class ‘"dataTableProxy"’ to a data.frame
[No stack trace available]
How can this be fixed?
Code
# Double click in a table cell to edit its value and then download the updated table
library(shiny)
library(DT)
library(tidyverse)
# Define UI for application that edits the table
ui = fluidPage(
DTOutput('x1'),
# App title
titlePanel("Downloading Data"),
# Sidebar layout with input and output definitions
sidebarLayout(
# Sidebar panel for inputs
sidebarPanel(
# Input: Choose dataset
selectInput("dataset", "Choose a dataset:",
choices = c("Demo Table")),
# Button
downloadButton("downloadData", "Download")
),
# Main panel for displaying outputs
mainPanel(
tableOutput("table")
)
))
# Define server logic required
server = function(input, output) {
x = iris
x$Date = Sys.time() + seq_len(nrow(x))
output$x1 = renderDT(x, selection = 'none', editable = TRUE)
proxy = dataTableProxy('x1')
observeEvent(input$x1_cell_edit, {
info = input$x1_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
x[i, j] <<- DT::coerceValue(v, x[i, j])
replaceData(proxy, x, resetPaging = FALSE) # important
})
# Downloadable table (df) as csv
output$downloadData = downloadHandler(
filename = function() {
paste(input$dataset, ".csv", sep = "")
},
content = function(file) {
write.csv(proxy, file, row.names = FALSE)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
Replace
write.csv(proxy, file, row.names = FALSE)
with
write.csv(x, file, row.names = FALSE)
This is not a full answer!
I know where the error occurs and I can fix it. But I can not make the downloadhandler to download the datatable (instead an empty csv file is occuring).
This might be due to:
input$dataset is not defined in your code. Here is a similar post handling this issue:
Shiny App Upload and Download Data Dynamically Not Working
And I think more important as stated by Stephane Laurent in his answer:
Replace data in R formattable datatable using replaceData function
replaceData requires a dataframe in the second argument, not a datatable.
This is the reason you get the error.
When you have a datatable proxy, the dataframe is in proxy$x$data.
Using this code removes the error, but a blank .csv file is downloaded
# Downloadable table (df) as csv
output$downloadData = downloadHandler(
filename = function() {
paste(input$dataset, ".csv", sep = "")
},
content = function(file) {
write.csv(proxy$proxy, file, row.names = FALSE)
}
)
}

File path from user input as get_fields file input in Shiny App

I'm building a little applet that will run locally, where people can upload a csv and a fillable pdf and the tool will execute a loop that will fill out the pdfs with names from the csv and save them as png files in an /output directory.
I am having trouble with the pdf portion. Using shinyFiles they navigate to the pdf and get its path, but am getting an invalid path error trying to get the pdf fields (staplr). I think it is happening with get_fields but I can't think of another way to get the pdf location.
Warning: Error in path.expand: invalid 'path' argument
[No stack trace available]
Code snip below. Any ideas welcome!
library(tidyverse)
library(staplr)
library(DT)
library(shinyFiles)
library(pdftools)
ui <- fluidPage(
titlePanel(p("Award PDF Creation App", style = "color:#3474A7")),
sidebarLayout(
sidebarPanel(
p("Award Creation Tool"),
# Horizontal line ----
tags$hr(),
fileInput(inputId = "filedata",
label = "Choose your CSV file",
accept = c(".csv")),
shinyFilesButton("pdf", "PDF select", "Please select a PDF", multiple = TRUE, viewtype = "detail"),
tags$p(),
tags$p('Please choose the fillable PDF for award creation.'),
tags$hr()
),
mainPanel(h3("Review your CSV format before you Create PDFs"),
DTOutput(outputId = "table"),
tableOutput("contents"),
actionButton("go", "Create PDFs")
)
)
)
server <- shinyServer(function(input, output, session){
volumes <- c(Home = fs::path_home(), "R Installation" = R.home(), getVolumes()())
shinyFileChoose(input, "pdf", roots = volumes, session = session,
filetypes = c('', 'pdf'))
# by setting `allowDirCreate = FALSE` a user will not be able to create a new directory
pdf <- reactive(input$pdf)
data <- reactive({
req(input$filedata)
read.csv(input$filedata$datapath)
})
pdfpath <- reactive({
req(input$pdf)
as.character(parseFilePaths(volumes,pdf())$datapath)
})
output$table <- renderDT(
data()
)
observeEvent(input$go,{
req(input$filedata)
req(input$pdf)
data <- data()
pdffields <-get_fields(input_filepath = pdfpath, convert_field_names = F)
withProgress(message = 'Making PDFs', value = 0, {
for(i in 1:nrow(data)){
pdffields$`Date`$value <- paste(format(data$AWARD_DATE[i], "%B %d, %Y"))
pdffields$`First Name Last Name`$value <- paste0(data$FIRST_NAME[i], " ", data$LAST_NAME[i])
filename <- paste0('./output/', Sys.Date(),
'_', data$LAST_NAME[i],
'_', data$AWARD[i], '.png')
set_fields(pdf, filename, pdffields)
bitmap <- pdf_render_page(filename, page = 1, dpi = 300)
png::writePNG(bitmap, filename)
# Increment the progress bar, and update the detail text.
incProgress(1/nrow(data), detail = paste("Processing"))
# Pause
Sys.sleep(0.1)
}
})
})
})
shinyApp(ui = ui, server = server)

downloadHandler in shiny in a loop

I am trying to build a shiny app to retrieve data from an Oracle table based on user specified ID. I want to create one file with data for each ID and download it to the default downloads folder. I would also like to zip the files and provide the user with that one file. Also, the app is just to download the data and I really don't want a main Panel hence the width of the mainPanel is zero. If that's not the way to do it, please let me know.The app is going to reside on a server and hence the need for a download Handler. Below is my code. Any help is greatly appreciated.
library(shiny)
library(ROracle)
library(shinyjs)
library(shinyalert)
library(shinyWidgets)
ui <- fluidPage(
useShinyjs(),
useShinyalert(),
# Application title
titlePanel(fluidRow(
column(10, "RAINFALL AND ET DATA RETRIEVAL",align="center"),
column(2, offset = 0,img(height =90,width=250,src="logo.png",align="left"))
)),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(width = 12,
helpText("Please enter IDs separated by commas. You can enter up to 25 IDs."),
textInput("PixelID", "Pixel ID(s)", value = ""),
helpText("OR"),
fileInput('datafile','Choose csv file to upload Pixel IDs.The csv file should have Pixel IDs in the first column WITHOUT ANY HEADER.',accept = c('csv','comma-separated-values','.csv')),
helpText("Please select a parameter you would like to retrieve."),
radioButtons("ParameterType", "Parameters",
choices = c("Rainfall Estimates","Evapotranspiration Estimates"),
selected = "None"),
dateInput("startdate","Data From", format = "yyyy-mm-dd",max = Sys.Date()),
dateInput("enddate","Data To", format = "yyyy-mm-dd",max = Sys.Date()),
br(), br(),
actionBttn("goButton","Go!",color = "default",style = "fill",size = "lg"),
br(),br(),
uiOutput("download"),
mainPanel(width=0)
)
)
server <- function(input, output, session) {
data<-eventReactive(input$goButton,{
if(is.null(input$PixelID) || input$PixelID == ""){
req(input$datafile)
infile<-input$datafile
PixelList<-read.table(infile$datapath, header = FALSE, sep = ",", stringsAsFactors = FALSE)
colnames(PixelList)<-"PixelNum"
PixelList_comma<-paste(PixelList$PixelNum, collapse = ",")} else{
if(input$PixelID != ""){
PixelList<-data.frame(strsplit(input$PixelID,","))
colnames(PixelList)<-"PixelNum"
PixelList_comma<-input$PixelID
}}
drv <- dbDriver("Oracle")
connection <- dbConnect(drv, username = "xxxx", password = "xxxxx", dbname = "xxxx")
if(input$ParameterType=="Rainfall Estimates"){
for(i in 1:nrow(PixelList)){
raindata<-dbGetQuery(connection, paste("select PIXEL, TO_CHAR(tsdatetime_dt, 'MM/DD/YYYY HH24:MI') as DATE_TIME, tsvalue_ms as RAINFALL from xxxx
where feature_id =",PixelList[i,1]," order by tsdatetime_dt", sep=""))
}
dbDisconnect(conn = connection)
}
return(raindata)
})
output$download <- renderUI({
downloadButton("downloadData", "Download")
})
output$downloadData <- downloadHandler(
filename = function() {
paste("testnexrad",".zip",sep = "")
},
content = function(file) {
for(i in 1:nrow(PixelList)){
#No idea what to do here
}
}
)
}
# Run the application
shinyApp(ui = ui, server = server)

Turning Data Conflict Error (409) into a message that clients can understand

I'm relatively new to using R and shiny. Currently, I'm getting the Error: Conflict (HTTP 409) when trying to access an html file from dropbox and this is fine, I know the reason. What I do have a problem with is trying to find a way to change Error code message.
I've tried a couple forms of validation and try-catches.
library(shiny)
library(rdrop2)
library(httr)
ui <- # Define UI for dataset viewer application
shinyUI(pageWithSidebar(
headerPanel("Test DropBox html Docs to Shiny"),
sidebarPanel(
selectInput("Cat", "Choose a Category:",
choices = c("A", "B", "C")),
selectInput("Year", "Choose a Year:",
choices = c("2012", "2011")),
downloadButton("downFile", "Download File"),
width = 2),
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Html Pages", htmlOutput("viewReport"))),
width = 10)
)
)
#IMPORTANT: The two lines below needs to be run just one time unless the token is deleted
# Create Token
token <- drop_auth()
# Save token
saveRDS(token, "droptoken.rds")
token <- readRDS("droptoken.rds")
server <- shinyServer(function(input, output) {
# ---------------------------------------------------
filePutReport <- reactive(
paste(input$Cat, "_", input$Year, "_Doc.html", sep = "")
)
filePutReport2 <- reactive({
# Search if the file exists in DropBox
drop_download(path = paste("shiny_docs/shinydbtest/", filePutReport(), sep = ""),
overwrite = TRUE, local_path = "./www",
dtoken = token)
filePutReport()
})
# Show Html Pages
output$viewReport <- renderUI({
tags$iframe(seamless = "seamless", width = "1400", height = "1000",
src = filePutReport2()
)
})
###
output$downFile <- downloadHandler(
# generate bins based on input$bins from ui.R
filename = function() {
paste0(filePutReport() )
},
content = function(file){
file.copy(from = paste0("./www/", filePutReport2() ), to = file, overwrite = TRUE)
}
)
})
shinyApp(ui = ui, server = server)
Instead of simply "Error: Conflict (HTTP 409)", I would a message a client might be able to understand. Any and all suggestions are welcome. Thank you in advance for your help.
In my current environment I cannot establish a connection to dropbox, but please try the approach below. I first deleted the last line refering to filePutReport() in your filePutReport2() reactive, since they are the same and you want your call to drop_download to produce either a value (TRUE) or an invisible object of class "try-error". Therefore, you need to further wrap your call to drop_download in a try statement. This way filePutReport2() either contains the value TRUE or an invisible object of class "try-error". Then you should be able to use a need/validate function in your renderUI statement including a custom error message. I hope it's working, since I can't test it.
library(shiny)
library(rdrop2)
library(httr)
ui <- # Define UI for dataset viewer application
shinyUI(pageWithSidebar(
headerPanel("Test DropBox html Docs to Shiny"),
sidebarPanel(
selectInput("Cat", "Choose a Category:",
choices = c("A", "B", "C")),
selectInput("Year", "Choose a Year:",
choices = c("2012", "2011")),
downloadButton("downFile", "Download File"),
width = 2),
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Html Pages", htmlOutput("viewReport"))),
width = 10)
)
)
#IMPORTANT: The two lines below needs to be run just one time unless the token is deleted
# Create Token
token <- drop_auth()
# Save token
saveRDS(token, "droptoken.rds")
token <- readRDS("droptoken.rds")
server <- shinyServer(function(input, output) {
# ---------------------------------------------------
filePutReport <- reactive(
paste(input$Cat, "_", input$Year, "_Doc.html", sep = "")
)
filePutReport2 <- reactive({
# Search if the file exists in DropBox
try({
drop_download(path = paste("shiny_docs/shinydbtest/", filePutReport(), sep = ""),
overwrite = TRUE, local_path = "./www",
dtoken = token)
}, silent = TRUE)
})
# Show Html Pages
output$viewReport <- renderUI({
validate(
need(filePutReport2(), 'Custom error message!'))
tags$iframe(seamless = "seamless", width = "1400", height = "1000",
src = filePutReport()
)
})
###
output$downFile <- downloadHandler(
# generate bins based on input$bins from ui.R
filename = function() {
paste0(filePutReport() )
},
content = function(file){
file.copy(from = paste0("./www/", filePutReport2() ), to = file, overwrite = TRUE)
}
)
})
shinyApp(ui = ui, server = server)

Resources