Facilitate (public) spaces that are not tight to an individual

.github/workflows/r_new.yml

@@ -6,7 +6,7 @@ on:
   pull_request:
     branches: [main, master]
 
-name: R-CMD-check-new
+name: R-CMD-check
 
 jobs:
   R-CMD-check:
@@ -18,7 +18,7 @@ jobs:
       fail-fast: false
       matrix:
         config:
-          - {os: macOS-latest,   r: 'release'}
+          - {os: macos-latest,   r: 'release'}
           - {os: windows-latest, r: 'release'}
           - {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
           - {os: ubuntu-latest,   r: 'release'}
@@ -29,10 +29,9 @@ jobs:
       R_KEEP_PKG_SOURCE: yes
 
     steps:
-      - uses: actions/checkout@v2
-
+      - uses: actions/checkout@v3
+      - uses: r-lib/actions/setup-tinytex@v2
       - uses: r-lib/actions/setup-pandoc@v2
-
       - uses: r-lib/actions/setup-r@v2
         with:
           r-version: ${{ matrix.config.r }}
@@ -41,7 +40,7 @@ jobs:
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          extra-packages: any::rcmdcheck, any::XML
+          extra-packages: any::rcmdcheck
           needs: check
 
       - uses: r-lib/actions/check-r-package@v2

NAMESPACE

@@ -19,7 +19,6 @@ importFrom(geosphere,distGeo)
 importFrom(purrr,reduce)
 importFrom(readr,read_csv)
 importFrom(readr,write_csv)
-importFrom(rlang,UQ)
 importFrom(rlang,parse_expr)
 importFrom(stats,as.formula)
 importFrom(stats,end)

R/build_days.R

@@ -24,25 +24,27 @@
 #'
 #' @import dplyr
 #' @import sf
-#' @importFrom rlang parse_expr UQ
+#' @importFrom rlang parse_expr
 #' @importFrom purrr reduce
 #'
 #' @export
 # Code modified from https://thets.github.io/palmsplusr/
 build_days <- function(data = NULL, verbose = TRUE, 
-                           palmsplus_domains = NULL,
-                           palmsplus_fields = NULL,
-                           loca = NULL,
-                           participant_basis = NULL) {
+                       palmsplus_domains = NULL,
+                       palmsplus_fields = NULL,
+                       loca = NULL,
+                       participant_basis = NULL) {
   # Note:
   # home, school, home_nbh, school_nbh (or similar) need to be present, 
   # because the functions that are passed on assume that they exist
   # So, now we need to create those objects from object loca
   Nlocations = length(loca)
   identifier = NULL
   for (i in 1:Nlocations) {
-    txt = paste0(names(loca[[i]])[1], " = loca[[i]][[1]]")
-    eval(parse(text = txt))
+    for (j in 1:2) {
+      txt = paste0(names(loca[[i]])[j], " = loca[[i]][[j]]")
+      eval(parse(text = txt))
+    }
   }
 
   duration = datetime = name = domain_field = NULL
@@ -58,32 +60,50 @@ build_days <- function(data = NULL, verbose = TRUE,
   domain_args <- setNames("1", "total") %>% lapply(parse_expr)
   domain_args <- c(domain_args, setNames(domain_fields[[2]], domain_fields[[1]]) %>%
                      lapply(parse_expr))
-
   data <- data %>%
     mutate(!!! domain_args) %>%
     mutate_if(is.logical, as.integer)
 
   fields <- palmsplus_fields %>% filter(domain_field == TRUE) %>% pull(name)
 
-    data <- data %>%
+  data <- data %>%
     st_set_geometry(NULL) %>%
     dplyr::select(identifier, datetime, any_of(domain_names), all_of(fields)) %>%
     mutate(duration = 1) %>%
     mutate_at(vars(-identifier,-datetime), ~ . * palms_epoch(data) / 60) %>%
     group_by(identifier, date = as.Date(datetime)) %>%
     dplyr::select(-datetime)
-
+  
   x <- list()
   for (i in domain_names) {
     x[[i]] <- data %>%
-      filter(UQ(as.name(i)) > 0) %>%
-      dplyr::select(-one_of(domain_names), duration) %>%
+      filter(!!(as.name(i)) > 0) %>%
+      dplyr::select(-any_of(domain_names), duration) %>%
       summarise_all(~ sum(.)) %>%
       ungroup() %>%
       rename_at(vars(-identifier, -date), ~ paste0(i, "_", .))
   }
 
   result <- x %>%
     reduce(left_join, by = c("identifier" = "identifier", "date" = "date"))
+
+  # Count the number of segments per domain per day per identifier
+  segmentcount = function(x) {
+    x = as.numeric(unlist(x)) # x is a tibble column, so first convert to numeric vector
+    return(length(which(rle(x)$values != 0)))
+  }
+
+  for (dom in domain_names) {
+    if (dom != "total") {
+      result[, dom] <- NA
+      for (id in unique(result$identifier)) {
+        for (date in as.Date(unique(result$date[which(result$identifier == id)]))) {
+          CNT = segmentcount(data[which(data$identifier == id & data$date == date), dom])
+          result[which(result$identifier == id & result$date == date), dom] = CNT
+        }
+      }
+      names(result)[which(names(result) == dom)] = paste0(dom, "_segmentcount")
+    }
+  }
   return(result)
 }

R/build_multimodal.R

@@ -152,9 +152,9 @@ build_multimodal <- function(data = NULL,
       group_by(identifier, mmt_number) %>%
       summarise(start_trip = first(tripnumber),
                 end_trip = last(tripnumber),
-                trip_numbers = paste0(tripnumber, collapse = "-"),
+                trip_numbers = paste0(tripnumber, collapse = ">"),
                 n_segments = n(),
-                mot_order = paste0(mot, collapse = "-"),
+                mot_order = paste0(mot, collapse = ">"),
                 start = first(start),
                 end = last(end),
                 do_union = FALSE, .groups = 'keep') %>%