In my Shiny app, users can upload a file which is stored as a reactive dataframe. Inside the reactive expression that is shown below, I call an external time-consuming function (called performDigestion) which requires several seconds to complete.
fastafile_data <- reactive(){
inFile_fastafile <- input$fastaFile
req(inFile_fastafile)
ext <- tools::file_ext(inFile_fastafile$datapath)
validate(need(ext == "fasta", "Please upload a fasta file"))
dt.seq <- readAAStringSet(inFile_fastafile$datapath)
tbl <- performDigestion(dt.seq) ##the time-consuming step
return(tbl)
}
Next, I render a Datatable to present the results of the fastafile_data in the UI:
output$dt_fastafile <- DT::renderDataTable({
withProgress(message = 'Computation in progress, this step might take a while. Please wait...', {
incProgress(1/1)
fastafile_data()
})
}, options = list(scrollX = TRUE, dom = 'lfrtip', pageLength = 10, lengthMenu = c(10, 25, 50, 100)), rownames = FALSE)
In the UI, I also have two additional components (a sliderInput and a numericInput) and in the server-side I handle their values through two observeEvents .
What I would like to achieve is to update the fastafile_data dataframe every time any of these two additional components is triggered without reading the input$fastaFile again and re-running the time consuming performDigestion() function. I would ideally like to trigger the above reactive process again only when a new file is uploaded by the user.
I think the problem here is in my logic and/or there exists a smarter way to do it in ShinyR that I'm currently missing? Can you please point me to the right direction?
EDIT:
When I try to handle the reactive fastafile_data through a second reactive fastafile_data_new the first fastafile_data is re-executed.
fastafile_data_new <- reactive({
dt <- fastafile_data()
##### the condition I'd like to apply
dt$identifiable <- ifelse(dt$length >= min_peptide_length$choice & dt$length <= max_peptide_length$choice & dt$`mass [Da]` < max_peptide_mass$choice, 1, 0)
return(dt)
})
Related
I am trying to write a shiny app to accommodate a specific function which estimates numbers of fish from sampled data. The function creates an amalgamated variable that is nonsense to the user. The code does run, but I am trying to modify this table after the fact to create variables that will make sense to the user. In order to do this, I need to split the nonsense variable into parts, rename those parts, and specify which ones to print. I can do this in the tidyverse using mutate, but haven't figured out how or where to incorporate these changes so that it doesn't kill the app.
I have tried a reactive within server. I have tried to perform these changes within renderTable.
In the code below, estimate is the output of the custom function MRIP.catch and the output needs to be modified. There is an output column called "domain" that conglomerates all of the inputs. I need to split these back apart so that the user knows what they are looking at in the table output.
I know this code isn't run-able on it's own. I was just hoping that it was a simple syntax question that someone could help me to untangle. I haven't been able to find examples of tables that need to be changed after being calculated but before being displayed.
server <- function(input, output, session) {
sp<-eventReactive(input$go,{input$species})
yr1<-eventReactive(input$go, {input$start_yr})
yr2<-eventReactive(input$go, {input$end_yr})
freq2<-eventReactive(input$go,{
case_when(input$freq =='annual'~annual,
input$freq =='wave'~wave)
})
sub<-eventReactive(input$go, {
case_when(input$reg =='by state'~state,
input$reg =='by coast'~coast)
})
mode<-eventReactive(input$go, {
case_when(input$modes=='all modes combined'~all_mode,
input$modes=='all modes by mode'~each_mode)
})
area<-eventReactive(input$go, {
case_when(input$areas == 'all areas combined'~all_area,
input$areas=='all areas by area'~each_area)
})
dom1<- eventReactive(input$go, {list(wave=freq2()#Use for annual estimate. Comment out for wave
,sub_reg=sub() #Use for custom geo regions
,mode_fx=mode() #use to combine modes.
,area_x=area() #Use to combine fishing areas.
)})
estimate<-eventReactive(input$go,{
MRIP.catch(intdir='C:\\Users\\',
st = 12, styr = yr1(), endyr= yr2(), common = sp()
, dom = dom1()
)})
output$species <- renderText({paste( 'you have seletected',sp()) })
output$range<-renderText({paste ('from',yr1(), 'to', yr2())})
output$table<-renderTable({estimate()})
}
The following is the code I used in dplyr to create the independent sections of the variable and rename them. I'm sure it isn't the most elegant way to make this go, but it does work.
##Separates out each piece of domain to name
estimate<-
estimate%>%
mutate (yr = substr(Domain, 5,8),
wave1=substr(Domain,13,13),
basin1=substr(Domain,25,25),
mode1=substr(Domain, 33,33),
area1=substr(Domain, 40,40),
cntys1=substr(Domain, 45,45),
yr_wave=paste(yr,wave1, sep='-'))
estimate<-
estimate%>%
mutate (basin = case_when (basin1 == '6' ~'SA',
basin1=='7'~'Gulf',
basin1=='1'~'statewide'
),
mode = case_when(mode1=='1'~'combined',
mode1 =='3'~'Shore',
mode1=='5'~'Charter',
mode1=='7'~'Private'),
area = case_when(area1 =='1'~'EC state',
area1=='2'~'EC fed',
area1=='3'~'Gulf state',
area1=='4'~'Gulf fed',
area1=='5'~'Inland'))
I will try to focus on this part: "find examples of tables that need to be changed after being calculated but before being displayed".
Take a look at the example below and check if this is something which can help you.
library(shiny)
ui <- fluidPage(
actionButton("go", "Go"),
tableOutput("table")
)
server <- function(input, output, session) {
df <- reactiveVal(data.frame(a = c(1, 2))) # but reactiveVal() can be left empty as well, then it starts with NULL value
initial_data <- reactive({
first_computation <- df() %>%
mutate(b = c(3, 4))
df(first_computation )
})
observeEvent(input$go, {
second_computation <- initial_data() %>%
mutate(c = c(5, 6))
df(second_computation)
})
output$table <- renderTable({
req(input$go) # not sure if this will be enough for your needs!
df()
})
}
shinyApp(ui, server)
I created reactiveVal object and this is most important part - this object can be use in different places (active-reactive context) and can be modify. At first is data.frame with one variable, then I made some computation, but do not display anything. Then I have made some new additional computation when user clicks "go" and after that the new table is displayed.
I am currently working on a shiny app that runs a series of calculations on a dataset on the fly when someone presses "Calculate". The dataset is very large and a lot of calculations are made via a lapply, which allows the user to track the progress with a progress bar.
This means the generation of the output data frame can be quite slow even when there are potentially results already sitting there just waiting to be displayed. The problem I'm having is that the data is potentially quite time sensitive when something is found and therefore if the calculations take, say, 15 minutes to run, there may have been something to display on the first calculation that is 15 minutes out of date.
Is there a way that after each iteration of the lapply (or feel free to suggest another method) the app can look to see whether there is data there and immediately show it, essentially refreshing the output table after each iteration? Essentially updating the reactive value during the observe rather than after.
I've put below a short example app that may help visualise the problem I'm having:
library(shiny)
testDF <- data.frame(number = c(1:10),
letter = letters[1:10])
ui <- fluidPage(
# UI Input
numericInput(inputId = "attemptDivide", label = "Number to divide by",
value = 1, min = 1, max = 10),
actionButton(inputId = "calculate", label = "Calculate"),
# UI Output
dataTableOutput("dividedTable")
)
# Define server logic
server <- function(input, output) {
# Create a bucket for results
results <- reactiveVal()
# Observe when "Calculate" is pushed and we should work out whether the
# number is perfectly divisible by the input given
observeEvent(input$calculate, {
divisibleDF <- lapply(testDF$number, function(x) {
# Set to sleep for 1 second to simulate for the the lapply being
# bigger and taking more time than this example
Sys.sleep(1)
# Find the row we're interested in
interest <- subset(testDF, number == x)
# Find whether the number is perfectly divisible by the one given
divisible <- (x / input$attemptDivide) %% 1 == 0
# If divisible is TRUE we keep, else we return an empty data frame
if (divisible) {
return(interest)
} else {
return(data.frame(number = integer(), letter = character()))
}
}) %>%
do.call(rbind, .)
# Save the results to bucket
results(divisibleDF)
})
# Create the table
output$dividedTable <- renderDataTable({
results()
})
}
# Run the app
shinyApp(ui = ui, server = server)
Thanks in advance for any help.
I have a shiny app which has many text inputs. I could not get the save data part right, for example, to save to a local drive. Any suggestions?
server = function(input, output) {
values <- reactiveValues()
#Initial Dataframe
values$df <- data.frame(matrix(ncol=4,nrow=0, dimnames=list(NULL, c("Name", "date","Traning", "certificate"))))
FinalData =observe({
if(input$submit >0) {
isolate(values$df <- rbind(values$df,data.frame("name" = input$name,"date" = input$date,
"training" = input$training, "certificate" = input$certificate)))
# saveRDS(values$df)
# saveRDS(FinalData)
}})
#display the inputs
output$Combined_table = renderDataTable({values$df})
}
)
Try this demonstration:
library(shiny)
.log <- function(...) message(format(Sys.time(), format = "[ %H:%M:%S ]"), " ", ...)
.read <- function(path) if (file.exists(path)) return(readRDS(path))
shinyApp(
ui = fluidPage(
textInput("txt", "Text: "),
actionButton("btn", "Submit"),
tableOutput("tbl")
),
server = function(input, output, session) {
.log("hello world")
rv <- reactiveValues()
rv$df <- data.frame(row = 0L, word = "a", stringsAsFactors = FALSE)[0,]
observeEvent(req(input$btn), {
.log("submit!")
rv$df <- rbind(rv$df,
data.frame(row = input$btn, word = input$txt,
stringsAsFactors = FALSE))
.log("saveRDS: ", nrow(rv$df))
saveRDS(rv$df, "local.rds")
})
filedata <- reactiveFileReader(1000, session, "local.rds", .read)
output$tbl <- renderTable(filedata())
}
)
The engineering of this app:
I use a reactiveValues like you did, in order to keep the in-memory data. (Note: iteratively adding rows to a frame is bad in the long-run. If this is low-volume adding, then you're probably fine, but it scales badly. Each time a row is added, it copies the entire frame, doubling memory consumption.)
I pre-fill the $df with a zero-row frame, just for formatting. Nothing fancy here.
observe and observeEvent do not return something you are interested in, it should be operating completely by side-effect. It does return something, but it is really only meaningful to shiny internals.
saveRDS as you do, nothing fancy, but it works.
I added a shiny::reactiveFileReader in order to demonstrate that the file was being saved. When the shiny table shows an update, it's because (1) the data was added to the underlying frame; (2) the frame was saved to the "local.rds" file; then (3) reactiveFileReader noticed that the underlying file exists and has changed, causing (4) it to call my .read function to read the contents and return it as reactive data into filedata. This block is completely unnecessary in general, just for demonstration here.
I create a function .read for this reactiveFileReader that is resilient to the file not existing first. If the file does not exist, it invisibly returns NULL. There may be better ways to do this.
I created a dashboard with 15 data tables in Shiny. Each table draws data from an API and this process takes some time. So I want to output each table to ui at a time such that users can read the first table while the other ones load. But it seems Shiny always holds all output until server function finishes execution. Is there a way to change this?
I had a similar problem with an app once. What I did was to do the calculations that take much time in another R session. Maybe now there are packages that make it easier, but here is how I solved it:
You can make an observeEvent which is triggered by an actionButton. In this observer you start another R session (with a system call to Rscript for example).
Then the app is still responsive while an R session in the background is doing all the calculations.
To retrieve information from the background process you can use shiny's reactivePoll function.
In your case the background R session would do the process each table and write the result into a file once it is done with a table. The reactivePoll would watch out for these files. Once such a file appear the reactivePoll function can read it and present it as a reactive. The value of this reactive can then be rendered somehow for the user to see.
This way each table is processed 1 by 1, while the app is still responsive and able to show results while the background process is still running.
Here is a app that shows the principle.
server
library(shiny)
# batch process communicates via file
write("", "tmp.info")
# cheap function to check for results
cheap <- function() scan("tmp.info", what = "")
shinyServer(function(input, output, session) {
# start process
observeEvent(input$go, {
system2("Rscript", args = c("batch.r", input$num1, input$num2),
stdout = "", stderr = "", wait = FALSE)
})
# watch file
watch <- reactivePoll(500, NULL, cheap, cheap)
# retrieve result from batch process
result1 <- reactive(if(length(watch()) > 0) watch()[1] else NULL)
result2 <- reactive(if(length(watch()) > 1) watch()[2] else NULL)
# show results
output$add <- renderPrint(result1())
output$multiply <- renderPrint(result2())
})
ui
library(shiny)
shinyUI(fluidPage(sidebarLayout(
sidebarPanel(
h2("Add and multiply"),
numericInput("num1", "Number 1", value = 1),
numericInput("num2", "Number 2", value = 1),
helpText("Both numbers are added, and multiplied. Each calculation takes 4 sec."),
br(),
actionButton('go', 'Start')
),
mainPanel(
h4("Result of Addition"),
verbatimTextOutput("add"),
h4("Result of Multiplication"),
verbatimTextOutput("multiply")
)
)))
batch.r
# read info
args <- commandArgs(TRUE)
args <- as.numeric(args)
# add
res <- args[1] + args[2]
Sys.sleep(4)
write(res, "tmp.info")
# mult
res <- args[1] * args[2]
Sys.sleep(4)
write(res, "tmp.info", append = TRUE)
quit(save = "no")
server.r ui.r and batch.r must be in the same directory. A file "tmp.info" is created which is used for communication. The results are directly read from this file and batch.r is started with the input as parameters. You can also use files for all that.
I'm populating a selectInput with updateSelectInput using the file names from a directory. The user selects which directory to populate from using a radioButtons input. Everything works, but when the app is first loaded or the directory is changed, the selectInput reactive passes either the default value or the last selected file from the old directory (for startup and directory change, respectively). This results in a failed load of the data file until the selectInput updates.
How can I get my file loading reactive to wait until the selectInput has been updated?
Here's the relevant code...
ui.R:
radioButtons("system", label = h3("System"),
choices = list("USAMS" = usamspath, "CFAMS" = cfamspath),
selected = usamspath),
selectInput("wheelSelect",
label = h3("Wheel"),
c("label 1" = "option1")),
server.R:
observe({
#Get and order wheelnames
details <- file.info(list.files(path = input$system,
pattern = "*AMS*.*", full.names=TRUE))
details <- details[with(details, order(as.POSIXct(mtime))), ]
wheels <- basename(rownames(details))
# Change values for input$wheelSelect
updateSelectInput(session, "wheelSelect",
choices = wheels,
selected = tail(wheels, n = 1))
})
wheelData <- reactive({
#Code to reload wheel when file changes
wheelFile <- reactiveFileReader(1000, session,
paste(input$system, input$wheelSelect, sep = "/"),
read.delim, skip = 4, comment.char = "=")
z <- wheelFile()
mungeCFWheel(z)
})
The problem is that input$wheelSelect gets read by the wheelData reactive before it gets updated by updateSelectInput in the preceeding observe().
Finally figured this out. I don't know if it's the correct fix or a hack, but using the shiny function validate() to check whether the filename generated by the selectInput is valid seems to work.
Adding this to the wheelData reactive function does the trick:
validate(
need(file.exists(
paste(input$system, input$wheelSelect, sep = "/")),
message = FALSE)
)
Making the message = FALSE allows it to fail silently until the selectInput generates a valid filename.