使用 insertUI 方法创建不同的闪亮小部件

我有下面的闪亮应用程序，用户可以在数据框中选择一个或多个列名称。

name<-c("John","Jack","Bill")
value1<-c(2,4,6)
add<-c("SDF","GHK","FGH")
value2<-c(3,4,5)
dt<-data.frame(name,value1,add,value2)

然后对于每一个选择，他都会做出相对的pickerInput()可能会显示在下面。也许我可以用if对于每种情况，但问题是我的真实数据集可能要大得多，并且每次都有不同的列名称，所以我正在寻找一种方法来立即连接pickerInput()创建亲属时选择的名称pickerInput()其中将包括列值。例如，如果有人选择所有 4 个列名称 4pickerInput()应使用相对列名称作为标签来创建。

我的方法是insertUI方法，但我必须找到一种方法来创建每次都有不同选择和标签的小部件，并在取消选择第一个的相对值时将其删除pickerInput().

library(shiny)
library(shinyWidgets)
library(DT)
# ui object
ui <- fluidPage(
    titlePanel(p("Spatial app", style = "color:#3474A7")),
    sidebarLayout(
        sidebarPanel(
            pickerInput(
                inputId = "p1",
                label = "Select Column headers",
                choices = colnames( dt),
                multiple = TRUE,
                options = list(`actions-box` = TRUE)
            )

            
        ),
        
        mainPanel(
        )
    )
)

# server()
server <- function(input, output) {
    
    observeEvent(input$p1, {
        insertUI(
            selector = "#p1",
            where = "afterEnd",
            ui = pickerInput(
                inputId = #The colname of selected column
                    ,
                label = #The colname of selected column
                    ,
                choices = #all rows of selected column
                    ,
                multiple = TRUE,
                options = list(`actions-box` = TRUE)
            )
        )
    })

    
    
    
}

# shinyApp()
shinyApp(ui = ui, server = server)

我真的不喜欢使用lapply创建闪亮的输入元素，因为当您添加元素时，现有（选定）输入的输入 UI 会被覆盖，因此所有内容都会设置回默认值，并且之前为这些输入选择的值会丢失。

您可以配对insertUI with removeUI和一个变量来跟踪先前选择的列。然后您可以动态添加/删除 UI 元素并保持其他输入不变。

library(shiny)
library(shinyWidgets)
library(DT)

name<-c("John","Jack","Bill")
value1<-c(2,4,6)
add<-c("SDF","GHK","FGH")
value2<-c(3,4,5)
dt<-data.frame(name,value1,add,value2)

# ui object
ui <- fluidPage(
  titlePanel(p("Spatial app", style = "color:#3474A7")),
  sidebarLayout(
    sidebarPanel(
      pickerInput(
        inputId = "p1",
        label = "Select Column headers",
        choices = colnames( dt),
        multiple = TRUE,
        options = list(`actions-box` = TRUE)
      ),
      tags$div(id = "add_ui_here")
      
      
    ),
    
    mainPanel(
    )
  )
)

# server()
server <- function(input, output) {
  
  # store currently selected columns
  selected_columns <- c()
  
  observeEvent(input$p1, {
    
    # determine pickerInputs to remove
    input_remove <- !selected_columns %in% input$p1
    input_remove <- selected_columns[input_remove]
    
    # remove inputs
    if (!is.null(input_remove) && length(input_remove) > 0) {
      for (input_element in input_remove) {
        removeUI(selector = paste0("#", input_element, "_remove_id"))
      }
    }
    
    # determine pickerInputs to add
    input_add <- !input$p1 %in% selected_columns
    input_add <- input$p1[input_add]
    
    # add inputs
    if (length(input_add) > 0) {
      for (input_element in input_add) {
        insertUI(
          selector = "#add_ui_here",
          where = "afterEnd",
          ui = tags$div(id = paste0(input_element, "_remove_id"),
                        pickerInput(
                          inputId = input_element
                          ,
                          label = input_element
                          ,
                          choices = dt[, input_element]
                          ,
                          multiple = TRUE,
                          options = list(`actions-box` = TRUE)
                        ))
        )
      }
    }
    
    # update the currently stored column variable
    selected_columns <<- input$p1
  },
  ignoreNULL = FALSE)
  
  
  
  
}

# shinyApp()
shinyApp(ui = ui, server = server)

我已经包裹好插入的pickerInputs in a div，因此更容易删除它们。另外，你需要设置ignoreNULL = FALSE对于观察者来说，如果所有元素都被取消选择，它也会被触发。