Question

重现我的问题的步骤：

运行应用
在选项 2 中选择“D”
删除选项 1 中的“C”
在选项 1 中，将“B”拖到“A”前面

选择 1 有预选选项，而选择 2 默认为空白。

在选项 1 中进行选择时，该选项会从选项 2 的下拉列表中删除。

我希望能够对我的选择进行排序，但它们总是会回到原来的顺序。我如何防止这种情况发生？

library(shiny)
library(flexdashboard)

# UI ----------
ui <- fluidPage(
        uiOutput("Select1"),
        uiOutput("Select2"))

# Server -------------
server <- function(input, output, session) {
  vals <- reactiveValues(sel1 = character(),
                        sel2 = character())

observeEvent(input$Select1, {
    vals$sel1 = input$Select1
})

observeEvent(input$Select2, {
     vals$sel2 = input$Select2
})

  output$Select1 <- renderUI({

    letters = c("A", "B", "C", "D", "E", "F", "G")
    selected = c("A", "B", "C")

    if (length(vals$sel1) != 0 && vals$sel1 %in% letters) {
      selected = vals$sel1
    }

    selectizeInput('Select1', label = "Choice 1:",
                   multiple = TRUE,
                   choices = letters[!letters %in% input$Select2],
                   selected = selected,
                   options = list(plugins = list('remove_button', 'drag_drop')))

  })

  output$Select2 <- renderUI({

    letters = c("A", "B", "C", "D", "E", "F", "G")
    selected <- NULL

    if (length(vals$sel2) != 0 && vals$sel2 %in% letters) {
      selected = vals$sel2
    }

    selectizeInput('Select2', label = "choice 2:",
                   multiple = TRUE,
                   choices = letters[!letters %in% input$Select1],
                   selected = selected,
                   options = list(plugins = list('remove_button', 'drag_drop')))

  })
}

shinyApp(ui = ui, server = server)

在选定的周围使用isolate() 不起作用。我能够使用以下代码进行排序，但随后无法保留我的选择。

observeEvent(input$Select1, {
  # Allows reordering of columns
  if (!all(vals$sel1 %in% input$Select1)) {
    vals$sel1 = input$Select1
  }
})

observeEvent(input$Select2, {
  # Allows reordering of columns
  if (!all(vals$sel2 %in% input$Select2)) {
    vals$sel2 = input$Select2
  }
})

有人可以帮忙吗？

Answer 1

基本上，每次输入选择时都会重新创建 UI 元素，这会导致对选择进行排序。我个人可能会考虑使用 updateSelectizeInput，因为在服务器端动态渲染它们会破坏选择点。

话虽如此，您可以在代码中添加一个 req 语句，以防止动态 UI 重新渲染它们，除非实际更改了值（或者没有值可以覆盖初始渲染）

  output$Select1 <- renderUI({
    
    req(!all(vals$sel1 %in% input$Select1) | is.null(input$Select1), cancelOutput = TRUE)
    
    letters = c("A", "B", "C", "D", "E", "F", "G")
     ...<<other code>>...
    
  })
  
  output$Select2 <- renderUI({
    
    req(!all(vals$sel2 %in% input$Select2) | is.null(input$Select1), cancelOutput = TRUE)
    
    letters = c("A", "B", "C", "D", "E", "F", "G")
    
    ...<<other code>>...
    
  })

Answer 2

也许 orderInput() 包中的 shinyjqui 可能对您有用。请注意，如果在您的用例中，您在 select3 中有太多选择，您可能需要重新考虑。试试这个

library(shiny)
library(shinyjqui)

### UI ----------
ui <- fluidPage(

  orderInput(inputId = 'select1', 'Choice 1: ', items = LETTERS[1:3], connect = c("select3", "select2")),
  orderInput(inputId = 'select2', 'Choice 2: ', items = NULL, connect = c("select1", "select3"), placeholder = 'Drag item here...'),
  orderInput(inputId = 'select3', 'Choose items', items = LETTERS[4:7], connect = c("select1", "select2")),
  verbatimTextOutput("t1")

)

server <- function(input, output) {
  output$t1 <- renderPrint({input$select1})
}

shinyApp(ui, server)

保留 R Shiny 中 selectizeInput 选择的顺序

2 个答案: