如何动态更新R shiny中SelectInput选项中的列名

Question

我正在制作一个闪亮的应用程序，我有'SplitColumn'(拆分合并的列)，'替换值'和'删除列'。所有这些函数都依赖于选项(列名)中' selectinput '的列选择。

每当我使用'SplitColumn '时，它会按预期在数据表中创建额外的列，如'未合并的Type1'和'未合并的Type2 '，但这些新列不会在选择列中的'SelectInput'中动态更新，同样的问题仍然存在，同时使用其他按钮。

有人能帮我解决这个问题吗?

csv数据

ID  Type   Range
21  A1 B1   100
22  C1 D1   200
23  E1 F1   300

应用程序。R

library(shiny)
library(reshape2)
#source('splitColumn_stack.R')
library(DT)
library(tibble)

###function for deleting the rows
splitColumn <- function(data, column_name) {
newColNames <- c("Unmerged_type1", "Unmerged_type2")
newCols <- colsplit(data[[column_name]], " ", newColNames)
after_merge <- cbind(data, newCols)
after_merge[[column_name]] <- NULL
after_merge
}
###_______________________________________________
### function for inserting a new column
fillvalues <- function(data, values, columName){
df_fill <- data
vec <- strsplit(values, ",")[[1]]
df_fill <- tibble::add_column(df_fill, newcolumn = vec, .after = columName)
df_fill
}
##function for removing the colum
removecolumn <- function(df, nameofthecolumn){
df[ , -which(names(df) %in% nameofthecolumn)]
}
### use a_splitme.csv for testing this program
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose CSV File", accept = ".csv"),
checkboxInput("header", "Header", TRUE),
actionButton("Splitcolumn", "SplitColumn"),
selectInput(inputId='selectcolumn', label='select column', ''),
actionButton("deleteRows", "Delete Rows"),
textInput("textbox", label="Input the value to replace:"),
actionButton("replacevalues", label = 'Replace values'),
actionButton("removecolumn", "Remove Column")
),
mainPanel(
DTOutput("table1")
)
)
)
server <- function(session, input, output) {
rv <- reactiveValues(data = NULL)

observeEvent(input$file1, {
file <- input$file1
ext <- tools::file_ext(file$datapath)

req(file)

validate(need(ext == "csv", "Please upload a csv file"))

rv$data <- read.csv(file$datapath, header = input$header)

updateSelectInput(session, 'selectcolumn', 'select column', names(rv$data))

})

observeEvent(input$Splitcolumn, {
rv$data <- splitColumn(rv$data, input$selectcolumn)
})

observeEvent(input$deleteRows,{
if (!is.null(input$table1_rows_selected)) {
rv$data <- rv$data[-as.numeric(input$table1_rows_selected),]
}
})

output$table1 <- renderDT({
rv$data
})
observeEvent(input$replacevalues, {
rv$data <- fillvalues(rv$data, input$textbox, input$selectcolumn)
})
observeEvent(input$removecolumn, {
rv$data <- removecolumn(rv$data,input$selectcolumn)
})
}
shinyApp(ui, server)

Answer 1

我只是最小程度地更改了您的文件，但希望这能满足您的要求。我没有使用selectInput，而是使用了uiOutput并在其中放置了一个selectInput。这个新的selectInput中的选择直接使用了响应值。只要rv$data发生变化，它就会更新选择。由于这个更改，不需要updateSelectInput，所以我也删除了它。我相信你的代码没有像你想的那样工作的一个关键原因是你只在一个地方使用了updateSelectInput，即文件上传。这意味着无论何时删除或拆分列，都要更新reactiveValue，但它不会更新选择，因为reactiveValue本身没有绑定到selectInput。希望这能说得通!

library(shiny)
library(reshape2)
library(DT)
library(tibble)

###function for deleting the rows
splitColumn <- function(data, column_name) {
newColNames <- c("Unmerged_type1", "Unmerged_type2")
newCols <- colsplit(data[[column_name]], " ", newColNames)
after_merge <- cbind(data, newCols)
after_merge[[column_name]] <- NULL
after_merge
}
###_______________________________________________
### function for inserting a new column
fillvalues <- function(data, values, columName){
df_fill <- data
vec <- strsplit(values, ",")[[1]]
df_fill <- tibble::add_column(df_fill, newcolumn = vec, .after = columName)
df_fill
}
##function for removing the colum
removecolumn <- function(df, nameofthecolumn){
df[ , -which(names(df) %in% nameofthecolumn)]
}
### use a_splitme.csv for testing this program
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose CSV File", accept = ".csv"),
checkboxInput("header", "Header", TRUE),
actionButton("Splitcolumn", "SplitColumn"),
uiOutput("selectUI"),
actionButton("deleteRows", "Delete Rows"),
textInput("textbox", label="Input the value to replace:"),
actionButton("replacevalues", label = 'Replace values'),
actionButton("removecolumn", "Remove Column")
),
mainPanel(
DTOutput("table1")
)
)
)
server <- function(session, input, output) {
rv <- reactiveValues(data = NULL)

observeEvent(input$file1, {
file <- input$file1
ext <- tools::file_ext(file$datapath)

req(file)

validate(need(ext == "csv", "Please upload a csv file"))

rv$data <- read.csv(file$datapath, header = input$header)

})

output$selectUI<-renderUI({
req(rv$data)
selectInput(inputId='selectcolumn', label='select column', choices = names(rv$data))
})


observeEvent(input$Splitcolumn, {
rv$data <- splitColumn(rv$data, input$selectcolumn)
})

observeEvent(input$deleteRows,{
if (!is.null(input$table1_rows_selected)) {
rv$data <- rv$data[-as.numeric(input$table1_rows_selected),]
}
})

output$table1 <- renderDT({
rv$data
})
observeEvent(input$replacevalues, {
rv$data <- fillvalues(rv$data, input$textbox, input$selectcolumn)
})
observeEvent(input$removecolumn, {
rv$data <- removecolumn(rv$data,input$selectcolumn)
})
}
shinyApp(ui, server)