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

Question

I have a datatable with date column that shows UTC timezone. Using last development version of DT one can choose to convert date column to locale string and everything shows nicely in shiny webapp. However, if user will download the table through Buttons extension, the date column will be exported in the UTC time zone (and unreadable format)

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)

So if local OS time zone is +5, it will show "23/08/2017 à 10:00:00" in a shiny webapp, but "2017-08-23T05:00:00Z" in excel file. Is there any possible way to format exports?

Answer 1

To achieve what you want, I propose two methods, both require you to transform the data set to the user's locale.

Using an input

In the same view as the table, provide a shiny input, which allows user selection of the locale. Use this value to transform the UTC entries.

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)

Automatically based on the client machine

This is more involved and relies on the answer to this question.

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 While the advantage of the automated option is that no user interaction is required, I have not tried to determine the Olson Name location of the client and therefore not resolving the time zone beyond a time offset from UTC . There are likely options available to improve using alternate javascript .

Update using download button

If you want to download something different to what is available in the DT::datatable via the Buttons extension, you have the option to use the standard downloadHandler and associated button. In the code below I demonstrate how you can combine your original code to display the table and offer a csv download of the data transformed to suit the client time zone offset shown in the previous two approaches.

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)

The Buttons extention for DT does not currently have the ability to be customised with R. Changing the behaviour may be possible with javascript , you can read here about the API.