Shiny场景下DT输出表格周日期排序错误问题咨询

该问题与现有StackOverflow相关问题逻辑相似，但对应解决方案仅在脱离Shiny环境运行时生效，在Shiny框架内无法正常生效。
需排查表格生成顺序错误的原因：当前需求为展示11/07（周日）至11/13（周六）的周维度数据，预期表格按周日到周六的顺序排列，但实际输出的表格顺序不符合要求。
可复现问题的完整可执行代码如下：

library(shiny)
library(shinythemes)
library(dplyr)
library(DT)


Test <- structure(list(date1 = as.Date(c("2021-11-01","2021-11-01","2021-11-01","2021-11-01","2021-11-01","2021-11-01","2021-11-01")),
                      date2 = as.Date(c("2021-10-18","2021-10-19","2021-10-20","2021-10-21","2021-10-22","2021-10-23","2021-10-24")),
                       Week = c("Monday", "Tuesday", "Wednesday", "Thursday","Friday","Saturday","Sunday"),
                      Category = c("FDE", "FDE", "FDE", "FDE","FDE","FDE","FDE"),
                       time = c(4, 6, 3, 2,3,3,4)), class = "data.frame",row.names = c(NA, -7L))


ui <- fluidPage(
    
    shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                      br(),
                      tabPanel("",
                               sidebarLayout(
                                   sidebarPanel(
                                       uiOutput('daterange')
                                   ),
                                   mainPanel(
                                       dataTableOutput('table')
                                       
                                   )
                               ))
    ))

server <- function(input, output,session) {
  
  data <- reactive(Test)
  
  output$daterange <- renderUI({
    dateRangeInput("daterange1", "Period you want to see:",
                   min   = min(data()$date1))
  })
  
  observe({updateDateRangeInput(session,"daterange1",start = NA, end = NA)})
  
  wk_port2eng <- data.frame(
    WeekE = c("Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"),
    WeekP = c("segunda-feira", "terça-feira", "quarta-feira", "quinta-feira",  "sexta-feira", "sábado", "domingo")
  )
  
  data_subset <- reactive({
    req(input$daterange1)
    req(input$daterange1[1] <= input$daterange1[2])
    days <- seq(input$daterange1[1], input$daterange1[2], by = 'day')
    Test1 <- dplyr::filter(data(), date1 %in% days)
    weeks_inp <- unique(weekdays(days))  
    wk <- wk_port2eng[wk_port2eng$WeekP %in% weeks_inp,]  ###  if weekday is in Portuguese in your notebook
    #wk <- wk_port2eng[wk_port2eng$WeekE %in% weeks_inp,]  ###  if weekday is in English in your notebook
    
    weeks_ine <- wk$WeekE
    meanTest1 <- data() %>%
      group_by(Week = tools::toTitleCase(Week), Category) %>% 
      summarise(mean = mean(time, na.rm = TRUE), .groups = 'drop')
    meanTest <- meanTest1[meanTest1$Week %in% as.character(weeks_ine),]
    left_join(meanTest, wk_port2eng, by = c("Week" = "WeekE")) %>%      
    arrange(match(WeekP, weekdays(input$daterange1))) %>%
    arrange(lubridate::wday(data()$date2))%
    select(-WeekP)
    
  })
  
  output$table <- renderDataTable({
    data_subset()
  })
  
}

shinyApp(ui = ui, server = server)

输出表格截图：

错误原因 #

• 重复调用arrange()：后执行的排序规则会覆盖前序规则，代码中同时匹配葡萄牙语星期排序和date2列的星期排序，逻辑冲突导致排序失效
• 排序参考对象错误：lubridate::wday(data()$date2)参考的是测试数据中date2列的历史日期星期，与实际要展示的用户选择日期区间的星期规则无关
• match匹配逻辑错误：weekdays(input$daterange1)仅返回起止两个日期的星期，无法覆盖整周7天的排序规则，匹配返回的顺序不符合预期

修复方案 #

修改data_subset响应式函数中的排序逻辑，通过固定星期的因子水平控制排序顺序，不依赖动态日期或系统语言返回值，修复后的核心逻辑为：

left_join(meanTest, wk_port2eng, by = c("Week" = "WeekE")) %>%      
  # 定义周日到周六的固定排序顺序
  mutate(Week = factor(Week, levels = c("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday"))) %>%
  arrange(Week) %>%
  select(-WeekP)

修复后不管是Shiny环境还是本地运行，都会严格按照周日到周六的顺序输出表格，不受系统语言、日期区间选择的影响。

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