R/act24_get_missing_info.R

Defines functions get_missing_info

Documented in get_missing_info

#' Identify areas where ACT24 primary activity has not been determined
#'
#' @param info output from \code{\link{get_activity_info}} or similar
#' @inheritParams act24_wrapper
#' @keywords internal
get_missing_info <- function(info, verbose) {

  if (verbose) cat("\n...getting missing info")

  current <-
    info$complete %>%
    info$matches[.] %T>%
    {stopifnot(all(sapply(., length) %in% 0:1))} %>%
    unlist(.) %>%
    table(.) %>%
    data.frame(.) %>%
    stats::setNames(c("index", "Freq")) %>%
    within({
      index = as.integer(as.character(index))
      Activity = info$original$Activity[index]
    })

  targets <-
    info$original$Duration_Primary %>%
    data.frame(
      index = seq_along(.),
      target_freq = .,
      Activity = info$original$Activity,
      stringsAsFactors = FALSE
    )

  remaining <-
    merge(targets, current, all = TRUE) %T>%
    {stopifnot(
      nrow(.) == nrow(targets),
      !anyNA(.$target_freq)
    )} %>%
    within({
      index = index
      Freq = ifelse(is.na(Freq), 0, Freq)
      remaining = target_freq - Freq
    }) %>%
    {.[.$remaining > 0, ]}

  if (nrow(remaining) > 0) {

    row.names(remaining) <- seq(nrow(remaining))

  } else {

    if (verbose) message("\nAll data successfully labeled!")

  }

  list(
    current = current,
    targets = targets,
    remaining = remaining
  )

}
PAHPLabResearch/FLASH documentation built on May 15, 2020, 7:08 p.m.