#653 parameters added to myfun object, output colnames and name order…

… improved

R/aggregateEvent.R

@@ -2,21 +2,25 @@ aggregateEvent = function(metric_name, varnum,
                           epochsize, anwi_nameindices,
                           anwi_index, ds_names,
                           fi, di, daysummary,
-                          acc.thresholds, metashort, 
-                          anwindices, cadence.thresholds = c(0, 30, 60)) {
+                          metashort, anwindices, myfun) {
+  acc.thresholds = myfun$ilevels
+  cadence.thresholds = myfun$clevels
+  qlevels = myfun$qlevels
+
+  fi_start = fi
 
   if (metric_name == "step_count") {
     cadence = varnum * (60/epochsize)
   }
   # aggregate per window total
-  varnameevent = paste0("total_", metric_name, anwi_nameindices[anwi_index])
+  varnameevent = paste0("tot_", metric_name, anwi_nameindices[anwi_index])
   # fi = correct_fi(di, ds_names, fi, varname = varnameevent)
   daysummary[di,fi] = sum(varnum)
   ds_names[fi] = varnameevent; fi = fi + 1
 
   if (metric_name == "step_count") {
     # cadence
-    varnameevent = paste0("mean_cadence", anwi_nameindices[anwi_index])
+    varnameevent = paste0("mn_cad", anwi_nameindices[anwi_index])
     daysummary[di,fi] = mean(cadence, na.rm = TRUE)
     ds_names[fi] = varnameevent; fi = fi + 1
   }
@@ -34,10 +38,10 @@ aggregateEvent = function(metric_name, varnum,
         whereAccLevel = which(metashort[anwindices, acc.metrics[ami]] >= (acc.thresholds[ti]/1000) &
                                 metashort[anwindices, acc.metrics[ami]] < (acc.thresholds[ti + 1]/1000))
       } else {
-        acc_level_name = paste0("atleast_", acc.thresholds[ti], "mg",  "_",  acc.metrics[ami])
+        acc_level_name = paste0("atleast", acc.thresholds[ti], "mg",  "_",  acc.metrics[ami])
         whereAccLevel = which(metashort[anwindices,acc.metrics[ami]] >= (acc.thresholds[ti]/1000))
       }
-      varnameevent = paste0("total_", metric_name, "_", acc_level_name, anwi_nameindices[anwi_index])
+      varnameevent = paste0("tot_", metric_name, "_acc", acc_level_name, anwi_nameindices[anwi_index])
       if (length(whereAccLevel) > 0)  {
         daysummary[di,fi] = sum(varnum[whereAccLevel], na.rm = TRUE)
       } else {
@@ -47,7 +51,7 @@ aggregateEvent = function(metric_name, varnum,
 
       if (metric_name == "step_count") {
         # cadence per acceleration level
-        varnameevent = paste0("mean_cadence_", 
+        varnameevent = paste0("mn_cad_acc", 
                               acc_level_name, anwi_nameindices[anwi_index])
         if (length(whereAccLevel) > 0)  {
           daysummary[di,fi] = mean(cadence[whereAccLevel], na.rm = TRUE)
@@ -59,25 +63,25 @@ aggregateEvent = function(metric_name, varnum,
     }
   }
   if (metric_name == "step_count") {
-    varnamescalar = paste0("mean_cadence", anwi_nameindices[anwi_index])
-    daysummary[di,fi] = mean(cadence)
-    ds_names[fi] = varnamescalar; fi = fi + 1
+    # varnamescalar = paste0("mean_cad", anwi_nameindices[anwi_index])
+    # daysummary[di,fi] = mean(cadence)
+    # ds_names[fi] = varnamescalar; fi = fi + 1
     #========================================
     # per cadence level
     acc.metrics = cn_metashort[cn_metashort %in% c("timestamp","anglex","angley","anglez", metric_name) == FALSE]
     # cadence.thresholds = c(0, 30, 60) # hard-coded make this a user input arguments myfun
     for (ti in 1:length(cadence.thresholds)) {
       # define cadence level
       if (ti < length(cadence.thresholds)) {
-        cadence_level_name = paste0(cadence.thresholds[ti], "-", cadence.thresholds[ti + 1], "steppm")
+        cadence_level_name = paste0(cadence.thresholds[ti], "-", cadence.thresholds[ti + 1], "spm")
         whereCadenceLevel = which(cadence >= (cadence.thresholds[ti]/1000) &
                                     cadence < (cadence.thresholds[ti + 1]/1000))
       } else {
-        cadence_level_name = paste0("atleast_", cadence.thresholds[ti], "steppm")
+        cadence_level_name = paste0("atleast", cadence.thresholds[ti], "spm")
         whereCadenceLevel = which(cadence >= (cadence.thresholds[ti]/1000))
       }
       # cadence per cadence level
-      varnameevent = paste0("mean_cadence_", cadence_level_name, anwi_nameindices[anwi_index])
+      varnameevent = paste0("mn_cad_cad", cadence_level_name, anwi_nameindices[anwi_index])
       if (length(whereCadenceLevel) > 0)  {
         daysummary[di,fi] = mean(cadence[whereCadenceLevel], na.rm = TRUE)
       } else {
@@ -86,7 +90,7 @@ aggregateEvent = function(metric_name, varnum,
       ds_names[fi] = varnameevent; fi = fi + 1
 
       # step count per cadence level
-      varnameevent = paste0("total_", metric_name, "_", 
+      varnameevent = paste0("tot_", metric_name, "_cad", 
                             cadence_level_name, anwi_nameindices[anwi_index])
       if (length(whereCadenceLevel) > 0)  {
         daysummary[di,fi] = sum(varnum[whereCadenceLevel], na.rm = TRUE)
@@ -96,13 +100,13 @@ aggregateEvent = function(metric_name, varnum,
       ds_names[fi] = varnameevent; fi = fi + 1
 
       # time per cadence level
-      varnameevent = paste0("dur_", cadence_level_name, anwi_nameindices[anwi_index])
+      varnameevent = paste0("dur_cad", cadence_level_name, anwi_nameindices[anwi_index])
       daysummary[di,fi] = length(whereCadenceLevel) / (60/epochsize)
       ds_names[fi] = varnameevent; fi = fi + 1
 
       for (ami in 1:length(acc.metrics)) {
         # acceleration per cadence level
-        varnameevent = paste0("mean_",  acc.metrics[ami],"_",
+        varnameevent = paste0("mn_",  acc.metrics[ami],"_cad",
                               cadence_level_name, anwi_nameindices[anwi_index])
         if (length(whereCadenceLevel) > 0)  {
           daysummary[di,fi] = mean(metashort[anwindices[whereCadenceLevel], acc.metrics[ami]], na.rm = TRUE) * 1000
@@ -114,5 +118,10 @@ aggregateEvent = function(metric_name, varnum,
       }
     }
   }
+  # order variablenames
+  CoI = fi_start:(fi - 1) # columns of interest
+  neworder = sort(ds_names[CoI])
+  daysummary[, CoI] = daysummary[,CoI[match(x = neworder, table = ds_names)]]
+  ds_names = neworder
   invisible(list(ds_names = ds_names, daysummary = daysummary, fi = fi))
 }

R/check_myfun.R

@@ -3,93 +3,100 @@ check_myfun = function(myfun, windowsizes) { # Function to check myfun object
   # check that myfun is a list:
   if (is.list(myfun) == F) {
     status = 1
-    stop("Error in check_myfun.R: Object myfun is not a list.") 
+    stop("Object myfun is not a list.", call. = FALSE) 
   }
   # check that there are no foreign object:
-  foreignElements = which(names(myfun) %in% c("FUN", "parameters", "expected_sample_rate", "expected_unit", 
-                                              "colnames", "minlength", "outputres", "outputtype", "aggfunction",
-                                              "timestamp","reporttype") == FALSE)
+  foreignElements = which(names(myfun) %in% c("FUN", "parameters", "expected_sample_rate", 
+                                              "expected_unit", "colnames", 
+                                              "minlength", "outputres", 
+                                              "outputtype", "aggfunction",
+                                              "timestamp","reporttype", 
+                                              "clevels", "ilevels", "qlevels" ) == FALSE)
   if (length(foreignElements) != 0) {
     status = 1
-    stop("Error in check_myfun.R: Object myfun has unexpected elements.")
+    stop("Object myfun has unexpected elements.", call. = FALSE)
   }
   # check that essential objects are included:
   expectedElements = c("FUN", "parameters", "expected_sample_rate", "expected_unit", 
                        "colnames", "minlength", "outputres") 
   missingElements = which(expectedElements %in% names(myfun) == FALSE)
   if (length(missingElements) != 0) {
     status = 1
-    stop(paste0("Error in check_myfun.R: Object myfun misses the following elements: ",
-                paste(expectedElements[missingElements],collapse=", "),"."))
+    stop(paste0("Object myfun misses the following elements: ",
+                paste(expectedElements[missingElements],collapse = ", "), "."), call. = FALSE)
   }
   # check that FUN is a function:
   if (is.function(myfun$FUN) ==  FALSE) {
     status = 1
-     stop("Error in check_myfun.R: Element FUN in myfun is not a function.")
+     stop("Element FUN in myfun is not a function.", call. = FALSE)
   }
   # check that expected_sample_rate is numeric
   if (is.numeric(myfun$expected_sample_rate) == F) {
     status = 1
-    stop("Error in check_myfun.R: Element expected_sample_rate in myfun is not numeric.")
+    stop("Element expected_sample_rate in myfun is not numeric.", call. = FALSE)
   }
   # check that unit is specified:
-  if (length(which(myfun$expected_unit %in%  c("mg","g", "ms2") == TRUE)) != 1) {
+  if (length(which(myfun$expected_unit %in%  c("mg", "g", "ms2") == TRUE)) != 1) {
     status = 1
-    stop("Error in check_myfun.R: Object myfun lacks a clear specification of the expected_unit.")
+    stop("Object myfun lacks a clear specification of the expected_unit.", call. = FALSE)
   }
   # check that colnames has at least one character value:
   if (length(myfun$colnames) == 0) {
     status = 1
-    stop("Error in check_myfun.R: Element colnames in myfun does not have a value.")
+    stop("Element colnames in myfun does not have a value.", call. = FALSE)
   }
   # Check that colnames is a character:
   if (is.character(myfun$colnames) == F) {
     status = 1
-    stop("Error in check_myfun.R: Element colnames in myfun does not hold a character value.")
+    stop("Element colnames in myfun does not hold a character value.", call. = FALSE)
   }
   # check that minlegnth has one value:
   if (length(myfun$minlength) != 1) {
     status = 1
-    stop("Error in check_myfun.R: Element minlength in myfun does not have one value.")
+    stop("Element minlength in myfun does not have one value.", call. = FALSE)
   }
   # Check that minlength is a number
   if (is.numeric(myfun$minlength) == F) {
     status = 1
-    stop("Error in check_myfun.R: Element minlength in myfun is not numeric.")
+    stop("Element minlength in myfun is not numeric.", call. = FALSE)
   }
   # check that outputres has one value:
   if (length(myfun$outputres) != 1) {
     status = 1
-    stop("Error in check_myfun.R: Element outputres in myfun does not have one value.")
+    stop("Element outputres in myfun does not have one value.", call. = FALSE)
   }
   # Check that outputres is a number:
   if (is.numeric(myfun$outputres) == F) {
     status = 1
-    stop("Error in check_myfun.R: Element outputres in myfun is not numeric.")
+    stop("Element outputres in myfun is not numeric.", call. = FALSE)
   }
   # check that it is a round number can add up to 900 seconds:
   if (myfun$outputres != round(myfun$outputres)) {
     status = 1
-    stop("Error in check_myfun.R: Element outputres in myfun should be a round number.")
+    stop("Element outputres in myfun should be a round number.", call. = FALSE)
   }
   # check that outputres is either a multitude of the epochs size or vica versa:
   if (myfun$outputres/windowsizes[1] != round(myfun$outputres/windowsizes[1]) &
       windowsizes[1]/myfun$outputres != round(windowsizes[1]/myfun$outputres)) {
     status = 1
-    stop("Error in check_myfun.R: Element outputres and the epochsize used in GGIR (first element of windowsizes) are not a multitude of each other.")
+    stop(paste0("Element outputres and the epochsize used in GGIR",
+                " (first element of windowsizes) are not a multitude",
+                " of each other.", call. = FALSE))
   }
   if ("outputtype" %in% names(myfun)) { # If outputtype is available:
     if (is.character(myfun$outputtype) == F) {
       status = 1
-      stop("Error in check_myfun.R: Element outputtype is expexted to be a character specifying the ouput type")
+      stop(paste0("Element outputtype is expexted to be a character",
+                  " specifying the ouput type"), call. = FALSE)
     }
   }
   if ("aggfunction" %in% names(myfun)) { # If aggfunction is available:
     if (is.function(myfun$aggfunction) == F) {
       status = 1
-      stop("Error in check_myfun.R: Element aggfunction is not a function object.")
+      stop("Element aggfunction is not a function object.", call. = FALSE)
     }
   }
+
   # if ("timestamp" %in% names(myfun)) { # If timestamp is available:
   #   if (is.logical(myfun$timestamp) == F) {
   #     status = 1

R/g.analyse.perday.R

@@ -555,12 +555,18 @@ g.analyse.perday = function(ndays, firstmidnighti, time, nfeatures,
               }
               if (mi %in% ExtFunColsi == TRUE) { # INSERT HERE VARIABLES DERIVED WITH EXTERNAL FUNCTION
                 if (myfun$reporttype == "event") { # For the event report type we take the sum
+                  if ("ilevels" %in% names(myfun) == FALSE) myfun$ilevels = c(0, 80)
+                  if ("clevels" %in% names(myfun) == FALSE) myfun$clevels = c(0, 30)
+                  if ("qlevels" %in% names(myfun) == FALSE) myfun$qlevels = c(0.25, 0.5, 0.75)
+                  if (length(myfun$ilevels) == 0) myfun$ilevels = 0
+                  if (length(myfun$clevels) == 0) myfun$clevels = 0
+                  if (length(myfun$qlevels) == 0) myfun$qlevels = 0.5
                   eventAgg = aggregateEvent(metric_name = cn_metashort[mi], varnum = varnum,
                                             epochsize = ws3, anwi_nameindices = anwi_nameindices,
                                             anwi_index = anwi_index, ds_names = ds_names,
                                             fi = fi, di = di, daysummary = daysummary,
-                                            acc.thresholds = c(0, 50, 100), metashort = metashort, 
-                                            anwindices = anwindices, cadence.thresholds = c(0, 30, 60))
+                                            metashort = metashort, 
+                                            anwindices = anwindices, myfun)
 
                   daysummary = eventAgg$daysummary
                   ds_names = eventAgg$ds_names

tests/testthat/test_aggregateEvent.R

@@ -16,54 +16,56 @@ test_that("Events from external function are correctly aggregated", {
   varnum = metashort$step_count[anwindices]
   ws3 = 5
   anwi_nameindices = "_1234hrs"
-  daysummary = matrix("", 1, 21)
+  daysummary = matrix("", 1, 20)
   fi = 1
   di = 1
   ds_names = ""
+  myfun = list(ilevels = c(0, 50, 100),
+               clevels = c(0, 30, 50),
+               qlevels = c(0.25, 0.5, 0.75))
   # run function  
   eventAgg = aggregateEvent(metric_name = "step_count", varnum = varnum,
                             epochsize = ws3, anwi_nameindices = anwi_nameindices,
                             anwi_index = anwi_index, ds_names = ds_names,
                             fi = fi, di = di, daysummary = daysummary,
-                            acc.thresholds = c(0, 50, 100), metashort = metashort, 
-                            anwindices = anwindices, cadence.thresholds = c(0, 30, 50))
+                            metashort = metashort,  anwindices = anwindices, myfun)
 
   daysummary = as.data.frame(eventAgg$daysummary)
-  names(daysummary)[1:21] = eventAgg$ds_names
+  names(daysummary)[1:20] = eventAgg$ds_names
 
   # total steps
-  expect_equal(daysummary$total_step_count_1234hrs, "120")
+  expect_equal(daysummary$tot_step_count_1234hrs, "120")
 
   #total steps per acc range
-  expect_equal(daysummary$`total_step_count_0-50mg_ENMO_1234hrs`, "0")
-  expect_equal(daysummary$`total_step_count_50-100mg_ENMO_1234hrs`, "60")
-  expect_equal(daysummary$total_step_count_atleast_100mg_ENMO_1234hrs, "60")
+  expect_equal(daysummary$`tot_step_count_acc0-50mg_ENMO_1234hrs`, "0")
+  expect_equal(daysummary$`tot_step_count_acc50-100mg_ENMO_1234hrs`, "60")
+  expect_equal(daysummary$tot_step_count_accatleast100mg_ENMO_1234hrs, "60")
 
   #total steps per cadence range
-  expect_equal(daysummary$`total_step_count_0-30steppm_1234hrs`, "0")
-  expect_equal(daysummary$`total_step_count_30-50steppm_1234hrs`, "0")
-  expect_equal(daysummary$total_step_count_atleast_50steppm_1234hrs, "120")
+  expect_equal(daysummary$`tot_step_count_cad0-30spm_1234hrs`, "0")
+  expect_equal(daysummary$`tot_step_count_cad30-50spm_1234hrs`, "0")
+  expect_equal(daysummary$tot_step_count_cadatleast50spm_1234hrs, "120")
 
   #mean cadence
-  expect_equal(daysummary$mean_cadence_1234hrs, "40")
+  expect_equal(daysummary$mn_cad_1234hrs, "40")
 
   #mean cadence per acc range
-  expect_equal(daysummary$`mean_cadence_0-50mg_ENMO_1234hrs`, "0")
-  expect_equal(daysummary$`mean_cadence_50-100mg_ENMO_1234hrs`, "60")
-  expect_equal(daysummary$mean_cadence_atleast_100mg_ENMO_1234hrs, "60")
+  expect_equal(daysummary$`mn_cad_acc0-50mg_ENMO_1234hrs`, "0")
+  expect_equal(daysummary$`mn_cad_acc50-100mg_ENMO_1234hrs`, "60")
+  expect_equal(daysummary$mn_cad_accatleast100mg_ENMO_1234hrs, "60")
 
   #mean cadence per cadence range
-  expect_equal(daysummary$`mean_cadence_0-30steppm_1234hrs`, "0")
-  expect_equal(daysummary$`mean_cadence_30-50steppm_1234hrs`, "0")
-  expect_equal(daysummary$mean_cadence_atleast_50steppm_1234hrs, "60")
+  expect_equal(daysummary$`mn_cad_cad0-30spm_1234hrs`, "0")
+  expect_equal(daysummary$`mn_cad_cad30-50spm_1234hrs`, "0")
+  expect_equal(daysummary$mn_cad_cadatleast50spm_1234hrs, "60")
 
   # mean acc per cadence range
-  expect_equal(daysummary$`mean_ENMO_0-30steppm_1234hrs`, "0")
-  expect_equal(daysummary$`mean_ENMO_30-50steppm_1234hrs`, "0")
-  expect_equal(daysummary$mean_ENMO_atleast_50steppm_1234hrs, "100")
+  expect_equal(daysummary$`mn_ENMO_cad0-30spm_1234hrs`, "0")
+  expect_equal(daysummary$`mn_ENMO_cad30-50spm_1234hrs`, "0")
+  expect_equal(daysummary$mn_ENMO_cadatleast50spm_1234hrs, "100")
 
   # time per cadence range
-  expect_equal(daysummary$`dur_0-30steppm_1234hrs`, "1")
-  expect_equal(daysummary$`dur_30-50steppm_1234hrs`, "0")
-  expect_equal(daysummary$dur_atleast_50steppm_1234hrs, "2")
+  expect_equal(daysummary$`dur_cad0-30spm_1234hrs`, "1")
+  expect_equal(daysummary$`dur_cad30-50spm_1234hrs`, "0")
+  expect_equal(daysummary$dur_cadatleast50spm_1234hrs, "2")
 })