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.
Related
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)
})
I'm having an issue with reactivity when using modules in R. If I update a module and then try to update another module with those updated values, I instead get the values prior to the update.
I've written up some basic code to show what I mean below. Here I have an app that updates a rHandsontableOutput placed in a module called my_module and then copies this updated rHandsontableOutput to a second module called module_to_update when a button is pressed.
What I'm finding is that the first table in my_module will update but not the one in module_to_update. Instead, the module_to_update table will receive a copy of my_module's initial table prior to the update. If I press the update button again, things work as expected.
I'm guessing this is an issue with either how I'm handling the session or reactive values generally, but I'm out of ideas.
QUESTION: How can I set up reactive values and modules such that I can run operations on updated module data within the same function call? (e.g. see the observeEvent(input$update_btn, ...) call below for an example)
Image:
application.R
library(shiny)
library(rhandsontable)
source('my_modules.R')
active_tab = ""
ui <- navbarPage("Module Test Tool",
tabsetPanel(id = 'mainTabset',
tabPanel("My Tab",
#This is the HoT that works as expected, updating when called upon
h4("Table 1"),
myModuleUI('my_module'),
#This is the HoT that does NOT work as expected. This HoT fails to use the updated values from 'my_module' HoT
h4("Table to be updated"),
myModuleUI('module_to_update'),
br(),
br(),
fluidRow(
#this button updates tables to new values
actionButton("update_btn", "Update and Add Tables"),
br(),
br(),
textOutput('table1_sum'),
textOutput('table2_sum'),
br(),
br()
)
)
)
)
server <- function(input, output, session) {
#Link logic for tab module
callModule(myModule, 'my_module')
#This button sums up all the rHandsonTable data frames
observeEvent(input$update_btn, {
#Update values in table and integer drop down list before doing basic operations on them
#New values should be all 5s
five_col = rep(5,3)
callModule(updateModule, 'my_module', 5, data.frame(col1 = five_col,
col2 = five_col,
col3 = five_col))
#Grabs updated module table and does operations on it
module_data = callModule(getMyModuleData, 'my_module')
module_int= module_data$module_int
module_df = module_data$module_df
output$table1_sum = renderText({
paste0("Sum of Table 1 is: ", sum(module_df())," | The selected integer is: ", module_int())
})
#------------------------------------------------------
#------------------ERROR BELOW-------------------------
#------------------------------------------------------
#THIS IS THE CODE THAT FAILS. This updates a 2nd module that should mirror the updated values. However, this results in old values.
callModule(updateModule, 'module_to_update', module_int(), module_df())
#Tries to call on new, updated table
updated_module_data = callModule(getMyModuleData, 'module_to_update')
updated_module_int= updated_module_data$module_int
updated_module_df = updated_module_data$module_df
#Display results of basic operations on new table
output$table2_sum = renderText({
paste0("Sum of Updated Table is: ", sum(updated_module_df())," | The selected integer is: ", updated_module_int())
})
})
}
## Create Shiny app ----
shinyApp(ui, server)
my_modules.R
#Simple module containing one rHandsontable and a drop down list of integers
myModuleUI <- function(id,tab_name){
ns <- NS(id)
fluidRow(
rHandsontableOutput(ns("module_hot")),
selectInput(ns('module_int_list'),"Integers:",c(1:5), selected = 1)
)
}
#Initializes myModuleUI rHandsonTable with some values
myModule <- function(input, output, session) {
one_col = rep.int('VALUE AT INITIALIZATION',3)
df = data.frame(col1 = one_col,
col2 = one_col,
col3 = one_col)
output$module_hot <- renderRHandsontable({
rhandsontable(df, stretchH = "none", rowHeaders = NULL)
})
}
#Returns myModule data for use outside of the module
getMyModuleData <- function(input,output,session){
return (
list(
module_df = reactive({hot_to_r(input$module_hot)}),
module_int = reactive({input$module_int_list})
)
)
}
updateModule<- function(input,output,session, new_integer, new_dataframe){
if(!is.null(new_dataframe))
{
output$module_hot <- renderRHandsontable({
rhandsontable(new_dataframe, stretchH = "none", rowHeaders = NULL)
})
}
outputOptions(output, "module_hot", suspendWhenHidden = FALSE)
updateSelectInput(session, "module_int_list",selected = new_integer)
}
There are a few problems in here...
You are calling multiple different modules with the same namespace. Modules are supposed to operate independently of each other. They should each have their own namespace. The following are not correct:
callModule(myModule, 'my_module')
callModule(updateModule, 'my_module', 5, data.frame(col1 = five_col,
col2 = five_col,
col3 = five_col))
module_data = callModule(getMyModuleData, 'my_module')
You are calling modules from within observeEvent(). This means every time you observe that event you try to initialize that module. You don't want to initialize the module, you want to pass the new variables to that module. If you make a module return it's values, then use those returned values as inputs into another module you won't need to observe the event...the module that receives the new information will decide whether to observe the change.
You have created a function/module getMyModuleData that is only supposed to return data that is present in a different module. Instead you should have the other module return the data you want.
Check out: https://shiny.rstudio.com/articles/communicate-bet-modules.html.
I wrote a shiny app which will be used for searching and downloading a quite large dataset. The app works and is nearly done, but some functionalities do not work as I want:
I tried several ways of adding a function in order to download the chosen data as .csv-file. All of them failed and I was only able to download all data instead of the displayed ones.
I was not able to include a function to round data and show some columns as percentage instead of numbers. The formatRound() function within datatable() works well and I would like to use it, but the problem is that I was not able to include it in the server function. Since the user should get the whole number (with all numbers also behind the comma) for his or her work, the data should only be rounded when displayed. If I would be able to fix the rounding, the percentage problem will also be solved, since I would use the similar function formatPercentage().
I made an example using the mtcars-data and removed all wrong or not-working codes for the download and rounding problem. Any hints how I could solve my problem would be extremely appreciated! Thanks in advance!
EDIT3: Rounding problem solved with the code below thanks to #Claud H. The download function exports an empty file (no file-type) named download. Do you have any idea where the error is?
EDIT4: problems solved thanks to #Claud H. I changed mt_cars_filtered()[, c(input$results_columns_selected)]into mt_cars_filtered()[, input$indicator]. Also, I didn't know first that I had to open the web browser to download the data.
library(tidyverse)
library(shiny)
library(shinythemes)
library(DT)
library(ggthemes)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(width=3,
h3("title", align = 'center'),
checkboxGroupInput("cylinder", "Cylinder", choices = c(4,6), selected = c(4)),
checkboxGroupInput('indicator', label = 'Indicators', choices = colnames(mtcars)[1:7],
selected = colnames(mtcars)[c(1:7)]),
fluidRow(p(class = 'text-center', downloadButton('download', label = 'Download')))),
mainPanel(
tabsetPanel(
tabPanel('Table',
DT::dataTableOutput('results'))
)
)
))
server <- function(input, output){
mtcars_filtered <- reactive({
mtcars %>%
filter(cyl %in% input$cylinder)
})
# Output Table
output$results <- DT::renderDataTable({
columns = input$indicator
mtcars_filtered()[, columns, drop = FALSE] %>%
datatable(style = 'bootstrap', selection = list(target = 'column'), options = list(paging = FALSE, dom = 't')) %>%
formatRound(input$indicator[grep('t', input$indicator)], 2)
})
# Download Data
output$download <- downloadHandler(
filename = function() { paste('filename', '.csv', sep = '') },
content = function(file) {
write.csv(mtcars_filtered()[,input$indicator], file, row.names = FALSE)
})
}
shinyApp(ui = ui, server = server)
Suggest looking at ?"%>%" from magrittr package
Also, check this and this answers on SO.
Your table should be fine with this kind of syntax
output$results <- DT::renderDataTable({
columns = input$indicator
mtcars_filtered()[, columns, drop = FALSE] %>%
datatable() %>%
formatCurrency( input your code here) %>%
formatPercentage( and so on ... )
}, style = 'bootstrap', options = list(paging = FALSE, dom = 't'))
Also, I didnt quite get the question about downloading. If you want to download a data FROM server, use downloadHandler() function. Something like:
output$save_data <- downloadHandler(
filename = function() { paste("filename", '.csv', sep = '') },
content = function(file) {
write.csv(mydata(), file, row.names = FALSE)
})
and downloadButton("save_data", "download") in ui.R
edit: as per your changes, download isn't working because you got wrong columns selected: there is no table called tableId, and you need to take the columns from the table called results:
write.csv(mtcars_filtered()[, c(input$results_columns_selected)], file, row.names = FALSE)
as of rounding problem, you can use your indicator variable to see if column is selected input$indicator %in% c('drat', 'qsec', 'wt') then use subsetting to select only columns with TRUE, if there are any: formatRound(input$indicator[input$indicator %in% c('drat', 'qsec', 'wt')], 2)
edit2
Seems I've understood everything you wanted to do right.
To select columns in the downloadHandler function based on your checkboxes , use indicator variable to filter it:
mtcars_filtered()[, input$indicator]
Otherwise, if you want to select them from the table itself with the mouse clicks, use input$results_columns_selected, like this:
mtcars_filtered()[, c(input$results_columns_selected)]
I'm stuck trying to get dates to show up in a Shiny table. I have done some research and see that in the past xtable does not work nicely with Shiny. There are a couple of questions on SO that dealt with this issue. The one routinely reference can be found here R: xtable and dates.
My problem is that 1)I'm extremely new at programming in Shiny and using xtable. 2) I am unfamiliar with using POSIXct. 3) I don't understand the solution provided in the link above.
Please provide a helping hand for the basic code below. The idea is that somebody would use this app to enter data daily. These data would be stored on a .csv. When stored on the .csv only the numeric value of the R date is stored. This is what shows up on the Shiny table as well. Please teach me how to format correctly in both the table and the .csv file.
Before examining the code below, know that there would be a .csv file stored that would have the Headers Date, A, B. Let's call this file "log" and it would be stored locally. Here is the code:
library(shiny)
log <- read.table("V:\\My\\Path\\log.csv",sep=",",header=T)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(width=2,
#Enter Date
dateInput("date","Date",min="2016-07-04", max = "2017-07-04"),
#Enter Combo
selectInput(inputId = "a", "A", c("Choose one" = "","A1", "A2", "A3"), multiple = FALSE, selectize = TRUE, width = NULL, size = NULL),
#Enter Number
numericInput(inputId = "b", "Favorite Number", NULL, min = 0, max = NA),
#Enter Submit to write info to file
actionButton(inputId = "submit", "Submit", icon = NULL, width = NULL)
),
mainPanel(
# Application title
titlePanel("Read Date"),
tableOutput("summary"))
)
)
server <- function(input, output) {
#Create vector of current trial results
data <- eventReactive(input$submit, {
cbind(input$date,input$a, input$b)
})
#Append current trial results to master list
observeEvent(input$submit, {
write.table(data(), file="V:\\My\\Path\\log.csv", sep=",", col.names= FALSE, row.names=F, append = T)
})
#Create datatable variable reading in latest log
datatable <- eventReactive(c(input$agent,input$submit), { #Putting both reactive variables allow to see dataset without running and see updated dataset after running.
data.frame(read.table("V:\\My\\Path\\log.csv",sep=",",header=T))
})
#Create Table
output$summary <- renderTable({
datatable() }, digits=2,align = "cccc" )
}
shinyApp(ui = ui, server = server)
It seems the answer is to write as character to the log file and read it back in as a character. I can't figure out to do this. Am I on the right track? Because I'm learning I'll take any other suggestions on how to improve my code.
I finally figured out the simple solution.
I just changed the code when I build the dataframe from
data <- eventReactive(input$submit, {
cbind(input$date,input$a, input$b)
to
data <- eventReactive(input$submit, {
cbind(as.character(input$date),input$a, input$b))
Adding the as.character() seems to have done the trick. I don't know if this will have consequences later, but the displayed table now looks nice.
I have a shiny app in which there is a dropdown with values that I have been entering manually. However, since there are a lot of values that I need to populate in my drop down, it would be better if I could let the users type the words in a textbox and the app display only the matching elements(something like a browser). Currently, I am using the code:
lapply(1:num, function(i) {
selectInput(paste0("n_input_", i), label = paste0("n_input", i),
choices = list("IN120" = 1, "CR23" = 2, "FG45" = 3,"OR45"=4),
selected = 1)
})
Can we do this in shiny? In case not, how do we read values from a csv file to populate our drop down?
To answer your second question try:
myData <- read.csv("my_csv_file_path.csv", row.names=NULL, na.strings="", stringsAsFactors=FALSE)
myList <- as.list(unique(myData[[1]])) ## The number should be the column/field in myData that has the desired list.
lapply(1:num, function(i) {
selectInput(paste0("n_input_", i), label = paste0("n_input", i),
choices = myList)
})
This should read in the .csv file and create a list of the unique values in the desired list. Edited your script to use choices = myList and removed the selected = 1 portion. The drop down will default to the first item in your list when this is omitted. A technique is to add an initial value to the top of the list (e.g., "Select Something") to display until the user selects something from the dropdown.
Cheers!
To answer your first question, Shiny selectInput() now uses the selectize.js library by default for the input element. This allows searching of the choices by default in Shiny.