R/RcppExports.R

In accelerometry: Functions for Processing Minute-to-Minute Accelerometer Data

# This file was generated by Rcpp::compileAttributes
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

accel.artifacts <- function(counts, thresh = 32767, skipchecks = FALSE) {
  
  # If skipchecks is FALSE, perform data quality checks
  if (skipchecks == FALSE) {
    
    # If thresh out of range, output error
    if (thresh <= 0) {
      stop("For thresh input, please enter integer greater than 0")
    }
    
    # If counts is a character, output error
    if (is.character(counts)) {
      stop("For counts input, please enter a vector or single-column matrix or data frame")
    }
    
    # If counts is a matrix or data frame and has multiple columns, output error
    if (is.matrix(counts) | is.data.frame(counts)) {
      if (ncol(counts) > 1) {
        stop("For counts input, please enter vector or single-column matrix or data frame")
      }
    }
    
    # If counts is a data frame or matrix, convert to vector
    if (is.data.frame(counts)) {
      counts <- as.vector(as.matrix(counts))
    }
    if (is.matrix(counts)) {
      counts <- as.vector(counts)
    }
    
    # If any count values are less than 0, output error
    if (sum(counts < 0) > 0) {
      stop("For counts input, please ensure that all values of object are non-negative")
    }
    
  }
  
  # Convert counts to vector of integers (if not already)
  if (!is.integer(counts)) {
    counts <- as.integer(counts)
  }
  
  # Pass values to C++ function artifacts
  .Call('accelerometry_artifacts', PACKAGE = 'accelerometry', counts, thresh)
}

accel.bouts <- function(counts, weartime = NULL, bout.length = 10, thresh.lower = 0, 
                        thresh.upper = Inf, tol = 0, tol.lower = 0, tol.upper = Inf, 
                        nci = FALSE, days.distinct = FALSE, skipchecks = FALSE) {
  
  # If skipchecks is FALSE, perform data quality checks
  if (skipchecks == FALSE) {
    
    # If any numeric options are out of range, output error
    if (bout.length < 0 | thresh.lower < 0 | thresh.upper < 0 | tol < 0 | 
          tol.lower < 0 | tol.upper < 0) {
      stop("For bout.length, thresh.lower, thresh.upper, tol, tol.lower, and 
           tol.upper inputs, please enter non-negative values")
    }
    
    # If counts is a character, output error
    if (is.character(counts)) {
      stop("For counts input, please enter a vector or single-column matrix or data frame")
    }
    
    # If counts is a matrix or data frame and has multiple columns, output error
    if (is.matrix(counts) | is.data.frame(counts)) {
      if (ncol(counts) > 1) {
        stop("For counts input, please enter vector or single-column matrix or data frame")
      }
    }
    
    # If counts is a data frame or matrix, convert to vector
    if (is.data.frame(counts)) {
      counts <- as.vector(as.matrix(counts))
    }
    if (is.matrix(counts)) {
      counts <- as.vector(counts)
    }
    
    # If any count values are less than 0, output error
    if (sum(counts<0) > 0) {
      stop("For counts input, please ensure that all values of object are non-negative")
    }
    
    # If weartime is NULL, define as vector of 1's
    if (is.null(weartime)) {
      weartime <- as.integer(rep(1,length(counts)))
    }
    
    # If weartime is a matrix or data frame and has multiple columns, output error
    if (is.matrix(weartime) | is.data.frame(weartime)) {
      if (ncol(weartime) > 1) {
        stop("For weartime input, please enter object with no more than 1 column")
      }
    }
    
    # If weartime is a data frame or matrix, convert to vector of integers
    if (is.data.frame(weartime)) {
      weartime <- as.matrix(weartime)
    }
    weartime <- as.integer(weartime)
    
    # If any weartime values are not 0 or 1, output error
    if (sum(weartime != 0 & weartime != 1)) {
      stop("For weartime input, please enter object consisting of only 0's and 1's")
    }
    
    # If length of counts vector and weartime vector differ, output error
    if (length(counts) != length(weartime)) {
      stop("For counts and weartime inputs, please enter Objects of same length")
    }
    
    # If bout.length is greater than or equal to length(counts), output error
    if (bout.length >= length(counts)) {
      stop("For bout.length input, please enter value smaller than length(counts)")
    }
    
    # If tol is greater than or equal to bout.length, output error
    if (tol >= bout.length) {
      stop("For tol input, please enter value smaller than bout.length")
    }
    
    # If neither thresh.lower nor thresh.upper are specified, output error
    if (thresh.lower == 0 & thresh.upper == Inf) {
      stop("Please enter values for thresh.lower, thresh.upper, or both")
    }
    
    # If nci is not a logical, output error
    if (!is.logical(nci)) {
      stop("For nci input, please enter either TRUE or FALSE")
    }
    
    # If days.distinct is not a logical, output error
    if (!is.logical(days.distinct)) {
      stop("For days.distinct input, please enter either TRUE or FALSE")
    }
    
    # If tol > 0, nci = FALSE, and tol.lower = 0, output warning
    if (tol > 0 & nci == FALSE & tol.lower == 0) {
      message("Specifying a non-zero for tol.lower is highly recommended; 
               otherwise, bout durations will frequently be over-estimated")
    }
    
  }
  
  # If upper thresholds are set to Inf, change to 1 million for purposes of C++ code
  if (thresh.upper == Inf) {
    thresh.upper <- 1000000
  }
  if (tol.upper == Inf) {
    tol.upper <- 1000000
  }
  
  # Convert counts and weartime to vectors of integers (if not already)
  if (!is.integer(counts)) {
    counts <- as.integer(counts)
  }
  if (!is.integer(weartime)) {
    weartime <- as.integer(weartime)
  }
  
  # Convert nci values of TRUE/FALSE to 1/0
  if (nci == TRUE) {
    nci<-1
  } else if (nci == FALSE) {
    nci<-0
  }
  
  # Convert days.distinct values of TRUE/FALSE to 1/0
  if (days.distinct == TRUE) {
    days.distinct <- 1
  } else if (days.distinct == FALSE) {
    days.distinct <- 0
  }
  
  # Pass values to C++ function bouts
  .Call('accelerometry_bouts', PACKAGE = 'accelerometry', counts, weartime, bout.length, thresh.lower, thresh.upper, tol, tol.lower, tol.upper, nci, days.distinct)
}

accel.intensities <- function(counts, thresh = c(100, 760, 2020, 5999), skipchecks = FALSE) {
  
  # If skipchecks = FALSE, perform data quality checks
  if (skipchecks == FALSE) {
    
    # If thresh is not a vector of length 4 or has values out of range, output error
    if (length(thresh) != 4 | min(thresh) <= 0) {
      stop("For thresh option, please enter a vector of 4 positive integers")
    }
    
    # If counts is a character, output error
    if (is.character(counts)) {
      stop("For counts input, please enter a vector or single-column matrix or data frame")
    }
    
    # If counts is a matrix or data frame and has multiple columns, output error
    if (is.matrix(counts) | is.data.frame(counts)) {
      if (ncol(counts) > 1) {
        stop("For counts input, please enter vector or single-column matrix or data frame")
      }
    }
    
    # If counts is a data frame or matrix, convert to vector
    if (is.data.frame(counts)) {
      counts <- as.vector(as.matrix(counts))
    }
    if (is.matrix(counts)) {
      counts <- as.vector(counts)
    }
    
    # If any count values are less than 0, output error
    if (sum(counts<0) > 0) {
      stop("For counts input, please ensure that all values of object are non-negative")
    }
    
  }
  
# # Commented out on 12/13/14 after deciding that non-integer count values should be allowed
#   # Convert counts and weartime to vectors of integers (if not already)
#   if (!is.integer(counts)) {
#     counts <- as.integer(counts)
#   }
  
  # Pass values to C++ function intensities_c
  .Call('accelerometry_intensities', PACKAGE = 'accelerometry', counts, thresh)
}

accel.sedbreaks <- function(counts, weartime = NULL, thresh = 100, return.flags = FALSE, 
                            skipchecks = FALSE) {
  
  # If skipchecks is FALSE, perform data quality checks
  if (skipchecks == FALSE) {
    
    # If any numeric options are out of range, output error
    if (thresh<1) {
      stop("For sed.break.cutpoint input, please enter integer greater than 0")
    }
    
    # If counts is a character, output error
    if (is.character(counts)) {
      stop("For counts input, please enter a vector or single-column matrix or data frame")
    }
    
    # If counts is a matrix or data frame and has multiple columns, output error
    if (is.matrix(counts) | is.data.frame(counts)) {
      if (ncol(counts) > 1) {
        stop("For counts input, please enter vector or single-column matrix or data frame")
      }
    }
    
    # If counts is a data frame or matrix, convert to vector
    if (is.data.frame(counts)) {
      counts <- as.vector(as.matrix(counts))
    }
    if (is.matrix(counts)) {
      counts <- as.vector(counts)
    }
    
    # If any count values are less than 0, output error
    if (sum(counts<0) > 0) {
      stop("For counts input, please ensure that all values of object are non-negative")
    }
    
    # If weartime is NULL, define as vector of 1's
    if (is.null(weartime)) {
      weartime <- as.integer(rep(1, length(counts)))
    }
    
    # If weartime is a matrix or data frame and has multiple columns, output error
    if (is.matrix(weartime) | is.data.frame(weartime)) {
      if (ncol(weartime) > 1) {
        stop("For weartime input, please enter object with no more than 1 column")
      }
    }
    
    # If weartime is a data frame or matrix, convert to vector of integers
    if (is.data.frame(weartime)) {
      weartime <- as.matrix(weartime)
    }
    weartime <- as.integer(weartime)
    
    # If any weartime values are not 0 or 1, output error
    if (sum(weartime != 0 & weartime != 1)) {
      stop("For weartime input, please enter object consisting of only 0's and 1's")
    }
    
    # If length of counts vector and weartime vector differ, output error
    if (length(counts) != length(weartime)) {
      stop("For counts and weartime inputs, please enter Objects with same length")
    }
    
    # If return.flags is not a logical, output error
    if (!is.logical(return.flags)) {
      stop("For return.logical input, please enter either TRUE or FALSE")
    }
  }
  
  # Convert counts and weartime to vectors of integers (if not already)
  if (!is.integer(counts)) {
    counts <- as.integer(counts)
  }
  if (!is.integer(weartime)) {
    weartime <- as.integer(weartime)
  }
  
  # Pass values to C++ function sedbreaks_c
  if (return.flags == FALSE) {
    .Call('accelerometry_sedbreaks', PACKAGE = 'accelerometry', counts, weartime, thresh)
  }
  else {
    .Call('accelerometry_sedbreaks_flags', PACKAGE = 'accelerometry', counts, weartime, thresh)
  }
  
}

accel.weartime <- function(counts, window = 60, tol = 0, tol.upper = 99, nci = FALSE, 
                           days.distinct = FALSE, skipchecks = FALSE) {
  
  # If skipchecks is FALSE, perform data quality checks
  if (skipchecks == FALSE) {
    
    # If any numeric options are out of range, output error
    if (window <= 0 | tol<0 | tol.upper<0) {
      stop("window, tol, and tol.upper must be non-negative integers")
    }
    
    # If any count values are less than 0, output error
    if (sum(counts<0) > 0) {
      stop("All count values must be non-negative")
    }
    
    # If counts is a matrix or data frame and has multiple columns, output error
    if (is.matrix(counts) | is.data.frame(counts)) {
      if (ncol(counts) > 1) {
        stop("For counts input, please enter a vector or single-column matrix or data frame")
      }
    }
    
    # If counts is a data frame or matrix, convert to vector
    if (is.data.frame(counts)) {
      counts <- as.vector(as.matrix(counts))
    }
    if (is.matrix(counts)) {
      counts <- as.vector(counts)
    }
    
    # If window is greater than length(counts), output error
    if (window > length(counts)) {
      stop("window must be no greater than length(counts)")
    }
    
    # If tol is greater than or equal to window, output error
    if (tol >= window) {
      stop("tol must be smaller than window")
    }
    
    # If nci is not a logical, output error
    if (!is.logical(nci)) {
      stop("For nci input, please enter either TRUE or FALSE")
    }
    
    # If days.distinct is not a logical, output error
    if (!is.logical(days.distinct)) {
      stop("For days.distinct input, please enter either TRUE or FALSE")
    }
    
  }
  
  # Convert counts to vector of integers (if not already)
  if (!is.integer(counts)) {
    counts <- as.integer(counts)
  }
  
  # Convert nci values of TRUE/FALSE to 1/0
  if (nci == TRUE) {
    nci <- 1
  } else if (nci == FALSE) {
    nci <- 0
  }
  
  # Convert days.distinct values of TRUE/FALSE to 1/0
  if (days.distinct == TRUE) {
    days.distinct <- 1
  } else if (days.distinct == FALSE) {
    days.distinct <- 0
  }
  
  # Pass values to C++ function weartime
  .Call('accelerometry_weartime', PACKAGE = 'accelerometry', counts, window, tol, tol.upper, nci, days.distinct)
  
}

movingaves <- function(x, window, return.max = FALSE, skipchecks = FALSE) {
  
  # If skipchecks is FALSE, perform data quality checks
  if (skipchecks == FALSE) {
    
    # If window is out of range, output error
    if (window <= 1) {
      stop("For window input, please enter integer greater than 1")
    }
    
    # If x is a character, output error
    if (is.character(x)) {
      stop("For x input, please enter a vector or single-column matrix or data frame")
    }
    
    # If x is a matrix or data frame and has multiple columns, output error
    if (is.matrix(x) | is.data.frame(x)) {
      if (ncol(x) > 1) {
        stop("For x input, please enter vector or single-column matrix or data frame")
      }
    }
    
    # If x is a data frame or matrix, convert to vector
    if (is.data.frame(x)) {
      x <- as.vector(as.matrix(x))
    }
    if (is.matrix(x)) {
      x <- as.vector(x)
    }
    
    # If window is greater than length of x, output error
    if (window > length(x)) {
      stop("For window input, please enter a value no greater than length(x)")
    }
    
    # If return.max is not a logical, output error
    if (!is.logical(return.max)) {
      stop("For return.max input, please enter either TRUE or FALSE")
    }
    
  }
  
  # Pass values to appropriate C++ function, depending on return.max
  if (return.max == FALSE) {
    .Call('accelerometry_movingaves', PACKAGE = 'accelerometry', x, window)
  } else {
    .Call('accelerometry_movingaves_max', PACKAGE = 'accelerometry', x, window)
  }
  
}

blockaves <- function(x, window, skipchecks = FALSE) {
  
  # If skipchecks is FALSE, perform data quality checks
  if (skipchecks == FALSE) {
    
    # If window is out of range, output error
    if (window <= 1) {
      stop("For window input, please enter integer greater than 1")
    }
    
    # If x is a character, output error
    if (is.character(x)) {
      stop("For x input, please enter a vector or single-column matrix or data frame")
    }
    
    # If x is a matrix or data frame and has multiple columns, output error
    if (is.matrix(x) | is.data.frame(x)) {
      if (ncol(x) > 1) {
        stop("For x input, please enter vector or single-column matrix or data frame")
      }
    }
    
    # If x is a data frame or matrix, convert to vector
    if (is.data.frame(x)) {
      x <- as.vector(as.matrix(x))
    }
    if (is.matrix(x)) {
      x <- as.vector(x)
    }
    
    # If window is greater than length of x, output error
    if (window > length(x)) {
      stop("For window input, please enter a value no greater than length(x)")
    }
    
  }
  
  # Pass values to C++ function blockaves
  .Call('accelerometry_blockaves', PACKAGE = 'accelerometry', x, window)
  
}

personvars <- function(dayvars, rows, days, wk, we) {
  .Call('accelerometry_personvars', PACKAGE = 'accelerometry', dayvars, rows, days, wk, we)
}

rle2.num <- function(x, n, nmax, indices) {
  .Call('accelerometry_rle2_num', PACKAGE = 'accelerometry', x, n, nmax, indices)
}

rle2.char <- function(x, n, nmax, indices) {
  .Call('accelerometry_rle2_char', PACKAGE = 'accelerometry', x, n, nmax, indices)
}

rle2 <- function(x, indices = FALSE, return.list = FALSE) {
  
  # If x is a matrix or data frame and has multiple columns, output error
  if (is.matrix(x) | is.data.frame(x)) {
    if (ncol(x) > 1) {
      stop("For x input, please enter vector or single-column matrix or data frame (can be numeric or character)")
    }
  }
  
  # If indices is not a logical, output error
  if (!is.logical(indices)) {
    stop("For indices input, please enter TRUE or FALSE")
  }
  
  # If return.list is not a logical, output error
  if (!is.logical(return.list)) {
    stop("For return.list input, please enter TRUE or FALSE")
  }
  
  # Get class of x and output error if not numeric or character
  if (is.numeric(x)) {
    class_x <- 1
  } else if (is.character(x)) {
    class_x <- 2
  } else {
    stop("For x input, please enter vector or single-column matrix or data frame (can be numeric or character)")
  }
  
  # Convert indices from TRUE/FALSE to 0/1
  indices <- ifelse(indices, 1, 0)
  
  # Get length of x
  length_x <- length(x)
  
  # If length is 10k or less, use simplest version of algorithm
  if (length_x <= 10000) {
    if (class_x == 1) {
      out <- rle2.num(x = x, n = length_x, nmax = -1, indices = indices)
    } else {
      out <- rle2.char(x = x, n = length_x, nmax = -1, indices = indices)
    }
  }
  
  # Else use a faster method (up to 2x as fast)
  else {
    
    # Calculate end point for first 0.1% of data in x
    end_partial <- ceiling(length_x/1000)
    
    # Send first 0.1% of x to C++ function
    if (class_x == 1) {
      partial <- rle2.num(x = x[1:end_partial], n = end_partial, nmax = -1, indices = 0)
    } else {
      partial <- rle2.char(x = x[1:end_partial], n = end_partial, nmax = -1, indices = 0)
    }
    
    # Calculate number of rows in out_partial
    rows <- nrow(partial)
    
    # If average less than 2 data points per interval, use simplest version of algorithm
    if (rows/end_partial > 0.5) {
      
      if (class_x == 1) {
        out <- rle2.num(x = x, n = length_x, nmax = -1, indices = indices)
      } else {
        out <- rle2.char(x = x, n = length_x, nmax = -1, indices = indices)
      }
      
    }
    
    # Otherwise, estimate the number of rows and use faster algorithm
    else {
      
      # Set nmax according to number of segments in first 0.1% of data
      nmax <- rows*1000*1.1
      
      # Send x to rle2 and confirm that nmax was sufficiently high
      repeat {
        
        if (class_x == 1) {
          out <- rle2.num(x = x, n = length_x, nmax = nmax, indices = indices)
        } else {
          out <- rle2.char(x = x, n = length_x, nmax = nmax, indices = indices)
        }
        
        if (nrow(out) < nmax) {
          break
        }
        else {
          nmax <- nmax*10
        }
      }
      
    }
    
  }
  
  # If x was character, convert output matrix to a data frame
  if (class_x == 2) {
    
    if (indices == 0) {
      out <- cbind(as.data.frame(x = cbind(out[,1]), stringsAsFactors = FALSE),
                   as.numeric(out[,2]))
    } else {
      out <- cbind(as.data.frame(x = cbind(out[,1]), stringsAsFactors = FALSE), 
                   as.numeric(out[,2]), as.numeric(out[,3]), as.numeric(out[,4]))
    }
  }
  
  # Add column names
  if (indices == 0) {
    colnames(out) <- c("values", "lengths")
  } else {
    colnames(out) <- c("values", "starts", "stops", "lengths")
  }
  
  # If return.list is TRUE, create list similar to rle
  if (return.list == TRUE) {
    if (indices == 0) {
      out <- list(values = out[,1], lengths = out[,2])
    } else {
      out <- list(values = out[,1], starts = out[,2], stops = out[,3], lengths = out[,4])
    }
  }
  
  return(out)
  
}

inverse.rle2 <- function(x) {
  
  # Convert x to list if necessary
  if (class(x) %in% c("data.frame", "matrix")) {
    
    colx <- ncol(x)
    if (colx == 2) {
      x.list <- list(values = x[,1], lengths = x[,2])
    } else if (colx == 4) {
      x.list <- list(values = x[,1], lengths = x[,4])
    } else {
      stop("Please make sure that input vector x is object generated by rle2 function")
    }
  } else {
    
    lengthx <- length(x)
    if (lengthx == 2) {
      x.list <- x
    } else if (lengthx == 4) {
      x.list <- x[c(1, 4)]
    } else {
      stop("Please make sure that input vector x is object generated by rle2 function")
    }
  }
  
  # Re-construct original vector using rle
  y <- inverse.rle(x.list)
  
  # Return original vector
  return(y)
  
}

accel.process.uni <- function(counts, steps = NULL, nci.methods = FALSE, 
                              start.date = as.Date("2014/1/5"), start.time = "00:00:00", id = NULL, 
                              brevity = 1, valid.days = 1, valid.week.days = 0, 
                              valid.weekend.days = 0, int.cuts = c(100, 760, 2020, 5999), 
                              cpm.nci = FALSE, days.distinct = FALSE, nonwear.window = 60, 
                              nonwear.tol = 0, nonwear.tol.upper = 99, nonwear.nci = FALSE, 
                              weartime.minimum = 600, weartime.maximum = 1440, 
                              partialday.minimum = 1440, active.bout.length = 10, 
                              active.bout.tol = 0, mvpa.bout.tol.lower = 0, vig.bout.tol.lower = 0, 
                              active.bout.nci = FALSE, sed.bout.tol = 0, 
                              sed.bout.tol.maximum = int.cuts[2]-1, artifact.thresh = 25000, 
                              artifact.action = 1, weekday.weekend = FALSE, return.form = 2) {
    
  # If counts is a character, output error
  if (is.character(counts)) {
    stop("For counts input, please enter a vector or single-column matrix or data frame")
  }
  
  # If counts is a matrix or data frame and has multiple columns, output error
  if (is.matrix(counts) | is.data.frame(counts)) {
    if (ncol(counts) > 1) {
      stop("For counts input, please enter vector or single-column matrix or data frame")
    }
  }
  
  # If counts is a data frame or matrix, convert to vector
  if (is.data.frame(counts)) {
    counts <- as.vector(as.matrix(counts))
  }
  if (is.matrix(counts)) {
    counts <- as.vector(counts)
  }
  
  # If any count values are less than 0, output error
  if (sum(counts<0) > 0) {
    stop("For counts input, please ensure that all values of object are non-negative")
  }
  
  # If steps is a data frame or matrix, convert to vector
  if (is.data.frame(steps)) {
    steps <- as.vector(as.matrix(steps))
  }
  if (is.matrix(steps)) {
    steps <- as.vector(steps)
  }
  
  # If any step values are less than 0, output error
  if (sum(steps<0) > 0) {
    stop("For steps input, please ensure that all values of object are non-negative")
  }
  
  # If length of steps and counts vectors are different, output error
  if (!is.null(steps) & length(steps) != length(counts)) {
    stop("For counts and steps inputs, please enter objects of same length")
  }
  
  # If nci.methods is not a logical, output error
  if (!is.logical(nci.methods)) {
    stop("For nci.methods input, please enter TRUE or FALSE")
  }
  
  # If start.date is not a date, output error
  if (class(start.date) != "Date") {
    stop("For start.date input, please enter a valid date variable")
  }
  
  # If start.time is not a character, output error
  if (!is.character(start.time)) {
    stop("For start.time input, please enter the start time for the first day of monitoring. 
         For example,'08:30:00' for 8:30 a.m.")
  }
  
  # If more than one id, output error
  if (!is.null(id) & length(unique(id)) > 1) {
    stop("For id input, please enter either a single ID number or a vector with repeated value of a single ID number")
  }
  
  # If brevity out of range, output error
  if (sum(brevity == c(1, 2, 3)) == 0) {
    stop("For brevity input, please enter 1, 2, or 3 (see documentation)")
  }
  
  # If valid.days, valid.week.days, or valid.weekend.days out of range, output error
  if (valid.days < 1 | valid.days > 7 | valid.week.days > 5 | valid.weekend.days > 2) {
    stop("For valid.days input, please enter value between 1 and 7; for valid.week.days 
         and valid.weekend.days inputs, please enter values no greater than 5 and 2, 
         respectively")
  }
  
  # If length of int.cuts is not 4, or if values are out of range, output error
  if (length(int.cuts) != 4 | sum(int.cuts < 0) > 0) {
    stop("For int.cuts input, please enter a vector of 4 non-negative values")
  }
  
  # If cpm.nci is not a logical, output error
  if (!is.logical(cpm.nci)) {
    stop("For cpm.nci input, please enter TRUE or FALSE")
  }
  
  # If days.distinct is not a logical, output error
  if (!is.logical(days.distinct)) {
    stop("For days.distinct input, please enter TRUE or FALSE")
  }
  
  # If If nonwear.window is out of range, output error
  if (nonwear.window<1) {
    stop("For nonwear.window input, please enter positive value")
  }
  
  # If nonwear.tol out of range, output error
  if (nonwear.tol<0 | nonwear.tol >= nonwear.window) {
    stop("For nonwear.tol input, please enter non-negative value less than nonwear.window")
  }
  
  # If nonwear.tol.upper out of range, output error
  if (nonwear.tol.upper<0) {
    stop("For nonwear.tol.upper input, please enter non-negative value")
  }
  
  # If nonwear.nci is not a logical, output error
  if (!is.logical(nonwear.nci)) {
    stop("For nonwear.nci input, please enter TRUE or FALSE")
  }
  
  # If weartime.minimum out of range, output error
  if (weartime.minimum <= 0) {
    stop("For weartime.minimum input, please enter positive value")
  }
  
  # If weartime.maximum out of range, output error
  if (weartime.maximum <= weartime.minimum) {
    stop("For weartime.maximum input, please enter positive value greater than weartime.minimum")
  }
  
  # If partialday.minimum is not in range, output error
  if (!is.numeric(partialday.minimum) || partialday.minimum < 1 || partialday.minimum > 1440)  {
    stop("For partialday.minimum input, please enter positive whole number less than or equal to 1440")
  }
  
  # If active.bout.length out of range, output error
  if (active.bout.length <= 1) {
    stop("For active.bout.length input, please enter value greater than 1")
  }
  
  # If active.bout.tol out of range, output error
  if (active.bout.tol<0 | active.bout.tol >= active.bout.length) {
    stop("For active.bout.tol input, please enter non-negative value less than active.bout.tol")
  }
  
  # If mvpa.bout.tol.lower out of range, output error
  if (mvpa.bout.tol.lower < 0 | mvpa.bout.tol.lower > int.cuts[3]) {
    stop("For mvpa.bout.tol.lower input, please enter non-negative value no greater than int.cuts[3]")
  }
  
  # If vig.bout.tol.lower out of range, output error
  if (vig.bout.tol.lower < 0 | vig.bout.tol.lower > int.cuts[4]) {
    stop("For vig.bout.tol.lower input, please enter non-negative value no greater than int.cuts[4]")
  }
  
  # If active.bout.nci is not a logical, output error
  if (!is.logical(active.bout.nci)) {
    stop("For active.bout.nci input, please enter TRUE or FALSE")
  }
  
  # If sed.bout.tol out of range, output error
  if (sed.bout.tol < 0 | sed.bout.tol >= 10) {
    stop("For sed.bout.tol input, please enter non-negative value less than 10")
  }
  
  # If sed.bout.tol.maximum out of range, output error
  if (sed.bout.tol.maximum < 0) {
    stop("For sed.tol.maximum input, please enter non-negative value")
  }
  
  # If artifact.thresh out of range, output error
  if (artifact.thresh <= int.cuts[4]) {
    stop("For artifact.thresh input, please enter value greater than int.cuts[4]")
  }
  
  # If artifact.action out of range, output error
  if (sum(artifact.action == c(1, 2, 3, 4)) == 0) {
    stop("For artifact.action input, please enter 1, 2, 3, or 4 (see documentation)")
  }
  
  # If weekday.weekend is not a logical, output error
  if (!is.logical(weekday.weekend)) {
    stop("For weekday.weekend input, please enter TRUE or FALSE")
  }
  
  # If return.form is out of range, output error
  if (!return.form %in% c(1, 2, 3)) {
    stop("For return.form input, please enter 1 for per-person, 2 for per-day, or 3 for both")
  }
  
  # Get number of minutes of data
  datalength <- length(counts)
  
  # If nci.methods is TRUE, set inputs to replicate data processing done by NCI's SAS programs
  if (nci.methods == TRUE) {
    
    # Set certain inputs to match NCI methods
    valid.days <- 4
    valid.week.days <- 0
    valid.weekend.days <- 0
    int.cuts <- c(100, 760, 2020, 5999)
    cpm.nci <- TRUE
    days.distinct <- TRUE
    nonwear.window <- 60
    nonwear.tol <- 2
    nonwear.tol.upper <- 100
    nonwear.nci <- TRUE
    weartime.minimum <- 600
    weartime.maximum <- 1440
    partialday.minimum <- 1440
    active.bout.length <- 10
    active.bout.tol <- 2
    mvpa.bout.tol.lower <- 0
    vig.bout.tol.lower <- 0
    active.bout.nci <- TRUE
    sed.bout.tol <- 0
    sed.bout.tol.maximum <- 759
    artifact.thresh <- 32767
    artifact.action <- 3
    
  }
  
  # Get start/stop minutes for each day of monitoring
  extratime <- max(1, round(as.numeric(difftime(as.POSIXct(paste(start.date, "24:00:00")), as.POSIXct(paste(start.date, start.time)), units = "mins"))))
  startmins <- 1
  stopmins <- min(extratime, datalength)
  if (stopmins < datalength) {
    startmins <- c(startmins, seq(stopmins+1, datalength, 1440))
    stopmins <- c(stopmins, startmins[2:length(startmins)]+1439)
    stopmins[length(stopmins)] <- datalength
  }
  
  # If id value or vector is provided, get first value
  if (is.null(id)) {
    id <- 1
  } else {
    id <- id[1]
  }
  
  # Calculate number of full days of data
  numdays <- length(startmins)
  
  # Initialize matrix to save daily physical activity variables
  dayvars <- matrix(NA, ncol = 68, nrow = numdays)
  
  # If artifact.action = 3, replace minutes with counts > artifact.thresh with average of surrounding minutes
  if (artifact.action == 3) {
    counts <- accel.artifacts(counts = counts, thresh = artifact.thresh)
  }
  
  # Call weartime.flag function to flag minutes valid for analysis
  wearflag <- accel.weartime(counts = counts,
                            window = nonwear.window,
                            tol = nonwear.tol,
                            tol.upper = nonwear.tol.upper,
                            nci = nonwear.nci,
                            days.distinct = days.distinct)
  
  # If artifact.action = 2, consider minutes with counts >= artifact.thresh as non-weartime
  if (artifact.action == 2) {
    artifact.locs <- which(counts >= artifact.thresh)
    wearflag[artifact.locs] <- 0
    counts[artifact.locs] <- 0
  }
  
  # Identify bouts of MVPA, VPA, and sedentary time
  if (brevity == 2 | brevity == 3) {
    boutedMVPA <- accel.bouts(counts = counts,
                              weartime = wearflag,
                              bout.length = active.bout.length,
                              thresh.lower = int.cuts[3],
                              tol = active.bout.tol,
                              tol.lower = mvpa.bout.tol.lower,
                              nci = active.bout.nci,
                              days.distinct = days.distinct,
                              skipchecks = TRUE)
    boutedvig <- accel.bouts(counts = counts,
                             weartime = wearflag,
                             bout.length = active.bout.length,
                             thresh.lower = int.cuts[4],
                             tol = active.bout.tol,
                             tol.lower = vig.bout.tol.lower,
                             nci = active.bout.nci,
                             days.distinct = days.distinct,
                             skipchecks = TRUE)
    boutedsed10 <- accel.bouts(counts = counts,
                               weartime = wearflag,
                               bout.length = 10,
                               thresh.upper = int.cuts[1]-1,
                               tol = sed.bout.tol,
                               tol.upper = sed.bout.tol.maximum,
                               days.distinct = days.distinct,
                               skipchecks = TRUE)
    boutedsed30 <- accel.bouts(counts = counts,
                               weartime = wearflag,
                               bout.length = 30,
                               thresh.upper = int.cuts[1]-1,
                               tol = sed.bout.tol,
                               tol.upper = sed.bout.tol.maximum,
                               days.distinct = days.distinct,
                               skipchecks = TRUE)
    boutedsed60 <- accel.bouts(counts = counts,
                               weartime = wearflag,
                               bout.length = 60,
                               thresh.upper = int.cuts[1]-1,
                               tol = sed.bout.tol,
                               tol.upper = sed.bout.tol.maximum,
                               days.distinct = days.distinct,
                               skipchecks = TRUE)
  }
  
  # Get day of week
  currentday <- weekdays(start.date-1)
  if (currentday == "Sunday") {
    currentday <- 1
  } else if (currentday == "Monday") {
    currentday <- 2
  } else if (currentday == "Tuesday") {
    currentday <- 3
  } else if (currentday == "Wednesday") {
    currentday <- 4
  } else if (currentday == "Thursday") {
    currentday <- 5
  } else if (currentday == "Friday") {
    currentday <- 6
  } else if (currentday == "Saturday") {
    currentday <- 7
  }
  
  # Loop through accelerometer data for i days
  for (i in 1:numdays) { 
    
    # Update day of week
    currentday <- currentday + 1
    if (currentday == 8) {
      currentday <- 1
    }
    
    # Load accelerometer data from day i    
    day.counts <- counts[startmins[i]:stopmins[i]]
    day.wearflag <- wearflag[startmins[i]:stopmins[i]]
    if (brevity == 2 | brevity == 3) {
      day.boutedMVPA <- boutedMVPA[startmins[i]:stopmins[i]]
      day.boutedvig <- boutedvig[startmins[i]:stopmins[i]]
      day.boutedsed10 <- boutedsed10[startmins[i]:stopmins[i]]
      day.boutedsed30 <- boutedsed30[startmins[i]:stopmins[i]]
      day.boutedsed60 <- boutedsed60[startmins[i]:stopmins[i]]
    }
    if (!is.null(steps)) {
      day.steps <- steps[startmins[i]:stopmins[i]]
    }
    
    # Calculate constants that are used more than once
    daywear <- sum(day.wearflag)
    maxcount <- max(day.counts)
    daylength <- length(day.counts)
    
    # ID number
    dayvars[i,1] <- id
    
    # Day of week
    dayvars[i,2] <- currentday
    
    # Check whether day is valid for analysis; if not, mark as invalid
    if (daywear < weartime.minimum | daywear > weartime.maximum | (artifact.action == 1 & maxcount >= artifact.thresh) |
          daylength < partialday.minimum) {
      dayvars[i,3] <- 0
    } else {
      dayvars[i,3] <- 1
    }
    
    # Minutes of valid wear time
    dayvars[i,4] <- daywear
    
    # Store day.counts[day.wearflag == 1] into its own vector
    day.counts.valid <- day.counts[day.wearflag == 1]
    
    # Total counts during wear time
    dayvars[i,5] <- sum(day.counts.valid)
    
    # Counts per minute - calculated as total counts during wear time divided by wear time
    dayvars[i,6] <- dayvars[i,5]/dayvars[i,4]
    
    # Steps
    if (!is.null(steps)) {
      dayvars[i,7] <- sum(day.steps[day.wearflag == 1])
    }
    
    if (brevity == 2 | brevity == 3) {
      
      # Minutes in various intensity levels
      intensities <- accel.intensities(counts = day.counts.valid, thresh = int.cuts)
      dayvars[i,8:15] <- intensities[1:8]
      
      # Proportions of daily wear time in each intensity level
      dayvars[i,16:23] <- dayvars[i,8:15]/daywear
      
      # Counts accumulated during wear time in each intensity level  
      dayvars[i,24:31] <- intensities[9:16]
      
      # Bouted sedentary time
      dayvars[i,32] <- sum(day.boutedsed10)
      dayvars[i,33] <- sum(day.boutedsed30)
      dayvars[i,34] <- sum(day.boutedsed60)
      
      # Sedentary breaks
      dayvars[i,35] <- accel.sedbreaks(counts = day.counts, weartime = day.wearflag, thresh = int.cuts[1], skipchecks = TRUE)
      
      # Maximum 1-min, 5-min, 10-min, and 30-min count averages
      dayvars[i,36] <- maxcount
      dayvars[i,37] <- movingaves(x = day.counts, window = 5, return.max = TRUE, skipchecks = TRUE)
      dayvars[i,38] <- movingaves(x = day.counts, window = 10, return.max = TRUE, skipchecks = TRUE)
      dayvars[i,39] <- movingaves(x = day.counts, window = 30, return.max = TRUE, skipchecks = TRUE)
      
      # MVPA and vigorous physical activity in >= 10-min bouts
      dayvars[i,42] <- sum(day.boutedMVPA)
      dayvars[i,43] <- sum(day.boutedvig)
      dayvars[i,44] <- sum(dayvars[i,42:43])
      
      if (dayvars[i,42] > 0) {
        dayvars[i,40] <- sum(rle2(day.boutedMVPA)[,1] == 1)
      } else {
        dayvars[i,40] <- 0
      }
      if (dayvars[i,43] > 0) {
        dayvars[i,41] <- sum(rle2(day.boutedMVPA)[,1] == 1)
      } else {
        dayvars[i,41] <- 0
      }
      
      if (brevity == 3) {
        
        # Hourly counts/min averages
        if (daylength == 1440) {
          dayvars[i,45:68] <- blockaves(x = day.counts, window = 60, skipchecks = TRUE)
        }
        
      }
    }
    
  }
  
  # Format matrix of daily physical activity variables
  colnames(dayvars) <- c("id", "day", "valid_day", "valid_min", "counts", "cpm", "steps", "sed_min", "light_min", "life_min", 
                         "mod_min", "vig_min", "lightlife_min", "mvpa_min", "active_min", "sed_percent", "light_percent", 
                         "life_percent", "mod_percent", "vig_percent", "lightlife_percent", "mvpa_percent", "active_percent", 
                         "sed_counts", "light_counts", "life_counts", "mod_counts", "vig_counts", "lightlife_counts", 
                         "mvpa_counts", "active_counts", "sed_bouted_10min", "sed_bouted_30min", "sed_bouted_60min", 
                         "sed_breaks", "max_1min_counts", "max_5min_counts", "max_10min_counts", "max_30min_counts", 
                         "num_mvpa_bouts", "num_vig_bouts", "mvpa_bouted", "vig_bouted", "guideline_min", "cpm_hour1", 
                         "cpm_hour2", "cpm_hour3", "cpm_hour4", "cpm_hour5", "cpm_hour6", "cpm_hour7", "cpm_hour8", "cpm_hour9", 
                         "cpm_hour10", "cpm_hour11", "cpm_hour12", "cpm_hour13", "cpm_hour14", "cpm_hour15", "cpm_hour16", 
                         "cpm_hour17", "cpm_hour18", "cpm_hour19", "cpm_hour20", "cpm_hour21", "cpm_hour22", "cpm_hour23", 
                         "cpm_hour24")
  
  # Drop variables according to brevity setting
  if (brevity == 1) {
    dayvars <- dayvars[,1:7]
  } else if (brevity == 2) {
    dayvars <- dayvars[,1:44]
  }
  
  # Drop steps if NULL
  if (is.null(steps)) {
    dayvars <- dayvars[, -7, drop = FALSE]
  }

  # Calculate daily averages
  locs.valid <- which(dayvars[,3] == 1)
  locs.valid.wk <- which(dayvars[,3] == 1 & dayvars[,2] %in% 2:6)
  locs.valid.we <- which(dayvars[,3] == 1 & dayvars[,2] %in% c(1, 7))
  
  # If weekday.weekend is FALSE, just calculate overall averages
  if (weekday.weekend == FALSE) {
    averages <- c(id = id, valid_days = length(locs.valid), include = 0, colMeans(x = dayvars[locs.valid,4:ncol(dayvars), drop = FALSE]))
    if (length(locs.valid) >= valid.days & length(locs.valid.wk) >= valid.week.days & length(locs.valid.we) >= valid.weekend.days) {
      averages[3] <- 1
    }
  } else {
    
    # Otherwise calculate averages by all valid days and by valid weekdays and valid weekend days
    averages <- c(id = id, valid_days = length(locs.valid), valid_week_days = length(locs.valid.wk),
                  valid_weekend_days = length(locs.valid.we), include = 0,
                  colMeans(x = dayvars[locs.valid,4:ncol(dayvars)]),
                  colMeans(x = dayvars[locs.valid.wk,4:ncol(dayvars)]),
                  colMeans(x = dayvars[locs.valid.we,4:ncol(dayvars)]))
    if (length(locs.valid) >= valid.days & length(locs.valid.wk) >= valid.week.days & length(locs.valid.we) >= valid.weekend.days) {
      averages[5] <- 1
    }
    
    # Modify variable names for weekdays and weekends
    numvars <- (length(averages)-5)/3
    names(averages)[(6+numvars):(6+2*numvars-1)] <- paste("wk_", names(averages)[(6+numvars):(6+2*numvars-1)], sep = "")
    names(averages)[(6+2*numvars):(6+3*numvars-1)] <- paste("we_", names(averages)[(6+2*numvars):(6+3*numvars-1)], sep = "")
    
  }
  
  # If cpm.nci is TRUE, re-calculate averages for cpm variables
  if (cpm.nci == TRUE) {
    averages["cpm"] <- averages["counts"]/averages["valid_min"]
  }
  
  # Convert averages to matrix for the hell of it
  averages <- matrix(averages, nrow = 1, dimnames = list(NULL, names(averages)))
  
  
  # Return data frame(s)
  if (return.form == 1) {
    return(averages)
  } else if (return.form == 2) {
    return (dayvars)
  } else if (return.form == 3) {
    retlist <- list(averages = averages, dayvars = dayvars)
    return(retlist)
  }
}


accel.process.tri <- function(counts.tri, steps = NULL, nci.methods = FALSE, 
                              start.date = as.Date("2014/1/5"), start.time = "00:00:00", id = NULL, 
                              brevity = 1, valid.days = 1, valid.week.days = 0, 
                              valid.weekend.days = 0, int.axis = "vert", 
                              int.cuts = c(100, 760, 2020, 5999), cpm.nci = FALSE, 
                              hourly.axis = "vert", days.distinct = FALSE, nonwear.axis = "vert", 
                              nonwear.window = 60, nonwear.tol = 0, nonwear.tol.upper = 99, 
                              nonwear.nci = FALSE, weartime.minimum = 600, weartime.maximum = 1440, 
                              partialday.minimum = 1440, active.bout.length = 10, 
                              active.bout.tol = 0, mvpa.bout.tol.lower = 0, vig.bout.tol.lower = 0, 
                              active.bout.nci = FALSE, sed.bout.tol = 0, 
                              sed.bout.tol.maximum = int.cuts[2] - 1, artifact.axis = "vert", 
                              artifact.thresh = 25000, artifact.action = 1, weekday.weekend = FALSE, 
                              return.form = 2) {
  
  # If counts variable is a character, output error
  if (is.character(counts.tri)) {
    stop("For counts.tri input, please enter three-column matrix or data frame with vertical, 
         anteroposterior (AP), and mediolateral (ML) counts in that order")
  }
  
  # If counts variable is a data frame, convert to matrix
  if (is.data.frame(counts.tri)) {
    counts.tri <- as.matrix(counts.tri)
  }
  
  # If any count values are less than 0, output error
  if (sum(counts.tri < 0) > 0) {
    stop("For counts.tri input, please ensure that all count values are non-negative")
  }
  
  # If steps is a data frame or matrix, convert to vector
  if (is.data.frame(steps)) {
    steps <- as.vector(as.matrix(steps))
  }
  if (is.matrix(steps)) {
    steps <- as.vector(steps)
  }
  
  # If any step values are less than 0, output error
  if (sum(steps < 0) > 0) {
    stop("For steps input, please ensure that all values of object are non-negative")
  }
  
  # If length of steps and counts.tri vectors are different, output error
  if (!is.null(steps) & length(steps) != nrow(counts.tri)) {
    stop("For counts.tri and steps inputs, please enter objects of same length")
  }
  
  # If nci.methods is not a logical, output error
  if (!is.logical(nci.methods)) {
    stop("For nci.methods input, please enter TRUE or FALSE")
  }
  
  # If start.date is not a date, output error
  if (class(start.date) != "Date") {
    stop("For start.date input, please enter a valid date variable")
  }
  
  # If start.time is not a character, output error
  if (!is.character(start.time)) {
    stop("For start.time input, please enter the start time for the first day of monitoring. 
         For example,'08:30:00' for 8:30 a.m.")
  }
  
  # If more than one id, output error
  if (!is.null(id) & length(unique(id)) > 1) {
    stop("For id input, please enter either a single ID number or a vector with repeated value of a single ID number")
  }
  
  # If brevity out of range, output error
  if (sum(brevity == c(1, 2, 3)) == 0) {
    stop("For brevity input, please enter 1, 2, or 3 (see documentation)")
  }
  
  # If valid.days, valid.week.days, or valid.weekend.days out of range, output error
  if (valid.days < 1 | valid.days > 7 | valid.week.days > 5 | valid.weekend.days > 2) {
    stop("For valid.days input, please enter value between 1 and 7; for valid.week.days 
         and valid.weekend.days inputs, please enter values no greater than 5 and 2, 
         respectively")
  }
  
  # If int.axis is out of range, output error
  if (!int.axis %in% c("vert", "ap", "ml", "sum", "mag")) {
    stop("For int.axis input, please enter 'vert', 'ap', 'ml', 'sum', or 'mag'")
  }
  
  # If length of int.cuts is not 4, or if values are out of range, output error
  if (length(int.cuts) != 4 | sum(int.cuts < 0) > 0) {
    stop("For int.cuts input, please enter a vector of 4 non-negative values")
  }
  
  # If cpm.nci is not a logical, output error
  if (!is.logical(cpm.nci)) {
    stop("For cpm.nci input, please enter TRUE or FALSE")
  }
  
  # If hourly.axis is out of range, output error
  if (!hourly.axis %in% c("vert", "ap", "ml", "sum", "mag")) {
    stop("For hourly.axis input, please enter 'vert', 'ap', 'ml', 'sum', or 'mag'")
  }
  
  # If days.distinct is not a logical, output error
  if (!is.logical(days.distinct)) {
    stop("For days.distinct input, please enter TRUE or FALSE")
  }
  
  # If nonwear.axis is out of range, output error
  if (!nonwear.axis %in% c("vert", "ap", "ml", "sum", "mag")) {
    stop("For nonwear.axis input, please enter 'vert', 'ap', 'ml', 'sum', or 'mag'")
  }
  
  # If If nonwear.window is out of range, output error
  if (nonwear.window < 1) {
    stop("For nonwear.window input, please enter positive value")
  }
  
  # If nonwear.tol out of range, output error
  if (nonwear.tol < 0 | nonwear.tol >= nonwear.window) {
    stop("For nonwear.tol input, please enter non-negative value less than nonwear.window")
  }
  
  # If nonwear.tol.upper out of range, output error
  if (nonwear.tol.upper < 0) {
    stop("For nonwear.tol.upper input, please enter non-negative value")
  }
  
  # If nonwear.nci is not a logical, output error
  if (!is.logical(nonwear.nci)) {
    stop("For nonwear.nci input, please enter TRUE or FALSE")
  }
  
  # If weartime.minimum out of range, output error
  if (weartime.minimum <= 0) {
    stop("For weartime.minimum input, please enter positive value")
  }
  
  # If weartime.maximum out of range, output error
  if (weartime.maximum <= weartime.minimum) {
    stop("For weartime.maximum input, please enter positive value greater than weartime.minimum")
  }
  
  # If partialday.minimum is not in range, output error
  if (!is.numeric(partialday.minimum) || partialday.minimum < 1 || partialday.minimum > 1440)  {
    stop("For partialday.minimum input, please enter positive whole number less than or equal to 1440")
  }
  
  # If active.bout.length out of range, output error
  if (active.bout.length <= 1) {
    stop("For active.bout.length input, please enter value greater than 1")
  }
  
  # If active.bout.tol out of range, output error
  if (active.bout.tol < 0 | active.bout.tol >= active.bout.length) {
    stop("For active.bout.tol input, please enter non-negative value less than active.bout.tol")
  }
  
  # If mvpa.bout.tol.lower out of range, output error
  if (mvpa.bout.tol.lower < 0 | mvpa.bout.tol.lower > int.cuts[3]) {
    stop("For mvpa.bout.tol.lower input, please enter non-negative value no greater than int.cuts[3]")
  }
  
  # If vig.bout.tol.lower out of range, output error
  if (vig.bout.tol.lower < 0 | vig.bout.tol.lower > int.cuts[4]) {
    stop("For vig.bout.tol.lower input, please enter non-negative value no greater than int.cuts[4]")
  }
  
  # If active.bout.nci is not a logical, output error
  if (!is.logical(active.bout.nci)) {
    stop("For active.bout.nci input, please enter TRUE or FALSE")
  }
  
  # If sed.bout.tol out of range, output error
  if (sed.bout.tol < 0 | sed.bout.tol >= 10) {
    stop("For sed.bout.tol input, please enter non-negative value less than 10")
  }
  
  # If sed.bout.tol.maximum out of range, output error
  if (sed.bout.tol.maximum < 0) {
    stop("For sed.tol.maximum input, please enter non-negative value")
  }
  
  # If artifact.thresh out of range, output error
  if (artifact.thresh <= int.cuts[4]) {
    stop("For artifact.thresh input, please ensure that value is greater than int.cuts[4]")
  }
  
  # If artifact.action out of range, output error
  if (sum(artifact.action == c(1, 2, 3, 4)) == 0) {
    stop("For artifact.action input, please enter 1, 2, 3, or 4 (see documentation)")
  }
  
  # If weekday.weekend is not a logical, output error
  if (!is.logical(weekday.weekend)) {
    stop("For weekday.weekend input, please enter TRUE or FALSE")
  }
  
  # If return.form is out of range, output error
  if (!return.form %in% c(1, 2, 3)) {
    stop("For return.form input, please enter 1 for per-person, 2 for per-day, or 3 for both")
  }
  
  # If nci.methods is TRUE, set inputs to replicate data processing done by NCI's SAS programs
  if (nci.methods == TRUE) {
    
    # Set certain inputs to match NCI methods
    valid.days <- 4
    valid.week.days <- 0
    valid.weekend.days <- 0
    int.axis <- "vert"
    int.cuts <- c(100, 760, 2020, 5999)
    cpm.nci <- TRUE
    hourly.axis <- "vert"
    days.distinct <- TRUE
    nonwear.axis <- "vert"
    nonwear.window <- 60
    nonwear.tol <- 2
    nonwear.tol.upper <- 100
    nonwear.nci <- TRUE
    weartime.minimum <- 600
    weartime.maximum <- 1440
    partialday.minimum <- 1440
    active.bout.length <- 10
    active.bout.tol <- 2
    mvpa.bout.tol.lower <- 0
    vig.bout.tol.lower <- 0
    active.bout.nci <- TRUE
    sed.bout.tol <- 0
    sed.bout.tol.maximum <- 759
    artifact.axis <- "vert"
    artifact.thresh <- 32767
    artifact.action <- 3
    
  }
  
  # Get number of minutes of data
  datalength <- nrow(counts.tri)
  
  # Get start/stop minutes for each day of monitoring
  extratime <- max(1, round(as.numeric(difftime(as.POSIXct(paste(start.date, "24:00:00")), as.POSIXct(paste(start.date, start.time)), units = "mins"))))
  startmins <- 1
  stopmins <- min(extratime, datalength)
  if (stopmins < datalength) {
    startmins <- c(startmins, seq(stopmins+1, datalength, 1440))
    stopmins <- c(stopmins, startmins[2:length(startmins)]+1439)
    stopmins[length(stopmins)] <- datalength
  }
  
  # If id value or vector is provided, get first value
  if (is.null(id)) {
    id <- 1
  } else {
    id <- id[1]
  }
  
  # Calculate number of full days of data
  numdays <- length(startmins)
  
  # Initializing matrix to save daily physical activity variables
  dayvars <- matrix(NA, ncol = 124, nrow = numdays)
  
  # Calculate triaxial sum and vector magnitude and add to counts.tri
  counts.tri <- cbind(counts.tri, .rowSums(counts.tri, m = datalength, n = 3),
                      sqrt(counts.tri[,1]^2+counts.tri[,2]^2+counts.tri[,3]^2))
  
  # Add column names to counts matrix
  colnames(counts.tri) <- c("vert", "ap", "ml", "sum", "mag")
  
  # Put vertical axis counts in its own vector for efficiency
  counts.vert <- counts.tri[,1]
  
  # Determine which column of counts.tri should be used for artifacts
  if (artifact.axis == "vert" ) {
    artifactvec <- counts.vert
  } else {
    artifactvec <- counts.tri[,artifact.axis]
  }
  
  # Find locations of artifacts
  if (max(artifactvec) >= artifact.thresh) {
    artifact.locs <- which(artifactvec >= artifact.thresh)
  } else {
    artifact.locs <- NULL
  }
  
  # If artifact.action = 3, replace minutes with counts > artifact.thresh with average of surrounding minutes
  if (artifact.action == 3 & !is.null(artifact.locs)) {
    counts.tri[artifact.locs,1:5] <- artifact.thresh
    counts.tri[,1] <- accel.artifacts(counts = counts.tri[,1], thresh = artifact.thresh)
    counts.tri[,2] <- accel.artifacts(counts = counts.tri[,2], thresh = artifact.thresh)
    counts.tri[,3] <- accel.artifacts(counts = counts.tri[,3], thresh = artifact.thresh)
    counts.tri[,4] <- accel.artifacts(counts = counts.tri[,4], thresh = artifact.thresh)
    counts.tri[,5] <- accel.artifacts(counts = counts.tri[,5], thresh = artifact.thresh)
  }
  
  # Determine which column of counts.tri should be used for non-wear detection
  if (nonwear.axis == "vert" ) {
    nonwearvec <- counts.vert
  } else {
    nonwearvec <- counts.tri[,nonwear.axis]
  }
  
  # Apply non-wear algorithm
  wearflag <- accel.weartime(counts = nonwearvec,
                             window = nonwear.window,
                             tol = nonwear.tol,
                             tol.upper = nonwear.tol.upper,
                             nci = nonwear.nci,
                             days.distinct = days.distinct)
  
  # If artifact.action = 2, consider minutes with counts >= artifact.thresh as non-weartime
  if (artifact.action == 2 & !is.null(artifact.locs)) {
    wearflag[artifact.locs] <- 0
    counts.tri[artifact.locs,] <- 0
  }
  
  # Determine which column of counts.tri should be used for intensities and activity bouts
  if (int.axis == "vert" ) {
    intvec <- counts.vert
  } else {
    intvec <- counts.tri[,int.axis]
  }
  
  # Identify bouts of MVPA, VPA, and sedentary time
  if (brevity == 2 | brevity == 3) {
    boutedMVPA <- accel.bouts(counts = intvec,
                              weartime = wearflag,
                              bout.length = active.bout.length,
                              thresh.lower = int.cuts[3],
                              tol = active.bout.tol,
                              tol.lower = mvpa.bout.tol.lower,
                              nci = active.bout.nci,
                              days.distinct = days.distinct,
                              skipchecks = TRUE)
    boutedvig <- accel.bouts(counts = intvec,
                             weartime = wearflag,
                             bout.length = active.bout.length,
                             thresh.lower = int.cuts[4],
                             tol = active.bout.tol,
                             tol.lower = vig.bout.tol.lower,
                             nci = active.bout.nci,
                             days.distinct = days.distinct,
                             skipchecks = TRUE)
    boutedsed10 <- accel.bouts(counts = intvec,
                               weartime = wearflag,
                               bout.length = 10,
                               thresh.upper = int.cuts[1]-1,
                               tol = sed.bout.tol,
                               tol.upper = sed.bout.tol.maximum,
                               days.distinct = days.distinct,
                               skipchecks = TRUE)
    boutedsed30 <- accel.bouts(counts = intvec,
                               weartime = wearflag,
                               bout.length = 30,
                               thresh.upper = int.cuts[1]-1,
                               tol = sed.bout.tol,
                               tol.upper = sed.bout.tol.maximum,
                               days.distinct = days.distinct,
                               skipchecks = TRUE)
    boutedsed60 <- accel.bouts(counts = intvec,
                               weartime = wearflag,
                               bout.length = 60,
                               thresh.upper = int.cuts[1]-1,
                               tol = sed.bout.tol,
                               tol.upper = sed.bout.tol.maximum,
                               days.distinct = days.distinct,
                               skipchecks = TRUE)
  }
  
  # Get day of week
  currentday <- weekdays(start.date-1)
  if (currentday == "Sunday") {
    currentday <- 1
  } else if (currentday == "Monday") {
    currentday <- 2
  } else if (currentday == "Tuesday") {
    currentday <- 3
  } else if (currentday == "Wednesday") {
    currentday <- 4
  } else if (currentday == "Thursday") {
    currentday <- 5
  } else if (currentday == "Friday") {
    currentday <- 6
  } else if (currentday == "Saturday") {
    currentday <- 7
  }
  
  # Loop through accelerometer data for i days
  for (i in 1:numdays) { 
    
    # Update day of week
    currentday <- currentday + 1
    if (currentday == 8) {
      currentday <- 1
    }
    
    # Load accelerometer data from day i
    day.counts <- counts.tri[startmins[i]:stopmins[i],, drop = FALSE]
    day.wearflag <- wearflag[startmins[i]:stopmins[i]]
    if (brevity == 2 | brevity == 3) {
      day.intvec <- intvec[startmins[i]:stopmins[i]]
      day.boutedMVPA <- boutedMVPA[startmins[i]:stopmins[i]]
      day.boutedvig <- boutedvig[startmins[i]:stopmins[i]]
      day.boutedsed10 <- boutedsed10[startmins[i]:stopmins[i]]
      day.boutedsed30 <- boutedsed30[startmins[i]:stopmins[i]]
      day.boutedsed60 <- boutedsed60[startmins[i]:stopmins[i]]
    }
    if (!is.null(steps)) {
      day.steps <- steps[startmins[i]:stopmins[i]]
    }
    
    # Calculate constants that are used more than once
    daywear <- sum(day.wearflag)
    maxcounts <- apply(X = day.counts, MARGIN = 2, FUN = max)
    daylength <- nrow(day.counts)
    
    # ID number
    dayvars[i,1] <- id
    
    # Day of week
    dayvars[i,2] <- currentday
    
    # Check whether day is valid for analysis; if not, mark as invalid
    if (daywear < weartime.minimum | daywear > weartime.maximum | (artifact.action == 1 & maxcounts[artifact.axis] >= artifact.thresh) |
          daylength < partialday.minimum) {
      dayvars[i,3] <- 0
    } else {
      dayvars[i,3] <- 1
    }
    
    # Minutes of valid wear time
    dayvars[i,4] <- daywear
    
    # Store day.counts[day.wearflag == 1] into its own matrix
    day.counts.valid <- day.counts[day.wearflag == 1,, drop = FALSE]
    
    # Total counts during wear time in each axis
    dayvars[i,5:9] <- .colSums(day.counts.valid, m = daywear, n = 5)
    
    # Counts per minute
    dayvars[i,10:14] <- dayvars[i,5:9]/dayvars[i,4]
    
    # Steps
    if (!is.null(steps)) {
      dayvars[i,15] <- sum(day.steps[day.wearflag == 1])
    }
    
    if (brevity == 2 | brevity == 3) {
      
      # Store day.counts.valid[,int.axis] into its own matrix and each axis
      day.counts.valid.int <- day.counts.valid[,int.axis]
      
      # Store each axis of counts in its own vector
      day.counts.vert <- day.counts[,1]
      day.counts.ap <- day.counts[,2]
      day.counts.ml <- day.counts[,3]
      day.counts.sum <- day.counts[,4]
      day.counts.mag <- day.counts[,5]
      day.counts.int <- day.counts[,int.axis]
      
      # Flag valid minutes by intensity level
      intensity <- cut(x = day.counts.valid.int, breaks = c(0, int.cuts, Inf), right = FALSE, labels = 1:5)
      
      # Minutes in various intensity levels
      dayvars[i,16:20] <- table(intensity)
      dayvars[i,21] <- dayvars[i,17]+dayvars[i,18]
      dayvars[i,22] <- dayvars[i,19]+dayvars[i,20]
      dayvars[i,23] <- daywear-dayvars[i,16]
      
      # Proportions of daily wear time in each intensity level
      dayvars[i,24:31] <- dayvars[i,16:23]/daywear
      dayvars[i,32:36] <- apply(X = day.counts.valid[intensity == 1,, drop = FALSE], MARGIN = 2, FUN = sum)
      dayvars[i,37:41] <- apply(X = day.counts.valid[intensity == 2,, drop = FALSE], MARGIN = 2, FUN = sum)
      dayvars[i,42:46] <- apply(X = day.counts.valid[intensity == 3,, drop = FALSE], MARGIN = 2, FUN = sum)
      dayvars[i,47:51] <- apply(X = day.counts.valid[intensity == 4,, drop = FALSE], MARGIN = 2, FUN = sum)
      dayvars[i,52:56] <- apply(X = day.counts.valid[intensity == 5,, drop = FALSE], MARGIN = 2, FUN = sum)
      dayvars[i,57:61] <- apply(X = day.counts.valid[intensity %in% c(2, 3),, drop = FALSE], MARGIN = 2, FUN = sum)
      dayvars[i,62:66] <- apply(X = day.counts.valid[intensity %in% c(4, 5),, drop = FALSE], MARGIN = 2, FUN = sum)
      dayvars[i,67:71] <- apply(X = day.counts.valid[intensity %in% c(2, 3, 4, 5),, drop = FALSE], MARGIN = 2, FUN = sum)
      
      # Bouted sedentary time
      dayvars[i,72] <- sum(day.boutedsed10)
      dayvars[i,73] <- sum(day.boutedsed30)
      dayvars[i,74] <- sum(day.boutedsed60)
      
      # Sedentary breaks
      dayvars[i,75] <- accel.sedbreaks(counts = day.counts.int, weartime = day.wearflag, thresh = int.cuts[1], skipchecks = TRUE)
      
      # Maximum 1-min, 5-min, 10-min, and 30-min count averages
      dayvars[i,76:80] <- maxcounts
      dayvars[i,81] <- movingaves(x = day.counts.vert, window = 5, return.max = TRUE, skipchecks = TRUE)
      dayvars[i,82] <- movingaves(x = day.counts.ap, window = 5, return.max = TRUE, skipchecks = TRUE)
      dayvars[i,83] <- movingaves(x = day.counts.ml, window = 5, return.max = TRUE, skipchecks = TRUE)
      dayvars[i,84] <- movingaves(x = day.counts.sum, window = 5, return.max = TRUE, skipchecks = TRUE)
      dayvars[i,85] <- movingaves(x = day.counts.mag, window = 5, return.max = TRUE, skipchecks = TRUE)
      
      dayvars[i,86] <- movingaves(x = day.counts.vert, window = 10, return.max = TRUE, skipchecks = TRUE)
      dayvars[i,87] <- movingaves(x = day.counts.ap, window = 10, return.max = TRUE, skipchecks = TRUE)
      dayvars[i,88] <- movingaves(x = day.counts.ml, window = 10, return.max = TRUE, skipchecks = TRUE)
      dayvars[i,89] <- movingaves(x = day.counts.sum, window = 10, return.max = TRUE, skipchecks = TRUE)
      dayvars[i,90] <- movingaves(x = day.counts.mag, window = 10, return.max = TRUE, skipchecks = TRUE)
      
      dayvars[i,91] <- movingaves(x = day.counts.vert, window = 30, return.max = TRUE, skipchecks = TRUE)
      dayvars[i,92] <- movingaves(x = day.counts.ap, window = 30, return.max = TRUE, skipchecks = TRUE)
      dayvars[i,93] <- movingaves(x = day.counts.ml, window = 30, return.max = TRUE, skipchecks = TRUE)
      dayvars[i,94] <- movingaves(x = day.counts.sum, window = 30, return.max = TRUE, skipchecks = TRUE)
      dayvars[i,95] <- movingaves(x = day.counts.mag, window = 30, return.max = TRUE, skipchecks = TRUE)
      
      # MVPA and vigorous physical activity in >= 10-min bouts
      dayvars[i,98] <- sum(day.boutedMVPA)
      dayvars[i,99] <- sum(day.boutedvig)
      dayvars[i,100] <- sum(dayvars[i,98:99])
      if (dayvars[i,98] > 0) {
        dayvars[i,96] <- sum(rle2(day.boutedMVPA)[,1] == 1)
      } else {
        dayvars[i,96] <- 0
      }
      if (dayvars[i,99] > 0) {
        dayvars[i,97] <- sum(rle2(day.boutedvig)[,1] == 1)
      } else {
        dayvars[i,97] <- 0
      }
      
      if (brevity == 3) {
        
        # Hourly counts/min averages
        if (daylength == 1440) {
          if (hourly.axis == "vert") {
            dayvars[i,101:124] <- blockaves(x = day.counts.vert, window = 60, skipchecks = TRUE)
          } else {
            dayvars[i,101:124] <- blockaves(x = day.counts[, hourly.axis], window = 60, skipchecks = TRUE)
          }
        }
        
      }
    }
    
  }
  
  # Format matrix of daily physical activity variables
  colnames(dayvars) <- c("id", "day", "valid_day", "valid_min", "counts_vert", "counts_ap", "counts_ml", 
                         "counts_sum", "counts_mag", "cpm_vert", "cpm_ap", "cpm_ml", "cpm_sum", "cpm_mag", 
                         "steps", "sed_min", "light_min", "life_min", "mod_min", "vig_min", "lightlife_min", 
                         "mvpa_min", "active_min", "sed_percent", "light_percent", "life_percent", 
                         "mod_percent", "vig_percent", "lightlife_percent", "mvpa_percent", "active_percent", 
                         "sed_counts_vert", "sed_counts_ap", "sed_counts_ml", "sed_counts_sum", 
                         "sed_counts_mag", "light_counts_vert", "light_counts_ap", "light_counts_ml", 
                         "light_counts_sum", "light_counts_mag", "life_counts_vert", "life_counts_ap", 
                         "life_counts_ml", "life_counts_sum", "life_counts_mag", "mod_counts_vert", 
                         "mod_counts_ap", "mod_counts_ml", "mod_counts_sum", "mod_counts_mag", 
                         "vig_counts_vert", "vig_counts_ap", "vig_counts_ml", "vig_counts_sum", 
                         "vig_counts_mag", "lightlife_counts_vert", "lightlife_counts_ap", "lightlife_counts_ml", 
                         "lightlife_counts_sum", "lightlife_counts_mag", "mvpa_counts_vert", 
                         "mvpa_counts_ap", "mvpa_counts_ml", "mvpa_counts_sum", "mvpa_counts_mag", 
                         "active_counts_vert", "active_counts_ap", "active_counts_ml", "active_counts_sum", 
                         "active_counts_mag", "sed_bouted_10min", "sed_bouted_30min", "sed_bouted_60min", 
                         "sed_breaks", "max_1min_vert", "max_1min_ap", "max_1min_ml", "max_1min_sum", 
                         "max_1min_mag", "max_5min_vert", "max_5min_ap", "max_5min_ml", "max_5min_sum", 
                         "max_5min_mag", "max_10min_vert", "max_10min_ap", "max_10min_ml", "max_10min_sum", 
                         "max_10min_mag", "max_30min_vert", "max_30min_ap", "max_30min_ml", 
                         "max_30min_sum", "max_30min_mag", "num_mvpa_bouts", "num_vig_bouts", "mvpa_bouted", 
                         "vig_bouted", "guideline_min", "cpm_hour1", "cpm_hour2", "cpm_hour3", "cpm_hour4", 
                         "cpm_hour5", "cpm_hour6", "cpm_hour7", "cpm_hour8", "cpm_hour9", "cpm_hour10", "cpm_hour11", 
                         "cpm_hour12", "cpm_hour13", "cpm_hour14", "cpm_hour15", "cpm_hour16", "cpm_hour17", "cpm_hour18", 
                         "cpm_hour19", "cpm_hour20", "cpm_hour21", "cpm_hour22", "cpm_hour23", "cpm_hour24")
  
  # Drop variables according to brevity setting
  if (brevity == 1) {
    dayvars <- dayvars[,1:15, drop = FALSE]
  } else if (brevity == 2) {
    dayvars <- dayvars[,1:100, drop = FALSE]
  }
  
  # Drop steps if NULL
  if (is.null(steps)) {
    dayvars <- dayvars[,-15, drop = FALSE]
  }
  
  # Calculate daily averages
  locs.valid <- which(dayvars[,3] == 1)
  locs.valid.wk <- which(dayvars[,3] == 1 & dayvars[,2] %in% 2:6)
  locs.valid.we <- which(dayvars[,3] == 1 & dayvars[,2] %in% c(1, 7))
  
  # If weekday.weekend is FALSE, just calculate overall averages
  if (weekday.weekend == FALSE) {
    averages <- c(id = id, valid_days = length(locs.valid), include = 0, colMeans(x = dayvars[locs.valid,4:ncol(dayvars), drop = FALSE]))
    if (length(locs.valid) >= valid.days & length(locs.valid.wk) >= valid.week.days & length(locs.valid.we) >= valid.weekend.days) {
      averages[3] <- 1
    }
  } else {
    
    # Otherwise calculate averages by all valid days and by valid weekdays and valid weekend days
    averages <- c(id = id, valid_days = length(locs.valid), valid_week_days = length(locs.valid.wk),
                  valid_weekend_days = length(locs.valid.we), include = 0,
                  colMeans(x = dayvars[locs.valid,4:ncol(dayvars), drop = FALSE]),
                  colMeans(x = dayvars[locs.valid.wk,4:ncol(dayvars), drop = FALSE]),
                  colMeans(x = dayvars[locs.valid.we,4:ncol(dayvars), drop = FALSE]))
    if (length(locs.valid) >= valid.days & length(locs.valid.wk) >= valid.week.days & length(locs.valid.we) >= valid.weekend.days) {
      averages[5] <- 1
    }
    
    # Modify variable names for weekdays and weekends
    numvars <- (length(averages)-5)/3
    names(averages)[(6+numvars):(6+2*numvars-1)] <- paste("wk_", names(averages)[(6+numvars):(6+2*numvars-1)], sep = "")
    names(averages)[(6+2*numvars):(6+3*numvars-1)] <- paste("we_", names(averages)[(6+2*numvars):(6+3*numvars-1)], sep = "")
    
  }
  
  # If cpm.nci is TRUE, re-calculate averages for cpm variables
  if (cpm.nci == TRUE) {
    averages["cpm_vert"] <- averages["counts_vert"]/averages["valid_min"]
    averages["cpm_ap"] <- averages["counts_ap"]/averages["valid_min"]
    averages["cpm_ml"] <- averages["counts_ap"]/averages["valid_min"]
    averages["cpm_sum"] <- averages["counts_ap"]/averages["valid_min"]
    averages["cpm_mag"] <- averages["counts_ap"]/averages["valid_min"]
  }
  
  # Convert averages to matrix for the hell of it
  averages <- matrix(averages, nrow = 1, dimnames = list(NULL, names(averages)))
  
  # Return data frame(s)
  if (return.form == 1) {
    return(averages)
  } else if (return.form == 2) {
    return (dayvars)
  } else if (return.form == 3) {
    retlist <- list(averages = averages, dayvars = dayvars)
    return(retlist)
  }
  
}