Filter_loaded_trips

NAMESPACE

@@ -7,16 +7,24 @@ export(connect_stage_collections)
 export(convert_columns_to_datetime)
 export(convert_datetime_string_to_datetime)
 export(generate_trajectories)
+export(get_query_size)
 export(mod_mapview_ui)
 export(normalise_uuid)
 export(query_cleaned_locations)
+export(query_cleaned_locations_by_timestamp)
 export(query_cleaned_place)
 export(query_cleaned_section)
 export(query_cleaned_trips)
+export(query_cleaned_trips_by_timestamp)
+export(query_diary_summ)
+export(query_max_trip_timestamp)
+export(query_min_trip_timestamp)
 export(query_raw_trips)
 export(query_server_calls)
 export(query_stage_profiles)
 export(query_stage_uuids)
+export(query_usercache_get_summ)
+export(query_usercache_put_summ)
 export(run_app)
 export(save_config_file)
 export(summarise_server_calls)

R/app_server.R

@@ -10,6 +10,7 @@ app_server <- function(input, output, session) {
   # prepare data ------------------------------------------------------------
   cons <- connect_stage_collections(url = getOption("emdash.mongo_url"))
   data_r <- callModule(mod_load_data_server, "load_data_ui", cons)
+  data_geogr <- callModule(mod_load_trips_server, "load_trips_ui", cons)
 
   # Side bar ----------------------------------------------------------------
 
@@ -61,11 +62,15 @@ app_server <- function(input, output, session) {
     "ggplotly_ui_signup_trend",
     utils_plot_signup_trend(data_r$participants)
   )
-  callModule(
-    mod_ggplotly_server,
-    "ggplotly_ui_trip_trend",
-    utils_plot_trip_trend(data_r$trips)
-  )
+
+  observeEvent(data_geogr$click, {
+    callModule(
+      mod_ggplotly_server,
+      "ggplotly_ui_trip_trend",
+      utils_plot_trip_trend(data_geogr$trips)
+    )
+  })
+
   callModule(
     mod_ggplotly_server,
     "ggplotly_ui_participation_period",
@@ -101,7 +106,7 @@ app_server <- function(input, output, session) {
     }
     if (input$tabs == "trips") {
       data_esquisse$data <-
-        data_r$trips %>%
+        data_geogr$trips %>%
         drop_list_columns() %>%
         sf::st_drop_geometry()
     }
@@ -118,7 +123,7 @@ app_server <- function(input, output, session) {
   #
   # use these to generate lists of columns to inform which columns to remove
   # data_r$participants %>% colnames() %>% dput()
-  # data_r$trips %>% colnames() %>% dput()
+  # data_geogr$trips %>% colnames() %>% dput()
   # POSSIBLE LINE: allNames[!(allNames %in% config$column_names)]
   # cols_to_remove_from_participts_table <- c("first_trip_datetime",
   #                                            "last_trip_datetime")
@@ -129,8 +134,11 @@ app_server <- function(input, output, session) {
         dplyr::select(-dplyr::any_of(getOption("emdash.cols_to_remove_from_participts_table"))) %>%
         data.table::setnames(originalColumnNames, new_column_names, skip_absent = TRUE)
     )
+  })
+
+  observeEvent(data_geogr$click, {
     callModule(mod_DT_server, "DT_ui_trips",
-      data = data_r$trips %>%
+      data = data_geogr$trips %>%
         dplyr::select(-dplyr::any_of(getOption("emdash.cols_to_remove_from_trips_table"))) %>%
         sf::st_drop_geometry()
     )
@@ -142,10 +150,10 @@ app_server <- function(input, output, session) {
   # 1) which columns to remove in the map filter
   # 2) which columns to remove to pass to the map and show up in the map popups
 
-  # data_r$trips_with_trajectories %>% colnames() %>% dput()
+  # data_geogr$trips_with_trajectories %>% colnames() %>% dput()
 
   cols_to_include_in_map_filter <- reactive({
-    data_r$trips %>%
+    data_geogr$trips_with_trajectories %>%
       colnames() %>%
       # specify columns to remove here
       setdiff(c(
@@ -160,7 +168,7 @@ app_server <- function(input, output, session) {
     callModule(
       module = esquisse::filterDF,
       id = "filtering",
-      data_table = reactive(anonymize_uuid_if_required(data_r$trips)),
+      data_table = reactive(anonymize_uuid_if_required(data_geogr$trips_with_trajectories)),
       data_name = reactive("data"),
       data_vars = cols_to_include_in_map_filter, # the map filter uses start_fmt_time and end_fmt_time (UTC time)
       drop_ids = FALSE

R/app_ui.R

@@ -18,7 +18,8 @@ app_ui <- function(request) {
           menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
           menuItem("Tables", tabName = "tables", icon = icon("table")),
           menuItem("Maps", tabName = "maps", icon = icon("globe")),
-          mod_load_data_ui("load_data_ui")
+          mod_load_data_ui("load_data_ui"),
+          mod_load_trips_ui("load_trips_ui")
         )
       ),
       dashboardBody(

R/mod_ggplotly.R

@@ -22,6 +22,7 @@ mod_ggplotly_ui <- function(id) {
 #' @noRd
 mod_ggplotly_server <- function(input, output, session, a_ggplot, plotly.hovermode = NULL) {
   ns <- session$ns
+
   output$plot <- plotly::renderPlotly({
     if (!is.null(plotly.hovermode)) {
       return(

R/mod_load_data.R

@@ -28,46 +28,11 @@ mod_load_data_server <- function(input, output, session, cons) {
 
   observeEvent(input$reload_data,
     {
-      message("About to load trips")
-      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))
-      #       message("Finished loading locations")
-      #
-      #       message("About to create trajectories within trips")
-      #       data_r$trips_with_trajectories <- generate_trajectories(data_r$trips,
-      #         data_r$locations,
-      #         project_crs = get_golem_config("project_crs")
-      #       )
-      #       message("Finished creating trajectories within trips")
-
-      message("About to load participants")
-      data_r$participants <-
-        tidy_participants(query_stage_profiles(cons), query_stage_uuids(cons)) %>%
-        summarise_trips(., data_r$trips) %>%
-        summarise_server_calls(., data_r$server_calls)
-      message("Finished loading participants")
-
-      #       message("About to create trajectories within trips")
-      #       data_r$trips_with_trajectories <- generate_trajectories(data_r$trips,
-      #         data_r$locations,
-      #         project_crs = get_golem_config("project_crs")
-      #       )
-      #       message("Finished creating trajectories within trips")
-      #
       message("About to load participants")
       data_r$participants <-
         tidy_participants(query_stage_profiles(cons), query_stage_uuids(cons)) %>%
-        summarise_trips(., data_r$trips) %>%
-        summarise_server_calls(., data_r$server_calls)
+        summarise_trips_without_trips(., cons) %>%
+        summarise_server_calls(., cons)
       message("Finished loading participants")
 
       # output column names into R

R/mod_load_trips.R

@@ -0,0 +1,131 @@
+#' load_data UI Function
+#'
+#' @description A shiny Module.
+#'
+#' @param id,input,output,session Internal parameters for {shiny}.
+#'
+#' @noRd
+#'
+#' @importFrom shiny NS tagList
+mod_load_trips_ui <- function(id) {
+  ns <- NS(id)
+  cons <- connect_stage_collections(url = getOption("emdash.mongo_url"))
+
+  first_trip <- query_min_trip_timestamp(cons) %>%
+    lubridate::as_datetime(.) %>%
+    as.Date(.)
+  message(paste("First trip:", first_trip))
+
+  last_trip <- query_max_trip_timestamp(cons) %>%
+    lubridate::as_datetime(.) %>%
+    as.Date(.)
+  message(paste("Last trip: ", last_trip))
+
+  thirty_before_last_date <- last_trip - 30
+
+  tagList(
+    dateRangeInput(ns("dates"),
+      "Select the range of dates for trip data",
+      # start = "2016-01-05",
+      # end = "2016-01-05"),
+      start = thirty_before_last_date,
+      end = last_trip,
+      min = min(thirty_before_last_date, first_trip),
+      max = last_trip
+    ),
+    textOutput(ns("load_display")),
+    actionButton(inputId = ns("reload_trips"), label = "Reload trips data"),
+    textOutput(ns("last_load_datetime"))
+  )
+}
+
+#' load_data Server Function
+#'
+#' @noRd
+mod_load_trips_server <- function(input, output, session, cons) {
+  ns <- session$ns
+
+  # Add one day to the final date because we want the date range to include the final date.
+  # Converting these dates to timestamps gives us the timestamp at the beginning of the first user selected date,
+  # and the timestamp at the end of the second user selected date = timestamp for the day after.
+  # The timestamp for a given date is for the beginning of the day.
+  dates <- reactive(c(input$dates[1], input$dates[2] + 1))
+
+  load_allowed <- reactive({
+    message(
+      sprintf(
+        "The dates reactive values are: %s to %s",
+        dates()[1],
+        dates()[2]
+      )
+    )
+    window_width <-
+      difftime(dates()[2], dates()[1], units = "days") %>%
+      as.numeric()
+    message(sprintf("Window_width is %s days", window_width))
+
+    n_trips <- get_query_size(cons, dates())
+
+    if (window_width > getOption("emdash.max_windows_for_mod_load_trips")) {
+      return("The date range is too wide.")
+    }
+
+    if (is.null(n_trips)) {
+      return("No trips in the selected date range.")
+    }
+
+    TRUE
+  })
+
+  # When referring to reactives, remember to use parentheses
+  output$load_display <-
+    renderPrint(ifelse(isTRUE(load_allowed()), "", load_allowed()))
+
+  data_geogr <- reactiveValues(data = data.frame(), name = "data")
+
+  output$last_load_datetime <-
+    renderText(paste0("Last loaded: ", as.character(Sys.time())))
+
+  observeEvent(input$reload_trips,
+    {
+      message("Reload_trips observed")
+      if (isTRUE(load_allowed())) {
+        message("About to load trips")
+        data_geogr$trips <- query_cleaned_trips_by_timestamp(cons, dates()) %>%
+          tidy_cleaned_trips_by_timestamp() %>%
+          normalise_uuid() %>%
+          data.table::setorder(end_fmt_time) %>%
+          tidy_cleaned_trips(project_crs = get_golem_config("project_crs"))
+        message("Finished loading trips")
+
+        message("About to load locations")
+        data_geogr$locations <- tidy_cleaned_locations(query_cleaned_locations_by_timestamp(cons, dates()))
+        message("Finished loading locations")
+
+        message("About to create trajectories within trips")
+        data_geogr$trips_with_trajectories <- generate_trajectories(data_geogr$trips,
+          data_geogr$locations,
+          project_crs = get_golem_config("project_crs")
+        )
+        message("Finished creating trajectories within trips")
+
+        # output column names into R
+        # data_geogr$trips %>% colnames() %>% dput()
+        # data_geogr$participants %>% colnames() %>% dput()
+        # data_geogr$trips_with_trajectories %>% colnames() %>% dput()
+
+        data_geogr$click <- runif(1)
+      }
+    },
+    ignoreNULL = FALSE
+  )
+
+  message("Running: mod_load_data_server")
+  return(data_geogr)
+}
+
+## To be copied in the UI
+# mod_load_data_ui("load_data_ui_1")
+
+## To be copied in the server
+# callModule(mod_load_data_server, "load_data_ui_1")

R/run_app.R

@@ -24,15 +24,8 @@ run_app <- function(mongo_url, config_file, ...) {
     config_file <- app_sys("config-default.yml")
   }
   config <- config::get(file = config_file)
-
-  options(
-    "emdash.disp_signup_trend" = config$display_signup_trend,
-    "emdash.cols_to_remove_from_participts_table" = config$cols_to_remove_from_participts_table,
-    "emdash.cols_to_remove_from_trips_table" = config$cols_to_remove_from_trips_table,
-    "emdash.cols_to_remove_from_map_popup" = config$cols_to_remove_from_map_popup,
-    "emdash.col_labels_for_participts" = config$col_labels_for_participts,
-    "emdash.anon_locations" = config$anon_locations
-  )
+  names(config) <- paste0("emdash.", names(config))
+  options(config)
 
   app <- with_golem_options(
     app = shinyApp(