R/read_rds.R

In antaldaniel/retroharmonize: Ex Post Survey Data Harmonization

#' @title Read rds file
#' 
#' @description Import a survey from an rds file.
#'
#' @param file A path to a file to import.
#' @param id An identifier of the tibble, if omitted, defaults to the
#' file name without its extension.
#' @param doi An optional document object identifier.
#' @importFrom tibble rowid_to_column as_tibble
#' @importFrom fs path_ext_remove path_file is_file
#' @importFrom labelled var_label
#' @importFrom purrr safely
#' @importFrom utils object.size
#' @return A tibble, data frame variant with survey attributes.
#' @family import functions
#' @examples
#' path <-  system.file("examples", "ZA7576.rds", package = "retroharmonize")
#' read_survey <- read_rds(path)
#' attr(read_survey, "id")
#' attr(read_survey, "filename")
#' attr(read_survey, "doi") 
#' @export

read_rds <- function(file,
                     id = NULL, 
                     doi = NULL) {
  
  source_file_info <- valid_file_info(file)
  filename <- fs::path_file(file)
  
  if ( is.null(id) ) {
    id <- fs::path_ext_remove ( filename )
  }
  
  safely_readRDS <- purrr::safely (readRDS)
  
  tmp <- safely_readRDS (file = file)  
  
  if ( ! is.null(tmp$error) ) {
    warning ( tmp$error, "\nReturning an empty survey." )
    return(
      survey ( data.frame(), id="Could not read file", filename=filename, doi=doi)
    )
  } else {
    tmp  <- tmp$result
  }
  
  source_file_info <- valid_file_info(file)
  
  if ( ! "rowid" %in% names(tmp) ) {
    tmp <- tibble::rowid_to_column(tmp)
  }
  
  if ( is.null(doi)) {
    if ( "doi" %in% names(tmp) ) {
      doi <- tmp$doi[1]
    } else {
      doi <- ""
    }
  }
  
  tmp$rowid <- paste0(id, "_", gsub(id, "", tmp$rowid))
  labelled::var_label ( 
    tmp$rowid ) <- paste0("Unique identifier in ", id)
  
  return_survey <- survey (tmp, id=id, filename=filename, doi=doi)
  
  object_size <- as.numeric(object.size(as_tibble(tmp)))
  attr(return_survey, "object_size") <- object_size
  attr(return_survey, "source_file_size") <- source_file_info$size
  
  return_survey
}