R/assertions.R

In antaldaniel/retroharmonize: Ex Post Survey Data Harmonization

#' @keywords  internal
validate_survey_list <- function(survey_list) { 
  
  assert_that(!is.null(survey_list), 
              msg = "The parameter 'survey_list' is NULL.")

  assert_that("list" %in%  class (survey_list) | is.survey(survey_list), 
              msg = "The parameter 'survey_list' is not a list or a single survey.")
  
  if ( "list" %in%  class (survey_list) ) {
    are_these_surveys <- vapply ( survey_list, is.survey, logical(1))
    not_surveys <- paste( which (are_these_surveys == FALSE), collapse = ", ")
    assert_that(all(are_these_surveys), 
                msg = glue::glue("{not_surveys} in 'survey_list' are not surveys.") )
    
    n_survey <- length(survey_list)
    
    filenames <- vapply ( survey_list, function(x) attr(x, "filename"), character(1))
    ids <-  vapply ( survey_list, function(x) attr(x, "id"), character(1))
    
    duplicate_ids <- ids[duplicated (ids )]
    missing_ids <- vapply ( survey_list, function(x) is.null(attr(x, "id")), logical(1))
    missing_filenames <- vapply ( survey_list, function(x) is.null(attr(x, "filename")), logical(1))
    
    assert_that(! all(missing_ids), 
                msg = paste0(paste(which(missing_ids), " have no IDs"))
    )
    
    assert_that(! all(missing_filenames), 
                msg = paste0(paste(which(missing_ids), " have no filenames"))
    )
    
    ids  <- tryCatch({
      vapply ( survey_list, function(x) attr(x, "id"), character(1))
    }, 
    error = function(cond) {
      message ( "Some IDs are not character(1L) single characters.") 
    },
    finally = {}
    )
    
    filenames  <- tryCatch({
      vapply ( survey_list, function(x) attr(x, "filename"), character(1))
    }, 
    error = function(cond) {
      message ( "Some filenames are not character(1L) single characters.") 
    },
    finally = {}
    )
    
    duplicate_ids <- ids[duplicated (ids )]
    duplicate_filenames <- filenames[duplicated (filenames)]
    
    duplicate_msg <- paste0(
      paste(duplicate_ids, collapse = ", "), 
      " are not unique."
    )
 
    
    assert_that(length(duplicate_ids)==0, msg = duplicate_msg)
    
    assert_that(length(duplicate_filenames)==0, 
                msg = paste0(
                  paste(duplicate_filenames, collapse = ", "), 
                  " are not unique."
                ))
  }
}

#' @importFrom fs file_exists
#' @keywords internal
validate_survey_files <- function(survey_files) {
  
  existing_survey_files <- vapply ( survey_files, fs::file_exists, logical(1))
  not_existing_survey_files <- existing_survey_files [ existing_survey_files == FALSE  ]
  
  if (length(not_existing_survey_files)>0) {
    error_msg <- paste0("the following files were not found :", paste(names(not_existing_survey_files), collapse = ", "))
    stop ("Error in validate_survey_files() -  ", error_msg)
  }
  
  TRUE
}

#' @importFrom assertthat assert_that
#' @importFrom fs is_file
#' @keywords  internal
valid_file_info <- function(file) {
  assertthat::assert_that(
    fs::is_file(file),
    msg =  paste0("file='", file, "' is not a file. ")
  )
  
  file.info(file)
}

#' @title Validate harmonize_labels parameter
#' Check if "from", "to", and "numeric_values" are of equal lengths.
#' @importFrom dplyr select
#' @importFrom assertthat assert_that
#' @keywords  internal
validate_harmonize_labels <- function( harmonize_labels ) {
  
  if( inherits(harmonize_labels, "list") | inherits (harmonize_labels, "data.frame") ) {
    
    assertthat::assert_that(
      all(c("from", "numeric_values", "to") %in% names (harmonize_labels)), 
      msg = "The harmonize_values must contain <from>, <to> and <numeric_values> vectors."
    )
    
    assertthat::assert_that(
      inherits( harmonize_labels$numeric_values, "numeric"), 
      msg = "The harmonize_values must a numeric <numeric_values> vector."
    )
   
    assertthat::assert_that(is.numeric(harmonize_labels$numeric_values) |
                              is.null(harmonize_labels$numeric_values), 
                            msg = "The harmonize_values must have a numeric <numeric_values> with non-NULL or non-NA values.")
    
    assertthat::assert_that(
      inherits( harmonize_labels$from, "character"), 
      msg = "The harmonize_values must a character <from> vector."
    )
    
    assertthat::assert_that(
      inherits( harmonize_labels$to, "character"), 
      msg = "The harmonize_values must a character <to> vector."
    )
    
    list_length <- as.numeric(vapply ( c("from", "numeric_values", "to"), function(x) length(harmonize_labels[[x]]), numeric(1)))
    
    assertthat::assert_that(
      all(vapply ( list_length, function(x) list_length[[1]] == x, logical(1))), 
      msg = "<harmonize_label> must have <from>, <to>, <numeric_values> of equal lengths.")
      
    
  } else {
    stop("<harmonize label> must have <from>, <to>, <numeric_values> of equal lengths as list or data.frame.")
  }
}