How to Retrieve the Client's Current Time and Time Zone When Using Shiny

  • Home
  • Languages
  • R
  • How to Retrieve the Client's Current Time and Time Zone When Using Shiny

How to retrieve the client's current time and time zone when using Shiny?

I found out a method that works and which is just a small modification of the stackoverflow answer to Reading javascript variable into shiny/R on app load. It does not retrieve the actuall time zone, but well the time zone offset.

In ui.R

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())
  });    
')

This above created two divs and the javascript code retrieves the clients time and time zone offset and put them in the divs.

In server.R

client_time <- reactive(as.numeric(input$client_time) / 1000) # in s
time_zone_offset <- reactive(as.numeric(input$client_time_zone_offset) * 60 ) # in s

This above creates two reactive variables that can be used in the server code. For ease of handling I also transform input$client_time from ms to s and input$client_time_zone_offset from min to s.

Get the user's current date and time in R/Shiny

There are a couple solutions that people have found to this (for example, here), and they all have particular advantages. Since you're looking to use it as the default value in a textInput, this solution that I've adopted for a similar need may work well for you. It involves reading the client's browser time using some JS, assigning that as the default value in a textInput, and then using that textInput later in the server. In my application, I'm using this to timestamp data submissions from the user.

In the UI, you need the follow JS script just before your textInput:

tags$script('
          $(document).ready(function(){
          var d = new Date();
          var target = $("#clientTime");
          target.val(d.toLocaleString());
          target.trigger("change");
          });
          '),
textInput("clientTime", "Client Time", value = "")

As suggested in the comments, session$userData can be used to store session-specific data such as input$clientTime for use and manipulation in the server. Below is a complete app showing the difference between the server time and the client time, but you'll obviously need to publish it to a server in order to see the difference.

library(shiny)

ui <- fluidPage(
  verbatimTextOutput("server"),
  tags$script('
          $(document).ready(function(){
          var d = new Date();
          var target = $("#clientTime");
          target.val(d.toLocaleString());
          target.trigger("change");
          });
          '),
  textInput("clientTime", "Client Time", value = ""),
  verbatimTextOutput("local")
)

server <- function(input, output, session) {

  output$server <- renderText({ c("Server time:", as.character(Sys.time()), as.character(Sys.timezone())) })
  session$userData$time <- reactive({format(lubridate::mdy_hms(as.character(input$clientTime)), "%d/%m/%Y; %H:%M:%S")})
  output$local <- renderText({session$userData$time() })

}

shinyApp(ui = ui, server = server)

How to set dateInput maximum to client current date?

You can use the same idea as the first answer in the link you posted and use updateDateInput in the server.R to get the client's date and change the max of your dateInput:

shinyApp(
  ui=fluidPage(
    HTML('<input type="text" id="client_time" name="client_time" style="display: none;" > '),
    tags$script('
    $(function() {
     var time_now = new Date()
     var month_now=time_now.getMonth()+1
      $("input#client_time").val(time_now.getFullYear()+"-"+month_now+"-"+time_now.getDate())
  });    
'),
    dateInput("date","Choose a date",max=Sys.Date()),
    textOutput("text")
  ),server = function(input, output,session) {
    observe({
    updateDateInput(session,"date", value = as.Date(input$client_time), max = as.Date(input$client_time))
    })
    output$text=renderText(as.character(input$date))
  }
)

In Shiny for R, why does Sys.Date() return yesterday's date inside a dateInput?

That does sound weird. I am just starting on Shiny so do not know for sure.

COULD IT BE

  1. Timezone?? Maybe Sys.timezone() is different on their servers?

    Have you tried formatting the date for your timezone?

  2. Caching problem??

    Could the value be cached from an old instance? But I take it you are running this within your Shinyserver{ ... code} not above. Try a rebuild in the Dashboard?

BUT HERE IS SOLUTION

Set value to NULL (see helpfile)

value The starting date. Either a Date object, or a string in yyyy-mm-dd format. If NULL (the default), will use the current date in the client's time zone.

It will default to your date in your timezone.

dateInput("asOfDateTime", label = "As Of", 
                                    value = NULL, max = Sys.Date())

gave me today's date

ShinyDateInputEG

Shiny DT: format date column in excel through Buttons extensions

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)

N.B. 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.

In Shiny for R, why does Sys.Date() return yesterday's date inside a dateInput?

That does sound weird. I am just starting on Shiny so do not know for sure.

COULD IT BE

  1. Timezone?? Maybe Sys.timezone() is different on their servers?

    Have you tried formatting the date for your timezone?

  2. Caching problem??

    Could the value be cached from an old instance? But I take it you are running this within your Shinyserver{ ... code} not above. Try a rebuild in the Dashboard?

BUT HERE IS SOLUTION

Set value to NULL (see helpfile)

value The starting date. Either a Date object, or a string in yyyy-mm-dd format. If NULL (the default), will use the current date in the client's time zone.

It will default to your date in your timezone.

dateInput("asOfDateTime", label = "As Of", 
                                    value = NULL, max = Sys.Date())

gave me today's date

ShinyDateInputEG

Reading javascript variable into shiny/R on app load

Erik Westlund was kind enough to provide the following solution.


get_user_id.js:

document.domain = "MYDOMAIN.com"; 

var userIDVariableName = parent.userID; 
var userID = document.getElementById("userID"); 
userID.value = userIDVariableName; 

var usernameVariableName = parent.username; 
var username = document.getElementById("username"); 
username.value = usernameVariableName;

As mentioned above remember to change the domain. And set it in the page loading the iframe.


ui.R:

library(shiny) 

shinyUI( bootstrapPage( 

# Hidden input boxes to save the variable to 
HTML(‘ <input type="text" id="userID" name="userID" style="display: none;"> ‘), 
HTML(‘ <input type="text" id="username" name="username" style="display: none;"> ‘), 

# include the js code 
includeScript("get_user_id.js"), 

# Show the output 
textOutput("view") 
))

Change the path to the script as needed.


server.R:

shinyServer(function(input, output, session) { 

userID <- reactive({ input$userID }) 
username <- reactive({ input$username }) 

output$view <- renderText( paste0( "User ID is: ",userID()," and username is: ",username() ) ) 

})


Add this to the page containing the iframe:

PHP to get the variable from wordpress.

<?php global $current_user; 
get_currentuserinfo(); 
$user_name = $current_user->user_login; 
$user_ID = get_current_user_id(); 
?>

And then this to make it a java variable:

<script type="text/javascript"> 
var username = <?php echo json_encode($user_name) ?> ; 
var userID = <?php echo json_encode($user_ID) ?> ; 
</script>

Set domain and the iframe:

<script type="text/javascript"> 
document.domain = "MYDOMAIN.com"; 
</script> 
<iframe id="example1" style="border: none; width: 100%; height: 500px;" src="PATH_TO_SHINY_APP" width="300" height="150" frameborder="0"></iframe>

Return default value for SelectInput matching current date

I would order the data when the app is loaded. And render the select input accordingly.

library(shiny)
shinyApp(
    shinyUI(
        fluidPage(
            uiOutput('getter'),
            actionButton('submit', 'SUBMIT')
        )
    ),
    shinyServer(function(input, output, session) {
        today <- Sys.Date()
        dat <- reactive({
            ind <- match(today, as.Date(df1$date), FALSE)
            if (ind) df1[c(ind, seq_len(nrow(df1))[-ind]), ]
            else df1
        })

        output$getter <- renderUI({
            selectInput('get.id', label="ID NUMBER", choices=as.character(dat()$date))
        })
    })
)

Alternatively, you could keep the choices as a reactive and use

choices <- reactive({
    ind <- match(today, as.Date(df1$date), FALSE)
    if (ind) df1$date[c(ind, seq_len(nrow(df1))[-ind])]
    else df1$date
})

output$getter <- renderUI({
    selectInput('get.id', label="ID NUMBER", choices=as.character(choices()))
})

interactive shiny global date picker

The issue here is that you're never calling that reactive object. In server, you'd have to do something like:

shinyApp(ui, server = function(input, output) {
  observeEvent(input$date2, {x <<- input$date2})
})

This way, a change in input$date2 will trigger the global assignment of x.


Related Topics

Adding a Simple Lm Trend Line to a Ggplot Boxplot

How to Account for Leap Years

Ping a Website in R

Dplyr - Mutate Dynamically Named Variables Using Other Dynamically Named Variables

Fuzzy Matching in R

Find Matches of a Vector of Strings in Another Vector of Strings

Using Variable Value as Column Name in Data.Frame or Cbind

Replace Na with Previous and Next Rows Mean in R

How to Use Tidyr to Fill in Completed Rows Within Each Value of a Grouping Variable

Filling Under the a Curve with Ggplot Graphs

Importing Data into R (Rdata) from Github

Insert Missing Time Rows into a Dataframe

How to See All Rows of a Data Frame in a Jupyter Notebook with an R Kernel

Removing Particular Character in a Column in R

Extract Date from Given String in R

How to Plot a List of Vectors with Different Lengths

Convert a Mm-Yy String "Jan-01" into Date Format

Convert from K to Thousand (1000) in R


Leave a reply



Submit