Question

我有一个数据表，其日期列显示UTC时区。使用DT的最后一个开发版本，可以选择将日期列转换为区域设置字符串，一切都在闪亮的webapp中很好地显示。但是，如果用户将通过按钮扩展名下载表，则日期列将以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"。有没有可能的格式化出口？

Answer 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 进行改进。

使用下载按钮更新

如果您想通过按钮扩展程序下载与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的按钮扩展目前无法使用R自定义。使用 javascript 可以更改行为，您可以阅读关于API的here。

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

1 个答案:

使用输入

自动基于客户端计算机

使用下载按钮更新