Shiny DT：通过按钮扩展在 excel 中格式化日期列

Posted 2023-02-14

【中文标题】Shiny DT：通过按钮扩展在 excel 中格式化日期列

【英文标题】：Shiny DT: format date column in excel through Buttons extensions

【发布时间】：2018-05-13 23:08:25

【问题描述】：

我有一个包含显示 UTC 时区的日期列的数据表。 使用 DT 的最新开发版本，可以选择将日期列转换为区域设置字符串，并且在闪亮的 webapp 中一切都很好地显示。但是，如果用户通过 Buttons 扩展下载表格，则日期列将以 UTC 时区导出（并且格式不可读）

library(DT)
library(shiny)

df <- data.frame(a = 1:100, b = 1:100, 
             d=seq(as.POSIXct("2017-08-23 10:00:00"), as.POSIXct("2017-11-30 10:00:00"), by = "days"))

ui <- fluidPage(
  dataTableOutput("table")
)

server <- function(input, output)

  output$table <- DT::renderDataTable(
    datatable(df, 
              extensions = c("Buttons"), 
              options = list(dom = 'Bfrtip',
                             buttons = list("csv",list(extend='excel',filename="DF"))
              )) %>% formatDate(3, "toLocaleString", params = list('fr-FR'))
  )



shinyApp(ui, server)

因此，如果本地操作系统时区为 +5，它将在闪亮的 web 应用程序中显示 "23/08/2017 à 10:00:00"，但在 excel 文件中显示 "2017-08-23T05:00:00Z"。有没有办法格式化导出？

【参考方案1】：

为了实现你想要的，我提出了两种方法，都需要你将数据集转换为用户的语言环境。

使用输入

在与表格相同的视图中，提供闪亮的输入，允许用户选择区域设置。使用此值转换 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。

【讨论】：

太棒了！但问题在于它将日期类转换为字符串格式，这会导致闪亮应用中的过滤和排序出现问题。

@Asayat，没有获取客户端机器确切时区的功能（请参阅我的链接问题）。如果没有时区而只有偏移量，您可以显示为字符串，也可以接受存储为 UTC 的本地时间（我认为这具有误导性）。您可以继续使用原始代码在表格中显示，但要更改数据框以供下载，以获得两全其美的效果。否则，您将需要编写自定义 javascript，这超出了我的回答范围。

就是这样，恐怕我不确定如何仅通过使用闪亮的应用功能而不是 DT 的按钮扩展来变异下载。