我正在编写一个应用程序，它将帮助将数据文件整理为标准格式以提供可重复使用的仪表板。其中一部分工作是创建一个用户界面，以使用户可以轻松地将输入文件中的随机列名称映射到仪表板期望的“标准”列名称。
我实际上使这段代码运行良好。但是该应用程序需要对几个不同的输入文件（每个文件都有自己的标准列名）执行相同的映射操作，因此似乎很适合模块化！
这是工作流程：
用户加载“映射输入”文件。如果他们完成了此映射 练习之前，我想使用此文件来预先填充 下拉菜单。我也从中提取标准列名称的列表 这个桌子。每个标准列名称都会有一个关联的下拉列表。
他们加载要处理的文件-带有错误列的文件 名称。该文件中的列名将成为 下拉菜单。
我觉得我很亲近。问题在于模块何时运行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的相同代码（因此，从其他选项中删除了selected-elsewhere选项），但是未显示预先填充的值。
# 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)