如何调整R Shiny代码中left_join函数实现多格式葡萄牙语星期匹配

调整思路 #

• 先自动检测当前运行环境的星期表述格式，区分长葡萄牙语（带-feira后缀）、短葡萄牙语、英语三类
• 匹配对应格式的星期值作为最终展示的Week列内容，自动删除冗余的WeekP、WeekS列，实现两者互斥展示
• 排序逻辑同步适配当前环境的星期格式，保证排序和用户选择的日期范围顺序一致

完整修改后代码 #

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")),
                       date2 = as.Date(c("2021-10-18","2021-10-18","2021-10-28","2021-10-30")),
                       Week = c("Monday", "Monday", "Sunday", "Sunday"),
                       Category = c("FDE", "FDE", "FDE", "FDE"),
                       time = c(4, 6, 6, 3)), class = "data.frame",row.names = c(NA, -4L))

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", "terca-feira", "quarta-feira", "quinta-feira",  "sexta-feira", "sabado", "domingo"),
    WeekS = c("segunda", "terca", "quarta", "quinta", "sexta", "sabado", "domingo")
  )
  # 新增：自动检测当前系统星期表述格式
  wk_sample <- weekdays(Sys.Date())
  wk_type <- case_when(
    wk_sample %in% wk_port2eng$WeekP ~ "long_port",
    wk_sample %in% wk_port2eng$WeekS ~ "short_port",
    wk_sample %in% wk_port2eng$WeekE ~ "english",
    TRUE ~ "long_port"
  )
  
  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) | (wk_port2eng$WeekS %in% weeks_inp) | (wk_port2eng$WeekE %in% weeks_inp),]
    #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")) %>%      
      mutate(Week = case_when(
        wk_type == "long_port" ~ WeekP,
        wk_type == "short_port" ~ WeekS,
        wk_type == "english" ~ Week
      )) %>%
      arrange(match(Week, weekdays(input$daterange1))) %>%
      select(-WeekP, -WeekS)
  })
  
  output$table <- renderDataTable({
    data_subset()
  })
  
}

shinyApp(ui = ui, server = server)

核心修改点 #

• 新增了环境格式自动检测逻辑，无需手动切换配置即可适配本地、学习系统、服务器三类运行环境
• 调整了join后的字段处理逻辑，最终输出表仅保留1个星期列，和原有仅保留WeekP的逻辑完全一致
• 补充了英语环境的匹配规则，服务器运行时会自动展示英语星期，不会出现匹配失效问题

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