如何在R Shiny中保留selectizeInput的选择顺序？

云原生阿岚

2026-6-13

问题描述

我正在开发一个R Shiny应用，功能是让用户上传CSV文件，在第一个选项卡选择时间范围，第二个选项卡用selectizeInput()多选Y变量绘制堆叠图。数据表包含Time列和a、b、c、d四列，示例数据集如下：

library(data.table)
dt <- data.table(
  Time = as.POSIXct(c("2022-01-01 00:00", "2022-01-02 00:00", "2022-01-03 00:00", 
                      "2022-01-04 00:00", "2022-01-05 00:00", "2022-01-06 00:00", 
                      "2022-01-07 00:00", "2022-01-08 00:00", "2022-01-09 00:00", 
                      "2022-01-10 00:00", "2022-01-11 00:00", "2022-01-12 00:00", 
                      "2022-01-13 00:00", "2022-01-14 00:00")),
  a = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14),
  b = c(2, 4, 6, 8, 10, 12, 14, 16, 18, 20, 22, 24, 26, 28),
  c = c(4, 8, 12, 16, 20, 24, 28, 32, 36, 40, 44, 48, 52, 56),
  d = c(8, 16, 24, 32, 40, 48, 56, 64, 72, 80, 88, 96, 104, 112)
)

# 生成用于Shiny测试的CSV文件
dt[, Time := format(Time, "%Y-%m-%d %H:%M:%S")]
write.csv(dt, "file_for_shiny.csv", row.names = FALSE)

在Shiny环境外，我的plotly_stacked()函数会严格遵循传入的Y变量顺序：

plotly_stacked(dt, "Time", c("Time", "a", "b", "c"))会把a放在最上方，b在中间，c在最下方。
plotly_stacked(dt, "Time", c("Time", "b", "a", "c"))会把b放在最上方，a在中间，c在最下方。

但在Shiny应用中，当我用selectizeInput多选Y变量（比如先选b再选a）时，UI会自动把选择项按字母顺序重新排列成a、b，导致绘图顺序被打乱，忽略了用户的选择顺序。以下是最小可复现的Shiny应用，请上传生成的file_for_shiny.csv进行测试：

# === 全局选项与库加载 ===
options(shiny.maxRequestSize = 800 * 1024^2)
library(plotly)
library(shiny)
library(data.table)
library(tidyverse)
library(writexl)

# === 自定义绘图函数 ===
plotly_stacked <- function(df, x_colName, cols, xcol_time = FALSE) {
  f1 <- list(size = 12, color = "black")
  ax1 <- list(
    title = "", tickfont = f1, titlefont = f1, side = "bottom",
    showticklabels = TRUE, tickangle = 0, rangemode = "tozero", autotick = TRUE, dtick = 10000
  )
  
  DF <- df[, ..cols] %>%
    tidyr::gather(variable, value, -x_colName) %>%
    transform(id = as.integer(factor(variable)))
  DF$variable <- factor(DF$variable, levels = unique(DF$variable))
  
  while (any(is.na(DF$value))) {
    DF <- DF %>%
      group_by(variable) %>%
      mutate(value = ifelse(is.na(value), ifelse(is.na(lead(value)), lag(value), lead(value)), value)) %>%
      ungroup()
  }
  
  p <- plot_ly(
    data = DF, x = ~get(names(DF[1])), y = ~value, color = ~variable, colors = "Dark2",
    yaxis = ~paste0("y", sort(id, decreasing = FALSE))
  ) %>%
    add_lines() %>%
    layout(
      xaxis = ax1,
      legend = list(orientation = "h", xanchor = "center", x = 0.5)
    ) %>%
    plotly::subplot(nrows = length(unique(DF$variable)), shareX = TRUE, titleY = TRUE)
  
  labels <- c("xy", paste0("xy", 2:(length(cols) - 1)))
  labels_json <- jsonlite::toJSON(labels)
  js_code <- sprintf(
    'function(el, x){el.on("plotly_hover", function(d) {
      Plotly.Fx.hover(el.id, {xval: d.xvals[0]}, %s);
    })}', labels_json
  )
  
  p <- p |> layout(hovermode = "x") |> htmlwidgets::onRender(js_code)
  return(p)
}

# === UI定义 ===
ui <- fluidPage(
  tags$head(tags$style(".modebar { display: block !important; }")),
  titlePanel("TEST PLOTLY"),
  fileInput("file", "Choose CSV File", accept = c(".csv")),
  mainPanel(
    tabsetPanel(
      id = "tabsetPanelID",
      tabPanel(
        "Subset Data",
        fluidRow(
          column(
            4,
            selectizeInput("y_var", "Select Y Variable", choices = NULL),
            dateInput("start_date", "Start Date", format = "yyyy-mm-dd", value = "2022-01-02"),
            dateInput("end_date", "End Date", format = "yyyy-mm-dd", value = "2022-01-11")
          ),
          column(8, plotlyOutput("subset_plot"))
        )
      ),
      tabPanel(
        "Stacked Plots",
        fluidRow(
          column(
            4,
            uiOutput("ui_elements1")
          ),
          column(8, plotlyOutput("plot1"))
        )
      )
    )
  )
)

# === 服务器逻辑 ===
server <- function(input, output, session) {
  foo <- function() {
    req(input$file)
    df <- fread(input$file$datapath, na.strings = "empty")
    return(df)
  }
  
  data_full <- reactive({ foo() })
  
  observe({
    req(data_full())
    updateSelectizeInput(session, "y_var", choices = names(data_full())[-1])
  })
  
  data_subset <- reactive({
    req(data_full(), input$start_date, input$end_date)
    df <- data_full()
    df <- df[Time >= as.POSIXct(input$start_date) & Time <= as.POSIXct(input$end_date)]
    return(df)
  })
  
  selected_y_vars <- reactiveVal(NULL)
  
  observeEvent(input$y1, {
    selected_y_vars(input$y1)
  })
  
  output$subset_plot <- renderPlotly({
    req(data_full(), input$y_var)
    df <- data_full()
    plot_ly(data = df, x = ~Time, y = ~get(input$y_var), type = "scatter", mode = "lines") %>%
      layout(xaxis = list(title = "Time"), yaxis = list(title = input$y_var), dragmode = "select", hovermode = "x")
  })
  
  output$ui_elements1 <- renderUI({
    req(data_subset())
    choices <- names(data_subset())[-1]
    prev_selected <- selected_y_vars()
    valid_selections <- prev_selected[prev_selected %in% choices]
    
    tagList(
      h4("Select X and Y Datasets"),
      selectizeInput("x1", "X data", choices = names(data_subset()), selected = "Time"),
      selectizeInput("y1", "Y data", choices = choices, multiple = TRUE, selected = valid_selections)
    )
  })
  
  output$plot1 <- renderPlotly({
    req(data_subset(), input$x1, input$y1)
    plotly_stacked(df = data_subset(), x_colName = input$x1, cols = c(input$x1, input$y1))
  })
}

# === 运行应用 ===
shinyApp(ui = ui, server = server)

我已尝试的操作：

验证了plotly_stacked()在Shiny外会严格遵循cols参数的顺序。
推测selectizeInput在UI中会自动按字母排序选择项，但不确定如何禁用此行为。

核心问题：如何确保Shiny应用中的selectizeInput保留用户选择的顺序（比如先选b再选a时，绘图中b在上方、a在下方），而非按字母重新排序？

解决方案

要解决这个问题，需要从两个方面入手：禁用selectizeInput的自动排序功能，同时确保服务器端获取的选择顺序与用户操作一致。

1. 修改`selectizeInput`配置，禁用UI自动排序

在生成y1的selectizeInput时，添加options参数设置sortField = list(field = NULL)，阻止selectize自动按字母排序选择项，保留用户选择的显示顺序：

修改output$ui_elements1中的selectizeInput部分：

selectizeInput(
  "y1", 
  "Y data", 
  choices = choices, 
  multiple = TRUE, 
  selected = valid_selections,
  options = list(
    sortField = list(field = NULL),  # 禁用自动排序
    plugins = list('remove_button')  # 可选：保留移除按钮，提升用户体验
  )
)

2. 用JavaScript捕获真实选择顺序并传递给服务器

默认情况下，Shiny会将多选结果按字母排序后返回给服务器，即使UI显示的是用户选择的顺序。需要通过JavaScript捕获用户的实际选择顺序，再传递给服务器：

在UI的tags$head中添加自定义JS代码：

tags$head(
  tags$style(".modebar { display: block !important; }"),
  tags$script(HTML('
    $(document).on("shiny:connected", function() {
      // 监听y1的选择变化
      $("#y1").on("change", function() {
        // 获取用户选择的实际顺序
        var selectedOrder = $("#y1")[0].selectize.items;
        // 将顺序传递给服务器端的hidden_y_order输入
        Shiny.setInputValue("hidden_y_order", selectedOrder);
      });
    });
  '))
)

3. 服务器端使用真实选择顺序绘图

修改服务器端代码，用input$hidden_y_order替代input$y1获取用户选择的顺序，同时更新选择状态的监听逻辑：

server <- function(input, output, session) {
  # 其他代码保持不变...
  
  selected_y_vars <- reactiveVal(NULL)
  
  # 监听真实选择顺序的变化
  observeEvent(input$hidden_y_order, {
    selected_y_vars(input$hidden_y_order)
  })
  
  # 其他代码保持不变...
  
  output$plot1 <- renderPlotly({
    req(data_subset(), input$x1, input$hidden_y_order)
    # 使用用户选择的顺序调用绘图函数
    plotly_stacked(df = data_subset(), x_colName = input$x1, cols = c(input$x1, input$hidden_y_order))
  })
}

完整修改后的代码片段

UI部分：

ui <- fluidPage(
  tags$head(
    tags$style(".modebar { display: block !important; }"),
    tags$script(HTML('
      $(document).on("shiny:connected", function() {
        $("#y1").on("change", function() {
          var selectedOrder = $("#y1")[0].selectize.items;
          Shiny.setInputValue("hidden_y_order", selectedOrder);
        });
      });
    '))
  ),
  titlePanel("TEST PLOTLY"),
  fileInput("file", "Choose CSV File", accept = c(".csv")),
  mainPanel(
    tabsetPanel(
      id = "tabsetPanelID",
      tabPanel(
        "Subset Data",
        fluidRow(
          column(
            4,
            selectizeInput("y_var", "Select Y Variable", choices = NULL),
            dateInput("start_date", "Start Date", format = "yyyy-mm-dd", value = "2022-01-02"),
            dateInput("end_date", "End Date", format = "yyyy-mm-dd", value = "2022-01-11")
          ),
          column(8, plotlyOutput("subset_plot"))
        )
      ),
      tabPanel(
        "Stacked Plots",
        fluidRow(
          column(
            4,
            uiOutput("ui_elements1")
          ),
          column(8, plotlyOutput("plot1"))
        )
      )
    )
  )
)

服务器部分：

server <- function(input, output, session) {
  foo <- function() {
    req(input$file)
    df <- fread(input$file$datapath, na.strings = "empty")
    return(df)
  }
  
  data_full <- reactive({ foo() })
  
  observe({
    req(data_full())
    updateSelectizeInput(session, "y_var", choices = names(data_full())[-1])
  })
  
  data_subset <- reactive({
    req(data_full(), input$start_date, input$end_date)
    df <- data_full()
    df <- df[Time >= as.POSIXct(input$start_date) & Time <= as.POSIXct(input$end_date)]
    return(df)
  })
  
  selected_y_vars <- reactiveVal(NULL)
  
  observeEvent(input$hidden_y_order, {
    selected_y_vars(input$hidden_y_order)
  })
  
  output$subset_plot <- renderPlotly({
    req(data_full(), input$y_var)
    df <- data_full()
    plot_ly(data = df, x = ~Time, y = ~get(input$y_var), type = "scatter", mode = "lines") %>%
      layout(xaxis = list(title = "Time"), yaxis = list(title = input$y_var), dragmode = "select", hovermode = "x")
  })
  
  output$ui_elements1 <- renderUI({
    req(data_subset())
    choices <- names(data_subset())[-1]
    prev_selected <- selected_y_vars()
    valid_selections <- prev_selected[prev_selected %in% choices]
    
    tagList(
      h4("Select X and Y Datasets"),
      selectizeInput("x1", "X data", choices = names(data_subset()), selected = "Time"),
      selectizeInput(
        "y1", 
        "Y data", 
        choices = choices, 
        multiple = TRUE, 
        selected = valid_selections,
        options = list(
          sortField = list(field = NULL),
          plugins = list('remove_button')
        )
      )
    )
  })
  
  output$plot1 <- renderPlotly({
    req(data_subset(), input$x1, input$hidden_y_order)
    plotly_stacked(df = data_subset(), x_colName = input$x1, cols = c(input$x1, input$hidden_y_order))
  })
}

原理说明

sortField = list(field = NULL)：告知selectize不对选择项进行自动排序，保留用户选择的显示顺序。
自定义JS代码：通过selectize的API获取用户选择的真实顺序，再用Shiny.setInputValue传递给服务器，规避Shiny默认对多选结果按字母排序的问题。
服务器端使用传递的真实顺序调用绘图函数，确保绘图顺序与用户选择完全一致。

内容的提问来源于stack exchange，提问作者ACE

如何在R Shiny中保留selectizeInput的选择顺序？

1. 修改selectizeInput配置，禁用UI自动排序 #

2. 用JavaScript捕获真实选择顺序并传递给服务器 #

3. 服务器端使用真实选择顺序绘图 #

完整修改后的代码片段 #