diff --git a/DESCRIPTION b/DESCRIPTION
index 383607a..2562b25 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.2.0
-Date: 2022-09-30
+Version: 0.3.0
+Date: 2022-09-28
Authors@R:
c(person(given = "Vincent",
family = "van Hees",
diff --git a/NAMESPACE b/NAMESPACE
index 488b644..686ccf1 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -41,6 +41,7 @@ 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)
diff --git a/R/check_params.R b/R/check_params.R
index c06a5e1..47a1f0b 100644
--- a/R/check_params.R
+++ b/R/check_params.R
@@ -15,29 +15,31 @@ check_params = function(params = c(), tool = c()) {
cnt = 1
if (length(numi) > 0) {
for (i in numi) {
+
+ val = params$value[i]
+ # Consider vectors specified with c()
+ num_value = unlist(lapply(strsplit(x = as.character(val), "[(]|[)]|[,]|c"), function(x){x[!x == ""]}))
+ # Consider vectors specified with :
+ val2expand = grep(pattern = ":", x = num_value)
+ if (length(val2expand) > 0) {
+ for (vi in 1:length(val2expand)) {
+ tmp = as.numeric(unlist(strsplit(num_value[val2expand[vi]], ":")))
+ num_value = c(num_value, tmp[1]:tmp[2])
+ }
+ num_value = num_value[-val2expand]
+ }
+ # Attempt to turn into numeric
try(expr = {
num_value = suppressWarnings(
- as.numeric(unlist(lapply(strsplit(x = as.character(params$value[i]), "[(]|[)]|[,]|c"), function(x){x[!x == ""]})))
+ as.numeric(num_value)
)
}, silent = TRUE)
test_na = any(is.na(num_value))
- if (test_na == TRUE) {
+ if (test_na == TRUE || length(num_value) == 0) {
blocked_params$name[cnt] = rowNames[i]
blocked_params$error[cnt] = "is not numeric"
cnt = cnt + 1
- } else {
- if (length(num_value) > 1) {
- if (tool == "GGIR") {
- nc = nchar(params$value[i])
- if (substr(params$value[i], 1, 2) != "c(" | substr(params$value[i], nc, nc) != ")") {
- blocked_params$name[cnt] = rowNames[i]
- blocked_params$error[cnt] = "numeric vector needs to start with c( and end with ), with values separated by a comma"
- cnt = cnt + 1
- }
- }
- }
- }
- if (test_na == FALSE) {
+ } else if (test_na == FALSE) {
if (params$class[i] == "integer") {
if (any(round(num_value) != num_value)) {
blocked_params$name[cnt] = rowNames[i]
diff --git a/R/identify_tools.R b/R/identify_tools.R
index d12eb12..8df23ab 100644
--- a/R/identify_tools.R
+++ b/R/identify_tools.R
@@ -61,5 +61,10 @@ identify_tools = function(datatypes = c("AccRaw", "ACount", "GPS", "GIS",
tools_needed = tools_needed[-which(tools_needed == "CountConverter")]
}
}
+ # Mask tools that will be deprecated
+ if (any(c("CountConverter", "PALMSpy") %in% tools_needed == TRUE)) {
+ tools_needed = tools_needed[-which(tools_needed %in% c("CountConverter", "PALMSpy"))]
+ }
+
invisible(list(tools_needed = tools_needed, iotools = iotools[which(names(iotools) %in% tools_needed)]))
}
\ No newline at end of file
diff --git a/R/modConfigServer.R b/R/modConfigServer.R
index c0c144f..6fd2637 100644
--- a/R/modConfigServer.R
+++ b/R/modConfigServer.R
@@ -24,12 +24,12 @@ modConfigServer = function(id, tool, homedir = getwd()) {
contentType = "application/json")
} else if (tool() == "GGIR") {
output$download = downloadHandler(
- filename = "config.csv",
+ filename = "example_config_files_GGIR.zip",
content <- function(file) {
- config_default = system.file("testfiles_ggir/config.csv", package = "HabitusGUI")[1]
+ config_default = system.file("testfiles_ggir/example_config_files_GGIR.zip", package = "HabitusGUI")[1]
if (config_default != file) file.copy(config_default, file)
},
- contentType = "text/csv")
+ contentType = "zip")
} else if (tool() == "hbGPS") {
output$download = downloadHandler(
filename = "config_hbGPS.csv",
diff --git a/R/myApp.R b/R/myApp.R
index 1a0d602..54d7b29 100644
--- a/R/myApp.R
+++ b/R/myApp.R
@@ -13,6 +13,8 @@
# HabitusGUI::myApp(homedir="~/projects")
# options("sp_evolution_status" = 2)
# 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")
# roxygen2::roxygenise()
@@ -51,16 +53,16 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) {
),
p("\n"),
checkboxGroupInput("availabledata", label = "Which type(s) of data would you like to analyse? ",
- choiceNames = list("Acceleration",
- "Counts (in ActiGraph .csv format) => select only when using PALMSpy",
+ choiceNames = list("Acceleration (all formats accepted by GGIR)",
"GPS (in .csv format)",
"GIS (shape files + linkage file)",
"Sleep Diary (in GGIR compatible .csv format)",
- "previously generated PALMS(py) output",
"previously generated GGIR time series output",
- "previously generated hbGPS output"),
- choiceValues = list("AccRaw", "ACount", "GPS", "GIS", "SleepDiary",
- "PALMSpy_out", "GGIR_out", "hbGPS_out"), width = '100%'),
+ "previously generated hbGPS output",
+ "Counts (in ActiGraph .csv format) => soon to be deprecated",
+ "previously generated PALMS(py) output => soon to be deprecated"),
+ choiceValues = list("AccRaw", "GPS", "GIS", "SleepDiary",
+ "GGIR_out", "hbGPS_out", "ACount", "PALMSpy_out"), width = '100%'),
# Only show more check boxs if user specified available data sufficient for any of the tools
conditionalPanel(condition = paste0("input.availabledata.indexOf(`AccRaw`) > -1 || ", # GGIR
"(input.availabledata.indexOf(`ACount`) > -1 && ", # PALMSpy
@@ -87,11 +89,12 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) {
hr(),
checkboxGroupInput("tools", label = "Select the tools you would like to use:",
choiceNames = list("GGIR (R package)",
- "CountConverter (R package GGIR + actilifecounts)",
- "PALMSpy (Python library)",
"hbGPS (R package)",
- "palmsplusr (R package)"),
- choiceValues = list("GGIR", "CountConverter", "PALMSpy", "hbGPS", "palmsplusr"), width = '100%')
+ "palmsplusr (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",
+ "CountConverter", "PALMSpy"), width = '100%')
),
hr(),
actionButton("page_12", "next", style = "position:absolute;right:1em;"),
@@ -111,8 +114,8 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) {
conditionalPanel(condition = paste0("input.availabledata.indexOf(`AccRaw`) > -1 && ",
"(input.tools.includes(`GGIR`) || ",
"input.tools.includes(`CountConverter`))"),
- shinyFiles::shinyDirButton("rawaccdir", label = "Raw accelerometry data directory...",
- title = "Select raw accelerometer data directory"),
+ shinyFiles::shinyDirButton("rawaccdir", label = "Accelerometry data directory...",
+ title = "Select accelerometer data directory"),
verbatimTextOutput("rawaccdir", placeholder = TRUE),
hr()
),
@@ -402,7 +405,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) {
showNotification("Select at least one tool", type = "error")
} else {
if ("GGIR" %in% input$tools == TRUE & "AccRaw" %in% input$availabledata == FALSE) {
- showNotification("GGIR not possible without access to raw accelerometer data", type = "error")
+ showNotification("GGIR not possible without access to accelerometer data", type = "error")
} else {
if ("PALMSpy" %in% input$tools == TRUE & all(c("AccRaw", "ACount", "GPS") %in% input$availabledata == FALSE)) {
showNotification("PALMSpy not possible without access to Accelerometer and GPS data", type = "error")
@@ -423,7 +426,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) {
" run"), type = "error")
} else {
if ("CountConverter" %in% input$tools == TRUE & "AccRaw" %in% input$availabledata == FALSE) {
- showNotification("CountConverter not possible without access to raw accelerometer data", type = "error")
+ showNotification("CountConverter not possible without access to accelerometer data", type = "error")
} else {
if ("PALMSpy_out" %in% input$availabledata & "hbGPS_out" %in% input$availabledata) {
showNotification(paste0("You cannot select previously generated",
@@ -473,10 +476,10 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) {
save(values, file = "./HabitusGUIbookmark.RData")
# -----
if ("AccRaw" %in% input$availabledata & "GGIR" %in% input$tools & as.character(input$rawaccdir)[1] == "0" & is.null(selectedRawaccdir)) {
- showNotification("Select raw accelerometer data directory", type = "error")
+ showNotification("Select accelerometer data directory", type = "error")
} else {
if ("AccRaw" %in% input$availabledata & "CountConverter" %in% input$tools & as.character(input$rawaccdir)[1] == "0" & is.null(selectedRawaccdir)) {
- showNotification("Select raw accelerometer data directory", type = "error")
+ showNotification("Select accelerometer data directory", type = "error")
} else {
if ("ACount" %in% input$availabledata & "PALMSpy" %in% input$tools & as.character(input$countaccdir)[1] == "0" & is.null(selectedCountaccdir)) {
showNotification("Select count accelerometer data directory", type = "error")
@@ -688,7 +691,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) {
} else {
researchgoalsNames = reasearchgoalsNames[which(reasearchgoalsValues %in% researchgoals == TRUE)]
reasearchgoalsValues = reasearchgoalsValues[which(reasearchgoalsValues %in% researchgoals == TRUE)]
- researchgoalsLabel = "What is your research interest?"
+ researchgoalsLabel = "(Optional) Do you need guidance on which tool(s) to use? Tell us your objective(s):"
}
# check previously selected
@@ -806,7 +809,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) {
if (!"path" %in% names(rawaccdir())) return()
home <- normalizePath(homedir)
global$raw_acc_in <-
- file.path(home, paste(unlist(rawaccdir()$path[-1]), collapse = .Platform$file.sep))
+ normalizePath(file.path(home, paste(unlist(rawaccdir()$path[-1]), collapse = .Platform$file.sep)))
})
observeEvent(ignoreNULL = TRUE,
eventExpr = {
@@ -816,7 +819,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) {
if (!"path" %in% names(countaccdir())) return()
home <- normalizePath(homedir)
global$count_acc_in <-
- file.path(home, paste(unlist(countaccdir()$path[-1]), collapse = .Platform$file.sep))
+ normalizePath(file.path(home, paste(unlist(countaccdir()$path[-1]), collapse = .Platform$file.sep)))
})
observeEvent(ignoreNULL = TRUE,
eventExpr = {
@@ -826,7 +829,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) {
if (!"path" %in% names(gpsdir())) return()
home <- normalizePath(homedir)
global$gps_in <-
- file.path(home, paste(unlist(gpsdir()$path[-1]), collapse = .Platform$file.sep))
+ normalizePath(file.path(home, paste(unlist(gpsdir()$path[-1]), collapse = .Platform$file.sep)))
})
observeEvent(ignoreNULL = TRUE,
eventExpr = {
@@ -836,7 +839,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) {
if (!"path" %in% names(gisdir())) return()
home <- normalizePath(homedir)
global$gis_in <-
- file.path(home, paste(unlist(gisdir()$path[-1]), collapse = .Platform$file.sep))
+ normalizePath(file.path(home, paste(unlist(gisdir()$path[-1]), collapse = .Platform$file.sep)))
# send gisdir to textInput field
# Can also set the label, this time for input$inText2
@@ -860,7 +863,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) {
if (!"files" %in% names(gislinkfile())) return()
home <- normalizePath(homedir)
global$gislinkfile_in <-
- as.character(parseFilePaths(c(home = homedir), gislinkfile())$datapath)
+ normalizePath(as.character(parseFilePaths(c(home = homedir), gislinkfile())$datapath))
})
observeEvent(ignoreNULL = TRUE,
eventExpr = {
@@ -870,7 +873,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) {
if (!"path" %in% names(palmspyoutdir())) return()
home <- normalizePath(homedir)
global$palmspyout_in <-
- file.path(home, paste(unlist(palmspyoutdir()$path[-1]), collapse = .Platform$file.sep))
+ normalizePath(file.path(home, paste(unlist(palmspyoutdir()$path[-1]), collapse = .Platform$file.sep)))
})
observeEvent(ignoreNULL = TRUE,
eventExpr = {
@@ -880,7 +883,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) {
if (!"path" %in% names(hbGPSoutdir())) return()
home <- normalizePath(homedir)
global$hbGPSout_in <-
- file.path(home, paste(unlist(hbGPSoutdir()$path[-1]), collapse = .Platform$file.sep))
+ normalizePath(file.path(home, paste(unlist(hbGPSoutdir()$path[-1]), collapse = .Platform$file.sep)))
})
observeEvent(ignoreNULL = TRUE,
eventExpr = {
@@ -890,7 +893,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) {
if (!"path" %in% names(ggiroutdir())) return()
home <- normalizePath(homedir)
global$ggirout_in <-
- file.path(home, paste(unlist(ggiroutdir()$path[-1]), collapse = .Platform$file.sep))
+ normalizePath(file.path(home, paste(unlist(ggiroutdir()$path[-1]), collapse = .Platform$file.sep)))
})
observeEvent(ignoreNULL = TRUE,
eventExpr = {
@@ -900,7 +903,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) {
if (!"path" %in% names(outputdir())) return()
home <- normalizePath(homedir)
global$data_out <-
- file.path(home, paste(unlist(outputdir()$path[-1]), collapse = .Platform$file.sep))
+ normalizePath(file.path(home, paste(unlist(outputdir()$path[-1]), collapse = .Platform$file.sep)))
})
observeEvent(ignoreNULL = TRUE,
eventExpr = {
@@ -910,7 +913,7 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) {
if (!"files" %in% names(sleepdiaryfile())) return()
home <- normalizePath(homedir)
global$sleepdiaryfile <-
- as.character(parseFilePaths(c(home = homedir), sleepdiaryfile())$datapath)
+ normalizePath(as.character(parseFilePaths(c(home = homedir), sleepdiaryfile())$datapath))
})
# Send directories to UI --------------------------------------------
@@ -1183,8 +1186,19 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) {
# Basic check before running function:
ready_to_run_hbGPS = FALSE
# Check for GGIR output (two possible sources either from this run or from a previous run)
- expected_ggir_results_dir = global$ggirout_in
- if (dir.exists(global$ggirout_in)) {
+ # expected_ggir_results_dir = global$ggirout_in
+
+ if ("GGIR_out" %in% input$availabledata && dir.exists(global$ggirout_in)) {
+ expected_ggir_results_dir = global$ggirout_in
+ } else {
+ expected_ggir_results_dir = paste0(global$data_out, "/output_", basename(global$raw_acc_in))
+ }
+
+ 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) {
# also check for GPS files
@@ -1222,15 +1236,15 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) {
on.exit(file.copy(from = stdout_hbGPS_tmp, to = logfile, overwrite = TRUE), add = TRUE)
# Start hbGPS
- x_hbGPS <- r_bg(func = function(hbGPS_shiny, ggiroutdir, gpsdir,
+ x_hbGPS <- r_bg(func = function(hbGPS_shiny, expected_ggir_results_dir, gpsdir,
outputdir, dataset_name,
configfile){
- hbGPS_shiny(ggiroutdir, gpsdir,
+ hbGPS_shiny(expected_ggir_results_dir, gpsdir,
outputdir, dataset_name,
configfile)
},
args = list(hbGPS_shiny = hbGPS_shiny,
- ggiroutdir = global$ggirout_in,
+ expected_ggir_results_dir = expected_ggir_results_dir,
gpsdir = global$gps_in,
outputdir = isolate(global$data_out),
dataset_name = input$dataset_name,
@@ -1298,13 +1312,13 @@ myApp <- function(homedir=getwd(), envConda = "~/miniconda3/bin/conda", ...) {
} else {
expected_results_dir = paste0(global$data_out,"/PALMSpy_output")
}
- } else if ("hbGPS_out" %in% input$availabledata) {
- if (dir.exists(global$hbGPSout_in)) {
- expected_results_dir = global$hbGPSout_in
- } else {
- expected_results_dir = paste0(global$data_out,"/hbGPS_output")
- }
+ } else if ("hbGPS_out" %in% input$availabledata && dir.exists(global$hbGPSout_in)) {
+ expected_results_dir = global$hbGPSout_in
+ } 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))
if (Nfiles_in_dir > 0) {
diff --git a/R/palmsplusr_shiny.R b/R/palmsplusr_shiny.R
index f09adfd..4999915 100644
--- a/R/palmsplusr_shiny.R
+++ b/R/palmsplusr_shiny.R
@@ -10,7 +10,7 @@
#' @return palms_to_clean_lower object
#' @importFrom stats end start formula as.formula
#' @importFrom tidyr pivot_wider
-#' @importFrom readr read_csv
+#' @importFrom readr write_csv read_csv
#' @import palmsplusr
#' @import dplyr
#' @importFrom utils head tail
@@ -69,6 +69,8 @@ palmsplusr_shiny <- function(gisdir = "",
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(),
@@ -81,31 +83,29 @@ palmsplusr_shiny <- function(gisdir = "",
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")
+ # 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")
-
+ # 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))
+ # 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)
+ 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)
+ # if (verbose) cat("\nreading basis file\n")
+ participant_basis = read_csv(gislinkfile, show_col_types = FALSE)
# Load all shape files ----------------------------------------------------
#----------------
# NEW CODE
@@ -145,7 +145,9 @@ palmsplusr_shiny <- function(gisdir = "",
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
@@ -242,7 +244,7 @@ palmsplusr_shiny <- function(gisdir = "",
loca = loca,
participant_basis = participant_basis,
verbose = verbose)
- data.table::fwrite(palmsplus, file = fns[1])
+ write_csv(palmsplus, file = fns[1])
if (verbose) cat(">>>\n")
} else {
if (verbose) cat("skipped because insufficient input data>>>\n")
@@ -259,7 +261,7 @@ palmsplusr_shiny <- function(gisdir = "",
if (length(days) > 0) {
if (verbose) cat(paste0(" N rows in days object: ", nrow(days)))
- data.table::fwrite(x = days, file = fns[2])
+ write_csv(x = days, file = fns[2])
} else {
if (verbose) cat(paste0(" WARNING: no days object produced."))
}
@@ -278,7 +280,7 @@ palmsplusr_shiny <- function(gisdir = "",
trajectory_fields = trajectory_fields,
trajectory_locations = trajectory_locations)
if (length(trajectories) > 0) {
- data.table::fwrite(trajectories, file = fns[3])
+ 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
@@ -302,7 +304,7 @@ palmsplusr_shiny <- function(gisdir = "",
verbose = verbose)
if (length(multimodal) > 0) {
- data.table::fwrite(multimodal, file = fns[4])
+ 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)
@@ -310,7 +312,7 @@ palmsplusr_shiny <- function(gisdir = "",
} else {
if (verbose) cat(paste0(" WARNING: no multimodal object produced."))
}
- if (verbose) cat(">>>\n")
+ if (verbose) cat(">>>\n\n")
} else {
if (verbose) cat("skipped because insufficient input data>>>\n")
}
diff --git a/inst/NEWS.Rd b/inst/NEWS.Rd
index d491145..a75c507 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.0 (GitHub-only-release date: 28-09-2023)}{
+ \itemize{
+ \item Series of fixes based on initial testing phase, see issue #94.
+ }
+}
\section{Changes in version 0.2.0 (GitHub-only-release date: 15-09-2023)}{
\itemize{
\item Embed hbGPS #90
diff --git a/inst/testfiles_ggir/config.csv b/inst/testfiles_ggir/config.csv
deleted file mode 100644
index 6ea678f..0000000
--- a/inst/testfiles_ggir/config.csv
+++ /dev/null
@@ -1,186 +0,0 @@
-"argument","value","context"
-"datadir","c()","not applicable"
-"do.report","c(2,4,5)","not applicable"
-"f0","1","not applicable"
-"f1","1","not applicable"
-"mode","c(1,2,3,4,5)","not applicable"
-"outputdir","./","not applicable"
-"studyname","c()","not applicable"
-"GGIRread_version","0.2.6","not applicable"
-"GGIRversion","2.9.0","not applicable"
-"R_version","R version 4.2.2 (2022-10-31 ucrt)","not applicable"
-"qwindow","c(0,24)","params_247"
-"qlevels","c()","params_247"
-"qwindow_dateformat","%d-%m-%Y","params_247"
-"ilevels","c()","params_247"
-"IVIS_windowsize_minutes","60","params_247"
-"IVIS_epochsize_seconds","c()","params_247"
-"IVIS.activity.metric","2","params_247"
-"IVIS_acc_threshold","20","params_247"
-"qM5L5","c()","params_247"
-"MX.ig.min.dur","10","params_247"
-"M5L5res","10","params_247"
-"winhr","5","params_247"
-"iglevels","c()","params_247"
-"LUXthresholds","c(0,100,500,1000,3000,5000,10000)","params_247"
-"LUX_cal_constant","c()","params_247"
-"LUX_cal_exponent","c()","params_247"
-"LUX_day_segments","c()","params_247"
-"window.summary.size","10","params_247"
-"L5M5window","c(0,24)","params_247"
-"cosinor","FALSE","params_247"
-"includedaycrit","16","params_cleaning"
-"ndayswindow","7","params_cleaning"
-"strategy","1","params_cleaning"
-"maxdur","0","params_cleaning"
-"hrs.del.start","0","params_cleaning"
-"hrs.del.end","0","params_cleaning"
-"includedaycrit.part5","0.666666667","params_cleaning"
-"excludefirstlast.part5","FALSE","params_cleaning"
-"TimeSegments2ZeroFile","c()","params_cleaning"
-"do.imp","TRUE","params_cleaning"
-"data_cleaning_file","c()","params_cleaning"
-"minimum_MM_length.part5","23","params_cleaning"
-"excludefirstlast","FALSE","params_cleaning"
-"includenightcrit","16","params_cleaning"
-"excludefirst.part4","FALSE","params_cleaning"
-"excludelast.part4","FALSE","params_cleaning"
-"max_calendar_days","0","params_cleaning"
-"nonWearEdgeCorrection","TRUE","params_cleaning"
-"overwrite","FALSE","params_general"
-"acc.metric","ENMO","params_general"
-"maxNcores","c()","params_general"
-"print.filename","FALSE","params_general"
-"do.parallel","TRUE","params_general"
-"windowsizes","c(5,900,3600)","params_general"
-"desiredtz","","params_general"
-"configtz","","params_general"
-"idloc","3","params_general"
-"dayborder","0","params_general"
-"part5_agg2_60seconds","FALSE","params_general"
-"sensor.location","wrist","params_general"
-"expand_tail_max_hours","c()","params_general"
-"recordingEndSleepHour","c()","params_general"
-"do.anglex","FALSE","params_metrics"
-"do.angley","FALSE","params_metrics"
-"do.anglez","TRUE","params_metrics"
-"do.zcx","FALSE","params_metrics"
-"do.zcy","FALSE","params_metrics"
-"do.zcz","FALSE","params_metrics"
-"do.enmo","TRUE","params_metrics"
-"do.lfenmo","FALSE","params_metrics"
-"do.en","FALSE","params_metrics"
-"do.mad","FALSE","params_metrics"
-"do.enmoa","FALSE","params_metrics"
-"do.roll_med_acc_x","FALSE","params_metrics"
-"do.roll_med_acc_y","FALSE","params_metrics"
-"do.roll_med_acc_z","FALSE","params_metrics"
-"do.dev_roll_med_acc_x","FALSE","params_metrics"
-"do.dev_roll_med_acc_y","FALSE","params_metrics"
-"do.dev_roll_med_acc_z","FALSE","params_metrics"
-"do.bfen","FALSE","params_metrics"
-"do.hfen","FALSE","params_metrics"
-"do.hfenplus","FALSE","params_metrics"
-"do.lfen","FALSE","params_metrics"
-"do.lfx","FALSE","params_metrics"
-"do.lfy","FALSE","params_metrics"
-"do.lfz","FALSE","params_metrics"
-"do.hfx","FALSE","params_metrics"
-"do.hfy","FALSE","params_metrics"
-"do.hfz","FALSE","params_metrics"
-"do.bfx","FALSE","params_metrics"
-"do.bfy","FALSE","params_metrics"
-"do.bfz","FALSE","params_metrics"
-"do.brondcounts","FALSE","params_metrics"
-"do.neishabouricounts","FALSE","params_metrics"
-"hb","15","params_metrics"
-"lb","0.2","params_metrics"
-"n","4","params_metrics"
-"zc.lb","0.25","params_metrics"
-"zc.hb","3","params_metrics"
-"zc.sb","0.01","params_metrics"
-"zc.order","2","params_metrics"
-"zc.scale","1","params_metrics"
-"actilife_LFE","FALSE","params_metrics"
-"epochvalues2csv","FALSE","params_output"
-"save_ms5rawlevels","FALSE","params_output"
-"save_ms5raw_format","csv","params_output"
-"save_ms5raw_without_invalid","TRUE","params_output"
-"storefolderstructure","FALSE","params_output"
-"timewindow","c(MM,WW)","params_output"
-"viewingwindow","1","params_output"
-"dofirstpage","TRUE","params_output"
-"visualreport","TRUE","params_output"
-"week_weekend_aggregate.part5","FALSE","params_output"
-"do.part3.pdf","TRUE","params_output"
-"outliers.only","FALSE","params_output"
-"criterror","3","params_output"
-"do.visual","TRUE","params_output"
-"do.sibreport","FALSE","params_output"
-"do.part2.pdf","TRUE","params_output"
-"mvpathreshold","100","params_phyact"
-"boutcriter","0.8","params_phyact"
-"mvpadur","c(1,5,10)","params_phyact"
-"boutcriter.in","0.9","params_phyact"
-"boutcriter.lig","0.8","params_phyact"
-"boutcriter.mvpa","0.8","params_phyact"
-"threshold.lig","40","params_phyact"
-"threshold.mod","100","params_phyact"
-"threshold.vig","400","params_phyact"
-"boutdur.mvpa","c(1,5,10)","params_phyact"
-"boutdur.in","c(10,20,30)","params_phyact"
-"boutdur.lig","c(1,5,10)","params_phyact"
-"frag.metrics","c()","params_phyact"
-"chunksize","1","params_rawdata"
-"spherecrit","0.3","params_rawdata"
-"minloadcrit","72","params_rawdata"
-"printsummary","FALSE","params_rawdata"
-"do.cal","TRUE","params_rawdata"
-"backup.cal.coef","retrieve","params_rawdata"
-"dynrange","c()","params_rawdata"
-"minimumFileSizeMB","2","params_rawdata"
-"rmc.dec",".","params_rawdata"
-"rmc.firstrow.acc","c()","params_rawdata"
-"rmc.firstrow.header","c()","params_rawdata"
-"rmc.header.length","c()","params_rawdata"
-"rmc.col.acc","c(1,2,3)","params_rawdata"
-"rmc.col.temp","c()","params_rawdata"
-"rmc.col.time","c()","params_rawdata"
-"rmc.unit.acc","g","params_rawdata"
-"rmc.unit.temp","C","params_rawdata"
-"rmc.unit.time","POSIX","params_rawdata"
-"rmc.format.time","%Y-%m-%d %H:%M:%OS","params_rawdata"
-"rmc.bitrate","c()","params_rawdata"
-"rmc.dynamic_range","c()","params_rawdata"
-"rmc.unsignedbit","TRUE","params_rawdata"
-"rmc.origin","01/01/1970","params_rawdata"
-"rmc.desiredtz","","params_rawdata"
-"rmc.configtz","c()","params_rawdata"
-"rmc.sf","c()","params_rawdata"
-"rmc.headername.sf","c()","params_rawdata"
-"rmc.headername.sn","c()","params_rawdata"
-"rmc.headername.recordingid","c()","params_rawdata"
-"rmc.header.structure","c()","params_rawdata"
-"rmc.check4timegaps","FALSE","params_rawdata"
-"rmc.noise","13","params_rawdata"
-"rmc.col.wear","c()","params_rawdata"
-"rmc.doresample","FALSE","params_rawdata"
-"interpolationType","1","params_rawdata"
-"imputeTimegaps","TRUE","params_rawdata"
-"anglethreshold","5","params_sleep"
-"timethreshold","5","params_sleep"
-"ignorenonwear","TRUE","params_sleep"
-"constrain2range","TRUE","params_sleep"
-"HASPT.algo","HDCZA","params_sleep"
-"HASIB.algo","vanHees2015","params_sleep"
-"Sadeh_axis","","params_sleep"
-"longitudinal_axis","c()","params_sleep"
-"HASPT.ignore.invalid","FALSE","params_sleep"
-"loglocation","c()","params_sleep"
-"colid","1","params_sleep"
-"coln1","2","params_sleep"
-"nnights","c()","params_sleep"
-"relyonguider","FALSE","params_sleep"
-"def.noc.sleep","1","params_sleep"
-"sleeplogsep",",","params_sleep"
-"sleepwindowType","SPT","params_sleep"
diff --git a/inst/testfiles_ggir/example_config_files_GGIR.zip b/inst/testfiles_ggir/example_config_files_GGIR.zip
new file mode 100644
index 0000000..739b17c
Binary files /dev/null and b/inst/testfiles_ggir/example_config_files_GGIR.zip differ
diff --git a/inst/testfiles_ggir/params_description_ggir.tsv b/inst/testfiles_ggir/params_description_ggir.tsv
index fc8e41f..b830907 100644
--- a/inst/testfiles_ggir/params_description_ggir.tsv
+++ b/inst/testfiles_ggir/params_description_ggir.tsv
@@ -2,26 +2,26 @@ parameter field subfield display class minimum maximum set priority description
overwrite general TRUE set TRUE;FALSE 1 Logical (default = FALSE) to indicate if the existent analysis of milestone data should be overwritten or not.
mode general TRUE integer 1 5 1;2;3;4;5 1 Numeric (default = 1:5). Specify which of the five parts of the GGIR pipeline need to be run.
acc.metric general TRUE set ENMO;ENMOa;MAD;NeishabouriCount_x;NeishabouriCount_y;NeishabouriCount_z;NeishabouriCount_vm;LFENMO 0 Character to define the acceleration metric to use for description and analysis of physical activity.
-windowsizes general TRUE integer 1 3600 0 Numeric vector of three values (default = c(5, 900, 3600)) to indicate the lengths of the windows in seconds for epoch, non-wear detection resolution, and non-wear detection window, respectively.
-desiredtz general TRUE timezone 1 Timezone in which device was configured and experiments took place according to the timezone database (https://en.wikipedia.org/wiki/Zone.tab). If empty, then local timezone where the app is run will be used.
-configtz general TRUE timezone 1 Timezone in which device was configured in the case that it is different from the timezone in which the experiment took place (see desiredtz) according to the timezone database (https://en.wikipedia.org/wiki/Zone.tab). If empty, then local timezone where the app is run will be used.
-idloc general TRUE set 1;2;3;4;5;6;7 1 How participant identifier should be extracted: idloc = 1 (default), ID number is stored in the obvious header field. Note that for ActiGraph data the ID is never stored in the file header. For idloc value set to 2, 5, 6, and 7, GGIR looks at the filename and extracts the character string preceding the first occurance of a '_', ' ' (space), '.' (dot), and '-', respectively.
+windowsizes general TRUE integer 1 3600 0 "Numeric vector of three values (default = c(5, 900, 3600)) to indicate the lengths of the windows in seconds for epoch, non-wear detection resolution, and non-wear detection window, respectively."
+desiredtz general TRUE timezone 1 "Timezone in which device was configured and experiments took place according to the timezone database (https://en.wikipedia.org/wiki/Zone.tab). If empty, then local timezone where the app is run will be used."
+configtz general TRUE timezone 1 "Timezone in which device was configured in the case that it is different from the timezone in which the experiment took place (see desiredtz) according to the timezone database (https://en.wikipedia.org/wiki/Zone.tab). If empty, then local timezone where the app is run will be used."
+idloc general TRUE set 1;2;3;4;5;6;7 1 "How participant identifier should be extracted: idloc = 1 (default), ID number is stored in the obvious header field. Note that for ActiGraph data the ID is never stored in the file header. For idloc value set to 2, 5, 6, and 7, GGIR looks at the filename and extracts the character string preceding the first occurance of a '_', ' ' (space), '.' (dot), and '-', respectively."
colid sleep TRUE integer 1 100 0 Column number in the sleep log spreadsheet in which the participant ID code is stored (default = 1)
coln1 sleep TRUE integer 1 1000 0 Column number in the sleep log spreadsheet where the onset of the first night starts (default = 2)
excludefirstlast sleep TRUE set TRUE;FALSE 0 If TRUE then the first and last night of the measurement are ignored for the sleep assessment.
excludefirst.part4 sleep TRUE set TRUE;FALSE 0 If TRUE then the first night of the measurement are ignored for the sleep assessment.
excludelast.part4 sleep TRUE set TRUE;FALSE 0 If TRUE then the last night of the measurement are ignored for the sleep assessment.
-includenightcrit sleep TRUE integer 0 24 0 Minimum number of valid hours per night (24 hour window between noon and noon, or between 6pm and 6pm in the case that wake up occurs after noon)
-nnights sleep TRUE integer 0 1000 0 Number of nights for which sleep log information should be available. It assumes that this is constant within a study. If sleep log information is missing for certain nights then leave these blank
+includenightcrit sleep TRUE integer 0 24 0 "Minimum number of valid hours per night (24 hour window between noon and noon, or between 6pm and 6pm in the case that wake up occurs after noon)"
boutcriter.in physical activity TRUE double 0 1 0 A number between 0 and 1 and defines what fraction of a bout needs to be below the light threshold
boutcriter.lig physical activity TRUE double 0 1 0 A number between 0 and 1 and defines what fraction of a bout needs to be between the light and moderate threshold
boutcriter.mvpa physical activity TRUE double 0 1 0 A number between 0 and 1 and defines what fraction of a bout needs to be above the MVPA threshold
-boutdur.in physical activity TRUE double 0 1000 0 Durations of inactivty bouts in minutes to be extracted. Inactivity bouts are detected in the segments of the data which were not labelled as sleep or MVPA bouts. The default duration values is c(10,20,30), this will start with the identification of 30 minute bouts, followed by 20 minute bouts in the rest of the data, and followed by 10 minute bouts in the rest of the data
-boutdur.lig physical activity TRUE double 0 1000 0 Durations of light activty bouts in minutes to be extracted. Light activity bouts are detected in the segments of the data which were not labelled as sleep, MVPA, or inactivity bouts. The default duration values is c(1,5,10), this will start with the identification of 10 minute bouts, followed by 5 minute bouts in the rest of the data, and followed by 1 minute bouts in the rest of the data
-boutdur.mvpa physical activity TRUE integer 0 1000 0 Durations of mvpa bouts in minutes to be extracted. The default values is c(1,5,10) and will start with the identification of 10 minute bouts, followed by 5 minute bouts in the rest of the data, and followed by 1 minute bouts in the rest of the data.
-threshold.lig physical activity TRUE integer 0 10000 0 Threshold for light physical activity to separate inactivity from light. Value can be one number or an array of multiple numbers, e.g. threshold.lig =c(30,40). If multiple numbers are entered then analysis will be replicated for each combination of threshold values. Remove this as only ENMO supported in the app: Threshold is applied to the first metric in the milestone data, so if you have only specified do.ENMO == TRUE then it will be applied to ENMO.
-threshold.mod physical activity TRUE double 0 10000 0 Threshold for moderate physical activity to separate light from moderate. Value can be one number or an array of multiple numbers, e.g. threshold.mod =c(100,110). If multiple numbers are entered then analysis will be repliced for each combination of threshold values. Remove this as only ENMO supported in the app: Threshold is applied to the first metric in the milestone data, so if you have only specified do.ENMO == TRUE then it will be applied to ENMO.
-threshold.vig physical activity TRUE double 0 10000 0 Threshold for vigorous physical activity to separate moderate from vigorous. Value can be one number or an array of multiple numbers, e.g. threshold.mod=c(400,500). If multiple numbers are entered then analysis will be repliced for each combination of threshold values. Remove this as only ENMO supported in the app: Threshold is applied to the first metric in the milestone data, so if you have only specified do.ENMO == TRUE then it will be applied to ENMO.
+boutdur.in physical activity TRUE double 0 1000 0 "Durations of inactivty bouts in minutes to be extracted. Inactivity bouts are detected in the segments of the data which were not labelled as sleep or MVPA bouts. The default duration values is c(10,20,30), this will start with the identification of 30 minute bouts, followed by 20 minute bouts in the rest of the data, and followed by 10 minute bouts in the rest of the data"
+boutdur.lig physical activity TRUE double 0 1000 0 "Durations of light activty bouts in minutes to be extracted. Light activity bouts are detected in the segments of the data which were not labelled as sleep, MVPA, or inactivity bouts. The default duration values is c(1,5,10), this will start with the identification of 10 minute bouts, followed by 5 minute bouts in the rest of the data, and followed by 1 minute bouts in the rest of the data"
+boutdur.mvpa physical activity TRUE double 0 1000 0 "Durations of mvpa bouts in minutes to be extracted. The default values is c(1,5,10) and will start with the identification of 10 minute bouts, followed by 5 minute bouts in the rest of the data, and followed by 1 minute bouts in the rest of the data."
+threshold.lig physical activity TRUE double 0 10000 0 "Threshold for light physical activity to separate inactivity from light. Value can be one number or an array of multiple numbers, e.g. threshold.lig =c(30,40). If multiple numbers are entered then analysis will be replicated for each combination of threshold values. Remove this as only ENMO supported in the app: Threshold is applied to the first metric in the milestone data, so if you have only specified do.ENMO == TRUE then it will be applied to ENMO."
+threshold.mod physical activity TRUE double 0 10000 0 "Threshold for moderate physical activity to separate light from moderate. Value can be one number or an array of multiple numbers, e.g. threshold.mod =c(100,110). If multiple numbers are entered then analysis will be repliced for each combination of threshold values. Remove this as only ENMO supported in the app: Threshold is applied to the first metric in the milestone data, so if you have only specified do.ENMO == TRUE then it will be applied to ENMO."
+threshold.vig physical activity TRUE double 0 10000 0 "Threshold for vigorous physical activity to separate moderate from vigorous. Value can be one number or an array of multiple numbers, e.g. threshold.mod=c(400,500). If multiple numbers are entered then analysis will be repliced for each combination of threshold values. Remove this as only ENMO supported in the app: Threshold is applied to the first metric in the milestone data, so if you have only specified do.ENMO == TRUE then it will be applied to ENMO."
excludefirstlast.part5 physical activity TRUE set TRUE;FALSE 0 If TRUE then the first and last window (waking-waking or midnight-midnight) are ignored in the part 5 reports.
includedaycrit physical activity TRUE integer 0 24 0 Minimum required number of valid hours in day specific analysis (24 hour window between midnight and midnight)
-includedaycrit.part5 physical activity TRUE double 0 24 0 Inclusion criteria for number of valid hours for the waking time window, either as expressed as a ratio of 1 or as the number of hours in a 24 hour day.
+includedaycrit.part5 physical activity TRUE double 0 24 0 "Inclusion criteria for number of valid hours for the waking time window, either as expressed as a ratio of 1 or as the number of hours in a 24 hour day."
+extEpochData_timeformat general TRUE timeformat 0 "Timestamp format in R code, e.g. %Y-%m-%d %H:%M:%S, see also https://www.stat.berkeley.edu/~s133/dates.html"
diff --git a/inst/testfiles_hbGPS/params_description_hbGPS.tsv b/inst/testfiles_hbGPS/params_description_hbGPS.tsv
index 20bf110..1917390 100644
--- a/inst/testfiles_hbGPS/params_description_hbGPS.tsv
+++ b/inst/testfiles_hbGPS/params_description_hbGPS.tsv
@@ -1,6 +1,6 @@
parameter field subfield display class minimum maximum set priority description
-idloc general TRUE set 2;6 1
-maxBreakLengthSeconds trip TRUE integer 30 300 0 "How participant identifier should be extracted: idloc=2 looks at the filename and extracts the character string preceding the first occurance of a '_', idloc = 6 '.' (dot)"
+idloc general TRUE set 2;6 1 "How participant identifier should be extracted: idloc=2 looks at the filename and extracts the character string preceding the first occurance of a '_', idloc = 6 '.' (dot)"
+maxBreakLengthSeconds trip TRUE integer 30 300 0 maximum trip break duration in seconds
minTripDur trip TRUE integer 30 900 0 Minimum trip duration seconds
minTripDist_m trip TRUE integer 10 1000 0 Minimum trip distance in meters
threshold_snr noise TRUE integer 0 1000 0 Threshold for snr
diff --git a/tests/testthat/test_check_params.R b/tests/testthat/test_check_params.R
index dfa1cc2..f298107 100644
--- a/tests/testthat/test_check_params.R
+++ b/tests/testthat/test_check_params.R
@@ -15,19 +15,18 @@ test_that("Parameters are checked", {
paramcheck = check_params(params, tool = "GGIR")
# Check that values are as expected
- expect_equal(paramcheck$blocked_params$name, c("a", "c", "f", "g", "i", "e"))
+ expect_equal(paramcheck$blocked_params$name, c("a", "c", "f", "g", "e"))
expect_equal(paramcheck$blocked_params$error, c("is not within expected range: 1 - 10",
"is not an integer", "is not numeric", "is not numeric",
- "numeric vector needs to start with c( and end with ), with values separated by a comma",
- "is not among expected values: D, E, F"))
- expect_equal(paramcheck$error_message, paste0("Error in parameter \" a \": Value 0 is not within expected",
- " range: 1 - 10
Error in parameter \" c \": Value 1.1 is not",
- " an integer
Error in parameter \" e \": Value A is not among",
- " expected values: D, E, F
Error in parameter \" f \": Value A",
- " is not numeric
Error in parameter \" g \": Value NA is not",
- " numeric
Error in parameter \" i \": Value 1,2,3 numeric",
- " vector needs to start with c( and end with ), with values",
- " separated by a comma
", collapse = ""))
+ "is not among expected values: D, E, F"))
+ expect_equal(paramcheck$error_message, paste0("Error in parameter \" a \": Value 0 is",
+ " not within expected range: 1 - 10
Error",
+ " in parameter \" c \": Value 1.1 is not an",
+ " integer
Error in parameter \" e \": ",
+ "Value A is not among expected values: D, E,",
+ " F
Error in parameter \" f \": Value A ",
+ "is not numeric
Error in parameter \" g",
+ " \": Value NA is not numeric
", collapse = ""))
#===================================
# Check timeformat seperately
params = data.frame(value = c("%Y-%m-%d %H:%M:%S", "%Y-typo-%d %H:%M:%S"),
diff --git a/tests/testthat/test_identify_tools.R b/tests/testthat/test_identify_tools.R
index b364ff4..ed7ec90 100644
--- a/tests/testthat/test_identify_tools.R
+++ b/tests/testthat/test_identify_tools.R
@@ -7,27 +7,26 @@ test_that("Correct tools are proposed by test_identify_tools", {
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), 4)
- expect_equal(sce1$tools_needed, c("GGIR", "PALMSpy", "palmsplusr", "hbGPS"))
+ expect_equal(length(sce1$tools_needed), 3)
+ expect_equal(sce1$tools_needed, c("GGIR", "palmsplusr", "hbGPS"))
expect_equal(sce1$iotools[[1]]@output, c("GGIR_out", "ACount"))
expect_equal(sce1$iotools[[3]]@output, "palmsplusr_out")
- expect_equal(sce1$iotools[[4]]@output, "palmsplusr_out")
- expect_equal(sce1$iotools[[5]]@output, "hbGPS_out")
+ expect_equal(sce1$iotools[[4]]@output, "hbGPS_out")
# Scenario 2: GIS missing
sce2 = identify_tools(datatypes = c("AccRaw", "ACount", "GPS", "GGIR_out"),
goals = c("PA", "Sleep", "QC", "Trips", "Environment"),
available_tools = available_tools)
- expect_equal(length(sce2$tools_needed), 3)
- expect_equal(sce2$tools_needed, c("GGIR", "PALMSpy", "hbGPS"))
- expect_equal(sce2$iotools[[2]]@output, "PALMSpy_out")
+ expect_equal(length(sce2$tools_needed), 2)
+ expect_equal(sce2$tools_needed, c("GGIR", "hbGPS"))
+ expect_equal(sce2$iotools[[2]]@output, "hbGPS_out")
# Scenario 3: AccRaw missing
sce3 = identify_tools(datatypes = c("ACount", "GPS", "GIS", "GGIR_out"),
goals = c("PA", "Sleep", "QC", "Trips", "Environment"),
available_tools = available_tools)
- expect_equal(length(sce3$tools_needed), 3)
- expect_equal(sce3$tools_needed, c("PALMSpy", "palmsplusr", "hbGPS"))
+ 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$iotools[[2]]@usecases, c("Environment", "QC"))
@@ -35,21 +34,21 @@ test_that("Correct tools are proposed by test_identify_tools", {
sce4 = identify_tools(datatypes = c("AccRaw", "GPS", "GIS", "GGIR_out"),
goals = c("PA", "Sleep", "QC", "Trips", "Environment"),
available_tools = available_tools)
- expect_equal(length(sce4$tools_needed), 5)
- expect_equal(sce4$tools_needed, c("GGIR", "PALMSpy", "palmsplusr", "CountConverter", "hbGPS"))
- expect_equal(sce4$iotools[[2]]@output, "PALMSpy_out")
- expect_equal(sce4$iotools[[2]]@usecases, c("Trips", "QC", "Environment"))
- expect_equal(sce4$iotools[[4]]@output, "palmsplusr_out")
- expect_equal(sce4$iotools[[5]]@usecases, c("PA", "Trips", "QC", "Environment"))
+ 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$iotools[[2]]@usecases, c("Environment", "QC"))
+ expect_equal(sce4$iotools[[4]]@output, "hbGPS_out")
+ expect_equal(sce4$iotools[[4]]@usecases, c("Trips", "QC", "Environment"))
# Scenario 5: All data vailable, but only interest in Environment
sce5 = identify_tools(datatypes = c("AccRaw", "ACount", "GPS", "GIS"),
goals = c("Environment"),
available_tools = available_tools)
- expect_equal(length(sce5$tools_needed), 4)
- expect_equal(sce5$tools_needed, c("GGIR", "PALMSpy", "palmsplusr", "hbGPS"))
- expect_equal(sce5$iotools[[2]]@output, "PALMSpy_out")
- expect_equal(sce5$iotools[[2]]@usecases, c("Trips", "QC", "Environment"))
+ 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$iotools[[2]]@usecases, c("Environment", "QC"))
# Scenario 6: hbGPS_out and GIS available
sce6 = identify_tools(datatypes = c("hbGPS_out", "GIS"),
diff --git a/tests/testthat/test_load_and_update_params.R b/tests/testthat/test_load_and_update_params.R
index a55f5f5..a6eecb9 100644
--- a/tests/testthat/test_load_and_update_params.R
+++ b/tests/testthat/test_load_and_update_params.R
@@ -4,10 +4,12 @@ context("Load and update parameters from configuration files")
test_that("Parameters can be loaded and updated from config files", {
# Load GGIR .csv file
- ggir_config_csv = system.file("testfiles_ggir/config.csv", package = "HabitusGUI")[1]
+ ggir_config_zip = system.file("testfiles_ggir/example_config_files_GGIR.zip", package = "HabitusGUI")[1]
+ ggir_config_csv = "config_GGIR_raw.csv"
+ unzip(ggir_config_zip, ggir_config_csv)
params_ggir = load_params(file = ggir_config_csv, format = "csv_ggir")
expect_equal(ncol(params_ggir), 9)
-
+
# Load PALMSpy .json file
palmspy_config_json = system.file("testfiles_palmspy/palmspy-params.json", package = "HabitusGUI")[1]
params_palmspy = load_params(file = palmspy_config_json, format = "json_palmspy")