How can I Save a project from Rshiny application? - r

I am very new to R shiny codes. I want to make an application which would allow users to save the selections and the project which could be availed for later usage. For example lets say I have uploaded a file and selected an input in ui. The users should be able to save the work somewhere so that they can open the project again tomorrow and continue working. this application would be desktop based in local machines not on server. I tried bookmark option wherein everything works fine, but the project as a whole cannot be saved in desktop app.
Is there a way in Rshiny where users can save the selections as a project in their directory and later on avail the project to continue working?
Any help would be much appreciated.
How do I save the below app as a project and then allow users to access .rds file in the environment?
library(shiny)
ui <- function(request){
fluidPage(
titlePanel("Put title of the application"),
sidebarLayout(
sidebarPanel(
radioButtons("sep", "File Separator: ",
choices = c(Comma = ",", Semicolon = ";", Tab = "\t"),selected = ","),
fileInput("file", "Select a file: ", multiple = FALSE,
accept = c("text/csv","text/comma-separated-values,text/plain",".csv")),
uiOutput("mytype")
,bookmarkButton()
),
mainPanel(
textOutput("mytext"),
textOutput("myrows")
)
)
)
}
server <- function(input, output, session) {
input_file <- reactive({
req(input$file)
read.csv(input$file$datapath,
header = TRUE,
sep = input$sep)
})
output$mytype <- renderUI({
selectInput("var1", "Select a type of drink: ", choices = levels(input_file()$Type))
})
onBookmark(function(state) {
state$values$var1 <- input$var1
})
onRestored(function(state){
updateSelectInput(session,"var1",selected=state$values$var1)
})
output$mytext <- renderText({paste("You have selected a Type of", tolower(input$var1))})
input_rows <- reactive({
data <- subset(input_file(), Type %in% input$var1)
nrow(data)
})
output$myrows <- renderText({paste("The selected type has", input_rows(), "rows")})
}
shinyApp(ui, server, enableBookmarking = "server")

Related

Shiny app file upload is substantially slower on different machines

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)

Weird problem with `renderDataTable` and `renderUI` with different orders

I'm working on a shiny app and trying to use renderDataTable and renderUI on the same page. The following codes work fine. But when I switch the order of 2. render select input and 3. render data table, it seems input$selected_variable cannot reflect what is selected on the shiny app. Neither the print(input$selected_variable) can print the selected value in the terminal, nor the textOutput can show the selected value on the app interface. Does anyone know why this may happen? Another follow-up question is that if I remove filter = 'top' in the renderDataTable, this issue won't occur either no matter which order is applied. Does this problem has anything to do with the filter = 'top'? (This filter = 'top' option in dataTable seemed also cause a few other weird behaviors when I tried out some other shiny app designs.)
if (interactive()) {
library(shiny)
library(DT)
shinyApp(
### ui
ui = fluidPage(
fileInput('input_data_file',
label = "Load input data file(s)",
multiple = TRUE,
buttonLabel = "Browse or Drop...",
placeholder = "(multiple) csv file(s)"),
dataTableOutput('input_table'),
uiOutput('params'),
verbatimTextOutput("text", placeholder = T),
plotlyOutput('plot')
),
### server
server = function(input, output) {
### values placeholder
values <- reactiveValues()
values$data <- NULL
### 1. upload data file
observeEvent(input$input_data_file, {
req(input$input_data_file)
file <- input$input_data_file
ext <- tools::file_ext(file$datapath)
req(file)
validate(need(ext == "csv", "Please upload a csv file"))
values$data <- read.csv(file$datapath, stringsAsFactors = FALSE)
})
### 2. render select input
output$params <- renderUI({
fluidRow(column(6, selectInput("selected_variable", "Variable:",
choices = setdiff(names(values$data), 'CustomerID')
)))
})
### 3. render data table
output$input_table <- DT::renderDataTable(
values$data,
filter = 'top', # removing this line can also solve the issue
options = list(scrollX=TRUE, scrollCollapse=TRUE, stateSave = TRUE, search = list(regex = TRUE)),
server = FALSE)
### 4. render text output
observe({
#req(input$selected_variable)
print(input$selected_variable)
output$text <-renderText({input$selected_variable})
})
}
)
}

Unable to get data downloaded from Shiny app hosted on shinyapps.io

I have built a Shiny app that allows users to upload a .txt file, filter for key terms and then download the returned dataset. When hosting locally it works. However, when I deployed it to shinyapps.io the download function no longer works. Everything else (e.g the data upload + wrangling step) do work. Nothing comes up as an error in the code log. The file it downloads is called 'downloadData.html' and simply says 'Please wait. Loading'. When I run and download locally it returns a .txt file (which is strange as the function is write.csv). My code is
library(tidyverse)
library(shiny)
library(rsconnect)
ui <- fluidPage(
titlePanel("Download data"),
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose .txt file",
multiple = F,
accept = c(".txt")),
textInput('energy_co', 'Name of energy company'),
textInput('asset', 'name of Asset Manager'),
downloadButton("downloadData", "Download")
),
mainPanel(
tableOutput("table")
)
)
)
options(shiny.maxRequestSize=30*1024^2)
server <- function(input, output, session) {
company_data <- reactive({
req(input$file1,input$asset,input$energy_co)
data <- read_lines(input$file1$datapath)
text_df <- as_data_frame(data)
company_data <- text_df %>%
filter(str_detect(value, input$asset)) %>%
filter(str_detect(value, input$energy_co)) %>%
distinct(.)
company_data
})
output$table <- renderTable({
company_data()
})
output$downloadData <- downloadHandler(
filename = function() {
paste(company_data(), ".csv", sep = "")
},
content = function(file) {
shiny::withProgress(
message = paste0("Downloading", company_data(), " Data"),
value = 0,
{
shiny::incProgress(1/10)
Sys.sleep(1)
shiny::incProgress(5/10)
write.csv(company_data(), file, row.names = FALSE)
}
)
}
)
}
shinyApp(ui, server)
Does anyone have any idea how to get this to work? The code is similar (and works locally) to other related questions on SO, but unable to work out what goes wrong when hosting remotely. Nothing comes up on the app's logs.

Run R script after input in Shiny

Good morning everyone,
I have a Shiny application that collects 5 inputs from the users and stores them into variables.
Then, I would be able to use another R script that would run based on the information provided by the user.
Here is a sample of my Shiny App :
jscode <- "shinyjs.closeWindow = function() { window.close(); }"
#Define UI for application
ui <- pageWithSidebar(
#App title
headerPanel("Filters applied for Powerpoints"),
#Panel to display the filters
sidebarPanel(
#Select dates
dateInput(inputId = "startDate", label = "Start date : ", value = "2018-12-01", format = "yyyy/mm/dd"),
dateInput(inputId = "endDate", label = "End date : ", value = "2018-12-31", format = "yyyy/mm/dd"),
#Select brand template
selectInput("Brand", label = "Select brand : ", choices = list("Carat" = "Carat", "Amplifi" = "Amplifi", "iProspect" = "iProspect", "Isobar" = "Isobar")),
#Select medium type
selectInput("Medium", label = "Select medium type : ", choices = list("Social Post" = "Social Post", "Display" = "Display", "Programmatic" = "Programmatic", "SEA" = "SEA")),
#Enter the plan ID of your campaign
textInput("Camp", label = "Enter the plan ID of your campaign : ", value = ""),
#Button to close the window, then run script
useShinyjs(),
extendShinyjs(text = jscode, functions = c("closeWindow")),
actionButton("close", "Close and run")
),
mainPanel()
)
#Define server logic
server <- function(input, output, session){
observe({
startDate <<- input$startDate
endDate <<- input$endDate
brand <<- input$Brand
medium <<- input$Medium
campaign <<- input$Camp
})
observeEvent(input$close, {
js$closeWindow()
stopApp()
})
source("C:/Users/RPeete01/Desktop/Automated powerpoints/Datorama R/Datorama reporting R/DatoramaSocial.R")
}
#Run the application
shinyApp(ui = ui, server = server)
I've used the source function but it doesn't work.
If someone has an idea, please let me know.
Thanks a lot,
RĂ©mi
You should take advantage of built in onStop functions in shiny to execute some functions before the stopApp() call
library(shiny)
if (interactive()) {
# Open this application in multiple browsers, then close the browsers.
shinyApp(
ui = basicPage("onStop demo",actionButton("close", "Close and run")),
server = function(input, output, session) {
onStop(function() cat("Session stopped\n"))
observeEvent(input$close, {
stopApp()
})
},
onStart = function() {
cat("Doing application setup\n")
onStop(function() {
cat("Doing application cleanup, your functions go here\n")
})
}
)
}
Instead of creating a function to replace your script, you can source your script by supplying an environment to the local option. This environment must contain the objects needed by your script. Something like that:
mylist <- reactiveVal() # we will store the inputs in a reactive list
observe({ # create the list
mylist(list(
startDate = input$startDate,
endDate = input$endDate,
brand = input$Brand,
medium = input$Medium,
campaign = input$Camp))
})
observeEvent(input$runScript, { # "runScript" is an action button
source("myscript.R", local = list2env(mylist()))
})
EDIT
Here is a full example.
library(shiny)
ui <- fluidPage(
textInput("text", "Enter text", value = "test"),
actionButton("runScript", "Run")
)
server <- function(input, output, session) {
mylist <- reactiveVal() # we will store the inputs in a reactive list
observe({ # create the list
mylist(list(
text = input$text))
})
observeEvent(input$runScript, { # "runScript" is an action button
source("myscript.R", local = list2env(mylist()))
})
}
shinyApp(ui, server)
File myscript.R:
writeLines(text, "output.txt")
When I run the app and click on the button, the file output.txt is correctly created (i.e. the script is correctly sourced).
Your script DatoramaSocial.R should be formulated as a function that takes your 5 input values as arguments. As to the return value, well you haven't told us what you want to do with it. By formulating it as a function I mean wrap everything in DatoramaSocial.R in a function (or several subfunctions). The code for that function can easily reside in the external script file or be pasted before the ui and server statements in your shiny app. If the former, simply include the definitions by calling source('DatoramaSocial.R') before your ui and server statements.
Now, in your server function, you can simply call it as a reaction to changes in the input:
observe({
DatoramaSocial(input$startDate, input$endDate, input$Brand, input$Medium, input$Camp)
})
Although in this case, I recommend inserting an actionbuttonInput and having the user click that when they have selected all their inputs. In which case, update to:
observeEvent(input$actionbutton, ignoreInit=TRUE, {
DatoramaSocial(input$startDate, input$endDate, input$Brand, input$Medium, input$Camp)
})
where actionbutton is the actionbutton's inputId.

Running scripts on uploaded csv file in shiny

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)
}
)
})
))

Resources