R/FemFit_removeNAs.r

In TheGreatGospel/FemFit: Functions to Analyse FemFit Datasets

#' Remove NAs from an FemFit dataset
#'
#' @description
#' Processes an FemFit dataset to remove unlabelled observations.
#'
#' @param x An "FemFit" object.
#' @param whichSession A character vector of session identifiers. Defaults to processing all sessions.
#'
#' @details
#' Removes observations that were not labelled with any protocol information found in the "session" JavaScript Object Notation file.
#'
#' @seealso
#' \code{\link{read_FemFit}}
#'
#' @return
#' Returns the processed "FemFit" object.
#'
#' @examples
#' session283 = read_FemFit("Datasets_AukRepeat/61aa0782289af385_283_csv.zip") %>%
#'     FemFit_removeNAs()
#'
#' # Alternatively without the piping operator:
#' session283 = FemFit_removeNAs(read_FemFit("Datasets_AukRepeat/61aa0782289af385_283_csv.zip"))
#'
#' @export
FemFit_removeNAs = function (x, whichSession = "") {
  # Throw an error if the x argument is not an FemFit object or missing
  if (!inherits(x, "FemFit") || is.na(x)) {
    stop("The x argument is not an FemFit object.", call. = FALSE)
  }

  # Throw an error if the whichSession argument is not a character or missing
  if (any(!is.character(whichSession) || is.na(whichSession))) {
    stop("The provided whichSession argument is not a character.", call. = FALSE)
  }

  sessionIDs = x$df$sessionID %>% unique

  # Throw an error if the whichSession argument does not map to the sessionIDs
  if (!all(whichSession %in% sessionIDs) && whichSession != "") {
    stop("The provided whichSession argument specifies sessionIDs which do not exist in x$df.", call. = FALSE)
  }

  # Which sessions to remove observations associated with NA JSONLabels from
  indices = match(whichSession, sessionIDs) %>% .[!is.na(.)]

  if (length(indices) == 0) {
    indices = 1:length(sessionIDs)
  }

  toRemove = setNames(rep(FALSE, length.out = length(sessionIDs)), sessionIDs)
  toRemove[indices] = TRUE

  # Remove observations with NAs in JSONLabel
  x_Work = by(x$df, x$df$sessionID, function (x_Child) {
    if (toRemove[x_Child$sessionID[1]]) {
      x_Child = x_Child %>%
        dplyr::filter(!is.na(JSONLabel)) %>%
        dplyr::mutate(time = trunc(row_number()*10 - 10))
    }

    return (x_Child)
  })

  # Setup the object to return to the end-user
  if (length(x_Work) == 1) {
    x$df = x_Work[[1]]
  } else {
    x$df = x_Work %>% Reduce(function(df1, df2) dplyr::bind_rows(df1, df2), .)
  }

  return (x)
}