来自 selectInput 的具有多个条件的闪亮 R 观察事件 [英] Shiny R observeEvent with Multiple Conditions from selectInput
问题描述
我正在开发一个闪亮的应用程序，当我创建一个由 selectInput() 派生的多个输入的复杂表达式时，我遇到了 代码>.observeEvent() 函数的困难
I'm working on a shiny app and I'm running into difficulty with observeEvent() function when creating a complex expression of multiple inputs that all derive from selectInput().
我的问题是 observeEvent() 函数中的一些表达式在启动时被触发，导致事件过早执行(即我的 actionButton() 在启动，因为它应该是，但是当至少选择一个输入时启用，理想情况下我希望它仅在选择所有输入时启用).如下图:
My issue is some of the expressions within the observeEvent() function are triggered at startup, causing the event to prematurely execute (i.e. my actionButton() is disabled at startup, as it should be, but becomes enabled when at least one of the inputs are selected when ideally I would want it to become enabled only when ALL inputs are selected). As seen below:
observeEvent({
#input$cohort_file
input$cohort_IDvar
input$cohort_index_date
input$cohort_EOF_date
input$cohort_EOF_type
input$cohort_Y_name
input$cohort_L0
}, {
enable("set_cohort_button")
})
作为参考，我正在使用 @daattali 在 github 上找到的 shinyjs 包来启用/禁用 actionButton().
For reference, I'm using the shinyjs package by @daattali found on github to enable/disable actionButton().
除了最后一个输入(即 input$cohort_L0)似乎在启动时初始化，所以 observeEvent() 仅在 actionButton 启用 actionButton代码>input$cohort_L0 被选中.如果您运行我的应用程序并按从上到下的顺序选择输入，则 observeEvent() 似乎按预期工作.当我决定随机选择输入时，我才发现它没有按预期工作，并发现选择 input$cohort_L0 是我需要选择的唯一输入以启用 actionButton().
All but the last input (i.e. input$cohort_L0) appear to be initialized at startup so observeEvent() enables actionButton only when input$cohort_L0 is selected. If you run my app and select input in sequential order from top to bottom, it appears that observeEvent() is working as intended. I only discovered that it wasn't working as intended when I decided to choose inputs at random and discovered that selecting input$cohort_L0 was the only input I needed to select to enable actionButton().
代码的 UI 部分如下所示:
The UI portion of the code looks like this:
# Variable selection
selectInput('cohort_IDvar', 'ID', choices = ''),
selectInput('cohort_index_date', 'Index date', choices = ''),
selectInput('cohort_EOF_date', 'End of follow-up date', choices = ''),
selectInput('cohort_EOF_type', 'End of follow-up reason', choices = ''),
selectInput('cohort_Y_name', 'Outcome', choices = ''),
selectInput('cohort_L0', 'Baseline covariate measurements', choices = '', multiple=TRUE, selectize=TRUE),
我正在使用 observe() 收集上传数据集的列名，以将它们定向到 selectInput()，如下所示:
And I'm using observe() to collect the column names of an upload data-set to direct them to selectInput() as follows:
### Collecting column names of dataset and making them selectable input
observe({
value <- c("",names(cohort_data()))
updateSelectInput(session,"cohort_IDvar",choices = value)
updateSelectInput(session,"cohort_index_date",choices = value)
updateSelectInput(session,"cohort_EOF_date",choices = value)
updateSelectInput(session,"cohort_EOF_type",choices = value)
updateSelectInput(session,"cohort_L0",choices = value)
})
我已经研究过使用参数 ignoreInit = TRUE 但它对我在 observeEvent() 中有多个表达式的情况没有任何作用.我还研究了在 selectInput() 中强制不进行默认选择，但没有运气.
I've looked into using the argument ignoreInit = TRUE but it does nothing for my case of having multiple expressions within observeEvent(). I've also looked into forcing no default selection in selectInput() but had no luck with that.
所以我的两部分问题是如何在仅选择所有输入时执行 observEvent()/如何停止在启动时初始化输入?
So my two-part question is how can I execute observEvent() when only ALL inputs are selected/how do I stop from the inputs from being initialized at startup?
我的整个代码:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage("Test",
tabPanel("Cohort",
sidebarLayout(
sidebarPanel(
fileInput("cohort_file", "Choose CSV File",
multiple = FALSE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
# Horizontal line ----
tags$hr(),
# Variable selection
selectInput('cohort_IDvar', 'ID', choices = ''),
selectInput('cohort_index_date', 'Index date', choices = ''),
selectInput('cohort_EOF_date', 'End of follow-up date', choices = ''),
selectInput('cohort_EOF_type', 'End of follow-up reason', choices = ''),
selectInput('cohort_Y_name', 'Outcome', choices = ''),
selectInput('cohort_L0', 'Baseline covariate measurements', choices = '', multiple=TRUE, selectize=TRUE),
# Horizontal line ----
tags$hr(),
disabled(
actionButton("set_cohort_button","Set cohort")
)
#actionButton("refresh_cohort_button","Refresh")
),
mainPanel(
DT::dataTableOutput("cohort_table"),
tags$div(id = 'cohort_r_template')
)
)
)
)
)
server <- function(input, output, session) {
################################################
################# Cohort code
################################################
cohort_data <- reactive({
inFile_cohort <- input$cohort_file
if (is.null(inFile_cohort))
return(NULL)
df <- read.csv(inFile_cohort$datapath,
sep = ',')
return(df)
})
rv <- reactiveValues(cohort.data = NULL)
rv <- reactiveValues(cohort.id = NULL)
rv <- reactiveValues(cohort.index.date = NULL)
rv <- reactiveValues(cohort.eof.date = NULL)
rv <- reactiveValues(cohort.eof.type = NULL)
### Creating a reactiveValue of the loaded dataset
observeEvent(input$cohort_file, rv$cohort.data <- cohort_data())
### Displaying loaded dataset in UI
output$cohort_table <- DT::renderDataTable({
df <- cohort_data()
DT::datatable(df,options=list(scrollX=TRUE, scrollCollapse=TRUE))
})
### Collecting column names of dataset and making them selectable input
observe({
value <- c("",names(cohort_data()))
updateSelectInput(session,"cohort_IDvar",choices = value)
updateSelectInput(session,"cohort_index_date",choices = value)
updateSelectInput(session,"cohort_EOF_date",choices = value)
updateSelectInput(session,"cohort_EOF_type",choices = value)
updateSelectInput(session,"cohort_L0",choices = value)
})
### Creating selectable input for Outcome based on End of Follow-Up unique values
observeEvent(input$cohort_EOF_type,{
updateSelectInput(session,"cohort_Y_name",choices = unique(cohort_data()[,input$cohort_EOF_type]))
})
### Series of observeEvents for creating vector reactiveValues of selected column
observeEvent(input$cohort_IDvar, {
rv$cohort.id <- cohort_data()[,input$cohort_IDvar]
})
observeEvent(input$cohort_index_date, {
rv$cohort.index.date <- cohort_data()[,input$cohort_index_date]
})
observeEvent(input$cohort_EOF_date, {
rv$cohort.eof.date <- cohort_data()[,input$cohort_EOF_date]
})
observeEvent(input$cohort_EOF_type, {
rv$cohort.eof.type <- cohort_data()[,input$cohort_EOF_type]
})
### ATTENTION: Following eventReactive not needed for example so commenting out
### Setting id and eof.type as characters and index.date and eof.date as Dates
#cohort_data_final <- eventReactive(input$set_cohort_button,{
# rv$cohort.data[,input$cohort_IDvar] <- as.character(rv$cohort.id)
# rv$cohort.data[,input$cohort_index_date] <- as.Date(rv$cohort.index.date)
# rv$cohort.data[,input$cohort_EOF_date] <- as.Date(rv$cohort.eof.date)
# rv$cohort.data[,input$cohort_EOF_type] <- as.character(rv$cohort.eof.type)
# return(rv$cohort.data)
#})
### Applying desired R function
#set_cohort <- eventReactive(input$set_cohort_button,{
#function::setCohort(data.table::as.data.table(cohort_data_final()), input$cohort_IDvar, input$cohort_index_date, input$cohort_EOF_date, input$cohort_EOF_type, input$cohort_Y_name, input$cohort_L0)
#})
### R code template of function
cohort_code <- eventReactive(input$set_cohort_button,{
paste0("cohort <- setCohort(data = as.data.table(",input$cohort_file$name,"), IDvar = ",input$cohort_IDvar,", index_date = ",input$cohort_index_date,", EOF_date = ",input$cohort_EOF_date,", EOF_type = ",input$cohort_EOF_type,", Y_name = ",input$cohort_Y_name,", L0 = c(",paste0(input$cohort_L0,collapse=","),"))")
})
### R code template output fo UI
output$cohort_code <- renderText({
paste0("cohort <- setCohort(data = as.data.table(",input$cohort_file$name,"), IDvar = ",input$cohort_IDvar,", index_date = ",input$cohort_index_date,", EOF_date = ",input$cohort_EOF_date,", EOF_type = ",input$cohort_EOF_type,", Y_name = ",input$cohort_Y_name,", L0 = c(",paste0(input$cohort_L0,collapse=","),"))")
})
### Disables cohort button when "Set cohort" button is clicked
observeEvent(input$set_cohort_button, {
disable("set_cohort_button")
})
### Disables cohort button if different dataset is loaded
observeEvent(input$cohort_file, {
disable("set_cohort_button")
})
### This is where I run into trouble
observeEvent({
#input$cohort_file
input$cohort_IDvar
input$cohort_index_date
input$cohort_EOF_date
input$cohort_EOF_type
input$cohort_Y_name
input$cohort_L0
}, {
enable("set_cohort_button")
})
### Inserts heading and R template code in UI when "Set cohort" button is clicked
observeEvent(input$set_cohort_button, {
insertUI(
selector = '#cohort_r_template',
ui = tags$div(id = "cohort_insertUI",
h3("R Template Code"),
verbatimTextOutput("cohort_code"))
)
})
### Removes heading and R template code in UI when new file is uploaded or when input is changed
observeEvent({
input$cohort_file
input$cohort_IDvar
input$cohort_index_date
input$cohort_EOF_date
input$cohort_EOF_type
input$cohort_Y_name
input$cohort_L0
}, {
removeUI(
selector = '#cohort_insertUI'
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
推荐答案
你作为触发事件传递给observeEvent的代码块是
The code chunk that you're passing to the observeEvent as the trigger event is
{
input$cohort_IDvar
input$cohort_index_date
input$cohort_EOF_date
input$cohort_EOF_type
input$cohort_Y_name
input$cohort_L0
}
这意味着，就像任何其他反应性代码块一样，当这些值中的任何一个发生变化时，该反应性块被视为无效，因此观察者将触发.所以你看到的行为是有道理的.
This means that, just like any other reactive code block, when ANY of these values changes, that reactive block is considered invalidated and therefore the observer will trigger. So the behaviour you're seeing makes sense.
听起来您想要的是仅在设置所有值时才执行.这听起来很好地使用了 req() 函数！尝试这样的事情:
It sounds like what you want is to execute only when all values are set. That sounds like a great use of the req() function! Try something like this:
observe({
req(input$cohort_IDvar, input$cohort_index_date, input$cohort_EOF_date, ...)
enable("set_cohort_button")
})
请注意，对于 shinyjs::enable()，您可以改用 shinyjs::toggleState() 函数.我认为在这种情况下 req() 函数是更好的选择.
Note that for shinyjs::enable() specifically, you can instead use the shinyjs::toggleState() function. I think in this case the req() function is the better option though.
这篇关于来自 selectInput 的具有多个条件的闪亮 R 观察事件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
