Add external parser to read_gt3x as a wrapper around the read.gt3x me…

…thod

R/external_parser.R

@@ -0,0 +1,31 @@
+external_parser <- function(file, tz, verbose, ...) {
+
+  read.gt3x::read.gt3x(file, verbose, asDataFrame = TRUE, ...) %>%
+  dplyr::rename(
+    "Timestamp" = "time", "Accelerometer_X" = "X",
+    "Accelerometer_Y" = "Y", "Accelerometer_Z" = "Z"
+  ) %T>%
+  {stopifnot(exists("Timestamp", .))} %>%
+  within({Timestamp = lubridate::force_tz(Timestamp, tz)}) %>%
+  external_restructure(.)
+
+}
+
+external_restructure <- function(AG) {
+
+  info <-
+    attributes(AG) %>%
+    {.[setdiff(names(.), c("names", "row.names", "class"))]} %>%
+    c(stringsAsFactors = FALSE) %>%
+    do.call(data.frame, .) %>%
+    stats::setNames(., gsub("^header\\.", "", names(.))) %>%
+    stats::setNames(., gsub("\\.+", "_", names(.))) %>%
+    .[ ,!duplicated(tolower(names(.)))] %>%
+    structure(., row.names = 1:nrow(.))
+
+  attributes(AG) %<>% .[c("names", "row.names", "class")]
+
+  structure(AG, class = c("RAW", "data.frame")) %>%
+  list(info = info, RAW = .)
+
+}

R/read_gt3x.R

@@ -5,15 +5,19 @@
 #' @param verbose logical. Print updates to console?
 #' @param include character. The PACKET types to parse
 #' @param flag_idle_sleep should recorded idle sleep times be tagged?
-#' @param parser the parsing scheme to use, either \code{legacy} or \code{dev}.
-#'   The former runs slower but includes more extensive checks to ensure
-#'   alignment with \code{RAW.csv} and \code{IMU.csv} files. The latter runs
-#'   faster and has also been checked for alignment with \code{RAW.csv} and
-#'   \code{IMU.csv} files, but not as strictly. For example, rounding is not
-#'   performed by \code{parser="dev"}.
+#' @param parser the parsing scheme to use, either \code{legacy}, \code{dev}, or
+#'   \code{external}. The legacy parser runs slowly but includes more extensive
+#'   checks to ensure alignment with \code{RAW.csv} and \code{IMU.csv} files.
+#'   The development parser runs faster and has also been checked for alignment
+#'   with \code{RAW.csv} and \code{IMU.csv} files, but not as strictly. For
+#'   example, rounding is not performed by \code{parser="dev"}. The external
+#'   parser is a wrapper for \code{read.gt3x::read.gt3x}, and specific arguments
+#'   can be passed in via \code{...}
 #' @param cleanup logical. Delete unzipped files?
 #' @param data_checks Run extra checks on the data, including large values
 #' and duplicated time stamps.  Set to \code{FALSE} to speed up reading.
+#' @param ... arguments passed to \code{read.gt3x::read.gt3x} when \code{parser
+#'   == "external"}
 #'
 #' @return A list of processed data, with one element for each of the relevant
 #'   packet types.
@@ -44,23 +48,33 @@ read_gt3x <- function(
                 "TAG", "ACTIVITY", "HEART_RATE_BPM", "HEART_RATE_ANT", "HEART_RATE_BLE",
                 "LUX", "CAPSENSE", "EPOCH", "EPOCH2", "EPOCH3", "EPOCH4", "ACTIVITY2",
                 "SENSOR_DATA"),
-  flag_idle_sleep = FALSE, parser = c("legacy", "dev"), cleanup = FALSE,
-  data_checks = TRUE
+  flag_idle_sleep = FALSE, parser = c("legacy", "dev", "external"), cleanup = FALSE,
+  data_checks = TRUE, ...
 ) {
 
-  timer <- PAutilities::manage_procedure(
-    "Start", "\nProcessing", basename(file), "\n",
-    verbose = verbose
-  )
+  parser <- match.arg(parser)
+
+  if (parser == "external") {
+
+    log <- external_parser(file, tz, verbose, ...)
+
+  } else {
 
-  file %<>% read_gt3x_setup(verbose, cleanup)
+    timer <- PAutilities::manage_procedure(
+      "Start", "\nProcessing", basename(file), "\n",
+      verbose = verbose
+    )
+
+    file %<>% read_gt3x_setup(verbose, cleanup)
 
-  info <- read_gt3x_info(file, tz, verbose)
+    info <- read_gt3x_info(file, tz, verbose)
 
-  log  <-
-    file$path %>%
-    utils::unzip("log.bin", exdir = tempdir()) %>%
-    parse_log_bin(info, tz, verbose, include, parser, file)
+    log  <-
+      file$path %>%
+      utils::unzip("log.bin", exdir = tempdir()) %>%
+      parse_log_bin(info, tz, verbose, include, parser, file)
+
+  }
 
   if (flag_idle_sleep) {
 
@@ -73,6 +87,7 @@ read_gt3x <- function(
         "Cannot flag idle sleep unless both `RAW` and `EVENT` are elements",
         " of the output.\n  Make sure `include` contains \"ACTIVITY\",",
         "\"ACTIVITY2\", and \"EVENT\".",
+        "\n  NOTE: `flag_idle_sleep` is not applicable if `parser = 'external'",
         call. = FALSE
       )
 

R/read_gt3x_utils.R

@@ -189,9 +189,6 @@ get_exponent <- function(value, n_bytes) {
 
   exponent <- as.integer(binx)
   if (is_negative) {
-    # magnitude <- binaryLogic::binAdd(
-    #   !binx, binaryLogic::as.binary(1)
-    # )
     exponent <- exponent * -1
   }
 
@@ -211,9 +208,6 @@ get_significand <- function(value, n_bits, n_bytes) {
 
   significand <- as.integer(binx)
   if (is_negative) {
-    # magnitude <- binaryLogic::binAdd(
-    #   !binx, binaryLogic::as.binary(1)
-    # )
     significand <- significand * -1
   }