R/TableWare-methods.R

In tidylab/tableware: Data Curation of Tables in R

# convert_col_types ------------------------------------------------------------
#
#' @title Convert Table Columns to the Type Specified in the Table Profile
#'
#' @param table (`data.frame`) The table to curate.
#' @param table_profile (`data.frame`) The table profile. See
#'   \code{\link{TableProfiler}}.
#'
#' @return (`data.frame`) A table with the specified column types.
#'
#' @note The function uses UTC as time zone for date-time conversions.
#'
#' @export
#' @keywords internal
#'
#' @family TableWare methods
#'
#' @examples
#' \dontrun{
#'  mtcars_profile <- TableProfiler$new(mtcars)$profile
#' .convert_col_types(mtcars, mtcars_profile)
#' }
#'
.convert_col_types <- function(table, table_profile){
    ## Helper Functions
    as.numeric <- function(x) if("factor" %in% class(x)) base::as.numeric(as.character(x)) else base::as.numeric(x)
    as.date <- function(x) base::as.Date(x)
    as.dttm <- function(x) lubridate::as_datetime(x)
    as.time <- function(x) lubridate::as.period(x, unit = "day")

    ## Setup
    tz <- Sys.getenv("TZ")
    on.exit(Sys.setenv(TZ = tz))
    Sys.setenv(TZ = "UTC")

    ## Programming Logic
    col_types <- subset(table_profile, Attribute %in% "type", select = -Attribute)

    for(k in seq_len(nrow(col_types) * ncol(col_types))){
        col_name <- names(col_types)[k]
        col_type <- col_types[[k]]
        table[, col_name] <- get(paste0("as.", col_type))(table[, col_name])
    }

    return(table)
}