R/check_names_and_classes.R

#' Check Names and Classes
#'
#' Checks that names and classes of data are correct simultaneously
#'
#' @param df_in data to check
#' @param names_and_classes_check list of name-class pairs to check with data
#' @author Andrew Pfeiffer <andrew.j.pfeiffer@@gmail.com>
#' @importFrom stringr str_c
#' @importFrom purrr map
#' @export
#' @note 19 June 2017

check_names_and_classes <- function(df_in, names_and_classes_check){
    # Throw an error if df_in isn't a tibble
    if (!identical(class(df_in), c("tbl_df", "tbl", "data.frame")))
        stop("Error: the input data needs to be a tibble")

    # Get classes
    names_and_classes_actual <- purrr::map(df_in, class)

    # Get list differences
    actual_not_check <- setdiff_list(names_and_classes_actual,
                                     names_and_classes_check)
    num_actual_not_check <- length(actual_not_check)

    check_not_actual <- setdiff_list(names_and_classes_check,
                                     names_and_classes_actual)
    num_check_not_actual <- length(check_not_actual)

    # If both lists have zero length, return data with success message
    if (num_actual_not_check + num_check_not_actual == 0) {
        # message("Success: names and classes checked")
        return(df_in)
    } else {
        # Otherwise, return error
        stop(stringr::str_c(
            "The names and/or classes aren't correct.",
            # Provide list of name-class pairs in the data, but not given
            # as part of the check
            dplyr::if_else(num_actual_not_check > 0, stringr::str_c(
                "\n\nName-class pairs in data, but not given:\n",
                print_and_capture(actual_not_check)
            ), ""),
            # Provide list of name-class pairs given as part of the check,
            # but not in the data
            dplyr::if_else(num_check_not_actual > 0, stringr::str_c(
                "\n\nName-class pairs given, but not in data:\n",
                print_and_capture(check_not_actual)
            ), "")
        ))
    }
}
andrewjpfeiffer/rutilities documentation built on May 11, 2019, 6:26 p.m.