Part 1 improving code readability

DESCRIPTION

@@ -30,6 +30,6 @@ URL: https://github.com/wadpac/GGIR/, https://groups.google.com/forum/#!forum/Rp
 BugReports: https://github.com/wadpac/GGIR/issues
 License: Apache License (== 2.0) | file LICENSE
 Suggests: testthat, covr, knitr, rmarkdown, actilifecounts, ActCR, GGIRread, read.gt3x, readxl
-Imports: data.table, foreach, doParallel, signal, zoo, unisensR, ineq, methods, psych, irr
+Imports: data.table, foreach, doParallel, signal, zoo, unisensR, ineq, methods, psych, irr, lubridate
 Depends: stats, utils, R (>= 3.5)
 VignetteBuilder: knitr

NAMESPACE

@@ -7,7 +7,7 @@ export(g.analyse, g.calibrate,
        GGIR, g.shell.GGIR, g.getbout,
        g.abr.day.names,
        g.applymetrics, g.create.sp.mat, g.detecmidnight,
-       g.dotorcomma, g.downsample, g.extractheadervars,
+       g.dotorcomma, g.extractheadervars,
        g.getM5L5,
        g.getstarttime, g.loadlog,
        g.plot5, g.readaccfile,
@@ -24,7 +24,7 @@ export(g.analyse, g.calibrate,
        g.part5.addsib, g.part5.definedays,
        g.part5.fixmissingnight, g.part5.onsetwaketiming,
        g.part5.wakesleepwindows, g.part5.savetimeseries,
-       get_nw_clip_block_params, get_starttime_weekday_meantemp_truncdata,
+       get_nw_clip_block_params, get_starttime_weekday_truncdata,
        ismovisens, g.readtemp_movisens,
        g.conv.actlog, g.fragmentation,
        g.intensitygradient, g.part5.handle_lux_extremes,

NEWS.md

@@ -1,3 +1,15 @@
+# CHANGES IN GGIR VERSION 3.0-6
+
+Part 1:
+
+- Improved readability and maintainability of the code #1027
+
+- Improved processing speed for Axivity .cwa, GENEActiv .bin, and Movisens files
+
+- Made sure that g.readaccfile() reads timestamps in the correct timezone, configtz, for all monitor types
+
+- Note: there will be small differences in both metalong and metashort metrics calculated by this GGIR version, compared to prior versions. This is due to small improvements in the management of timestamps, calibration coefficients, and input data block boundaries.
+
 # CHANGES IN GGIR VERSION 3.0-5
 
 - Part 5: Fix bug in functionality for Sensewear data (externally derived epoch data) #1030

R/check_params.R

@@ -72,6 +72,9 @@ check_params = function(params_sleep = c(), params_metrics = c(),
     check_class("Raw data", params = params_rawdata, parnames = numeric_params, parclass = "numeric")
     check_class("Raw data", params = params_rawdata, parnames = boolean_params, parclass = "boolean")
     check_class("Raw data", params = params_rawdata, parnames = character_params, parclass = "character")
+
+    if (params_rawdata[["chunksize"]] > 1.5) params_rawdata[["chunksize"]] = 1.5
+    if (params_rawdata[["chunksize"]] < 0.2) params_rawdata[["chunksize"]] = 0.2
   }
   if (length(params_247) > 0) {
     # iglevels and qwindow can be numeric or character, so not tested
@@ -127,6 +130,29 @@ check_params = function(params_sleep = c(), params_metrics = c(),
     check_class("general", params = params_general, parnames = numeric_params, parclass = "numeric")
     check_class("general", params = params_general, parnames = boolean_params, parclass = "boolean")
     check_class("general", params = params_general, parnames = character_params, parclass = "character")
+
+    ws3 = params_general[["windowsizes"]][1]; ws2 = params_general[["windowsizes"]][2]; ws = params_general[["windowsizes"]][3]
+    if (ws2/60 != round(ws2/60)) {
+      ws2 = as.numeric(60 * ceiling(ws2/60))
+      warning(paste0("The long windowsize needs to be a multitude of 1 minute periods.\n",
+                     "Long windowsize has now been automatically adjusted to ",
+                     ws2, " seconds in order to meet this criteria."), call. = FALSE)
+    }
+    if (ws2/ws3 != round(ws2/ws3)) {
+      def = c(1,5,10,15,20,30,60)
+      def2 = abs(def - ws3)
+      ws3 = as.numeric(def[which(def2 == min(def2))])
+      warning(paste0("The long windowsize needs to be a multitude of short windowsize.\n",
+                     "The short windowsize has now been automatically adjusted to ",
+                     ws3, " seconds in order to meet this criteria.\n"), call. = FALSE)
+    }
+    if (ws/ws2 != round(ws/ws2)) {
+      ws = ws2 * ceiling(ws/ws2)
+      warning(paste0("The third value of parameter windowsizes needs to be a multitude of the second value.\n",
+                     "The third value has been automatically adjusted to ",
+                     ws, " seconds in order to meet this criteria.\n"), call. = FALSE)
+    }    
+    params_general[["windowsizes"]] = c(ws3, ws2, ws)
   }
   #-----------------------------------------------------------------------------------
   # Check value combinations and apply corrections if not logical

R/datadir2fnames.R

@@ -13,14 +13,24 @@ datadir2fnames = function(datadir,filelist) {
     }
   } else {
     if (ismovisens(datadir)) {
-      fnamesfull = dir(datadir, recursive = TRUE, pattern = "acc.bin", full.names = TRUE)
-      fnames = basename(dirname(fnamesfull))
-      nfolders = length(dir(datadir))
-      if (nfolders > length(fnamesfull)) { # meaning there are movisens data folder without acc.bin
-        # folders without acc.bin
-        allfolders = dir(datadir, full.names = TRUE)
-        foldersWithAccBin = dirname(fnamesfull)
-        noAccBin = allfolders[which(!allfolders %in% foldersWithAccBin)]
+      fnamesfull = dir(datadir, recursive = TRUE, pattern = "acc.bin$", full.names = TRUE)
+      foldersWithAccBin = dirname(fnamesfull)
+      fnames = basename(foldersWithAccBin)
+
+      allfolders = list.dirs(datadir, recursive=FALSE, full.names = TRUE)
+
+      # are there any folders that don't contain acc.bin (directly, or in any subfolders)?
+      noAccBin = c()
+      for (fld in allfolders) {
+        if (fld %in% foldersWithAccBin) next # folder contains acc.bin
+
+        # do any subfolders contain acc.bin?
+        if (!any(grepl(paste(fld, '/', sep = ''), foldersWithAccBin))) {
+          noAccBin = c(noAccBin, fld)
+        }
+      }
+
+      if (length(noAccBin) > 0) {
         warning(paste0("The following movisens data folders do not contain the ",
                        "acc.bin file with the accelerometer recording, and ",
                        "therefore cannot be processed in GGIR: ",

R/detect_nonwear_clipping.R

@@ -11,11 +11,6 @@ detect_nonwear_clipping = function(data = c(), windowsizes = c(5, 900, 3600), sf
   CWav = NWav = rep(0, nmin)
   crit = ((window/window2)/2) + 1
 
-  if (is.numeric(data[,1]) == FALSE) {
-    data[,1] = as.numeric(data[,1])
-    data[,2] = as.numeric(data[,2])
-    data[,3] = as.numeric(data[,3])
-  }
   if (nonwear_approach %in% c("2013", "2023")) {
     # define windows to check:
     for (h in 1:nmin) { #number of windows
@@ -43,25 +38,24 @@ detect_nonwear_clipping = function(data = c(), windowsizes = c(5, 900, 3600), sf
         NWflag = h:(h + window/window2 - 1)
         if (NWflag[length(NWflag)] > nmin) NWflag = NWflag[-which(NWflag > nmin)]
         # window to check (not aggregated values)
-        hoc1 = h * window2 - window2 + 1
-        hoc2 = hoc1 + window - 1
+        hoc1 = h * window2 - window2
+        hoc2 = hoc1 + window
         if (hoc2 > nrow(data)) {
           hoc2 = nrow(data)
         }
       }
       # ---
-      if (length(params_rawdata[["rmc.col.wear"]]) > 0) {
-        wearcol = as.character(data[, which(colnames(data) == "wear")])
-        suppressWarnings(storage.mode(wearcol) <- "logical")
-        wearTable = table(wearcol[(1 + hoc1):hoc2], useNA = FALSE)
-        NWav[h] = as.logical(tail(names(sort(wearTable)), 1)) * 3 # times 3 to simulate heuristic approach
+      if ("wear" %in% colnames(data)) {
+        wearTable = table(data[(1 + hoc1):hoc2, "wear"], useNA = "no")
+        NWav[h] = as.numeric(tail(names(sort(wearTable)), 1)) * 3 # times 3 to simulate heuristic approach
       }
-      for (jj in  1:3) {
+      xyzCol = which(colnames(data) %in% c("x", "y", "z"))
+      for (jj in seq(3)) {
         # Clipping
-        aboveThreshold = which(abs(data[(1 + cliphoc1):cliphoc2, jj]) > clipthres)
+        aboveThreshold = which(abs(data[(1 + cliphoc1):cliphoc2, xyzCol[jj]]) > clipthres)
         CW[h, jj] = length(aboveThreshold)
         if (length(aboveThreshold) > 0) {
-          if (length(which(abs(data[c((1 + cliphoc1):cliphoc2)[aboveThreshold],jj]) > clipthres * 1.5)) > 0) {
+          if (length(which(abs(data[c((1 + cliphoc1):cliphoc2)[aboveThreshold],  xyzCol[jj]]) > clipthres * 1.5)) > 0) {
             CW[h, jj] = window2 # If there is a a value that is more than 150% the dynamic range then ignore entire block.
           }
         }
@@ -73,18 +67,18 @@ detect_nonwear_clipping = function(data = c(), windowsizes = c(5, 900, 3600), sf
         } else if (nonwear_approach == "2023") {
           indices = seq((1 + hoc1), hoc2, by = ceiling(sf / 5))
         }
-        maxwacc = max(data[indices, jj], na.rm = TRUE)
-        minwacc = min(data[indices, jj], na.rm = TRUE)
+        maxwacc = max(data[indices, xyzCol[jj]], na.rm = TRUE)
+        minwacc = min(data[indices, xyzCol[jj]], na.rm = TRUE)
         absrange = abs(maxwacc - minwacc)
         if (absrange < racriter) {
-          sdwacc = sd(data[indices,jj], na.rm = TRUE)
+          sdwacc = sd(data[indices, xyzCol[jj]], na.rm = TRUE)
           if (sdwacc < sdcriter) {
             NW[NWflag,jj] = 1
           }
         }
       }
       CW = CW / (window2)
-      if (length(params_rawdata[["rmc.col.wear"]]) == 0) {
+      if (!("wear" %in% colnames(data))) {
         NWav[h] = (NW[h,1] + NW[h,2] + NW[h,3]) #indicator of non-wear
       }
       CWav[h] = max(c(CW[h, 1], CW[h, 2], CW[h, 3])) #indicator of clipping

R/g.applymetrics.R

@@ -3,8 +3,10 @@ g.applymetrics = function(data, sf, ws3, metrics2do,
                           zc.lb = 0.25, zc.hb = 3, zc.sb = 0.01,
                           zc.order = 2, 
                           actilife_LFE = FALSE){
+  # data should be a 3 column matrix with the x, y, and z acceleration
+  data = data[, c("x", "y", "z")]
+
   epochsize = ws3 #epochsize in seconds
-  # data is a 3 column matrix with the x, y, and z acceleration
   do.bfen = metrics2do$do.bfen
   do.enmo = metrics2do$do.enmo
   do.lfenmo = metrics2do$do.lfenmo