r - R Shiny 模块中的 updateSelectInput 不会将现有输入传递给“选定”参数
问题描述
我正在编写一个应用程序，它将帮助将数据文件转换为标准格式以提供可重用的仪表板。这项工作的一部分涉及创建一个用户界面，以使用户可以轻松地将他们在输入文件中的随机列名映射到仪表板预期的“标准”列名。
我实际上让这段代码运行良好。但是应用程序需要对几个不同的输入文件（每个文件都有自己的一组标准列名）执行相同的映射练习，因此模块化似乎是一个不错的候选！
这是工作流程：
用户加载“映射输入”文件。如果他们以前做过这个映射练习，我想使用这个文件来预填充下拉列表。我还从该表中提取标准列名列表。每个标准列名称都有一个关联的下拉列表。
他们加载他们的文件以进行争论 - 具有古怪列名的文件。此文件中的列名将成为下拉列表中的选项。
- 当用户开始将他们的列名映射到不同的标准名称下拉列表时，他们的选择将从其他下拉列表中消失。这使得映射具有许多列的文件中的列变得更加容易。
我觉得我是如此接近。问题在于模块何时运行 updateSelectInput。我正在使用 updateSelectInput 从已使用的下拉列表中删除选项。这可行，但它会清除在 renderUI 函数中设置的预填充值。
这是具有预填充值的代码（已删除有问题的 updateSelectInput）：
# Load libraries and options ----------------------------------------------
library(shiny)
library(dplyr)
library(tidyr)
options(stringsAsFactors = FALSE)
# Modules -----------------------------------------------------------------
input_ui <- function(id, row_label, file_description) {
ns <- NS(id)
fluidRow(
uiOutput(ns("colmapping")) # References the dynamic dropdowns created by the server module.
)
}
# Creates dynamic dropdowns which ultimately will be used to rename columns from a number of different files.
input_server <- function(input, output, session, parent) {
# Create a fake file with misnamed columns that need remapped.
input_file <- reactive({
return(data.frame(Account.Number = 1:2,
Account.Name = c("Account 1", "Account 2"),
Quota.2018 = c(1000, 2000)))
})
# Get a list of what the columns SHOULD be named. These will also do double-duty as the labels for our dropdown inputs.
standard_columns <- reactive({
c("AccountId", "AccountName", "SalesGoal")
})
# Get the actual column names from the file with misnamed columns.
actual_columns <- reactive({
colnames(input_file())
})
# A separate input can be loaded that documents how the misnamed columns have been mapped to the correct names in the past.
# We want to pre-populate the dropdowns with these selections.
quickstart_columns <- reactive({
c("Account.Number", "Account.Name", "Quota")
})
# Create a drop-down selectInput for each of the "standard" column names, allowing the user to choose from the column names in their own misnamed file.
output$colmapping <- renderUI({
ns <- session$ns
dropdowns = tagList()
for (i in seq_len(length(standard_columns()))) { # For i in 1:number of standard names associated with this table
dropdowns[[i]] = selectInput(ns(paste0("input_", standard_columns()[i])), # Use the standard name value for the input object name
label = paste0(standard_columns()[i]), # And for the UI label
choices = actual_columns(),
selected = quickstart_columns()[i],
multiple = FALSE) #Use choices from loaded input table
}
return(dropdowns)
})
}
# UI ----------------------------------------------------------------------
ui <- fluidPage(
input_ui("acct_info")
)
# Server ------------------------------------------------------------------
server <- function(input, output, session) {
acct_info_mod_results <- callModule(input_server,
"acct_info",
parent = session)
}
shinyApp(ui = ui, server = server)
这是打开 updateSelectInput 的相同代码（因此选择的其他地方选项从选项中删除），但未显示预填充的值。
# Load libraries and options ----------------------------------------------
library(shiny)
library(dplyr)
library(tidyr)
options(stringsAsFactors = FALSE)
# Modules -----------------------------------------------------------------
input_ui <- function(id, row_label, file_description) {
ns <- NS(id)
fluidRow(
uiOutput(ns("colmapping")) # References the dynamic dropdowns created by the server module.
)
}
# Creates dynamic dropdowns which ultimately will be used to rename columns from a number of different files.
input_server <- function(input, output, session, parent) {
# Create a fake file with misnamed columns that need remapped.
input_file <- reactive({
return(data.frame(Account.Number = 1:2,
Account.Name = c("Account 1", "Account 2"),
Quota.2018 = c(1000, 2000)))
})
# Get a list of what the columns SHOULD be named. These will also do double-duty as the labels for our dropdown inputs.
standard_columns <- reactive({
c("AccountId", "AccountName", "SalesGoal")
})
# Get the actual column names from the file with misnamed columns.
actual_columns <- reactive({
colnames(input_file())
})
# A separate input can be loaded that documents how the misnamed columns have been mapped to the correct names in the past.
# We want to pre-populate the dropdowns with these selections.
quickstart_columns <- reactive({
c("Account.Number", "Account.Name", "Quota")
})
# Create a drop-down selectInput for each of the "standard" column names, allowing the user to choose from the column names in their own misnamed file.
output$colmapping <- renderUI({
ns <- session$ns
dropdowns = tagList()
for (i in seq_len(length(standard_columns()))) { # For i in 1:number of standard names associated with this table
dropdowns[[i]] = selectInput(ns(paste0("input_", standard_columns()[i])), # Use the standard name value for the input object name
label = paste0(standard_columns()[i]), # And for the UI label
choices = actual_columns(),
selected = quickstart_columns()[i],
multiple = FALSE) #Use choices from loaded input table
}
return(dropdowns)
})
# This is the chunk of code giving me trouble!
# For some of these files, there's like 20-some columns that will need renamed. That's a lot of scanning through long dropdown lists.
# As the user starts to map some of the columns, I want their selections to disappear from the other drop downs.
# The good news is, this works!
# The bad news is, it also clears out the pre-populated inputs. How can I keep the pre-populated inputs from disappearing when I apply updateSelectInput?
observe({
ns <- session$ns
n <- isolate(length(standard_columns()))
for (i in seq_len(n)) {
already_selected <- unlist(lapply((1:n)[-i], function(i)
input[[ paste0("input_",standard_columns()[i]) ]]))
print(i)
selected_i <- input[[ paste0("input_", standard_columns()[i]) ]]
print(selected_i) # For debugging. These return empty values until selections are made, but I never had the problem with analogous code until I tried to put it in the module.
updateSelectInput(session = parent,
ns(paste0("input_",standard_columns()[i])),
choices = append(c("Empty"),setdiff(actual_columns(), already_selected)),
selected = input[[ paste0("input_", standard_columns()[i]) ]]
)
}
})
}
# UI ----------------------------------------------------------------------
ui <- fluidPage(
input_ui("acct_info")
)
# Server ------------------------------------------------------------------
server <- function(input, output, session) {
acct_info_mod_results <- callModule(input_server,
"acct_info",
parent = session)
}
shinyApp(ui = ui, server = server)
这是我第一次完全陷入一个项目！我非常感谢任何见解或建议！
编辑：在经历了很多痛苦之后，我想出了如何获取一个会话输入列表，我可以循环通过该列表在父会话中创建 updateSelectInput。我还想出了如何将它放入主会话中的函数中。这是工作修复的一个最小示例，但如果有人有更聪明的方法来解决问题，我会全力以赴！
# Load libraries and options ----------------------------------------------
library(shiny)
library(dplyr)
options(stringsAsFactors = FALSE)
updateDropDowns <- function(session, all_inputs) {
inputs <- setdiff(all_inputs$names, all_inputs$names %>% str_subset(pattern="selectize"))
selected <- unname(unlist(all_inputs %>% filter(names %in% inputs) %>% select(selected)))
values <- c("a", "b", "c", "d")
n <- length(inputs)
for (i in seq_len(n)) {
already_selected <- unlist(lapply((1:n)[-i], function(i)
selected[i]))
updateSelectInput(session,
inputs[i],
choices = setdiff(values, already_selected),
selected = selected[i])
}
}
# UI ----------------------------------------------------------------------
ui <- fluidPage(
uiOutput("colmapping")
)
# Server ------------------------------------------------------------------
server <- function(input, output, session) {
output$colmapping <- renderUI({
dropdowns = tagList()
for (i in 1:3) {
dropdowns[[i]] = selectInput(paste0("input_",i),
label = paste0("input_",i),
choices = c("a", "b", "c", "d"),
selected = NULL,
multiple = FALSE)
}
return(dropdowns)
})
all_inputs <- reactive({ # get a dataframe of input names and values, else return an empty df
x <- reactiveValuesToList(input)
y <- data.frame(
names = names(x),
selected = unlist(x, use.names = FALSE)
)
empty <- as.data.frame(setNames(rbind(data.frame(matrix(ncol = 2, nrow = 1)),
c(rep("999",2))),
c("names", "selected")))
if(nrow(y) == 0) {empty} else {y}
})
observe({
updateDropDowns(session, all_inputs())
})
}
shinyApp(ui = ui, server = server)
解决方案
推荐阅读
- excel - 为什么 excel 公式没有从第一个条目开始水平拉入所有结果？
- javascript - 动态变量和内容 ejs
- c - 查找以数组中的字符开头的单词
- javascript - 如何在 vue.js 中获取 refs 数组？
- firebase - firebase 应用注册错误 => 找不到与包名称匹配的客户端
- arkit - 如何使用 ARMatteGenerator 将 CIFilter 添加到 MTLTexture？
- r - R：如何在 ggplot2 中允许轴刻度但不允许刻度线计数因方面而异？
- c# - 通过控制器操作填充下拉列表
- rust - Rust如何在某些结构的静态函数调用中解析类型注释
- html - 文本内容太长时列超过行宽