Add support for displaying the server communication status as well (#17)

* Add support for displaying the server communication status as well

If we are not getting data from users, the reasons can be:
- problems with the sensing, or
- problems with the communication to the server

The current information in the dashboard shows how much data we have received,
but does not help with troubleshooting missing data.

With these new columns, we have additional information on when the users last
communicated with the server.

If the users have not communicated for a long time, the problem is likely to be with server communication.
If the users have been communicating regularly, but still don't have any data,
the problem is likely to be with sensing.

Co-authored-by: amarin <[email protected]>

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: emdash
 Title: e-mission dashboard built with the Shiny framework
-Version: 1.2.1
+Version: 1.2.2
 Authors@R: person('Amarin', 'Siripanich', email = '[email protected]', role = c('cre', 'aut'))
 Description: e-mission dashboard built with the Shiny framework
 License: MIT + file LICENSE

NAMESPACE

@@ -14,13 +14,16 @@ export(query_cleaned_place)
 export(query_cleaned_section)
 export(query_cleaned_trips)
 export(query_raw_trips)
+export(query_server_calls)
 export(query_stage_profiles)
 export(query_stage_uuids)
 export(run_app)
+export(summarise_server_calls)
 export(summarise_trips)
 export(tidy_cleaned_locations)
 export(tidy_cleaned_trips)
 export(tidy_participants)
+export(tidy_server_calls)
 import(data.table)
 import(mapview)
 import(shiny)

NEWS.md

@@ -1,6 +1,10 @@
+# emdash 1.2.2
+
+- Added support for displaying the server communication status on the participant table.
+
 # emdash 1.2.1
 
--  Hide the "source" column from the trip table and the map. 
+-  Hid the "source" column from the trip table and the map. 
 
 # emdash 1.2.0
 

R/mod_load_data.R

@@ -31,6 +31,10 @@ mod_load_data_server <- function(input, output, session, cons){
     data_r$trips <- tidy_cleaned_trips(query_cleaned_trips(cons), 
                                        project_crs = get_golem_config("project_crs"))
     message("Finished loading trips")
+
+    message("About to load server calls")
+    data_r$server_calls <- tidy_server_calls(query_server_calls(cons))
+    message("Finished loading server calls")
 
     message("About to load locations")
     data_r$locations <- tidy_cleaned_locations(query_cleaned_locations(cons))
@@ -45,7 +49,8 @@ mod_load_data_server <- function(input, output, session, cons){
     message("About to load participants")
     data_r$participants <- 
       tidy_participants(query_stage_profiles(cons), query_stage_uuids(cons)) %>%
-      summarise_trips(., data_r$trips)
+      summarise_trips(., data_r$trips) %>%
+      summarise_server_calls(., data_r$server_calls)
     message("Finished loading participants")
 
 

R/utils_query_database.R

@@ -16,6 +16,19 @@ query_cleaned_locations <- function(cons) {
     normalise_uuid()
 }
 
+#' @rdname query
+#' @export
+query_server_calls <- function(cons) {
+  # to implement later - query only for the API call patterns that are relevant
+  # the problem is that if there aren't any entries (might happen if the user
+  # has just signed up and not taken any trips), then numerous downstream calls fail
+  # Fixes for downstream calls are in a patch in the PR
+  # cons$Stage_timeseries$find('{"metadata.key": "stats/server_api_time", "data.name": {"$regex": "/usercache|get_complete_ts/", "$options": ""}}') %>%
+  cons$Stage_timeseries$find('{"metadata.key": "stats/server_api_time"}') %>%
+    as.data.table() %>%
+    normalise_uuid()
+}
+
 #' @rdname query
 #' @export
 query_cleaned_trips <- function(cons) {
@@ -74,6 +87,9 @@ query_stage_profiles <- function(cons) {
 #' @return a data.frame
 #' @export
 normalise_uuid <- function(.data, keep_uuid = FALSE) {
+  if (nrow(.data) == 0) {
+    return(.data);
+  }
   # return(.data)
   if (!is.data.table(.data)) {
     setDT(.data)

R/utils_tidy_data.R

@@ -161,6 +161,30 @@ summarise_trips = function(participants, trips) {
   merge(participants, summ_trips, by = "user_id", all.x = TRUE)
 }
 
+#' Create a summary of server calls in data.table format.
+#'
+#' @param participants the output from `tidy_participants()`.
+#' @param server_calls the output from `tidy_server_calls()`.
+#'
+#' @return a data.table.
+#' @export
+summarise_server_calls = function(participants, server_calls) {
+
+  summ_calls <-
+    server_calls %>%
+    data.table::setDT(.) %>%
+    .[, date := format(lubridate::as_datetime(ts), usetz = FALSE)] # adds the date of local datetime of trip
+
+  usercache_get_summ <- summ_calls %>% .[name == 'POST_/usercache/get', .(first_get_call = min(date), last_get_call = max(date)), by = user_id]
+  usercache_put_summ <- summ_calls %>% .[name == 'POST_/usercache/put', .(first_put_call = min(date), last_put_call = max(date)), by = user_id]
+  diary_summ <- summ_calls %>% .[name == 'POST_/pipeline/get_complete_ts', .(first_diary_call = min(date), last_diary_call = max(date)), by = user_id]
+
+  message("merging ")
+  # merge(participants, usercache_get_summ, usercache_put_summ, by = "user_id", all.x = TRUE)
+  merge(participants, usercache_get_summ, by = "user_id", all.x = TRUE) %>%
+   merge(., usercache_put_summ, by = "user_id", all.x = TRUE) %>%
+    merge(., diary_summ, by = "user_id", all.x = TRUE)
+}
 
 #' Tidy the 'cleaned locations' data.frame into a tibble.
 #'
@@ -184,6 +208,28 @@ tidy_cleaned_locations = function(cleaned_locations) {
   return(tidied_locations)
 }
 
+#' Tidy the 'server calls' data.frame into a tibble.
+#'
+#' @param server_calls a data.table output from `query_server_calls()`.
+#'
+#' @return a tibble.
+#' @export
+tidy_server_calls = function(server_calls) {
+  message("Finished query, about to tidy server calls")
+  tidied_server_calls =
+    # flatten out names and select specific columns
+    server_calls %>%
+    setnames(gsub("data.", "", names(.))) %>%
+    janitor::clean_names() %>%
+    dplyr::select(user_id, name, ts, reading) %>%
+    # convert datetime
+    dplyr::mutate(
+      fmt_time_utc = lubridate::as_datetime(ts)
+    )
+  message("Finished tidying server calls")
+  return(tidied_server_calls)
+}
+
 
 #' Tidy together the 'tidied trips' and 'tidied locations' to generate trajectories within a trip
 #'