如何基于URL使用shiny.i18n实现Shiny应用语言切换？

我开发了一个Shiny应用，使用shiny.i18n包配合JSON翻译文件实现多语言支持，希望能通过URL自动切换应用语言。目前手动调用i18n$set_translation_language()可以切换语言，但通过URL判断设置语言时，只有服务端渲染的内容（如图表标题）完成切换，UI端的选项卡名称、输入标签等元素没有同步更新。

翻译文件（translate.json） #

{
  "languages": ["en", "fr"],
  "translation": [
    {
      "en": "Tab1",
      "fr": "This is tab 1"
    },
    {
      "en": "Tab2",
      "fr": "This is tab 2"
    },
    {
      "en": "My inputs",
      "fr": "This is my inputs"
    },
    {
      "en": "Cancel",
      "fr": "Cancel button"
    },
    {
      "en": "Subtab1",
      "fr": "This is subtab 1"
    },
    {
      "en": "Subtab2",
      "fr": "This is subtab 2"
    },
    {
      "en": "Title",
      "fr": "This is title"
    }
  ]
}

问题复现代码 #

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shiny.i18n)

i18n <- Translator$new(translation_json_path='translate.json')

get_user <- function(session) {
  isolate(session$clientData$url_hostname)
}

i18n$set_translation_language("en")

ui <- navbarPage(
  title = "Translation_test",
  position = "fixed-top",
  tabPanel(i18n$t("Tab1"),
           dashboardPage(
             options = list(sidebarExpandOnHover = TRUE), 
             
             dashboardHeader(disable = TRUE),
             dashboardSidebar(selectizeInput("input1",
                                             i18n$t("My inputs"),
                                             choices = c("Cylinders" = "cyl",
                                                         "Transmission" = "am",
                                                         "Gears" = "gear"),
             )
             ), 
             dashboardBody(
               fluidRow(4),
               fluidRow(4),
               tabsetPanel(
                 tabPanel(i18n$t("Subtab1"),plotOutput("plot"),
                          verbatimTextOutput("text"))
               )
             )
           )
  ) 
)


server <- function(input, output,session) {
  
  my_url_hostname <- isolate(as.character(get_user(session)))
  observe({
    if(my_url_hostname == "127.0.0.1"){
      i18n$set_translation_language("fr")
    }else{
      i18n$set_translation_language("en")
    }
  })
  
  output$plot <- renderPlot({
    plot(mtcars$wt, mtcars$mpg, main = i18n$t("Title"))
  })
  
  output$text <- renderText({
    isolate(session$clientData$url_hostname)
  })
}

shinyApp(ui = ui, server = server)

问题原因 #

• UI部分的i18n$t()调用是在应用启动时一次性静态渲染的，服务端后续修改i18n的语言设置无法触发UI元素的重新渲染。
• 服务端输出（如renderPlot中的图表标题）每次渲染都会重新调用i18n$t()，因此能响应语言变化，但静态UI元素不具备这种动态更新能力。

解决方案 #

方案1：初始化时根据URL设置语言（首次访问自动适配） #

这种方式在UI渲染前就根据URL确定语言，确保所有UI元素从一开始就使用正确的语言：

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shiny.i18n)

# 初始化翻译器
i18n <- Translator$new(translation_json_path='translate.json')

shinyApp(
  # 用函数式UI获取请求中的URL信息
  ui = function(request) {
    # 从request对象提取URL主机名
    url_hostname <- request$HTTP_HOST
    
    # 根据主机名设置目标语言
    target_lang <- if(grepl("127.0.0.1", url_hostname)) "fr" else "en"
    i18n$set_translation_language(target_lang)
    
    # 渲染带翻译的UI
    navbarPage(
      title = "Translation_test",
      position = "fixed-top",
      tabPanel(i18n$t("Tab1"),
               dashboardPage(
                 options = list(sidebarExpandOnHover = TRUE), 
                 
                 dashboardHeader(disable = TRUE),
                 dashboardSidebar(selectizeInput("input1",
                                                 i18n$t("My inputs"),
                                                 choices = c("Cylinders" = "cyl",
                                                             "Transmission" = "am",
                                                             "Gears" = "gear"),
                 )
                 ), 
                 dashboardBody(
                   fluidRow(4),
                   fluidRow(4),
                   tabsetPanel(
                     tabPanel(i18n$t("Subtab1"),plotOutput("plot"),
                              verbatimTextOutput("text"))
                   )
                 )
               )
      ) 
    )
  },
  server = function(input, output,session) {
    output$plot <- renderPlot({
      plot(mtcars$wt, mtcars$mpg, main = i18n$t("Title"))
    })
    
    output$text <- renderText({
      session$clientData$url_hostname
    })
  }
)

说明：

• 使用ui = function(request)的形式，让UI在每次请求时重新渲染，并能获取到请求中的URL信息。
• 适合用户首次访问时直接加载对应语言，若需在会话中更新语言，需刷新页面。

方案2：动态切换UI语言（会话内实时更新） #

如果需要在不刷新页面的情况下，随URL变化自动更新所有UI元素的语言，需使用update*系列函数手动更新UI文本：

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shiny.i18n)

i18n <- Translator$new(translation_json_path='translate.json')
i18n$set_translation_language("en")

ui <- navbarPage(
  id = "main_navbar",
  title = "Translation_test",
  position = "fixed-top",
  # 用固定ID代替初始翻译文本，后续动态更新
  tabPanel("tab1",
           dashboardPage(
             options = list(sidebarExpandOnHover = TRUE), 
             
             dashboardHeader(disable = TRUE),
             dashboardSidebar(selectizeInput("input1",
                                             label = "", # 初始空，后续更新
                                             choices = c("Cylinders" = "cyl",
                                                         "Transmission" = "am",
                                                         "Gears" = "gear"),
             )
             ), 
             dashboardBody(
               fluidRow(4),
               fluidRow(4),
               tabsetPanel(
                 id = "sub_tabset",
                 tabPanel("subtab1", plotOutput("plot"),
                          verbatimTextOutput("text"))
               )
             )
           )
  ) 
)

server <- function(input, output,session) {
  # 监听URL主机名变化
  observe({
    url_hostname <- session$clientData$url_hostname
    
    # 设置目标语言
    target_lang <- if(url_hostname == "127.0.0.1") "fr" else "en"
    i18n$set_translation_language(target_lang)
    
    # 更新主选项卡标题
    updateNavbarPage(session, "main_navbar",
                     tabPanel(title = i18n$t("Tab1"), value = "tab1"))
    
    # 更新输入框标签
    updateSelectizeInput(session, "input1",
                         label = i18n$t("My inputs"))
    
    # 更新子选项卡标题
    updateTabsetPanel(session, "sub_tabset",
                      tabPanel(title = i18n$t("Subtab1"), value = "subtab1"))
  })
  
  output$plot <- renderPlot({
    plot(mtcars$wt, mtcars$mpg, main = i18n$t("Title"))
  })
  
  output$text <- renderText({
    session$clientData$url_hostname
  })
}

shinyApp(ui = ui, server = server)

说明：

• 给所有需要更新的UI元素设置唯一id，方便通过update*函数修改文本。
• 通过observe监听URL变化，同步更新语言设置和所有UI元素的翻译文本。
• 支持会话内实时更新，但需要手动维护所有需翻译UI元素的更新逻辑。

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