R/utils.R

In modeltests: Testing Infrastructure for Broom Model Generics

#' Check that all elements of a list are equal
#'
#' From StackOverflow: https://tinyurl.com/list-elems-equal-r
#'
#' @param x A list.
#'
#' @return Either `TRUE` or `FALSE`.
#' @noRd
all_equal_list <- function(x) {
  sum(duplicated.default(x)) == length(x) - 1L
}

#' Determine acceptable names for augment output
#'
#' @description Given a data frame (or tibble), and a model object, makes a
#'   character vector of acceptable columns names for augment output. This
#'   includes:
#'
#'   - Any column names of the passed dataset
#'   - Any syntactically correct column names generated by calling
#'     [stats::model.frame()] on the object in question.
#'
#' @param object A model object.
#' @param passed_data The dataset used to create the model object.
#'
#' @return A vector of colnames that are acceptable in augment output.
#' @export
#'
acceptable_augment_colnames <- function(object, passed_data) {
  UseMethod("acceptable_augment_colnames")
}

acceptable_augment_colnames.default <- function(object, passed_data) {
  safe_mf <- purrr::possibly(stats::model.frame, NULL)
  mf <- safe_mf(object)
  mf_cols <- if (is.data.frame(mf)) colnames(mf) else character(0)
  c(mf_cols, make.names(mf_cols), colnames(passed_data))
}

acceptable_augment_colnames.poLCA <- function(object, passed_data) {
  c(colnames(object$x), colnames(object$y))
}

#' Check whether or not a data-frame-like object has rownames
#'
#' @param df A data frame
#'
#' @return Logical indicating if `df` has rownames. If `df` is a tibble,
#'   returns `FALSE`. If `df` is a data.frame, return `FALSE` if the rownames
#'   are simply row numbers. If the rownames are anything other than the
#'   return row numbers, returns `TRUE`.
#' @export
has_rownames <- function(df) {
  if (tibble::is_tibble(df))
    return(FALSE)
  any(rownames(df) != as.character(1:nrow(df)))
}

all.equal.tbl_df <- function(target, current, ...) {
  df_target <- as.data.frame(target)
  df_current <- as.data.frame(current)
  isTRUE(all.equal(df_target, df_current))
}