Shiny Reactive renderUI 和多个依赖/耦合输入
Posted
技术标签:
【中文标题】Shiny Reactive renderUI 和多个依赖/耦合输入【英文标题】：Shiny Reactive renderUI and multiple dependent / coupled inputs 【发布时间】：2018-07-04 13:44:21 【问题描述】：我有以下示例应用程序，我需要能够切换 multiple_choice_1_source 的输入 OR multiple_choice_2_type 而不会破坏应用程序和隐藏 submit_request_button_ui 和ColnamesInput 当输入改变时。基本上，用户应该能够在单击“提交”按钮后修改输入，并且应用程序应该重置为之前的状态。
我尝试过的：
shinyjs() - 这只是隐藏而不清除输入。这意味着一旦我按下submit_request_button，那么对multiple_choice_2_type 所做的任何更改都会被处理并做出反应。在实际应用程序中，我将提交绑定到非常大的表。我想阻止获取
selected_data() 重新运行并清除和隐藏前两个选项中创建的元素。
reactive - 我试图让观察者监听一些反应性触发器，这些触发器从多个输入中获取依赖关系。我使用user_input_rv 来存储值等，但这失败了，因为观察者被多次触发，所以当我点击提交按钮时，reactive() 中的 if 语句被触发两次，实际上是多次下载每个数据集。它也失败了。
isolate - 我无法完成这项工作。我尝试了多种隔离组合，但没有成功。
library(shiny)
library(tidyverse)
ui <- fluidPage(
selectizeInput(inputId ='multiple_choice_1_source',
choices = c("db1","db2","db3","db4"), # like this because we want the selected to be blank on initialisation
label = "1. Select source",
multiple = FALSE,
size = 10,
width = '100%'
)
,uiOutput(outputId="multiple_choice_2_type_ui")
,uiOutput(outputId="submit_request_button_ui")
,uiOutput(outputId="ColnamesInput")
)
server <- function(input, output)
user_input_rv = reactiveValues(
source_picked = NULL,
last_used_source = NULL,
type_picked = NULL,
series_picked = NULL,
last_used_series = NULL,
selected_data = NULL,
final_selection = NULL
)
observeEvent(input$multiple_choice_1_source,
user_input_rv$source_picked <- input$multiple_choice_1_source
#change data loaded under type picked.
user_input_rv$type_picked <-
if ( input$multiple_choice_1_source == "db1") paste0(colnames(mtcars))
else if ( input$multiple_choice_1_source == "db2") paste0(colnames(diamonds))
else if ( input$multiple_choice_1_source == "db3") NULL
else if ( input$multiple_choice_1_source == "db4") NULL
output$multiple_choice_2_type_ui <- renderUI(
selectizeInput( inputId = 'multiple_choice_2_type',
choices = paste(user_input_rv$type_picked),
label= "2. Select type",
multiple = TRUE,
size = 10,
width = '100%',
options = list( placeholder = 'Type',
maxItems =1
)
)
)
) #first observeEvent for source type and data load.
observeEvent(input$multiple_choice_2_type,
output$submit_request_button_ui <- renderUI(
actionButton(
inputId = "submit_request_button",
label = " Get data "
)
)
)#second observeEvent for submit_request_button_ui
observeEvent(input$submit_request_button,
selected_data <- reactive(
if( input$multiple_choice_1_source =="db1")
mtcars
else if ( input$multiple_choice_1_source == "db1")
diamonds
else if ( input$multiple_choice_1_source == "db3") NULL
else if ( input$multiple_choice_1_source == "db4") NULL
)
user_input_rv$series_picked <- input$multiple_choice_2_type
user_input_rv$selected_data <- selected_data()
min_cols <- as.integer(1) # default 1
max_cols <- as.integer(length(colnames(selected_data())))
#print(max_cols)
#this renderUI creates the right-hand side column of the app COLUMNS
output$ColnamesInput <- renderUI(
lapply(min_cols:max_cols, function(z)
column(width = 3,
offset = 0,
selectInput( inputId = paste0("cols","_",z),
label = paste(input$multiple_choice_2_type,": ",colnames(selected_data())[z]),
choices = unique(selected_data()[[z]]),
multiple = TRUE
) #selectizeInput
)
)#lapply inner
) #renderUI for columns
) #third observeEvent for data selection and customisation
shinyApp(ui = ui, server = server)
【问题讨论】：
您是否尝试过使用eventReactive？
是的，但我只尝试将反应式替换为selected_data()
如果您希望仅在按下提交按钮时更改值，那么您为什么使用reactive expression 或reactiveValues？
好问题 - 总结了我对闪亮反应的舒适程度......
【参考方案1】：
这是我从中删除 reactive expression 并改用局部变量 selected_data 的代码。
observeEvent(input$submit_request_button,
# selected_data <- reactive(
# browser()
selected_data <- NULL
if( input$multiple_choice_1_source =="db1")
selected_data <- mtcars
else if ( input$multiple_choice_1_source == "db1")
selected_data <- diamonds
else if ( input$multiple_choice_1_source == "db3") selected_data <- NULL
else if ( input$multiple_choice_1_source == "db4")selected_data <- NULL
# )
user_input_rv$series_picked <- isolate(input$multiple_choice_2_type)
user_input_rv$selected_data <- selected_data
min_cols <- as.integer(1) # default 1
max_cols <- as.integer(length(colnames(selected_data)))
#print(max_cols)
#this renderUI creates the right-hand side column of the app COLUMNS
output$ColnamesInput <- renderUI(
lapply(min_cols:max_cols, function(z)
column(width = 3,
offset = 0,
selectInput( inputId = paste0("cols","_",z),
label = paste(isolate(input$multiple_choice_2_type),": ",colnames(selected_data)[z]),
choices = unique(selected_data[[z]]),
multiple = TRUE
) #selectizeInput
)
)#lapply inner
) #renderUI for columns
) #third observeEvent for data selection and customisation
现在，当您更改选择输入选项时，ColnamesInput 不会被触发。只有在您单击提交按钮后才会触发它。
[编辑]：
可能不是最好的方法，但我认为我能够实现您想要的。另外，我冒昧地使用了您的服务器中已经定义的reactiveValue。看看下面修改后的服务器代码：
server <- function(input, output)
user_input_rv = reactiveValues(
source_picked = NULL,
last_used_source = NULL,
type_picked = NULL,
series_picked = NULL,
last_used_series = NULL,
selected_data = NULL,
final_selection = NULL
)
observeEvent(input$multiple_choice_1_source,
user_input_rv$source_picked <- input$multiple_choice_1_source
###Start: To check if the source changed#########
if(!is.null(user_input_rv$last_used_source))
if(user_input_rv$last_used_source != user_input_rv$source_picked)
shinyjs::hide("ColnamesInput")
user_input_rv$last_used_source = user_input_rv$source_picked
else
user_input_rv$last_used_source = user_input_rv$source_picked
###End: To check if the source changed#########
#change data loaded under type picked.
user_input_rv$type_picked <-
if ( input$multiple_choice_1_source == "db1") paste0(colnames(mtcars))
else if ( input$multiple_choice_1_source == "db2") paste0(colnames(diamonds))
else if ( input$multiple_choice_1_source == "db3") NULL
else if ( input$multiple_choice_1_source == "db4") NULL
output$multiple_choice_2_type_ui <- renderUI(
selectizeInput( inputId = 'multiple_choice_2_type',
choices = paste(user_input_rv$type_picked),
label= "2. Select type",
multiple = TRUE,
size = 10,
width = '100%',
options = list( placeholder = 'Type',
maxItems =1
)
)
)
) #first observeEvent for source type and data load.
observeEvent(input$multiple_choice_2_type,
###Start: To check if the series changed#########
user_input_rv$series_picked <- input$multiple_choice_2_type
if(!is.null(user_input_rv$last_used_series))
if(user_input_rv$last_used_series != user_input_rv$series_picked)
shinyjs::hide("ColnamesInput")
user_input_rv$last_used_series = user_input_rv$series_picked
else
user_input_rv$last_used_series = user_input_rv$series_picked
###End: To check if the series changed#########
output$submit_request_button_ui <- renderUI(
actionButton(
inputId = "submit_request_button",
label = " Get data "
)
)
)#second observeEvent for submit_request_button_ui
observeEvent(input$submit_request_button,
# selected_data <- reactive(
# browser()
shinyjs::show("ColnamesInput")
selected_data <- NULL
if( input$multiple_choice_1_source =="db1")
selected_data <- mtcars
else if ( input$multiple_choice_1_source == "db1")
selected_data <- diamonds
else if ( input$multiple_choice_1_source == "db3") selected_data <- NULL
else if ( input$multiple_choice_1_source == "db4")selected_data <- NULL
# )
user_input_rv$series_picked <- isolate(input$multiple_choice_2_type)
user_input_rv$selected_data <- selected_data
min_cols <- as.integer(1) # default 1
max_cols <- as.integer(length(colnames(selected_data)))
#print(max_cols)
#this renderUI creates the right-hand side column of the app COLUMNS
output$ColnamesInput <- renderUI(
lapply(min_cols:max_cols, function(z)
column(width = 3,
offset = 0,
selectInput( inputId = paste0("cols","_",z),
label = paste(isolate(input$multiple_choice_2_type),": ",colnames(selected_data)[z]),
choices = unique(selected_data[[z]]),
multiple = TRUE
) #selectizeInput
)
)#lapply inner
) #renderUI for columns
) #third observeEvent for data selection and customisation
希望对你有帮助！
【讨论】：
谢谢@SBista。问题是当两个selectizes 的选择发生变化时，ColnamesInput 仍然可见。我需要隐藏它们。
@J.Doe.，我已经编辑了代码来实现你想要的。看一看。希望对您有所帮助！
谢谢@SBista。它完成了工作。我认为它尽可能高效。我在顶部的reactiveValues 上走在正确的轨道上，但我不止一次失败了。 100% 正确的是嵌套的 if 语句。再次感谢您！以上是关于Shiny Reactive renderUI 和多个依赖/耦合输入的主要内容，如果未能解决你的问题，请参考以下文章
R Shiny - 将tabPanel动态添加到tabsetPanel（使用renderUI）
如何使用 `renderUI` 响应式更新 Shiny 应用程序中的活动菜单项？
如何在R Shiny中使用renderUI触发renderDataTable进行输入？