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

Question

我正在开发一个闪亮的应用程序，其中有 'SplitColumn'（用于拆分合并的列）、'Replace Values' 和 'Remove Column'。所有这些功能都依赖于选项（列名）中的“selection from'selectInput'列。

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

谁能帮我解决这个问题。

csv 数据

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

app.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)

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

how to dynamically update the column names in choices of SelectInput in R shiny

r

shiny

shinyapps

rshiny