R/import_measures_df.R

Defines functions import_measures_df

Documented in import_measures_df

#' import_measures_df
#'
#' Import measures from a data frame.
#'
#' @return A boolean (`TRUE` if no errors)
#'
#' @param input A data frame.
#' @param stat_unit A string containing the stat_unit label.
#' @param date A string containing the date label.
#' @param tag A string containing the tag label.
#' @param value A string containing the value label.
#' @param optional_data A vector containing label to import in descriptions
#' table (not required).
#' @param status A string containing the status label.
#' @param date_format_func A function to format date with (not required).
#' Default: `lubridate::parse_date_time(x, date_format_reg)`
#' If you want to use milliseconds [look at this](https://bit.ly/33JGr6s).
#' @param date_format_reg A expression to format date with (not required).
#' Default: `"ymd-HMS"`
#' For more details see [this documentation](https://bit.ly/3bp3FD0).
#' @param force_date_format Boolean to force date format func (not required).
#' Default: `FALSE`
#' @param model An AnalysR env.
#' Default: `analysr_env`
#'
#' @export
import_measures_df <-
  function(input,
            stat_unit = "stat_unit",
            date = "date",
            tag = "tag",
            value = "value",
            optional_data,
            status = "status",
            date_format_func =
                  (function(x) lubridate::parse_date_time(x, date_format_reg)),
            date_format_reg = "ymd-HMS",
            force_date_format = FALSE,
            model = analysr_env) {


    result <- tibble::tibble(input)
    n <- nrow(result)
    hash <- get_hash(n)

    if (!(status %in% colnames(result))) {
      result <- dplyr::bind_cols(
        result,
        status = rep(NA, n)
      )
    }

    if (!missing(optional_data)) {
      fill_descriptions(hash, optional_data, result, n, model)
    }

    result <- result[c(stat_unit, date, tag, value, status)]
    # we could use dplyr to extract colums https://bit.ly/32lGkNR
    colnames(result) <- c("stat_unit", "date", "tag", "value", "status")

    add_stat_units(result$stat_unit, model)

    if (!isDate(result$date) || force_date_format) {
      result$date <- date_format_func(result$date)
    }

    result <- dplyr::bind_cols(
      hash = hash,
      result
    )

    model$measures <- rbind(model$measures, result)

    TRUE
  }
analysr/analysr documentation built on Feb. 13, 2022, 11:22 a.m.