From 10fd02770e532e89e930d876b520d14d1be7ba0f Mon Sep 17 00:00:00 2001 From: Vincent van Hees Date: Thu, 9 Nov 2023 11:10:54 +0100 Subject: [PATCH 1/2] replace palmsplusr code by dependency on hbGIS #64 --- DESCRIPTION | 9 +- NAMESPACE | 31 +-- R/check_and_clean_palms_data.R | 48 ----- R/hbt_build_days.R | 89 --------- R/hbt_build_multimodal.R | 174 ---------------- R/hbt_build_palmsplus.R | 61 ------ R/hbt_build_trajectories.R | 56 ------ R/hbt_check_missing_id.R | 163 --------------- R/hbt_read_config.R | 22 -- R/myApp.R | 13 +- R/palmsplusr_shiny.R | 320 ------------------------------ man/check_and_clean_palms_data.Rd | 21 -- man/hbt_build_days.Rd | 43 ---- man/hbt_build_multimodal.Rd | 49 ----- man/hbt_build_palmsplus.Rd | 29 --- man/hbt_build_trajectories.Rd | 29 --- man/hbt_check_missing_id.Rd | 37 ---- man/hbt_read_config.Rd | 17 -- man/palmsplusr_shiny.Rd | 37 ---- 19 files changed, 11 insertions(+), 1237 deletions(-) delete mode 100644 R/check_and_clean_palms_data.R delete mode 100644 R/hbt_build_days.R delete mode 100644 R/hbt_build_multimodal.R delete mode 100644 R/hbt_build_palmsplus.R delete mode 100644 R/hbt_build_trajectories.R delete mode 100644 R/hbt_check_missing_id.R delete mode 100644 R/hbt_read_config.R delete mode 100644 R/palmsplusr_shiny.R delete mode 100644 man/check_and_clean_palms_data.Rd delete mode 100644 man/hbt_build_days.Rd delete mode 100644 man/hbt_build_multimodal.Rd delete mode 100644 man/hbt_build_palmsplus.Rd delete mode 100644 man/hbt_build_trajectories.Rd delete mode 100644 man/hbt_check_missing_id.Rd delete mode 100644 man/hbt_read_config.Rd delete mode 100644 man/palmsplusr_shiny.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 2562b25..208b48b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -7,14 +7,11 @@ Authors@R: c(person(given = "Vincent", family = "van Hees", role = c("aut", "cre"), - email = "v.vanhees@accelting.com"), - person("Tom", "Stewart", role = "cph", email = "tom.stewart@aut.ac.nz", - comment = "holds copyright over original palmsplusr code")) + email = "v.vanhees@accelting.com")) License: Apache License version 2.0 | file LICENSE Imports: shiny, shinyFiles, GGIR, bslib, methods, jsonlite, DT, - dplyr, magrittr, shinyjs, sf, readr, tidyr, stringr, callr, palmsplusr, - data.table, rlang, purrr, geosphere, hbGPS -Remotes: vincentvanhees/palmsplusr, habitus-eu/hbGPS + magrittr, shinyjs, callr, hbGPS, hbGIS +Remotes: habitus-eu/hbGPS, habitus-eu/hbGIS LazyData: true Suggests: testthat, covr, rmarkdown Depends: stats, utils, R (>= 3.5.0) diff --git a/NAMESPACE b/NAMESPACE index 686ccf1..9f969e8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,61 +4,32 @@ export(Counts2csv) export(GGIRshiny) export(PALMSpyshiny) export(checkConfigFile) -export(check_and_clean_palms_data) export(check_params) export(cleanPath) export(create_test_GGIRconfig) export(create_test_files) export(hbGPS_shiny) -export(hbt_build_days) -export(hbt_build_multimodal) -export(hbt_build_palmsplus) -export(hbt_build_trajectories) -export(hbt_check_missing_id) -export(hbt_read_config) export(load_params) export(modConfigServer) export(modConfigUI) export(myApp) -export(palmsplusr_shiny) export(update_params) exportClasses(toolio) import(GGIR) -import(dplyr) import(hbGPS) -import(palmsplusr) -import(sf) import(shiny) import(shinyFiles) importFrom(callr,r_bg) -importFrom(data.table,rbindlist) -importFrom(data.table,rleid) -importFrom(geosphere,distGeo) +importFrom(hbGIS,hbGIS) importFrom(jsonlite,fromJSON) importFrom(jsonlite,toJSON) importFrom(magrittr,"%>%") importFrom(methods,new) importFrom(methods,setClass) -importFrom(purrr,reduce) -importFrom(readr,read_csv) -importFrom(readr,write_csv) -importFrom(rlang,UQ) -importFrom(rlang,parse_expr) importFrom(stats,aggregate) -importFrom(stats,as.formula) -importFrom(stats,end) -importFrom(stats,formula) importFrom(stats,rnorm) importFrom(stats,runif) -importFrom(stats,setNames) -importFrom(stats,start) -importFrom(tidyr,gather) -importFrom(tidyr,pivot_wider) -importFrom(tidyr,spread) -importFrom(tidyr,unite) -importFrom(utils,head) importFrom(utils,read.csv) importFrom(utils,read.table) -importFrom(utils,tail) importFrom(utils,write.csv) importFrom(utils,write.table) diff --git a/R/check_and_clean_palms_data.R b/R/check_and_clean_palms_data.R deleted file mode 100644 index b258b1b..0000000 --- a/R/check_and_clean_palms_data.R +++ /dev/null @@ -1,48 +0,0 @@ -#' check_and_clean_palms_data -#' -#' @param palms_to_clean palms_to_clean -#' @param country_name country_name -#' @param outputdir outputdir -#' @return palms_to_clean_lower object -#' @import dplyr -#' @export -check_and_clean_palms_data <- function(palms_to_clean, country_name, outputdir = NULL){ - dif = datetime = identifier = tripnumber = triptype = tt1 = tt4 = NULL - miss_end = miss_start = multi_start = multi_end = error = NULL - # Create error list ------------------------------------------------------- - - error_list <- data.frame(identifier = character(), - tripnumber = integer(), - error = character(), - resolution = character()) - - - # Load PALMS dataset ------------------------------------------------------ - palms_to_clean_lower <- palms_to_clean %>% - rename_all(~tolower(.)) - - # Checking duplicated rows ------------------------------------------------ - - # VvH: Following lines do not seem to work - # palms_dupe <- palms_to_clean_lower %>% - # distinct(across(identifier:datetime)) - # VvH: I have now added the following line instead - palms_dupe = palms_to_clean_lower[!duplicated(palms_to_clean_lower[,c("identifier","datetime")]),] - if (nrow(palms_to_clean_lower) != nrow(palms_dupe)) { - dupe <- palms_to_clean_lower %>% dplyr::select(identifier:datetime) - dupe <- dupe[duplicated(dupe),] - error_list <- rbind(error_list, data.frame(identifier = dupe$identifier, - tripnumber = NA, - error = "Duplicated timestamp", - resolution = paste0("Keep one of each duplicate (timestamp: ", dupe$datetime, ")"))) - palms_to_clean_lower <- palms_dupe - } - rm(palms_dupe) - - # Saving the new 'clean' dataset - %>% --------------------------------------- - # write_csv(palms, str_replace(link_to_csv, pattern = '.csv', '_cleaned.csv'), na = "") - data.table::fwrite(error_list, paste(outputdir, country_name,"error_list.csv", sep = "_")) - - return(palms_to_clean_lower) -} - diff --git a/R/hbt_build_days.R b/R/hbt_build_days.R deleted file mode 100644 index 9e249de..0000000 --- a/R/hbt_build_days.R +++ /dev/null @@ -1,89 +0,0 @@ - -#' Calculate day-level summaries from the palmsplus dataset -#' -#' @description Build a days dataset by summarising \code{palmsplus} -#' by day and person (\code{identifier}). Not all variables in \code{palmsplus} -#' are summarised, only those specified using \code{\link{palms_add_field}} with -#' the argument \code{domain_field = TRUE}. By default, a \code{duration} field -#' is added (e.g., the total minutes per day). -#' -#' All data are summarised by default. However, additional aggragation \emph{domains} -#' can be specified using \code{\link{palms_add_domain}} before building days. -#' Domains are a subset of data, such as during school time. All \code{domain_field} -#' variables will be summarised for each \emph{domain} seperatly. -#' -#' @param data The palmsplus data obtained from \code{\link{palms_build_palmsplus}}. -#' @param verbose Print progress to console. Default is \code{TRUE}. -#' @param palmsplus_domains ... -#' @param palmsplus_fields ... -#' @param loca Nested list with location information -#' @param participant_basis participant_basis -#' -#' -#' @return A table summarised by day. -#' -#' @import dplyr -#' @import sf -#' @importFrom rlang parse_expr UQ -#' @importFrom purrr reduce -#' -#' @export -# Code modified from https://thets.github.io/palmsplusr/ -hbt_build_days <- function(data = NULL, verbose = TRUE, - 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) - for (i in 1:Nlocations) { - txt = paste0(names(loca[[i]])[1], " = loca[[i]][[1]]") - eval(parse(text = txt)) - } - - duration = datetime = name = domain_field = NULL - - domain_fields <- palmsplus_domains %>% filter(domain_field == TRUE) - domain_names <- domain_fields %>% pull(name) - - if (is.null(domain_names)) { - domain_names <- "total" - } else { - domain_names <- c("total", domain_names) - } - 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 %>% - 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) %>% - summarise_all(~ sum(.)) %>% - ungroup() %>% - rename_at(vars(-identifier, -date), ~ paste0(i, "_", .)) - } - - result <- x %>% - reduce(left_join, by = c("identifier" = "identifier", "date" = "date")) - return(result) -} diff --git a/R/hbt_build_multimodal.R b/R/hbt_build_multimodal.R deleted file mode 100644 index 29b17f8..0000000 --- a/R/hbt_build_multimodal.R +++ /dev/null @@ -1,174 +0,0 @@ - -#' Build multimodal trips from trajectories -#' -#' @description Build multimodal trips from trajectories. -#' -#' @param data The trajectories object built with \code{palms_calc_trajectories}. -#' @param spatial_threshold Spatial threshold in meters -#' @param temporal_threshold Temporal threshold in minutes -#' @param palmsplus ... -#' @param verbose Print progress after each step. Default is \code{TRUE}. -#' @param multimodal_fields ... -#' @param trajectory_locations ... -#' -#' -#' -#' @details Several columns are required in the \code{trajectories} dataset. These -#' need to be added as trajectory fields: -#' \itemize{ -#' \item identifier -#' \item tripnumber -#' \item mot -#' \item start -#' \item end -#' \item geometry -#' } -#' -#' @return The input trajectories LINESTRING geometry, collapsed into multimodal trips -#' -#' @import dplyr -#' @import sf -#' @importFrom rlang parse_expr -#' @importFrom geosphere distGeo -#' @importFrom data.table rleid -#' @importFrom purrr reduce -#' @importFrom tidyr gather spread unite -#' @importFrom stats setNames -#' -#' @export -# Code modified from https://thets.github.io/palmsplusr/ -hbt_build_multimodal <- function(data = NULL, - spatial_threshold, - temporal_threshold, - palmsplus = NULL, - verbose = TRUE, - multimodal_fields = NULL, - trajectory_locations = NULL) { - tripnumber = geometry = start_point = end_point = end_prev = NULL - triptype = mot = variable = value = start_trip = end_trip = NULL - distance_diff = time_diff = mmt_number = mmt_criteria = NULL - - if (!all(c("identifier", "tripnumber", "start", "end", "geometry", "mot") %in% colnames(data))) { - warning("Your trajectories data does not contain the required column names... skipping multimodal analyses") - df = NULL - } else { - - if (verbose) cat('Calculating multimodal eligibility...') - - # Determine if a trajectory meets spatial and temporal criteria - data <- data %>% - arrange(identifier, tripnumber) %>% - mutate(time_diff = difftime(start, lag(end), units = "mins")) %>% - group_by(identifier, tripnumber) %>% - mutate(start_point = st_as_text(st_cast(geometry, "POINT")[1]), - end_point = st_as_text(st_cast(geometry, "POINT")[length(st_cast(geometry, "POINT"))])) %>% - ungroup() %>% - mutate(end_prev = lag(end_point, default = start_point[1])) %>% - group_by(identifier, tripnumber) %>% - mutate(distance_diff = distGeo( - matrix(c(st_as_sfc(end_prev, crs = 4326)[[1]][1], - st_as_sfc(end_prev, crs = 4326)[[1]][2]), ncol = 2), - matrix(c(st_as_sfc(start_point, crs = 4326)[[1]][1], - st_as_sfc(start_point, crs = 4326)[[1]][2]), ncol = 2))) %>% - ungroup() %>% - mutate(mmt_criteria = ((distance_diff < spatial_threshold) & (time_diff < temporal_threshold)), - mmt_number = NA) - - if(verbose) cat('done\nAssigning trip numbers...') - - # Assign correct start times for consecutive mmt segments - for(i in 1:(nrow(data)-1)) { - data$mmt_number[i] <- ifelse((!data$mmt_criteria[i]) & data$mmt_criteria[i + 1], data$start[i], - ifelse(data$mmt_criteria[i], data$mmt_number[i - 1], data$start[i])) - } - - data$mmt_number[nrow(data)] <- ifelse(data$mmt_criteria[nrow(data)], data$mmt_number[nrow(data) - 1], - data$start[nrow(data)]) - - # Use run-length encoding to assign mmt numbers - data <- data %>% - group_by(identifier) %>% - mutate(mmt_number = data.table::rleid(mmt_number)) %>% - ungroup() %>% - dplyr::select(!any_of(c(start_point, end_point, end_prev, mmt_criteria, time_diff, distance_diff))) - - if(verbose) cat('done\nCalculating fields...') - - # Split varables into each mot - mot_split <- data %>% - dplyr::select(any_of(c("mot", "mmt_number", "identifier", "geometry", multimodal_fields$name))) %>% - mutate(mot = paste0("mot_", mot)) %>% - gather(variable, value, -mmt_number, -mot, -identifier, -geometry) %>% - unite(col, mot, variable) %>% - spread(col, value) %>% - arrange(identifier, mmt_number) %>% - cbind(data) %>% - dplyr::select(!any_of(ends_with(".1"))) - - # Calculate multimodal_fields - df_fields <- list() - - for (i in unique(multimodal_fields$formula)) { - df_fields[[i]] <- mot_split %>% - as.data.frame() %>% - group_by(identifier, mmt_number) %>% - summarise_at(vars(matches( - paste(multimodal_fields$name[multimodal_fields$formula == i], collapse = "|"))), - i, na.rm = TRUE) - } - - df_fields <- reduce(df_fields, left_join, - by = c("identifier" = "identifier", "mmt_number" = "mmt_number")) - - df_fields[is.na(df_fields)] <- NA - - # Build trajectory_location formulas - names <- unique(c(trajectory_locations$start_criteria, - trajectory_locations$end_criteria)) - - - # Rather than recalculating geometry, just lookup in palmsplus - lookup <- palmsplus %>% - filter(tripnumber > 0 & triptype %in% c(1, 4)) %>% - as.data.frame() %>% - dplyr::select(all_of(c("identifier", "tripnumber", "triptype", names))) - - # Helper function to lookup start and end locations from the lookup table - lookup_locations <- function(identifier, start_trip, start_loc, end_trip, end_loc) { - n1 <- lookup[(lookup$identifier == identifier) & (lookup$tripnumber == start_trip) & (lookup$triptype == 1), start_loc] - n2 <- lookup[(lookup$identifier == identifier) & (lookup$tripnumber == end_trip) & (lookup$triptype == 4), end_loc] - return(n1 & n2) - } - args_locations <- setNames( - paste0("lookup_locations(identifier, start_trip, '", - trajectory_locations$start_criteria, "', end_trip, '", - trajectory_locations$end_criteria, "')"), - trajectory_locations$name) %>% - lapply(parse_expr) - - - # Calculate other fields (+ trajectory_locations) - df_other <- mot_split %>% - group_by(identifier, mmt_number) %>% - summarise(start_trip = first(tripnumber), - end_trip = last(tripnumber), - trip_numbers = paste0(tripnumber, collapse = "-"), - n_segments = n(), - mot_order = paste0(mot, collapse = "-"), - start = first(start), - end = last(end), - do_union = FALSE, .groups = 'keep') %>% - rowwise() %>% - mutate(!!!args_locations) %>% - ungroup() %>% - dplyr::select(!any_of(c(start_trip, end_trip))) %>% - mutate_if(is.logical, as.integer) - if (exists("df_fields")) { - df <- reduce(list(df_other, df_fields), left_join, by = c("identifier" = "identifier", "mmt_number" = "mmt_number")) - } else { - df <- df_other - } - if(verbose) cat('done\n') - } - return(df) -} diff --git a/R/hbt_build_palmsplus.R b/R/hbt_build_palmsplus.R deleted file mode 100644 index 8970b14..0000000 --- a/R/hbt_build_palmsplus.R +++ /dev/null @@ -1,61 +0,0 @@ - -#' Build the palmsplus dataset -#' -#' @description Build the \code{palmsplus} dataset by adding additional columns to the PALMS dataset. -#' The additional columns are specified using \code{\link{palms_add_field}}. -#' -#' @param data The PALMS data obtained using \code{\link{read_palms}}. -#' @param verbose Print progress to console after each iteration. Default is \code{TRUE}. -#' @param palmsplus_fields fields defined in PALMSplusRshiny -#' @param loca Nested list with location information -#' @param participant_basis participant_basis -#' -#' @import dplyr -#' @import sf -#' @import palmsplusr -#' @importFrom rlang parse_expr -#' @importFrom stats setNames -#' @importFrom data.table rbindlist -#' -#' -#' @export -#' -# Code modified from https://thets.github.io/palmsplusr/ -hbt_build_palmsplus <- function(data = NULL, verbose = TRUE, 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) - for (i in 1:Nlocations) { - for (j in 1:2) { - txt = paste0(names(loca[[i]])[j], " = loca[[i]][[j]]") - eval(parse(text = txt)) - } - } - - - field_args <- setNames(palmsplus_fields$formula, palmsplus_fields$name) %>% - lapply(parse_expr) - - x <- list() - j <- 1 - len <- length(unique(data$identifier)) - - for (i in unique(data$identifier)) { - datai = data %>% - filter(identifier == i) - x[[i]] <- datai %>% - mutate(!!! field_args) %>% - mutate_if(is.logical, as.integer) - if (verbose) { - cat("[", j, "/", len, "] Computed palmsplus for: ", i, "\n", sep = "") - j <- j + 1 - } - } - data <- rbindlist(x) %>% - st_set_geometry(data$geometry) - return(data) -} diff --git a/R/hbt_build_trajectories.R b/R/hbt_build_trajectories.R deleted file mode 100644 index 9699f87..0000000 --- a/R/hbt_build_trajectories.R +++ /dev/null @@ -1,56 +0,0 @@ - -#' Build trajectories from the palmsplus dataset -#' -#' @description Build trajectories (trips) from the \code{palmsplus} dataset. This -#' returns a \code{sf data.frame} with \code{LINESTRING} geometry. Three columns -#' are returned by default (\code{identifier}, \code{tripnumber}, and \code{geometry}). -#' Additional columns can be specified with \code{\link{palms_add_trajectory_field}} -#' and \code{\link{palms_add_trajectory_location}}. -#' -#' @param data The palmsplus data obtained from \code{\link{palms_build_palmsplus}}. -#' @param trajectory_fields trajectory_fields -#' @param trajectory_locations trajectory_locations -#' -#' @return A table of individual trips represented as \code{LINESTRING} geometry. -#' -#' @import dplyr -#' @import sf -#' @importFrom rlang parse_expr -#' @importFrom stats setNames -#' -#' @export -# Code modified from https://thets.github.io/palmsplusr/ -hbt_build_trajectories <- function(data = NULL, trajectory_fields = NULL, trajectory_locations = NULL) { - name = after_conversion = tripnumber = NULL - - args <- trajectory_fields %>% filter(after_conversion == FALSE) - args_after <- trajectory_fields %>% filter(after_conversion == TRUE) - - args <- setNames(args$formula, args$name) %>% lapply(parse_expr) - args_after <- setNames(args_after$formula, args_after$name) %>% lapply(parse_expr) - - if (length(trajectory_locations) > 0) { - args_locations <- setNames(paste0("first(", trajectory_locations$start_criteria, - ") & last(", trajectory_locations$end_criteria, ")"), - trajectory_locations$name) %>% lapply(parse_expr) - args_locations = args_locations[order(names(args_locations))] - args <- c(args, args_locations) - } - - - # Build data object - data <- data %>% - filter(tripnumber > 0) %>% - group_by(identifier, tripnumber) %>% - summarise(!!!args, do_union = FALSE, .groups = 'keep') %>% - st_cast("LINESTRING") %>% - mutate(!!!args_after) %>% - ungroup() %>% - mutate_if(is.logical, as.integer) - return(data) -} - - - - - diff --git a/R/hbt_check_missing_id.R b/R/hbt_check_missing_id.R deleted file mode 100644 index 1a2fdc3..0000000 --- a/R/hbt_check_missing_id.R +++ /dev/null @@ -1,163 +0,0 @@ -#' hbt_check_missing_id -#' -#' @param participant_basis object as loaded inside PALMSplusRshiny -#' @param palmsplus_folder output folder path for storing log of excluded IDs -#' @param dataset_name Name of dataset -#' @param palms palms object as loaded inside PALMSplusRshiny -#' @param loca Nested list with location information -#' @param groupinglocation groupinglocation -#' @param verbose verbose -#' @return List with participant_basis and palms object without non-matching IDs -#' -#' @export -#' -hbt_check_missing_id = function(participant_basis, palmsplus_folder, dataset_name, palms, - loca, groupinglocation = "school", verbose = TRUE) { - - # Check whether id is found in all objects - check_N = function(loca, participant_basis, palms, groupinglocation, verbose) { - # Check loca - locationNames = names(loca) - for (i in 1:length(loca)) { - if (locationNames[i] != "home") { - loc_id = paste0(groupinglocation, "_id") - } else if (locationNames[i] == "home") { # assumption that home is always the identifier for individuals - loc_id = "identifier" - } - for (j in 1:2) { - N = length(unique(loca[[i]][j][[1]][[loc_id]])) - tibblename = names(loca[[i]][j]) - if (verbose) { - if (N == 0) { - cat(paste0("\nNo ",loc_id ," found in ", tibblename, "$", loc_id)) - } else { - cat(paste0("\n ", tibblename, ": ", N)) - } - } - } - } - if (verbose) { - # Check participant_basis - if (length(unique(participant_basis[[paste0(groupinglocation, "_id")]])) == 0) { - cat(paste0("\nNo ", groupinglocation, "_id found in participant_basis$", groupinglocation, "_id")) - } - - # NOT CHANGED: - Npbi = length(unique(participant_basis$identifier)) - if (Npbi == 0) { - cat("\nNo identifier found in participant_basis$identifier") - } - cat(paste0("\n participant_basis: ", Npbi)) - - Npi = length(unique(palms$identifier)) - if (Npi == 0) { - cat("\nNo identifier found in palms$identifier") - } else { - cat(paste0("\n palms: ", Npi)) - } - } - # cat("\n") - } - - locationNames = names(loca) - locationNames2 = NULL - if (groupinglocation %in% locationNames) { - locationNames2 = locationNames[which(locationNames == groupinglocation)] # focus here on school - } else { - locationNames2 = locationNames - } - loc_id = paste0(locationNames[which(names(participant_basis) %in% paste0(locationNames2, "_id"))][1], "_id") - - # Check sample size before cleaning - if (verbose) cat("\nSample size before cleaning:") - check_N(loca, participant_basis, palms, groupinglocation, verbose) - - #======================================================== - # Test for missing values in participant basis - test_missing_value = rowSums(is.na(participant_basis[,c("identifier", loc_id)])) #"school_id" - missing = which(test_missing_value > 1) - participant_exclude_list = list(identifier = NULL, loc_id = NULL) - names(participant_exclude_list)[2] = loc_id - - if (length(missing) > 0) { - if (verbose) { - cat(paste0("\n(MISSING) identifier or ", loc_id, " values in participant_basis\n")) - cat(paste0(" Now ignoring ", paste(participant_basis$identifier[missing], sep = " "))) - } - participant_exclude_list = participant_basis[[missing]] - participant_basis = participant_basis[test_missing_value == 0, ] - } else { - if (verbose) { - cat(paste0("\n(COMPLETE) identifier and ", loc_id, " values in participant_basis")) - } - } - - # Commented out, because there are more ids excluded then just these - # sink(paste0(palmsplus_folder, "/", dataset_name, "_excluded_ids.txt")) - # print(participant_exclude_list) - # sink() - # rm(missing) - - #======================================================== - # Make sure home, home_nbh, participant_basis have matching identifier numbers - # Make sure school, school_nbh, participant_basis have matching school_id numbers - for (k in locationNames) { - for (i in c(k, paste0(k, "_nbh"))) { - if (k == "home") { - idloc = "identifier" - } else { - idloc = paste0(k,"_id") - } - if (k == i) { - tmp1 = loca[[k]][[i]] - idset1 = loca[[k]][[i]][[idloc]] - } else { - tmp2 = loca[[k]][[i]] - idset2 = loca[[k]][[i]][[idloc]] - } - } - missing_identifiers = sort(unique(c(idset1[idset1 %in% idset2 == FALSE], idset2[idset2 %in% idset1 == FALSE]))) - if (length(missing_identifiers) > 0) { - if (verbose) { - cat(paste0("\n(MISSING) identifier(s) in ", k, " or ", k, "_nbh\n")) - cat(paste0(" Now ignoring: ", paste(missing_identifiers, collapse = ", "), sep = " ")) - } - participant_basis = participant_basis[which(participant_basis[[idloc]] %in% missing_identifiers == FALSE),] - if (idloc %in% names(palms)) { - palms = palms[which(palms[[idloc]] %in% missing_identifiers == FALSE),] - } - for (i in c(k, paste0(k, "_nbh"))) { - tmp = loca[[k]][[i]] - validrows = which(tmp[[idloc]] %in% missing_identifiers == FALSE) - loca[[k]][[i]] <- eval(parse(text = paste0("tmp[validrows,] %>% arrange(", idloc, ")"))) - } - } else { - if (verbose) cat(paste0("\n(COMPLETE) identifier(s) in ", k, " and ", k, " _nbh")) - } - } - - #======================================================== - # Test for incomplete id in palms object - missing_identifiers = unique(c(palms$identifier[which(palms$identifier %in% participant_basis$identifier == FALSE)], - participant_basis$identifier[which(participant_basis$identifier %in% palms$identifier == FALSE)])) - if (length(missing_identifiers) > 0) { - if (verbose) { - cat(paste0("\n(MISSING) identifier(s) in palms\n")) - cat(paste0(" Now ignoring: ", paste(missing_identifiers, collapse = ", "), sep = " ")) - } - participant_basis = participant_basis[participant_basis$identifier %in% missing_identifiers == FALSE,] - palms = palms[palms$identifier %in% missing_identifiers == FALSE,] - } else { - if (verbose) cat(paste0("\n(COMPLETE) identifier(s) in palms")) - } - # Check sample size aftercleaning - if (verbose) cat("\nSample size after cleaning:") - check_N(loca, participant_basis, palms, groupinglocation, verbose) - - - - # at this point we should have a cleaned dataset with only consistent data in all objects - if (verbose) cat("\n") - - invisible(list(palms = palms, participant_basis = participant_basis, loca = loca)) -} \ No newline at end of file diff --git a/R/hbt_read_config.R b/R/hbt_read_config.R deleted file mode 100644 index 6030375..0000000 --- a/R/hbt_read_config.R +++ /dev/null @@ -1,22 +0,0 @@ -#' Read palmsplusr config file -#' -#' @param path Path to config file -#' -#' @return dataframe -#' -#' @importFrom readr read_csv -#' -#' @export -hbt_read_config <- function(path) { - - if (file.exists(path)) { - df <- read_csv(path, show_col_types = FALSE) - } else { - stop("No config file found at ", path) - } - - - # TODO sanity checks - - return(df) -} diff --git a/R/myApp.R b/R/myApp.R index 54d7b29..fa5e75f 100644 --- a/R/myApp.R +++ b/R/myApp.R @@ -7,6 +7,7 @@ #' @import shiny #' @import shinyFiles #' @importFrom callr r_bg +#' @importFrom hbGIS hbGIS #' @export # pkgload::load_all("."); HabitusGUI::myApp(homedir="~/projects/fontys") @@ -1361,7 +1362,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { logfile = paste0(isolate(global$data_out), "/palmsplusr.log") on.exit(file.copy(from = stdout_palmsplusr_tmp, to = logfile, overwrite = TRUE), add = TRUE) - # palmsplusr_shiny(#country_name = "BA", # <= Discuss, extract from GIS foldername? + # hbGIS(#country_name = "BA", # <= Discuss, extract from GIS foldername? # # participant_exclude_list, # <= Discuss, leave out from linkfile? # gisdir = global$gis_in, # palmsdir = expected_palmspy_results_dir, @@ -1370,7 +1371,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { # dataset_name = input$dataset_name) - # print(list(palmsplusr_shiny = palmsplusr_shiny, + # print(list(hbGIS = hbGIS, # gisdir = global$gis_in, # palmsdir = expected_palmspy_results_dir, # gislinkfile = global$gislinkfile_in, @@ -1379,13 +1380,13 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { # configfile = paste0(global$data_out, "/config_palmsplusr.csv"))) # Start palmsplusr - x_palmsplusr <- r_bg(func = function(palmsplusr_shiny, gisdir, palmsdir, + x_palmsplusr <- r_bg(func = function(hbGIS, gisdir, palmsdir, gislinkfile, outputdir, dataset_name, configfile){ - palmsplusr_shiny(gisdir, palmsdir, gislinkfile, + hbGIS(gisdir, palmsdir, gislinkfile, outputdir, dataset_name, configfile) }, - args = list(palmsplusr_shiny = palmsplusr_shiny, + args = list(hbGIS = hbGIS, gisdir = global$gis_in, palmsdir = expected_results_dir, gislinkfile = global$gislinkfile_in, @@ -1395,7 +1396,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { stdout = stdout_palmsplusr_tmp, stderr = "2>&1") # # Start PALMSplusR - # palmsplusr_shiny(#country_name = "BA", # <= Discuss, extract from GIS foldername? + # hbGIS(#country_name = "BA", # <= Discuss, extract from GIS foldername? # # participant_exclude_list, # <= Discuss, leave out from linkfile? # gisdir = global$gis_in, # palmsdir = expected_palmspy_results_dir, diff --git a/R/palmsplusr_shiny.R b/R/palmsplusr_shiny.R deleted file mode 100644 index 4999915..0000000 --- a/R/palmsplusr_shiny.R +++ /dev/null @@ -1,320 +0,0 @@ -#' palmsplusr_shiny -#' -#' @param gisdir Path to directory with GIS files -#' @param palmsdir Path to PALMSpy or PALMS output directory -#' @param gislinkfile Path to participant basis file, which is the file that links all participant identifies with the GIS data -#' @param outputdir Path to outputdir location -#' @param dataset_name Name of dataset -#' @param configfile Configuration file -#' @param verbose verbose Boolean -#' @return palms_to_clean_lower object -#' @importFrom stats end start formula as.formula -#' @importFrom tidyr pivot_wider -#' @importFrom readr write_csv read_csv -#' @import palmsplusr -#' @import dplyr -#' @importFrom utils head tail -#' -#' @export - -palmsplusr_shiny <- function(gisdir = "", - palmsdir = "", - gislinkfile = "", - outputdir = "", - dataset_name = "", - configfile = "", - verbose = TRUE) { - - groupinglocation = "school" - # create list structure to house the location objects - shapefilenames = dir(path = gisdir, full.names = FALSE, pattern = "[.]shp") - locationNames = unique(gsub(pattern = "table|_|buffers|[.]|xml|shp|loc", replacement = "", x = shapefilenames)) - - Nlocations = length(locationNames) - loca = vector("list", Nlocations) - names(loca) = locationNames - for (i in 1:Nlocations) { - loca[[i]] = vector("list", 4) - names(loca[[i]]) = c(locationNames[i], paste0(locationNames[i], "_nbh"), - paste0(locationNames[i], "_tablefile"), paste0(locationNames[i], "_locbufferfile")) - } - lon = identifier = palms = NULL # . = was also included, but probably wrong - if (length(configfile) > 0) { - # check for missing parameters, such that palmsplusr can fall back on defaults - # here the config_pamsplusr file inside the package is assumed to hold all the defaults. - config_def = system.file("testfiles_palmsplusr/config_palmsplusr.csv", package = "HabitusGUI")[1] - params_def = load_params(file = config_def , format = "csv_palmsplusr") - params_def$id = rownames(params_def) #with(params_def, paste0(context, "__", name)) - params = load_params(file = configfile , format = "csv_palmsplusr") - params$id = rownames(params) #with(params, paste0(context, "__", name)) - missingPar = which(params_def$id %in% params$id == FALSE) - if (length(missingPar) > 0) { - # update the configfile as provide by the user - params = rbind(params, params_def[missingPar,]) - params = params[, -which(colnames(params) == "id")] - update_params(new_params = params, file = configfile, format = "csv_palmsplusr") - } - rm(params_def) - config <- configfile - } else { - # If no configfile is provided fall back on default - config <- system.file("testfiles_palmsplusr/config_palmsplusr.csv", package = "HabitusGUI")[1] - } - - palmsplus_folder = paste0(outputdir, "/palmsplusr_output") - if (!dir.exists(palmsplus_folder)) { - if (verbose) cat("\nCreating PALMSplusR output directory\n") - dir.create(palmsplus_folder) - } - sf::sf_use_s2(FALSE) - # identify palms csv output files in palmsdir: - palms_country_files <- list.files(path = palmsdir, pattern = "*.csv", full.names = TRUE) - # skip the combined file that hbGPS generates - palms_country_files = grep(pattern = "combined.csv", x = palms_country_files, invert = TRUE, value = TRUE) - # read and combine palms csv output files - csv_palms <- lapply(palms_country_files, FUN = readr::read_csv, col_types = list( - identifier = readr::col_character(), - dow = readr::col_integer(), - lat = readr::col_double(), - lon = readr::col_double(), - fixTypeCode = readr::col_integer(), - iov = readr::col_integer(), - tripNumber = readr::col_integer(), - tripType = readr::col_integer(), - tripMOT = readr::col_integer(), - activity = readr::col_double() - ), show_col_types = FALSE) - PALMS_combined <- bind_rows(csv_palms) - # Data cleaning: - # if (verbose) cat("\nstart cleaning...\n") - PALMS_reduced <- subset(PALMS_combined, lon > -180) - palms_reduced_cleaned <- check_and_clean_palms_data(PALMS_reduced, dataset_name, outputdir) - # if (verbose) cat("\ncleaning completed\n") - PALMS_reduced$dateTime = as.POSIXct(PALMS_reduced$dateTime, format = "%d/%m/%Y %H:%M:%S", tz = "") - - # Write to csv and read using read_palms to format the object as expected from the rest of the code - PALMS_reduced_file = normalizePath(paste0(palmsplus_folder, "/", stringr::str_interp("PALMS_${dataset_name}_reduced.csv"))) - # if (verbose) cat(paste0("\nCheck PALMS_reduced_file: ", PALMS_reduced_file)) - write.csv(palms_reduced_cleaned, PALMS_reduced_file) - palms = palmsplusr::read_palms(PALMS_reduced_file, verbose = FALSE) - palms$datetime = as.POSIXct(palms$datetime, format = "%d/%m/%Y %H:%M:%S", tz = "") - # Helper function to find shape files - find_file = function(path, namelowercase) { - allcsvfiles = dir(path, recursive = TRUE, full.names = TRUE) - file_of_interest = allcsvfiles[which(tolower(basename(allcsvfiles)) == namelowercase)] - return(file_of_interest) - } - # if (verbose) cat("\nreading basis file\n") - participant_basis = read_csv(gislinkfile, show_col_types = FALSE) - # Load all shape files ---------------------------------------------------- - #---------------- - # NEW CODE - for (jj in 1:Nlocations) { - findfile3 = find_file(path = gisdir, namelowercase = paste0(locationNames[jj], "_table.shp")) - if (!is.null(findfile3)) { - loca[[jj]][3] = findfile3 - } else { - stop(paste0("unable to find ", findfile3)) - } - findfile4 = find_file(path = gisdir, namelowercase = paste0("loc_", locationNames[jj], "buffers.shp")) - if (!is.null(findfile3)) { - loca[[jj]][4] = findfile4 - } else { - stop(paste0("unable to find ", findfile4)) - } - loca[[jj]][[1]] = sf::read_sf(loca[[jj]][3]) #home_nbh - loca[[jj]][[2]] = sf::read_sf(loca[[jj]][4]) #school_nbh - } - # Force id numbers to be characrer( - locationNames = names(loca) - for (i in 1:length(loca)) { - if (locationNames[i] != "home") { - loc_id = paste0(groupinglocation, "_id") - } else if (locationNames[i] == "home") { # assumption that home is always the identifier for individuals - loc_id = "identifier" - } - for (j in 1:2) { - loca[[i]][j][[1]][[loc_id]] = as.character(loca[[i]][j][[1]][[loc_id]]) - } - } - # Check for missing IDs ------------------------------------------------------------------------- - withoutMissingId = hbt_check_missing_id(participant_basis, palmsplus_folder, dataset_name, palms, - loca, groupinglocation = groupinglocation, - verbose = verbose) - palms = withoutMissingId$palms - participant_basis = withoutMissingId$participant_basis - loca = withoutMissingId$loca - write.csv(participant_basis, paste0(palmsplus_folder, "/", stringr::str_interp("participant_basis_${dataset_name}.csv"))) # store file for logging purposes only - if (length(participant_basis) == 0 || nrow(participant_basis) == 0) { - stop("\nParticipant basis file does not include references for the expected recording IDs") - } - - #=========================================================================================== - # Create field tables - # #============================= - # adding fields - CONF = read.csv(config, sep = ",") - CONF$start_criteria = "" - CONF$end_criteria = "" - # add standard location based fields to CONF object: - for (i in 1:Nlocations) { - if (locationNames[i] == "home") { - CONF[nrow(CONF) + 1, ] = c("palmsplus_field", - paste0("at_", locationNames[i]), - paste0("palms_in_polygon(datai, polygons = dplyr::filter(", - locationNames[i],", identifier == i), identifier)"), - NA, "", "", "") - CONF[nrow(CONF) + 1, ] = c("palmsplus_field", - paste0("at_", locationNames[i], "_nbh"), - paste0("palms_in_polygon(datai, polygons = dplyr::filter(", - locationNames[i], "_nbh, identifier == i), identifier)"), - NA, "", "", "") - } else { - CONF[nrow(CONF) + 1, ] = c("palmsplus_field", - paste0("at_", locationNames[i]), - paste0("palms_in_polygon(datai, polygons = dplyr::filter(", - locationNames[i],",", locationNames[i], - "_id == participant_basis %>% filter(identifier == i) %>% pull(", - locationNames[i], "_id)))"), - NA, "", "", "") - CONF[nrow(CONF) + 1, ] = c("palmsplus_field", - paste0("at_", locationNames[i], "_nbh"), - paste0("palms_in_polygon(datai, polygons = dplyr::filter(", - locationNames[i], "_nbh,", locationNames[i], - "_id == participant_basis %>% filter(identifier == i) %>% pull(", - locationNames[i], "_id)))"), - NA, "", "", "") - } - for (j in 1:Nlocations) { - CONF[nrow(CONF) + 1, ] = c("trajectory_location", - paste0(locationNames[i], "_", locationNames[i]), - paste0("at_", locationNames[i]), NA, "at_home", - paste0("at_", locationNames[i]), - paste0("at_", locationNames[j])) - } - CONF = CONF[!duplicated(CONF),] - } - palmsplusr_field_rows = which(CONF$context == "palmsplus_field") - palmsplus_fields = tibble(name = CONF$name[palmsplusr_field_rows], - formula = CONF$formula[palmsplusr_field_rows], - domain_field = CONF$domain_field[palmsplusr_field_rows]) - - palmsplusr_domain_rows = which(CONF$context == "palmsplus_domain") - palmsplus_domains = tibble(name = CONF$name[palmsplusr_domain_rows], - formula = CONF$formula[palmsplusr_domain_rows], - domain_field = CONF$domain_field[palmsplusr_domain_rows]) - # #============================= - # # trajectory_fields - trajectory_field_rows = which(CONF$context == "trajectory_field") - trajectory_fields = tibble(name = CONF$name[trajectory_field_rows], - formula = CONF$formula[trajectory_field_rows], - after_conversion = CONF$after_conversion[trajectory_field_rows]) - # #============================= - # # multimodal_fields - multimodal_fields_rows = which(CONF$context == "multimodal_field") - multimodal_fields = tibble(name = CONF$name[multimodal_fields_rows], - formula = CONF$formula[multimodal_fields_rows]) - # #============================= - # # trajectory locations - trajectory_location_rows = which(CONF$context == "trajectory_location") - trajectory_locations = tibble(name = CONF$name[trajectory_location_rows], - start_criteria = CONF$start_criteria[trajectory_location_rows], - end_criteria = CONF$end_criteria[trajectory_location_rows]) - # save(palms, loca, participant_basis, file = "~/projects/fontys/state_1_gui.RData") - # Run palmsplusr ---------------------------------------------------------- - fns = c(paste0(palmsplus_folder, "/", dataset_name, "_palmsplus.csv"), - paste0(palmsplus_folder, "/", dataset_name, "_days.csv"), - paste0(palmsplus_folder, "/", dataset_name, "_trajectories.csv"), - paste0(palmsplus_folder, "/", dataset_name, "_multimodal.csv")) - for (fn in fns) { - if (file.exists(fn)) file.remove(fn) - } - - Nlocation_objects = NULL - for (i in 1:Nlocations) { - Nlocation_objects = c(Nlocation_objects, length(loca[[i]][[1]]), length(loca[[i]][[2]])) - } - if (verbose) cat("\n<<< building palmsplus...\n") - if (length(palms) > 0 & length(palmsplus_fields) & - all(Nlocation_objects > 0) & length(participant_basis) > 0) { - - - palmsplus <- hbt_build_palmsplus(data = palms, - palmsplus_fields = palmsplus_fields, - loca = loca, - participant_basis = participant_basis, - verbose = verbose) - write_csv(palmsplus, file = fns[1]) - if (verbose) cat(">>>\n") - } else { - if (verbose) cat("skipped because insufficient input data>>>\n") - } - if (verbose) cat("\n<<< building days...") - if (length(palmsplus) > 0 & length(palmsplus_domains) > 0 & length(palmsplus_fields) & - all(Nlocation_objects > 0) & length(participant_basis) > 0) { - days <- hbt_build_days(data = palmsplus, - palmsplus_domains = palmsplus_domains, - palmsplus_fields = palmsplus_fields, - loca = loca, - participant_basis = participant_basis, - verbose = verbose) - - if (length(days) > 0) { - if (verbose) cat(paste0(" N rows in days object: ", nrow(days))) - write_csv(x = days, file = fns[2]) - } else { - if (verbose) cat(paste0(" WARNING: no days object produced.")) - } - - # sf::st_write(palmsplus, dsn = paste0(palmsplus_folder, "/", dataset_name, "_palmsplus.shp"), append = FALSE) - - } else { - if (verbose) cat("skipped because insufficient input data>>>\n") - } - if (verbose) cat(">>>\n") - trajectory_locations = trajectory_locations[order(trajectory_locations$name),] - if (verbose) cat("\n<<< building trajectories...\n") - if (length(palmsplus) > 0 & length(trajectory_fields) > 0) { - - trajectories <- hbt_build_trajectories(data = palmsplus, - trajectory_fields = trajectory_fields, - trajectory_locations = trajectory_locations) - if (length(trajectories) > 0) { - write_csv(trajectories, file = fns[3]) - shp_file = paste0(palmsplus_folder, "/", dataset_name, "_trajecories.shp") - if (file.exists(shp_file)) file.remove(shp_file) # remove because st_write does not know how to overwrite - - sf::st_write(obj = trajectories, dsn = shp_file) - if (verbose) cat(paste0(" N rows in trajectories object: ", nrow(trajectories))) - } else { - if (verbose) cat(paste0(" WARNING: no trajectories object produced.")) - } - if (verbose) cat(">>>\n") - } else { - if (verbose) cat("skipped because insufficient input data>>>\n") - } - if (verbose) cat("\n<<< building multimodal...\n") - if (length(palmsplus) > 0 & length(multimodal_fields) > 0 & length(trajectory_locations) > 0) { - multimodal <- hbt_build_multimodal(data = trajectories, - spatial_threshold = 200, - temporal_threshold = 10, - palmsplus = palmsplus, - multimodal_fields = multimodal_fields, - trajectory_locations = trajectory_locations, - verbose = verbose) - - if (length(multimodal) > 0) { - write_csv(multimodal, file = fns[4]) - shp_file = paste0(palmsplus_folder, "/", dataset_name, "_multimodal.shp") - if (file.exists(shp_file)) file.remove(shp_file) # remove because st_write does not know how to overwrite - sf::st_write(obj = multimodal, dsn = shp_file) - if (verbose) cat(paste0(" N rows in multimodal object: ", nrow(multimodal))) - } else { - if (verbose) cat(paste0(" WARNING: no multimodal object produced.")) - } - if (verbose) cat(">>>\n\n") - } else { - if (verbose) cat("skipped because insufficient input data>>>\n") - } - return() -} diff --git a/man/check_and_clean_palms_data.Rd b/man/check_and_clean_palms_data.Rd deleted file mode 100644 index 0d90039..0000000 --- a/man/check_and_clean_palms_data.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/check_and_clean_palms_data.R -\name{check_and_clean_palms_data} -\alias{check_and_clean_palms_data} -\title{check_and_clean_palms_data} -\usage{ -check_and_clean_palms_data(palms_to_clean, country_name, outputdir = NULL) -} -\arguments{ -\item{palms_to_clean}{palms_to_clean} - -\item{country_name}{country_name} - -\item{outputdir}{outputdir} -} -\value{ -palms_to_clean_lower object -} -\description{ -check_and_clean_palms_data -} diff --git a/man/hbt_build_days.Rd b/man/hbt_build_days.Rd deleted file mode 100644 index 9e0abf8..0000000 --- a/man/hbt_build_days.Rd +++ /dev/null @@ -1,43 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/hbt_build_days.R -\name{hbt_build_days} -\alias{hbt_build_days} -\title{Calculate day-level summaries from the palmsplus dataset} -\usage{ -hbt_build_days( - data = NULL, - verbose = TRUE, - palmsplus_domains = NULL, - palmsplus_fields = NULL, - loca = NULL, - participant_basis = NULL -) -} -\arguments{ -\item{data}{The palmsplus data obtained from \code{\link{palms_build_palmsplus}}.} - -\item{verbose}{Print progress to console. Default is \code{TRUE}.} - -\item{palmsplus_domains}{...} - -\item{palmsplus_fields}{...} - -\item{loca}{Nested list with location information} - -\item{participant_basis}{participant_basis} -} -\value{ -A table summarised by day. -} -\description{ -Build a days dataset by summarising \code{palmsplus} -by day and person (\code{identifier}). Not all variables in \code{palmsplus} -are summarised, only those specified using \code{\link{palms_add_field}} with -the argument \code{domain_field = TRUE}. By default, a \code{duration} field -is added (e.g., the total minutes per day). - -All data are summarised by default. However, additional aggragation \emph{domains} -can be specified using \code{\link{palms_add_domain}} before building days. -Domains are a subset of data, such as during school time. All \code{domain_field} -variables will be summarised for each \emph{domain} seperatly. -} diff --git a/man/hbt_build_multimodal.Rd b/man/hbt_build_multimodal.Rd deleted file mode 100644 index 431dce7..0000000 --- a/man/hbt_build_multimodal.Rd +++ /dev/null @@ -1,49 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/hbt_build_multimodal.R -\name{hbt_build_multimodal} -\alias{hbt_build_multimodal} -\title{Build multimodal trips from trajectories} -\usage{ -hbt_build_multimodal( - data = NULL, - spatial_threshold, - temporal_threshold, - palmsplus = NULL, - verbose = TRUE, - multimodal_fields = NULL, - trajectory_locations = NULL -) -} -\arguments{ -\item{data}{The trajectories object built with \code{palms_calc_trajectories}.} - -\item{spatial_threshold}{Spatial threshold in meters} - -\item{temporal_threshold}{Temporal threshold in minutes} - -\item{palmsplus}{...} - -\item{verbose}{Print progress after each step. Default is \code{TRUE}.} - -\item{multimodal_fields}{...} - -\item{trajectory_locations}{...} -} -\value{ -The input trajectories LINESTRING geometry, collapsed into multimodal trips -} -\description{ -Build multimodal trips from trajectories. -} -\details{ -Several columns are required in the \code{trajectories} dataset. These -need to be added as trajectory fields: -\itemize{ -\item identifier -\item tripnumber -\item mot -\item start -\item end -\item geometry -} -} diff --git a/man/hbt_build_palmsplus.Rd b/man/hbt_build_palmsplus.Rd deleted file mode 100644 index 4925a97..0000000 --- a/man/hbt_build_palmsplus.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/hbt_build_palmsplus.R -\name{hbt_build_palmsplus} -\alias{hbt_build_palmsplus} -\title{Build the palmsplus dataset} -\usage{ -hbt_build_palmsplus( - data = NULL, - verbose = TRUE, - palmsplus_fields = NULL, - loca = NULL, - participant_basis = NULL -) -} -\arguments{ -\item{data}{The PALMS data obtained using \code{\link{read_palms}}.} - -\item{verbose}{Print progress to console after each iteration. Default is \code{TRUE}.} - -\item{palmsplus_fields}{fields defined in PALMSplusRshiny} - -\item{loca}{Nested list with location information} - -\item{participant_basis}{participant_basis} -} -\description{ -Build the \code{palmsplus} dataset by adding additional columns to the PALMS dataset. -The additional columns are specified using \code{\link{palms_add_field}}. -} diff --git a/man/hbt_build_trajectories.Rd b/man/hbt_build_trajectories.Rd deleted file mode 100644 index c6b9a46..0000000 --- a/man/hbt_build_trajectories.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/hbt_build_trajectories.R -\name{hbt_build_trajectories} -\alias{hbt_build_trajectories} -\title{Build trajectories from the palmsplus dataset} -\usage{ -hbt_build_trajectories( - data = NULL, - trajectory_fields = NULL, - trajectory_locations = NULL -) -} -\arguments{ -\item{data}{The palmsplus data obtained from \code{\link{palms_build_palmsplus}}.} - -\item{trajectory_fields}{trajectory_fields} - -\item{trajectory_locations}{trajectory_locations} -} -\value{ -A table of individual trips represented as \code{LINESTRING} geometry. -} -\description{ -Build trajectories (trips) from the \code{palmsplus} dataset. This -returns a \code{sf data.frame} with \code{LINESTRING} geometry. Three columns -are returned by default (\code{identifier}, \code{tripnumber}, and \code{geometry}). -Additional columns can be specified with \code{\link{palms_add_trajectory_field}} -and \code{\link{palms_add_trajectory_location}}. -} diff --git a/man/hbt_check_missing_id.Rd b/man/hbt_check_missing_id.Rd deleted file mode 100644 index 4403680..0000000 --- a/man/hbt_check_missing_id.Rd +++ /dev/null @@ -1,37 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/hbt_check_missing_id.R -\name{hbt_check_missing_id} -\alias{hbt_check_missing_id} -\title{hbt_check_missing_id} -\usage{ -hbt_check_missing_id( - participant_basis, - palmsplus_folder, - dataset_name, - palms, - loca, - groupinglocation = "school", - verbose = TRUE -) -} -\arguments{ -\item{participant_basis}{object as loaded inside PALMSplusRshiny} - -\item{palmsplus_folder}{output folder path for storing log of excluded IDs} - -\item{dataset_name}{Name of dataset} - -\item{palms}{palms object as loaded inside PALMSplusRshiny} - -\item{loca}{Nested list with location information} - -\item{groupinglocation}{groupinglocation} - -\item{verbose}{verbose} -} -\value{ -List with participant_basis and palms object without non-matching IDs -} -\description{ -hbt_check_missing_id -} diff --git a/man/hbt_read_config.Rd b/man/hbt_read_config.Rd deleted file mode 100644 index f303b39..0000000 --- a/man/hbt_read_config.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/hbt_read_config.R -\name{hbt_read_config} -\alias{hbt_read_config} -\title{Read palmsplusr config file} -\usage{ -hbt_read_config(path) -} -\arguments{ -\item{path}{Path to config file} -} -\value{ -dataframe -} -\description{ -Read palmsplusr config file -} diff --git a/man/palmsplusr_shiny.Rd b/man/palmsplusr_shiny.Rd deleted file mode 100644 index bae240f..0000000 --- a/man/palmsplusr_shiny.Rd +++ /dev/null @@ -1,37 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/palmsplusr_shiny.R -\name{palmsplusr_shiny} -\alias{palmsplusr_shiny} -\title{palmsplusr_shiny} -\usage{ -palmsplusr_shiny( - gisdir = "", - palmsdir = "", - gislinkfile = "", - outputdir = "", - dataset_name = "", - configfile = "", - verbose = TRUE -) -} -\arguments{ -\item{gisdir}{Path to directory with GIS files} - -\item{palmsdir}{Path to PALMSpy or PALMS output directory} - -\item{gislinkfile}{Path to participant basis file, which is the file that links all participant identifies with the GIS data} - -\item{outputdir}{Path to outputdir location} - -\item{dataset_name}{Name of dataset} - -\item{configfile}{Configuration file} - -\item{verbose}{verbose Boolean} -} -\value{ -palms_to_clean_lower object -} -\description{ -palmsplusr_shiny -} From 5467d4ee40960b257650ce620e6e19451da03936 Mon Sep 17 00:00:00 2001 From: Vincent van Hees Date: Mon, 22 Jan 2024 11:39:57 +0100 Subject: [PATCH 2/2] finalise migration of palmsplusr to hbGIS #64 --- DESCRIPTION | 6 +- R/checkConfigFile.R | 8 +- R/identify_tools.R | 10 +- R/load_params.R | 15 +- R/modConfigServer.R | 26 +-- R/myApp.R | 219 +++++++++--------- R/update_params.R | 6 +- inst/NEWS.Rd | 5 + inst/testfiles_hbGIS/config_hbGIS.csv | 46 ++++ .../params_description_hbGIS.tsv | 46 ++++ .../config_palmsplusr.csv | 47 ---- .../params_description_palmsplusr.tsv | 55 ----- man/checkConfigFile.Rd | 2 +- man/load_params.Rd | 2 +- man/update_params.Rd | 2 +- tests/testthat/test_identify_tools.R | 22 +- tests/testthat/test_load_and_update_params.R | 24 +- tests/testthat/test_load_wrong_GGIRconfig.R | 2 +- 18 files changed, 271 insertions(+), 272 deletions(-) create mode 100644 inst/testfiles_hbGIS/config_hbGIS.csv create mode 100644 inst/testfiles_hbGIS/params_description_hbGIS.tsv delete mode 100755 inst/testfiles_palmsplusr/config_palmsplusr.csv delete mode 100644 inst/testfiles_palmsplusr/params_description_palmsplusr.tsv diff --git a/DESCRIPTION b/DESCRIPTION index 208b48b..1bb5d75 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: HabitusGUI Title: R Shiny App for Processing Behavioural Data -Description: Shiny app to ease processing behavioural data with research software such as GGIR, activityCounts, PALMSpy,and palmsplusr. -Version: 0.3.0 -Date: 2022-09-28 +Description: Shiny app to ease processing behavioural data with research software such as GGIR, activityCounts, PALMSpy,and hbGIS. +Version: 0.3.1 +Date: 2024-01-22 Authors@R: c(person(given = "Vincent", family = "van Hees", diff --git a/R/checkConfigFile.R b/R/checkConfigFile.R index 950c441..a712315 100644 --- a/R/checkConfigFile.R +++ b/R/checkConfigFile.R @@ -1,7 +1,7 @@ #' Function to check that the config files have the expected format #' #' @param file data path to config file -#' @param tool either PALMSpy, GGIR, or palmsplusr for now. +#' @param tool either PALMSpy, GGIR, or hbGIS for now. #' #' @return message with the result of the check (either ok or the description of a problem) #' @export @@ -17,7 +17,7 @@ checkConfigFile = function(file=c(), tool=c()) { } else { path_unlist = unlist(strsplit(x = file, split = ".", fixed = TRUE)) path_ext = tolower(path_unlist[length(path_unlist)]) - if (tool %in% c("GGIR", "hbGPS", "palmsplusr") & path_ext != "csv") { + if (tool %in% c("GGIR", "hbGPS", "hbGIS") & path_ext != "csv") { check = "The GGIR config file uploaded is not a csv file" } else if (tool == "PALMSpy" & path_ext != "json") { check = "The GGIR config file uploaded is not a json file" @@ -32,9 +32,9 @@ checkConfigFile = function(file=c(), tool=c()) { # read config file if it exists and it is a csv file params = read.csv(file = file) # sanity check 2: colnames of config file ---- - if (ncol(params) == 3 && tool != "palmsplusr") { + if (ncol(params) == 3 && tool != "hbGIS") { check_colnames = all.equal(colnames(params), c("argument", "value", "context")) - } else if (ncol(params) == 5 && tool == "palmsplusr") { + } else if (ncol(params) == 5 && tool == "hbGIS") { check_colnames = all.equal(colnames(params), c("context", "name", "formula", "domain_field", "after_conversion")) } else { check_colnames = FALSE diff --git a/R/identify_tools.R b/R/identify_tools.R index 8df23ab..f52ddda 100644 --- a/R/identify_tools.R +++ b/R/identify_tools.R @@ -14,7 +14,7 @@ setClass(Class = "toolio", slots = list(input = "character", output = "character identify_tools = function(datatypes = c("AccRaw", "ACount", "GPS", "GIS", "PALMSpy_out", "GGIR_out", "hbGPS_out"), goals = c("PA", "QC", "Trips", "Environment"), - available_tools = c("GGIR", "PALMSpy", "palmsplusr", "CountConverter", "hbGPS")) { + available_tools = c("GGIR", "PALMSpy", "hbGIS", "CountConverter", "hbGPS")) { iotools = list(GGIR = new("toolio", input = "AccRaw", output = c("GGIR_out", "ACount"), @@ -23,13 +23,13 @@ identify_tools = function(datatypes = c("AccRaw", "ACount", "GPS", "GIS", input = c("ACount", "GPS"), output = c("PALMSpy_out"), usecases = c("Trips", "QC", "Environment")), - palmsplusr = new("toolio", # palmsplusr based on PALMSpy output + hbGIS = new("toolio", # hbGIS based on PALMSpy output input = c("PALMSpy_out", "GIS"), - output = c("palmsplusr_out"), + output = c("hbGIS_out"), usecases = c("Environment", "QC")), - palmsplusr = new("toolio", # palmsplusr based on hbGPS output + hbGIS = new("toolio", # hbGIS based on hbGPS output input = c("hbGPS_out", "GIS"), - output = c("palmsplusr_out"), + output = c("hbGIS_out"), usecases = c("Environment", "QC")), CountConverter = new("toolio", input = "AccRaw", diff --git a/R/load_params.R b/R/load_params.R index 1d7f1f1..30a69e3 100644 --- a/R/load_params.R +++ b/R/load_params.R @@ -1,7 +1,7 @@ #' load_params #' #' @param file Character to specify location of configuration file -#' @param format Character to specify format of configuration file: json_palsmpy, csv_GGIR, csv_palmsplusr, csv_hbGPS +#' @param format Character to specify format of configuration file: json_palsmpy, csv_GGIR, csv_hbGIS, csv_hbGPS #' @return list of parameters extract from the configuration file #' @importFrom jsonlite fromJSON #' @importFrom utils read.csv read.table @@ -71,24 +71,23 @@ load_params = function(file=c(), format="json_palmspy") { rownames(params_merged) = params_merged$parameter params = params_merged[, expected_tsv_columns] params = params[,-which(colnames(params) == "subfield")] - } else if (format == "csv_palmsplusr") { + } else if (format == "csv_hbGIS") { params = read.csv(file = file, sep = ",") # remove duplicates, because sometimes GGIR config files have duplicates dups = duplicated(params) params = params[!dups,] # Keep only parameters with a matching description in the description file - params_info_palmsplusr_file = system.file("testfiles_palmsplusr/params_description_palmsplusr.tsv", package = "HabitusGUI")[1] - params_info_palmsplusr = read.table(file = params_info_palmsplusr_file, sep = "\t", header = TRUE) - params_info_palmsplusr$id = with(params_info_palmsplusr, paste0(field, "__", parameter)) + params_info_hbGIS_file = system.file("testfiles_hbGIS/params_description_hbGIS.tsv", package = "HabitusGUI")[1] + params_info_hbGIS = read.table(file = params_info_hbGIS_file, sep = "\t", header = TRUE) + params_info_hbGIS$id = with(params_info_hbGIS, paste0(field, "__", parameter)) params$id = with(params, paste0(params$context, "__", params$name)) - params_merged = merge(params_info_palmsplusr, params, by.x = "id", by.y = "id") + params_merged = merge(params_info_hbGIS, params, by.x = "id", by.y = "id") dups = duplicated(params_merged) params_merged = params_merged[!dups,] rownames(params_merged) = params_merged$id colnames(params_merged)[which(colnames(params_merged) == "formula")] = "value" - # colnames(params_merged)[which(colnames(params_merged) == "id")] = "field" colnames(params_merged)[which(colnames(params_merged) == "name")] = "subfield" - expected_tsv_columns = c(expected_tsv_columns, "domain_field", "after_conversion") + expected_tsv_columns = c(expected_tsv_columns, "is_where_field", "after_conversion") params = params_merged[, expected_tsv_columns] params = params[,-which(colnames(params) %in% c("subfield", "id", "field"))] } diff --git a/R/modConfigServer.R b/R/modConfigServer.R index 6fd2637..1784698 100644 --- a/R/modConfigServer.R +++ b/R/modConfigServer.R @@ -38,11 +38,11 @@ modConfigServer = function(id, tool, homedir = getwd()) { if (config_default != file) file.copy(config_default, file) }, contentType = "text/csv") - } else if (tool() == "palmsplusr") { + } else if (tool() == "hbGIS") { output$download = downloadHandler( - filename = "config_palmsplusr.csv", + filename = "config_hbGIS.csv", content <- function(file) { - config_default = system.file("testfiles_palmsplusr/config_palmsplusr.csv", package = "HabitusGUI")[1] + config_default = system.file("testfiles_hbGIS/config_hbGIS.csv", package = "HabitusGUI")[1] if (config_default != file) file.copy(config_default, file) }, contentType = "text/csv") @@ -86,8 +86,8 @@ modConfigServer = function(id, tool, homedir = getwd()) { params = load_params(file = current_config, format = "json_palmspy") #$datapath } else if (tool() == "GGIR") { params = load_params(file = current_config, format = "csv_ggir") #$datapath - } else if (tool() == "palmsplusr") { - params = load_params(file = current_config, format = "csv_palmsplusr") #$datapath + } else if (tool() == "hbGIS") { + params = load_params(file = current_config, format = "csv_hbGIS") #$datapath } else if (tool() == "hbGPS") { params = load_params(file = current_config, format = "csv_hbGPS") #$datapath } @@ -134,8 +134,8 @@ modConfigServer = function(id, tool, homedir = getwd()) { update_params(new_params = v$params, file = current_config, format = "json_palmspy") #$datapath } else if (tool() == "GGIR") { update_params(new_params = v$params, file = current_config, format = "csv_ggir") #$datapath - } else if (tool() == "palmsplusr") { - update_params(new_params = v$params, file = current_config, format = "csv_palmsplusr") #$datapath + } else if (tool() == "hbGIS") { + update_params(new_params = v$params, file = current_config, format = "csv_hbGIS") #$datapath } else if (tool() == "hbGPS") { update_params(new_params = v$params, file = current_config, format = "csv_hbGPS") #$datapath } @@ -152,8 +152,8 @@ modConfigServer = function(id, tool, homedir = getwd()) { update_params(new_params = v$params, file = current_config, format = "json_palmspy") #$datapath } else if (tool() == "GGIR") { update_params(new_params = v$params, file = current_config, format = "csv_ggir") #$datapath - } else if (tool() == "palmsplusr") { - update_params(new_params = v$params, file = current_config, format = "csv_palmsplusr") #$datapath + } else if (tool() == "hbGIS") { + update_params(new_params = v$params, file = current_config, format = "csv_hbGIS") #$datapath } else if (tool() == "hbGPS") { update_params(new_params = v$params, file = current_config, format = "csv_hbGPS") #$datapath } @@ -204,8 +204,8 @@ modConfigServer = function(id, tool, homedir = getwd()) { explanation = paste0("PALMSpy takes as input summarised accelerometer data (ActiGraph counts) ", "and GPS data and uses them to estimate movement behaviours from the ", "perspective location in a country or city and travel distance and speed") - } else if (tool() == "palmsplusr") { - explanation = paste0("palmsplusr takes as input PALMSpy output, GIS shape, and a GISlinkage file ", + } else if (tool() == "hbGIS") { + explanation = paste0("hbGIS takes as input PALMSpy output, GIS shape, and a GISlinkage file ", "and uses these to describe behaviour per domain.") } else if (tool() == "hbGPS") { explanation = paste0("hbGPS takes as input GGIR output and GPS data and uses them to estimate", @@ -219,8 +219,8 @@ modConfigServer = function(id, tool, homedir = getwd()) { config_explanation2 = "GGIR configuration files are in .csv format. If you do not have one Download a template below." } else if (tool() == "PALMSpy") { config_explanation2 = "PALMSpy configuration files are in .json. If you do not have one Download a template below." - } else if (tool() == "palmsplusr") { - config_explanation2 = "palmsplusr configuration files are in .csv. If you do not have one Download a template below." + } else if (tool() == "hbGIS") { + config_explanation2 = "hbGIS configuration files are in .csv. If you do not have one Download a template below." } else if (tool() == "hbGPS") { config_explanation2 = "hbGPS configuration files are in .csv. If you do not have one Download a template below." } diff --git a/R/myApp.R b/R/myApp.R index fa5e75f..b3c98ce 100644 --- a/R/myApp.R +++ b/R/myApp.R @@ -16,6 +16,8 @@ # pkgload::load_all("."); myApp(homedir="D:/Dropbox/Work/sharedfolder/DATA/Habitus") # myApp(homedir="D:/Dropbox/Work/sharedfolder/DATA/Habitus/GPSprocessing/BEtestdata") # myApp(homedir="D:/Dropbox/Work/sharedfolder/DATA/Habitus/GPSprocessing/Teun/Driestam") +# myApp(homedir="D:/Dropbox/Work/sharedfolder/DATA/Habitus/GPSprocessing/NBBB2010") + # roxygen2::roxygenise() @@ -23,11 +25,11 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { stdout_GGIR_tmp <- tempfile(fileext = ".log") - stdout_palmsplusr_tmp <- tempfile(fileext = ".log") + stdout_hbGIS_tmp <- tempfile(fileext = ".log") stdout_hbGPS_tmp <- tempfile(fileext = ".log") stdout_PALMSpy_tmp <- tempfile(fileext = ".log") mylog_GGIR <- shiny::reactiveFileReader(500, NULL, stdout_GGIR_tmp, readLines, warn = FALSE) - mylog_palmsplusr <- shiny::reactiveFileReader(500, NULL, stdout_palmsplusr_tmp, readLines, warn = FALSE) + mylog_hbGIS <- shiny::reactiveFileReader(500, NULL, stdout_hbGIS_tmp, readLines, warn = FALSE) mylog_hbGPS <- shiny::reactiveFileReader(500, NULL, stdout_hbGPS_tmp, readLines, warn = FALSE) mylog_PALMSpy <- shiny::reactiveFileReader(500, NULL, stdout_PALMSpy_tmp, readLines, warn = FALSE) @@ -36,7 +38,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { "max-height: 300px; background: ghostwhite;", "position:relative; align: centre;") ui <- function() { - + fluidPage( theme = bslib::bs_theme(bootswatch = "litera"), #,"sandstone"), "sketchy" "pulse" # preview examples: https://bootswatch.com/ @@ -56,7 +58,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { checkboxGroupInput("availabledata", label = "Which type(s) of data would you like to analyse? ", choiceNames = list("Acceleration (all formats accepted by GGIR)", "GPS (in .csv format)", - "GIS (shape files + linkage file)", + "GIS (shape files + optionally linkage file)", "Sleep Diary (in GGIR compatible .csv format)", "previously generated GGIR time series output", "previously generated hbGPS output", @@ -72,13 +74,13 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { "input.availabledata.indexOf(`GPS`) > -1) || ", "(input.availabledata.indexOf(`AccRaw`) > -1 && ", # hbGPS variant 2 "input.availabledata.indexOf(`GPS`) > -1) || ", - "(input.availabledata.indexOf(`ACount`) > -1 && ", # palmsplusr variant 1 + "(input.availabledata.indexOf(`ACount`) > -1 && ", # hbGIS variant 1 "input.availabledata.indexOf(`GPS`) > -1 && ", "input.availabledata.indexOf(`GIS`) > -1) || ", - "(input.availabledata.indexOf(`AccRaw`) > -1 && ", # palmsplusr variant 2 + "(input.availabledata.indexOf(`AccRaw`) > -1 && ", # hbGIS variant 2 "input.availabledata.indexOf(`GPS`) > -1 && ", "input.availabledata.indexOf(`GIS`) > -1) || ", - "((input.availabledata.indexOf(`hbGPS_out`) > -1 || ", #palmsplusr variant 3 + "((input.availabledata.indexOf(`hbGPS_out`) > -1 || ", #hbGIS variant 3 "input.availabledata.indexOf(`PALMSpy_out`) > -1) && ", "input.availabledata.indexOf(`GIS`) > -1)"), hr(), @@ -91,10 +93,10 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { checkboxGroupInput("tools", label = "Select the tools you would like to use:", choiceNames = list("GGIR (R package)", "hbGPS (R package)", - "palmsplusr (R package)", + "hbGIS (R package)", "CountConverter (R package GGIR + actilifecounts) => soon to be deprecated from this app", "PALMSpy (Python library) => soon to be deprecated from this app"), - choiceValues = list("GGIR", "hbGPS", "palmsplusr", + choiceValues = list("GGIR", "hbGPS", "hbGIS", "CountConverter", "PALMSpy"), width = '100%') ), hr(), @@ -139,20 +141,20 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { hr() ), # Select input folder GIS data and GIS linkage file ----------------------------------- - conditionalPanel(condition = "input.availabledata.indexOf(`GIS`) > -1 && input.tools.includes(`palmsplusr`)", + conditionalPanel(condition = "input.availabledata.indexOf(`GIS`) > -1 && input.tools.includes(`hbGIS`)", shinyFiles::shinyDirButton("gisdir", label = "GIS data directory...", title = "Select GIS data directory"), verbatimTextOutput("gisdir", placeholder = TRUE), uiOutput("uiSelectedGisdir"), hr(), - shinyFiles::shinyFilesButton("gislinkfile", label = "GIS linkage file...", + shinyFiles::shinyFilesButton("gislinkfile", label = "GIS linkage file... (optional)", title = "Select GIS linkage file", multiple = FALSE), verbatimTextOutput("gislinkfile", placeholder = TRUE), hr() ), # Select input folder PALMSpy output data ----------------------------------- conditionalPanel(condition = paste0("input.availabledata.indexOf(`PALMSpy_out`) > -1 && ", - "input.tools.includes(`palmsplusr`) && !input.tools.includes(`PALMSpy`)"), + "input.tools.includes(`hbGIS`) && !input.tools.includes(`PALMSpy`)"), shinyFiles::shinyDirButton("palmspyoutdir", label = "Previously generated PALMS(py) output directory...", title = "Select PALMS(py) output directory"), verbatimTextOutput("palmspyoutdir", placeholder = TRUE), @@ -168,7 +170,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { ), # Select input folder hbGPS output data ----------------------------------- conditionalPanel(condition = paste0("input.availabledata.indexOf(`hbGPS_out`) > -1 && ", - "input.tools.includes(`palmsplusr`) && !input.tools.includes(`hbGPS`)"), + "input.tools.includes(`hbGIS`) && !input.tools.includes(`hbGPS`)"), shinyFiles::shinyDirButton("hbGPSoutdir", label = "Previously generated hbGPS output directory...", title = "Select hbGPS output directory"), verbatimTextOutput("hbGPSoutdir", placeholder = TRUE), @@ -190,7 +192,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { ) ), # Provide dataset name (only needed when working with GIS data --------------------------------- - conditionalPanel(condition = "input.availabledata.indexOf(`GIS`) > -1 && input.tools.includes(`palmsplusr`)", + conditionalPanel(condition = "input.availabledata.indexOf(`GIS`) > -1 && input.tools.includes(`hbGIS`)", strong(textInput("dataset_name", label = "Give your dataset a name:", value = "", width = '100%')), ), hr(), @@ -228,9 +230,9 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { modConfigUI("edit_hbGPS_config"), hr() ), - conditionalPanel(condition = "input.tools.includes('palmsplusr')", - h2("palmsplusr"), - modConfigUI("edit_palmsplusr_config"), + conditionalPanel(condition = "input.tools.includes('hbGIS')", + h2("hbGIS"), + modConfigUI("edit_hbGIS_config"), hr() ), hr(), @@ -315,22 +317,22 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { DT::dataTableOutput("hbGPS_file1"), hr() ), - conditionalPanel(condition = "input.tools.includes('palmsplusr')", - h3("palmsplusr:"), + conditionalPanel(condition = "input.tools.includes('hbGIS')", + h3("hbGIS:"), shinyjs::useShinyjs(), - actionButton("start_palmsplusr", "Start analysis", width = '300px'), + actionButton("start_hbGIS", "Start analysis", width = '300px'), p("\n"), - tags$style(HTML(paste0("#mylog_palmsplusr {", logViewStyle, "}"))), br(), - checkboxInput("palmsplusr_showlog", "hide log", value = FALSE), + tags$style(HTML(paste0("#mylog_hbGIS {", logViewStyle, "}"))), br(), + checkboxInput("hbGIS_showlog", "hide log", value = FALSE), shinyjs::hidden( - div(id = "palmsplusr_log_div", - verbatimTextOutput("mylog_palmsplusr", placeholder = TRUE) + div(id = "hbGIS_log_div", + verbatimTextOutput("mylog_hbGIS", placeholder = TRUE) ) ), p("\n"), - htmlOutput("palmsplusr_end_message"), + htmlOutput("hbGIS_end_message"), p("\n"), - DT::dataTableOutput("palmsplusr_file1"), + DT::dataTableOutput("hbGIS_file1"), hr() ), actionButton("page_43", "prev"), @@ -414,13 +416,13 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { if ("hbGPS" %in% input$tools == TRUE & all(c("GPS", "GGIR_out") %in% input$availabledata == FALSE)) { showNotification("hbGPS not possible without access to GPS data and GGIR times series output", type = "error") } else { - if ("palmsplusr" %in% input$tools == TRUE & "GIS" %in% input$availabledata == FALSE) { - showNotification("palmsplusr not possible without access to GIS data", type = "error") + if ("hbGIS" %in% input$tools == TRUE & "GIS" %in% input$availabledata == FALSE) { + showNotification("hbGIS not possible without access to GIS data", type = "error") } else { - if ("palmsplusr" %in% input$tools == TRUE & ("PALMSpy_out" %in% input$availabledata == FALSE & - "hbGPS_out" %in% input$availabledata == FALSE & - "GPS" %in% input$availabledata == FALSE & all(c("AccRaw", "ACount") %in% input$availabledata == FALSE))) { - showNotification(paste0("palmsplusr requires either previously", + if ("hbGIS" %in% input$tools == TRUE & ("PALMSpy_out" %in% input$availabledata == FALSE & + "hbGPS_out" %in% input$availabledata == FALSE & + "GPS" %in% input$availabledata == FALSE & all(c("AccRaw", "ACount") %in% input$availabledata == FALSE))) { + showNotification(paste0("hbGIS requires either previously", " generated PALMS(py) or hbGPS output,", " or GPS and Accelerometer data such", " that either PALMSpyor hbGPS can be", @@ -450,7 +452,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { observeEvent(input$page_23, { # Previous selection of directories prevPathNames = c("rawaccdir", "countaccdir", "sleepdiaryfile", - "configfileGGIR", "configfilepalmsplusr", "configfilehbGPS", + "configfileGGIR", "configfilehbGIS", "configfilehbGPS", "gpsdir", "gisdir", "gislinkfile", "palmspyoutdir", "hbGPSoutdir", "ggiroutdir", "outputdir") prevPathNames = prevPathNames[which(prevPathNames %in% names(values))] @@ -493,17 +495,19 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { length(current_sleepdiary) == 0 & is.null(selectedSleepdiaryfile)) { showNotification("Select sleepdiary file", type = "error") } else { - current_gislinkfile = as.character(parseFilePaths(c(home = homedir), input$gislinkfile)$datapath) if ("GIS" %in% input$availabledata & - "palmsplusr" %in% input$tools & - (as.character(input$gisdir)[1] == "0" | - length(current_gislinkfile) == 0) & is.null(selectedGisdir)) { - showNotification("Select GIS data directory and GIS linkage file", type = "error") + "hbGIS" %in% input$tools & + as.character(input$gisdir)[1] == "0") { + showNotification("Select GIS data directory", type = "error") } else { - if ("PALMSpy_out" %in% input$availabledata & "palmsplusr" %in% input$tools & as.character(input$palmspyoutdir)[1] == "0" & is.null(selected_PALMSpyoutdir)) { + # current_gislinkfile = as.character(parseFilePaths(c(home = homedir), input$gislinkfile)$datapath) + # if (length(current_gislinkfile) == 0 & is.null(selectedGisdir)) { + # showNotification("Note that no GIS linkage file is specified", type = "warning") + # } else { + if ("PALMSpy_out" %in% input$availabledata & "hbGIS" %in% input$tools & as.character(input$palmspyoutdir)[1] == "0" & is.null(selected_PALMSpyoutdir)) { showNotification("Select previously generated PALMS(py) output directory", type = "error") } else { - if ("hbGPS_out" %in% input$availabledata & "palmsplusr" %in% input$tools & as.character(input$hbGPSoutdir)[1] == "0" & is.null(selected_hbGPSoutdir)) { + if ("hbGPS_out" %in% input$availabledata & "hbGIS" %in% input$tools & as.character(input$hbGPSoutdir)[1] == "0" & is.null(selected_hbGPSoutdir)) { showNotification("Select previously generated hbGPS output directory", type = "error") } else { if ("GGIR_out" %in% input$availabledata & "hbGPS" %in% input$tools & as.character(input$ggiroutdir)[1] == "0" & is.null(selected_GGIRoutdir)) { @@ -513,6 +517,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { } } } + # } } } } @@ -565,8 +570,8 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { configs_ready = FALSE } } - if ("palmsplusr" %in% input$tools) { - if (length(paste0(configfilepalmsplusr())) == 0) { + if ("hbGIS" %in% input$tools) { + if (length(paste0(configfilehbGIS())) == 0) { configs_ready = FALSE } } @@ -622,11 +627,11 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { values$configfilehbGPS = copyFile(from = config_from, to = config_to) } } - if ("palmsplusr" %in% input$tools) { - config_from = cleanPath(configfilepalmsplusr()) - config_to = cleanPath(paste0(global$data_out, "/config_palmsplusr.csv")) + if ("hbGIS" %in% input$tools) { + config_from = cleanPath(configfilehbGIS()) + config_to = cleanPath(paste0(global$data_out, "/config_hbGIS.csv")) if (length(config_from) > 0) { - values$configfilepalmsplusr = copyFile(from = config_from, to = config_to) + values$configfilehbGIS = copyFile(from = config_from, to = config_to) } } save(values, file = "./HabitusGUIbookmark.RData") @@ -954,7 +959,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { configfilePALMSpy <- modConfigServer("edit_palmspy_config", tool = reactive("PALMSpy"), homedir = homedir) configfileGGIR <- modConfigServer("edit_ggir_config", tool = reactive("GGIR"), homedir = homedir) configfilehbGPS <- modConfigServer("edit_hbGPS_config", tool = reactive("hbGPS"), homedir = homedir) - configfilepalmsplusr <- modConfigServer("edit_palmsplusr_config", tool = reactive("palmsplusr"), homedir = homedir) + configfilehbGIS <- modConfigServer("edit_hbGIS_config", tool = reactive("hbGIS"), homedir = homedir) #======================================================================== @@ -1198,7 +1203,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { if (dirname(expected_ggir_results_dir) != "ms5.rawout") { expected_ggir_results_dir = paste0(expected_ggir_results_dir, "/meta/ms5.outraw") } - + if (dir.exists(expected_ggir_results_dir)) { Nfiles_in_dir = length(dir(path = expected_ggir_results_dir, pattern = "csv", recursive = FALSE, full.names = FALSE)) if (Nfiles_in_dir > 0) { @@ -1297,15 +1302,15 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { #======================================================================== - # Apply palmsplusr after button is pressed + # Apply hbGIS after button is pressed #======================================================================== - runpalmsplusr <- eventReactive(input$start_palmsplusr, { - palmsplusr_message = "" + runhbGIS <- eventReactive(input$start_hbGIS, { + hbGIS_message = "" - if ("palmsplusr" %in% input$tools) { - palmsplusr_message = "Error: Contact maintainer" + if ("hbGIS" %in% input$tools) { + hbGIS_message = "Error: Contact maintainer" # Basic check before running function: - ready_to_run_palmsplusr = FALSE + ready_to_run_hbGIS = FALSE # Check for PALMSpy output (two possible sources either from this run or from a previous run) if ("PALMSpy_out" %in% input$availabledata) { if (dir.exists(global$palmspyout_in)) { @@ -1318,7 +1323,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { } else { expected_results_dir = paste0(global$data_out,"/hbGPSoutput") } - + if (dir.exists(expected_results_dir)) { Nfiles_in_dir = length(dir(path = expected_results_dir, pattern = "csv", recursive = FALSE, full.names = FALSE)) @@ -1327,40 +1332,40 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { if (dir.exists(global$gis_in)) { Nfiles_in_gisdir = length(dir(path = global$gis_in, recursive = FALSE, full.names = FALSE)) if (Nfiles_in_gisdir > 0) { - if (file.exists(global$gislinkfile_in)) { - ready_to_run_palmsplusr = TRUE - } else { - palmsplusr_message = paste0("GIS link file not found: ", global$gislinkfile_in) - } + # if (file.exists(global$gislinkfile_in)) { + ready_to_run_hbGIS = TRUE + # } else { + # hbGIS_message = paste0("GIS link file not found: ", global$gislinkfile_in) + # } } else { - palmsplusr_message = paste0("No files found in GIS folder: ", global$gis_in) + hbGIS_message = paste0("No files found in GIS folder: ", global$gis_in) } } else { - palmsplusr_message = paste0("Folder that is supposed to hold GIS files does not exist: ", global$gis_in) + hbGIS_message = paste0("Folder that is supposed to hold GIS files does not exist: ", global$gis_in) } } else { nameinput = ifelse(test = "PALMSpy_out" %in% input$availabledata, yes = "PALMSpy", no = "hbGPS") - palmsplusr_message = paste0("No files found in ", nameinput, " output folder: ", expected_results_dir) + hbGIS_message = paste0("No files found in ", nameinput, " output folder: ", expected_results_dir) } } else { - palmsplusr_message = paste0("Folder that is supposed to hold acceleration files does not exist: ", expected_results_dir) + hbGIS_message = paste0("Folder that is supposed to hold acceleration files does not exist: ", expected_results_dir) } # Only run function when checks are met: - if (ready_to_run_palmsplusr == TRUE) { - shinyjs::hide(id = "start_palmsplusr") - id_palmsplusr = showNotification("palmsplusr in progress ...", type = "message", duration = NULL, closeButton = FALSE) + if (ready_to_run_hbGIS == TRUE) { + shinyjs::hide(id = "start_hbGIS") + id_hbGIS = showNotification("hbGIS in progress ...", type = "message", duration = NULL, closeButton = FALSE) - write.table(x = NULL, file = stdout_palmsplusr_tmp) # initialise empty file - observeEvent(input$palmsplusr_showlog, { - shinyjs::toggle('palmsplusr_log_div') - output$mylog_palmsplusr <- renderText({ - paste(mylog_palmsplusr(), collapse = '\n') + write.table(x = NULL, file = stdout_hbGIS_tmp) # initialise empty file + observeEvent(input$hbGIS_showlog, { + shinyjs::toggle('hbGIS_log_div') + output$mylog_hbGIS <- renderText({ + paste(mylog_hbGIS(), collapse = '\n') }) }) # If process somehow unexpectedly terminates, always copy tmp log # file to actual log file for user to see - logfile = paste0(isolate(global$data_out), "/palmsplusr.log") - on.exit(file.copy(from = stdout_palmsplusr_tmp, to = logfile, overwrite = TRUE), add = TRUE) + logfile = paste0(isolate(global$data_out), "/hbGIS.log") + on.exit(file.copy(from = stdout_hbGIS_tmp, to = logfile, overwrite = TRUE), add = TRUE) # hbGIS(#country_name = "BA", # <= Discuss, extract from GIS foldername? # # participant_exclude_list, # <= Discuss, leave out from linkfile? @@ -1377,14 +1382,14 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { # gislinkfile = global$gislinkfile_in, # outputdir = isolate(global$data_out), # dataset_name = input$dataset_name, - # configfile = paste0(global$data_out, "/config_palmsplusr.csv"))) + # configfile = paste0(global$data_out, "/config_hbGIS.csv"))) - # Start palmsplusr - x_palmsplusr <- r_bg(func = function(hbGIS, gisdir, palmsdir, - gislinkfile, outputdir, dataset_name, - configfile){ + # Start hbGIS + x_hbGIS <- r_bg(func = function(hbGIS, gisdir, palmsdir, + gislinkfile, outputdir, dataset_name, + configfile){ hbGIS(gisdir, palmsdir, gislinkfile, - outputdir, dataset_name, configfile) + outputdir, dataset_name, configfile) }, args = list(hbGIS = hbGIS, gisdir = global$gis_in, @@ -1392,10 +1397,10 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { gislinkfile = global$gislinkfile_in, outputdir = isolate(global$data_out), dataset_name = input$dataset_name, - configfile = paste0(global$data_out, "/config_palmsplusr.csv")), - stdout = stdout_palmsplusr_tmp, + configfile = paste0(global$data_out, "/config_hbGIS.csv")), + stdout = stdout_hbGIS_tmp, stderr = "2>&1") - # # Start PALMSplusR + # # Start hbGIS # hbGIS(#country_name = "BA", # <= Discuss, extract from GIS foldername? # # participant_exclude_list, # <= Discuss, leave out from linkfile? # gisdir = global$gis_in, @@ -1405,40 +1410,40 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { # dataset_name = input$dataset_name) observe({ - if (x_palmsplusr$poll_io(0)[["process"]] != "ready") { + if (x_hbGIS$poll_io(0)[["process"]] != "ready") { invalidateLater(5000) } else { - on.exit(removeNotification(id_palmsplusr), add = TRUE) + on.exit(removeNotification(id_hbGIS), add = TRUE) # When process is finished copy tmp log file to actual log file for user to see - if (file.exists(stdout_palmsplusr_tmp)) { - file.copy(from = stdout_palmsplusr_tmp, to = logfile, overwrite = TRUE) + if (file.exists(stdout_hbGIS_tmp)) { + file.copy(from = stdout_hbGIS_tmp, to = logfile, overwrite = TRUE) } # Now check whether results are correctly generated: - expected_palmsplusr_folder = paste0(isolate(global$data_out), "/palmsplusr_output") - if (dir.exists(expected_palmsplusr_folder) == TRUE) { - csv_files_palmsplusr = dir(expected_palmsplusr_folder, pattern = "csv", recursive = TRUE, full.names = TRUE) - if (length(csv_files_palmsplusr) > 0) { - palmsplusr_message = paste0(#"PALMSplusR successfully completed at ", Sys.time(), - "Output is stored in: ", expected_palmsplusr_folder, #
- paste0("
The table below shows the content of ", basename(csv_files_palmsplusr)[1]), + expected_hbGIS_folder = paste0(isolate(global$data_out), "/hbGIS_output") + if (dir.exists(expected_hbGIS_folder) == TRUE) { + csv_files_hbGIS = dir(expected_hbGIS_folder, pattern = "csv", recursive = TRUE, full.names = TRUE) + if (length(csv_files_hbGIS) > 0) { + hbGIS_message = paste0(#"hbGIS successfully completed at ", Sys.time(), + "Output is stored in: ", expected_hbGIS_folder, #
+ paste0("
The table below shows the content of ", basename(csv_files_hbGIS)[1]), "
Log file: ", logfile) Sys.sleep(3) - palmsplusr_file1 = read.csv(file = csv_files_palmsplusr[1]) - if (length(palmsplusr_file1) > 0) { - output$palmsplusr_file1 <- DT::renderDataTable(palmsplusr_file1, options = list(scrollX = TRUE)) + hbGIS_file1 = read.csv(file = csv_files_hbGIS[1]) + if (length(hbGIS_file1) > 0) { + output$hbGIS_file1 <- DT::renderDataTable(hbGIS_file1, options = list(scrollX = TRUE)) } } else { - palmsplusr_message = paste0("palmsplusr unsuccessful", - "
No file found inside: ", expected_palmsplusr_folder, #
- "
Log file: ", logfile) + hbGIS_message = paste0("hbGIS unsuccessful", + "
No file found inside: ", expected_hbGIS_folder, #
+ "
Log file: ", logfile) } } else { - palmsplusr_message = paste0("palmsplusr unsuccessful", - "
No file found inside: ", expected_palmsplusr_folder, - "
Log file: ", logfile) + hbGIS_message = paste0("hbGIS unsuccessful", + "
No file found inside: ", expected_hbGIS_folder, + "
Log file: ", logfile) } - output$palmsplusr_end_message <- renderUI({ - HTML(paste0(palmsplusr_message)) + output$hbGIS_end_message <- renderUI({ + HTML(paste0(hbGIS_message)) }) } }) @@ -1469,8 +1474,8 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) { output$hbGPS_end_message <- renderText({ message = runhbGPS() }) - output$palmsplusr_end_message <- renderText({ - message = runpalmsplusr() + output$hbGIS_end_message <- renderText({ + message = runhbGIS() }) } # Run the application diff --git a/R/update_params.R b/R/update_params.R index 414b9ea..08e2f13 100644 --- a/R/update_params.R +++ b/R/update_params.R @@ -1,7 +1,7 @@ #' update_params #' #' @param file Character to specify location of original configuration file -#' @param format Character to specify format of configuration file: json_palsmpy, csv_GGIR, csv_hbGPS or csv_palmsplusr +#' @param format Character to specify format of configuration file: json_palsmpy, csv_GGIR, csv_hbGPS or csv_hbGIS #' @param new_params New parameters #' @return No object returned, function only reads original data, and overwrites parameters and stores it again #' @importFrom jsonlite fromJSON toJSON @@ -19,7 +19,7 @@ update_params = function(new_params = c(), file = c(), format="json_palmspy") { for (j in 1:nrow(new_params)) { ind = which(rownames(params) %in% rownames(new_params)[j] == TRUE) if (length(ind) > 0) { - if (format == "csv_palmsplusr") { + if (format == "csv_hbGIS") { if (new_params$value[j] != params$formula[ind]) { params$formula[ind] = new_params$value[j] } @@ -87,7 +87,7 @@ update_params = function(new_params = c(), file = c(), format="json_palmspy") { params = read.csv(file = file) params = overwriteMatchingFields(params, new_params, format) write.csv(x = params, file = file, row.names = FALSE) - } else if (format == "csv_palmsplusr") { + } else if (format == "csv_hbGIS") { params = read.csv(file = file, sep = ",") params$argument = with(params, paste0(params$context, "__",params$name)) params = overwriteMatchingFields(params, new_params, format) diff --git a/inst/NEWS.Rd b/inst/NEWS.Rd index a75c507..8371e2d 100755 --- a/inst/NEWS.Rd +++ b/inst/NEWS.Rd @@ -1,6 +1,11 @@ \name{NEWS} \title{News for Package \pkg{HabitusGUI}} \newcommand{\cpkg}{\href{http://CRAN.R-project.org/package=#1}{\pkg{#1}}} +\section{Changes in version 0.3.1 (GitHub-only-release date: 22-01-2024)}{ + \itemize{ + \item Migrate all palmsplusr functionality hbGIS package, see issue #64. + } +} \section{Changes in version 0.3.0 (GitHub-only-release date: 28-09-2023)}{ \itemize{ \item Series of fixes based on initial testing phase, see issue #94. diff --git a/inst/testfiles_hbGIS/config_hbGIS.csv b/inst/testfiles_hbGIS/config_hbGIS.csv new file mode 100644 index 0000000..338decc --- /dev/null +++ b/inst/testfiles_hbGIS/config_hbGIS.csv @@ -0,0 +1,46 @@ +"context","name","formula","is_where_field","after_conversion" +"whenwhat_field","weekday","dow < 6",FALSE,NA +"whenwhat_field","weekend","dow > 5",FALSE,NA +"whenwhat_field","indoors","iov == 3",FALSE,NA +"whenwhat_field","outdoors","iov == 1",FALSE,NA +"whenwhat_field","in_vehicle","iov == 2",FALSE,NA +"whenwhat_field","inserted","fixtypecode == 6",FALSE,NA +"whenwhat_field","pedestrian","tripmot == 1",FALSE,NA +"whenwhat_field","bicycle","tripmot == 2",FALSE,NA +"whenwhat_field","vehicle","tripmot == 3",FALSE,NA +"whenwhat_field","nonwear","activityintensity < 0",TRUE,NA +"whenwhat_field","wear","activityintensity >= 0",TRUE,NA +"whenwhat_field","sedentary","activityintensity == 0",TRUE,NA +"whenwhat_field","light","activityintensity == 1",TRUE,NA +"whenwhat_field","moderate","activityintensity == 2",TRUE,NA +"whenwhat_field","vigorous","activityintensity == 3",TRUE,NA +"whenwhat_field","mvpa","moderate + vigorous",TRUE,NA +"trajectory_field","mot","first(tripmot)",NA,FALSE +"trajectory_field","date","first(as.Date(datetime))",NA,FALSE +"trajectory_field","start","datetime[triptype==1]",NA,FALSE +"trajectory_field","end","datetime[triptype==4]",NA,FALSE +"trajectory_field","duration","as.numeric(difftime(end, start, units = ""secs"") + 30)",NA,FALSE +"trajectory_field","nonwear","sum(activityintensity < 0) * 15",NA,FALSE +"trajectory_field","wear","sum(activityintensity >= 0) * 15",NA,FALSE +"trajectory_field","sedentary","sum(activityintensity == 1) * 15",NA,FALSE +"trajectory_field","light","sum(activityintensity == 1) * 15",NA,FALSE +"trajectory_field","moderate","sum(activityintensity == 2) * 15",NA,FALSE +"trajectory_field","vigorous","sum(activityintensity == 3) * 15",NA,FALSE +"trajectory_field","mvpa","moderate + vigorous",NA,FALSE +"trajectory_field","length","as.numeric(st_length(geometry))",NA,TRUE +"trajectory_field","speed","(length / duration) * 3.6",NA,TRUE +"multimodal_field","duration","sum",NA,NA +"multimodal_field","nonwear","sum",NA,NA +"multimodal_field","wear","sum",NA,NA +"multimodal_field","sedentary","sum",NA,NA +"multimodal_field","light","sum",NA,NA +"multimodal_field","moderate","sum",NA,NA +"multimodal_field","vigorous","sum",NA,NA +"multimodal_field","mvpa","sum",NA,NA +"multimodal_field","length","sum",NA,NA +"multimodal_field","speed","mean",NA,NA +"general","groupinglocation","school",NA,NA +"general","baselocation","home",NA,NA +"general","write_shp","FALSE",NA,NA +"general","split_GIS","TRUE",NA,NA +"general","sublocationID","OBJECTID",NA,NA diff --git a/inst/testfiles_hbGIS/params_description_hbGIS.tsv b/inst/testfiles_hbGIS/params_description_hbGIS.tsv new file mode 100644 index 0000000..b5890df --- /dev/null +++ b/inst/testfiles_hbGIS/params_description_hbGIS.tsv @@ -0,0 +1,46 @@ +parameter field subfield display class minimum maximum set priority description +weekday whenwhat_field TRUE formula 0 description missing +weekend whenwhat_field TRUE formula 0 description missing +indoors whenwhat_field TRUE formula 0 description missing +outdoors whenwhat_field TRUE formula 0 description missing +in_vehicle whenwhat_field TRUE formula 0 description missing +inserted whenwhat_field TRUE formula 0 description missing +pedestrian whenwhat_field TRUE formula 0 description missing +bicycle whenwhat_field TRUE formula 0 description missing +vehicle whenwhat_field TRUE formula 0 description missing +nonwear whenwhat_field TRUE formula 0 description missing +wear whenwhat_field TRUE formula 0 description missing +sedentary whenwhat_field TRUE formula 0 description missing +light whenwhat_field TRUE formula 0 description missing +moderate whenwhat_field TRUE formula 0 description missing +vigorous whenwhat_field TRUE formula 0 description missing +mvpa whenwhat_field TRUE formula 0 description missing +mot trajectory_field TRUE formula 0 description missing +date trajectory_field TRUE formula 0 description missing +start trajectory_field TRUE formula 0 description missing +end trajectory_field TRUE formula 0 description missing +duration trajectory_field TRUE formula 0 description missing +nonwear trajectory_field TRUE formula 0 description missing +wear trajectory_field TRUE formula 0 description missing +sedentary trajectory_field TRUE formula 0 description missing +light trajectory_field TRUE formula 0 description missing +moderate trajectory_field TRUE formula 0 description missing +vigorous trajectory_field TRUE formula 0 description missing +mvpa trajectory_field TRUE formula 0 description missing +length trajectory_field TRUE formula 0 description missing +speed trajectory_field TRUE formula 0 description missing +duration multimodal_field TRUE formula 0 description missing +nonwear multimodal_field TRUE formula 0 description missing +wear multimodal_field TRUE formula 0 description missing +sedentary multimodal_field TRUE formula 0 description missing +light multimodal_field TRUE formula 0 description missing +moderate multimodal_field TRUE formula 0 description missing +vigorous multimodal_field TRUE formula 0 description missing +mvpa multimodal_field TRUE formula 0 description missing +length multimodal_field TRUE formula 0 description missing +speed multimodal_field TRUE formula 0 description missing +groupinglocation general TRUE formula 0 description missing +baselocation general TRUE formula 0 description missing +write_shp general TRUE set TRUE;FALSE 0 description missing +split_GIS general TRUE set TRUE;FALSE 0 description missing +sublocationID general TRUE formula 0 description missing diff --git a/inst/testfiles_palmsplusr/config_palmsplusr.csv b/inst/testfiles_palmsplusr/config_palmsplusr.csv deleted file mode 100755 index 32a1d04..0000000 --- a/inst/testfiles_palmsplusr/config_palmsplusr.csv +++ /dev/null @@ -1,47 +0,0 @@ -"context","name","formula","domain_field","after_conversion" -"palmsplus_field","weekday","dow < 6",FALSE,NA -"palmsplus_field","weekend","dow > 5",FALSE,NA -"palmsplus_field","indoors","iov == 3",FALSE,NA -"palmsplus_field","outdoors","iov == 1",FALSE,NA -"palmsplus_field","in_vehicle","iov == 2",FALSE,NA -"palmsplus_field","inserted","fixtypecode == 6",FALSE,NA -"palmsplus_field","pedestrian","tripmot == 1",FALSE,NA -"palmsplus_field","bicycle","tripmot == 2",FALSE,NA -"palmsplus_field","vehicle","tripmot == 3",FALSE,NA -"palmsplus_field","nonwear","activityintensity < 0",TRUE,NA -"palmsplus_field","wear","activityintensity >= 0",TRUE,NA -"palmsplus_field","sedentary","activityintensity == 0",TRUE,NA -"palmsplus_field","light","activityintensity == 1",TRUE,NA -"palmsplus_field","moderate","activityintensity == 2",TRUE,NA -"palmsplus_field","vigorous","activityintensity == 3",TRUE,NA -"palmsplus_field","mvpa","moderate + vigorous",TRUE,NA -"trajectory_field","mot","first(tripmot)",NA,FALSE -"trajectory_field","date","first(as.Date(datetime))",NA,FALSE -"trajectory_field","start","datetime[triptype==1]",NA,FALSE -"trajectory_field","end","datetime[triptype==4]",NA,FALSE -"trajectory_field","duration","as.numeric(difftime(end, start, units = ""secs"") + 30)",NA,FALSE -"trajectory_field","nonwear","sum(activityintensity < 0) * 15",NA,FALSE -"trajectory_field","wear","sum(activityintensity >= 0) * 15",NA,FALSE -"trajectory_field","sedentary","sum(activityintensity == 1) * 15",NA,FALSE -"trajectory_field","light","sum(activityintensity == 1) * 15",NA,FALSE -"trajectory_field","moderate","sum(activityintensity == 2) * 15",NA,FALSE -"trajectory_field","vigorous","sum(activityintensity == 3) * 15",NA,FALSE -"trajectory_field","mvpa","moderate + vigorous",NA,FALSE -"trajectory_field","length","as.numeric(st_length(geometry))",NA,TRUE -"trajectory_field","speed","(length / duration) * 3.6",NA,TRUE -"multimodal_field","duration","sum",NA,NA -"multimodal_field","nonwear","sum",NA,NA -"multimodal_field","wear","sum",NA,NA -"multimodal_field","sedentary","sum",NA,NA -"multimodal_field","light","sum",NA,NA -"multimodal_field","moderate","sum",NA,NA -"multimodal_field","vigorous","sum",NA,NA -"multimodal_field","mvpa","sum",NA,NA -"multimodal_field","length","sum",NA,NA -"multimodal_field","speed","mean",NA,NA -"palmsplus_domain","home","at_home",TRUE,NA -"palmsplus_domain","school","(!at_home & at_school)",TRUE,NA -"palmsplus_domain","transport","!at_home & !(at_school) & (pedestrian | bicycle | vehicle)",TRUE,NA -"palmsplus_domain","home_nbh","!at_home & !(at_school) & (!pedestrian & !bicycle & !vehicle) & at_home_nbh",TRUE,NA -"palmsplus_domain","school_nbh","!at_home & !(at_school) & (!pedestrian & !bicycle & !vehicle) & !(at_home_nbh) & at_school_nbh",TRUE,NA -"palmsplus_domain","other","!at_home & !(at_school) & (!pedestrian & !bicycle & !vehicle) & !(at_home_nbh) & !(at_school_nbh)",TRUE,NA diff --git a/inst/testfiles_palmsplusr/params_description_palmsplusr.tsv b/inst/testfiles_palmsplusr/params_description_palmsplusr.tsv deleted file mode 100644 index 73f1211..0000000 --- a/inst/testfiles_palmsplusr/params_description_palmsplusr.tsv +++ /dev/null @@ -1,55 +0,0 @@ -parameter field subfield display class minimum maximum set priority description -weekday palmsplus_field TRUE formula 0 description missing -weekend palmsplus_field TRUE formula 0 description missing -indoors palmsplus_field TRUE formula 0 description missing -outdoors palmsplus_field TRUE formula 0 description missing -in_vehicle palmsplus_field TRUE formula 0 description missing -inserted palmsplus_field TRUE formula 0 description missing -pedestrian palmsplus_field TRUE formula 0 description missing -bicycle palmsplus_field TRUE formula 0 description missing -vehicle palmsplus_field TRUE formula 0 description missing -nonwear palmsplus_field TRUE formula 0 description missing -wear palmsplus_field TRUE formula 0 description missing -sedentary palmsplus_field TRUE formula 0 description missing -light palmsplus_field TRUE formula 0 description missing -moderate palmsplus_field TRUE formula 0 description missing -vigorous palmsplus_field TRUE formula 0 description missing -mvpa palmsplus_field TRUE formula 0 description missing -at_home palmsplus_field TRUE formula 0 description missing -at_school palmsplus_field TRUE formula 0 description missing -at_home_nbh palmsplus_field TRUE formula 0 description missing -at_school_nbh palmsplus_field TRUE formula 0 description missing -mot trajectory_field TRUE formula 0 description missing -date trajectory_field TRUE formula 0 description missing -start trajectory_field TRUE formula 0 description missing -end trajectory_field TRUE formula 0 description missing -duration trajectory_field TRUE formula 0 description missing -nonwear trajectory_field TRUE formula 0 description missing -wear trajectory_field TRUE formula 0 description missing -sedentary trajectory_field TRUE formula 0 description missing -light trajectory_field TRUE formula 0 description missing -moderate trajectory_field TRUE formula 0 description missing -vigorous trajectory_field TRUE formula 0 description missing -mvpa trajectory_field TRUE formula 0 description missing -length trajectory_field TRUE formula 0 description missing -speed trajectory_field TRUE formula 0 description missing -home_school trajectory_location TRUE formula 0 description missing -school_home trajectory_location TRUE formula 0 description missing -school_school trajectory_location TRUE formula 0 description missing -home_home trajectory_location TRUE formula 0 description missing -duration multimodal_field TRUE formula 0 description missing -nonwear multimodal_field TRUE formula 0 description missing -wear multimodal_field TRUE formula 0 description missing -sedentary multimodal_field TRUE formula 0 description missing -light multimodal_field TRUE formula 0 description missing -moderate multimodal_field TRUE formula 0 description missing -vigorous multimodal_field TRUE formula 0 description missing -mvpa multimodal_field TRUE formula 0 description missing -length multimodal_field TRUE formula 0 description missing -speed multimodal_field TRUE formula 0 description missing -home palmsplus_domain TRUE formula 0 description missing -school palmsplus_domain TRUE formula 0 description missing -transport palmsplus_domain TRUE formula 0 description missing -home_nbh palmsplus_domain TRUE formula 0 description missing -school_nbh palmsplus_domain TRUE formula 0 description missing -other palmsplus_domain TRUE formula 0 description missing diff --git a/man/checkConfigFile.Rd b/man/checkConfigFile.Rd index e08aa84..2b10ffd 100644 --- a/man/checkConfigFile.Rd +++ b/man/checkConfigFile.Rd @@ -9,7 +9,7 @@ checkConfigFile(file = c(), tool = c()) \arguments{ \item{file}{data path to config file} -\item{tool}{either PALMSpy, GGIR, or palmsplusr for now.} +\item{tool}{either PALMSpy, GGIR, or hbGIS for now.} } \value{ message with the result of the check (either ok or the description of a problem) diff --git a/man/load_params.Rd b/man/load_params.Rd index 4cc0aa5..2c936e5 100644 --- a/man/load_params.Rd +++ b/man/load_params.Rd @@ -9,7 +9,7 @@ load_params(file = c(), format = "json_palmspy") \arguments{ \item{file}{Character to specify location of configuration file} -\item{format}{Character to specify format of configuration file: json_palsmpy, csv_GGIR, csv_palmsplusr, csv_hbGPS} +\item{format}{Character to specify format of configuration file: json_palsmpy, csv_GGIR, csv_hbGIS, csv_hbGPS} } \value{ list of parameters extract from the configuration file diff --git a/man/update_params.Rd b/man/update_params.Rd index cc2e8de..e17e488 100644 --- a/man/update_params.Rd +++ b/man/update_params.Rd @@ -11,7 +11,7 @@ update_params(new_params = c(), file = c(), format = "json_palmspy") \item{file}{Character to specify location of original configuration file} -\item{format}{Character to specify format of configuration file: json_palsmpy, csv_GGIR, csv_hbGPS or csv_palmsplusr} +\item{format}{Character to specify format of configuration file: json_palsmpy, csv_GGIR, csv_hbGPS or csv_hbGIS} } \value{ No object returned, function only reads original data, and overwrites parameters and stores it again diff --git a/tests/testthat/test_identify_tools.R b/tests/testthat/test_identify_tools.R index ed7ec90..c87e8c3 100644 --- a/tests/testthat/test_identify_tools.R +++ b/tests/testthat/test_identify_tools.R @@ -2,15 +2,15 @@ options("sp_evolution_status" = 2) library(HabitusGUI) context("Identify tools needed to process data") test_that("Correct tools are proposed by test_identify_tools", { - available_tools = c("GGIR", "PALMSpy", "hbGPS", "palmsplusr", "CountConverter") + available_tools = c("GGIR", "PALMSpy", "hbGPS", "hbGIS", "CountConverter") # Scenario 1: All tools needed sce1 = identify_tools(datatypes = c("AccRaw", "ACount", "GPS", "GIS", "GGIR_out"), goals = c("PA", "Sleep", "QC", "Trips", "Environment"), available_tools = available_tools) expect_equal(length(sce1$tools_needed), 3) - expect_equal(sce1$tools_needed, c("GGIR", "palmsplusr", "hbGPS")) + expect_equal(sce1$tools_needed, c("GGIR", "hbGIS", "hbGPS")) expect_equal(sce1$iotools[[1]]@output, c("GGIR_out", "ACount")) - expect_equal(sce1$iotools[[3]]@output, "palmsplusr_out") + expect_equal(sce1$iotools[[3]]@output, "hbGIS_out") expect_equal(sce1$iotools[[4]]@output, "hbGPS_out") # Scenario 2: GIS missing @@ -26,8 +26,8 @@ test_that("Correct tools are proposed by test_identify_tools", { goals = c("PA", "Sleep", "QC", "Trips", "Environment"), available_tools = available_tools) expect_equal(length(sce3$tools_needed), 2) - expect_equal(sce3$tools_needed, c("palmsplusr", "hbGPS")) - expect_equal(sce3$iotools[[2]]@output, "palmsplusr_out") + expect_equal(sce3$tools_needed, c("hbGIS", "hbGPS")) + expect_equal(sce3$iotools[[2]]@output, "hbGIS_out") expect_equal(sce3$iotools[[2]]@usecases, c("Environment", "QC")) # Scenario 4: ACount missing @@ -35,8 +35,8 @@ test_that("Correct tools are proposed by test_identify_tools", { goals = c("PA", "Sleep", "QC", "Trips", "Environment"), available_tools = available_tools) expect_equal(length(sce4$tools_needed), 3) - expect_equal(sce4$tools_needed, c("GGIR", "palmsplusr", "hbGPS")) - expect_equal(sce4$iotools[[2]]@output, "palmsplusr_out") + expect_equal(sce4$tools_needed, c("GGIR", "hbGIS", "hbGPS")) + expect_equal(sce4$iotools[[2]]@output, "hbGIS_out") expect_equal(sce4$iotools[[2]]@usecases, c("Environment", "QC")) expect_equal(sce4$iotools[[4]]@output, "hbGPS_out") expect_equal(sce4$iotools[[4]]@usecases, c("Trips", "QC", "Environment")) @@ -46,8 +46,8 @@ test_that("Correct tools are proposed by test_identify_tools", { goals = c("Environment"), available_tools = available_tools) expect_equal(length(sce5$tools_needed), 3) - expect_equal(sce5$tools_needed, c("GGIR", "palmsplusr", "hbGPS")) - expect_equal(sce5$iotools[[2]]@output, "palmsplusr_out") + expect_equal(sce5$tools_needed, c("GGIR", "hbGIS", "hbGPS")) + expect_equal(sce5$iotools[[2]]@output, "hbGIS_out") expect_equal(sce5$iotools[[2]]@usecases, c("Environment", "QC")) # Scenario 6: hbGPS_out and GIS available @@ -55,8 +55,8 @@ test_that("Correct tools are proposed by test_identify_tools", { goals = c("QC"), available_tools = available_tools) expect_equal(length(sce6$tools_needed), 1) - expect_equal(sce6$tools_needed, "palmsplusr") - expect_equal(sce6$iotools[[1]]@output, "palmsplusr_out") + expect_equal(sce6$tools_needed, "hbGIS") + expect_equal(sce6$iotools[[1]]@output, "hbGIS_out") expect_equal(sce6$iotools[[1]]@usecases, c("Environment", "QC")) }) \ No newline at end of file diff --git a/tests/testthat/test_load_and_update_params.R b/tests/testthat/test_load_and_update_params.R index a6eecb9..6dad48d 100644 --- a/tests/testthat/test_load_and_update_params.R +++ b/tests/testthat/test_load_and_update_params.R @@ -15,10 +15,10 @@ test_that("Parameters can be loaded and updated from config files", { params_palmspy = load_params(file = palmspy_config_json, format = "json_palmspy") expect_equal(ncol(params_palmspy), 10) - # Load palmsplusr .csv file - palmsplusr_config_csv = system.file("testfiles_palmsplusr/config_palmsplusr.csv", package = "HabitusGUI")[1] - params_palmsplusr = load_params(file = palmsplusr_config_csv, format = "csv_palmsplusr") - expect_equal(ncol(params_palmsplusr), 10) + # Load hbGIS .csv file + hbGIS_config_csv = system.file("testfiles_hbGIS/config_hbGIS.csv", package = "HabitusGUI")[1] + params_hbGIS = load_params(file = hbGIS_config_csv, format = "csv_hbGIS") + expect_equal(ncol(params_hbGIS), 10) # Load hbGPS .csv file hbGPS_config_csv = system.file("testfiles_hbGPS/config_hbGPS.csv", package = "HabitusGUI")[1] @@ -39,14 +39,14 @@ test_that("Parameters can be loaded and updated from config files", { expect_equal(ncol(params_ggir2), 9) expect_equal(params_ggir2$value[which(rownames(params_ggir2) == "idloc")] , "3") - # Update palmsplusr .csv file - params_palmsplusr$value[which(rownames(params_palmsplusr) == "trajectory_field__sedentary")] = "sum(activityintensity == 1) * 15" - # palmsplusr_config_csv_tmp = gsub(pattern = ".csv", replacement = "2.csv", x = palmsplusr_config_csv) - # file.copy(from = palmsplusr_config_csv, to = palmsplusr_config_csv_tmp, overwrite = TRUE) - update_params(new_params = params_palmsplusr, file = palmsplusr_config_csv, format = "csv_palmsplusr") - params_palmsplusr2 = load_params(file = palmsplusr_config_csv, format = "csv_palmsplusr") - expect_equal(ncol(params_palmsplusr2), 10) - expect_equal(params_palmsplusr2$value[which(rownames(params_palmsplusr2) == "trajectory_field__sedentary")] , + # Update hbGIS .csv file + params_hbGIS$value[which(rownames(params_hbGIS) == "trajectory_field__sedentary")] = "sum(activityintensity == 1) * 15" + # hbGIS_config_csv_tmp = gsub(pattern = ".csv", replacement = "2.csv", x = hbGIS_config_csv) + # file.copy(from = hbGIS_config_csv, to = hbGIS_config_csv_tmp, overwrite = TRUE) + update_params(new_params = params_hbGIS, file = hbGIS_config_csv, format = "csv_hbGIS") + params_hbGIS2 = load_params(file = hbGIS_config_csv, format = "csv_hbGIS") + expect_equal(ncol(params_hbGIS2), 10) + expect_equal(params_hbGIS2$value[which(rownames(params_hbGIS2) == "trajectory_field__sedentary")] , "sum(activityintensity == 1) * 15") }) \ No newline at end of file diff --git a/tests/testthat/test_load_wrong_GGIRconfig.R b/tests/testthat/test_load_wrong_GGIRconfig.R index 61ca095..97096e0 100644 --- a/tests/testthat/test_load_wrong_GGIRconfig.R +++ b/tests/testthat/test_load_wrong_GGIRconfig.R @@ -12,7 +12,7 @@ test_that("Wrong GGIR config files trigger a message and a sample config.csv fil expect_equal(check, "The GGIR config file uploaded is not a csv file") # Load a csv file that is not a GGIR config file ---- - ggir_config_wrong_csv = system.file("testfiles_palmsplusr/config_palmsplusr.csv", package = "HabitusGUI")[1] + ggir_config_wrong_csv = system.file("testfiles_hbGIS/config_hbGIS.csv", package = "HabitusGUI")[1] check = checkConfigFile(file = ggir_config_wrong_csv, tool = "GGIR") # test there is an error message