Shiny DT:excel中的格式日期列,通过按钮扩展名

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,它将显示"23/08/2017 à 10:00:00"在一个闪亮的webapp,但"2017-08-23T05:00:00Z"在excel文件中.有什么方法可以格式化出口吗？

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)

自动基于客户端机器

这涉及更多，并依赖于这个问题的答案。

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)

注意虽然自动选项的优点是不需要用户交互，但我没有尝试确定客户端的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)

该按钮为extentionDT目前没有能力与R.更改的行为可能与定制的JavaScript，你可以阅读这里关于API。