为了实现你想要的，我提出了两种方法，都需要你将数据集转换为用户的语言环境。
使用输入
在与表格相同的视图中，提供闪亮的输入，允许用户选择区域设置。使用此值转换 UTC 条目。
library(DT)
library(shiny)
library(dplyr)
ui <- fluidPage(
selectInput(
"timezone", "Timezone",
choices = c("Europe/Paris", "America/Los_Angeles", "Australia/Sydney")
),
DT::dataTableOutput("table")
)
server <- function(input, output, session){
df <- data.frame(
a = 1:100,
b = 1:100,
d = seq(
as.POSIXct("2017-08-23 10:00:00", tz = "UTC"),
as.POSIXct("2017-11-30 10:00:00", tz = "UTC"),
by = "days")
)
df_locale <- reactive({
df %>%
mutate(
local = format(d, "%d %B %Y %I:%M:%S %p %Z", tz = input$timezone)
)
})
output$table <- DT::renderDataTable({
DT::datatable(
df_locale(),
extensions = 'Buttons',
options = list(
dom = 'Bfrtip',
buttons = list("copy", "csv", list(extend = "excel", filename = "DF"))
)
) %>%
formatDate(3, "toLocaleString", params = list("fr-FR"))
})
}
shinyApp(ui, server)
自动基于客户端机器
这涉及更多，并且依赖于this问题的答案。
library(DT)
library(shiny)
library(dplyr)
library(lubridate)
ui <- fluidPage(
HTML('<input type="text" id="client_time" name="client_time" style="display: none;"> '),
HTML('<input type="text" id="client_time_zone_offset" name="client_time_zone_offset" style="display: none;"> '),
tags$script('
$(function() {
var time_now = new Date()
$("input#client_time").val(time_now.getTime())
$("input#client_time_zone_offset").val(time_now.getTimezoneOffset())
});
'),
DT::dataTableOutput("table")
)
server <- function(input, output, session){
df <- data.frame(
a = 1:100,
b = 1:100,
d = seq(
as.POSIXct("2017-08-23 10:00:00", tz = "UTC"),
as.POSIXct("2017-11-30 10:00:00", tz = "UTC"),
by = "days")
)
client_time <- reactive({as.numeric(input$client_time) / 1000})
time_zone_offset <- reactive({-as.numeric(input$client_time_zone_offset) * 60})
df_locale <- reactive({
df %>%
mutate(
local = format(d + seconds(time_zone_offset()), "%d %B %Y %I:%M:%S %p")
)
})
output$table <- DT::renderDataTable({
DT::datatable(
df_locale(),
extensions = 'Buttons',
options = list(
dom = 'Bfrtip',
buttons = list("copy", "csv", list(extend = "excel", filename = "DF"))
)
) %>%
formatDate(3, "toLocaleString", params = list("fr-FR"))
})
}
shinyApp(ui, server)
NB 虽然自动选项的优点是不需要用户交互，但我没有尝试确定客户端的 Olson Name 位置，因此无法解析超出 UTC 时间偏移的时区。使用备用 javascript 可能有一些可供改进的选项。
使用下载按钮更新
如果您想通过 Buttons 扩展下载与 DT::datatable 中可用的内容不同的内容，您可以选择使用标准的 downloadHandler 和相关按钮。在下面的代码中，我演示了如何结合原始代码来显示表格并提供 csv 下载数据，以适应前两种方法中显示的客户端时区偏移量。
library(DT)
library(shiny)
library(dplyr)
library(readr)
library(lubridate)
ui <- fluidPage(
HTML('<input type="text" id="client_time" name="client_time" style="display: none;"> '),
HTML('<input type="text" id="client_time_zone_offset" name="client_time_zone_offset" style="display: none;"> '),
tags$script('
$(function() {
var time_now = new Date()
$("input#client_time").val(time_now.getTime())
$("input#client_time_zone_offset").val(time_now.getTimezoneOffset())
});
'),
downloadButton("download_data", "Get Data"),
DT::dataTableOutput("table")
)
server <- function(input, output, session){
df <- data.frame(
a = 1:100,
b = 1:100,
d = seq(
as.POSIXct("2017-08-23 10:00:00", tz = "UTC"),
as.POSIXct("2017-11-30 10:00:00", tz = "UTC"),
by = "days")
)
client_time <- reactive({as.numeric(input$client_time) / 1000})
time_zone_offset <- reactive({-as.numeric(input$client_time_zone_offset) * 60})
df_locale <- reactive({
df %>%
mutate(
d = format(d + seconds(time_zone_offset()), "%d %B %Y %I:%M:%S %p")
)
})
output$download_data <- downloadHandler(
filename <- function() {
paste0(format(Sys.Date(), "%Y%m%d"), "-data.csv")
},
content <- function(file) {
write_csv(df_locale(), file)
},
contentType = "text/csv"
)
output$table <- DT::renderDataTable({
DT::datatable(df) %>%
formatDate(3, "toLocaleString")
})
}
shinyApp(ui, server)
DT 的 Buttons 扩展目前无法使用 R 进行自定义。可以使用 javascript 更改行为，您可以阅读 @987654322 @关于 API。