R/utils.R

Defines functions add_id get_private join_frames

Documented in add_id get_private join_frames

#' Adds column .id eqal to column row.
#'
#' Works with input dataframes or arrays. If it is an array, then the column's
#' name is chosen to be the column name if it exists, the passed arguments' name
#' otherwise.
#'
#' @param df `data.frame`
#' @param name `character(1)`
#'
#' @return a dataframe with column .id
add_id <- function(df, name = NULL){
  # Deal with arrays
  if (!is.data.frame(df)) {
    if (is.null(name) && !is.null(names(df)) && length(names(df)) == 1) {
      name <- names(df)
    } else if (is.null(name)) {
      name <- deparse(substitute(df))
    }
    df <- data.frame(V1 = df, row.names = row.names(df))
    names(df) <- name
  }
  return(
    dplyr::bind_cols(
      .id = 1:nrow(df),
      df
    )
  )
}

#' Get private members of R6 object
#'
#' Undocumented -- may break
#' For debugging purposes only
#'
#' @param x R6Object
#'
#' @return `R6Object`
#' @export
#'
get_private <- function(x) {
  x[[".__enclos_env__"]]$private
}


#' Join frames by ids
#'
#' @param ... `list(data.frame())` \cr List of data.frames to join.
#' @param id_names `character()` \cr Character vector of id column names to
#'   join by
#'
#' @return A data.frame with all frames joined
#' @export
join_frames <- function(..., id_names){

  frames <- list(...)
  assertthat::assert_that(length(frames) >= 1)
  assertthat::assert_that(all(
      purrr::map_lgl(frames, ~ all(id_names %in% names(.)))
      ))
  if (anyDuplicated(
      purrr::map_chr(frames, ~ setdiff(names(.), id_names))
      ) != 0) {
    warning("Column names are duplicated, and will be changed")
  }


  eval_frame <- frames[[1]][id_names]
  for (frame in frames){
    eval_frame <- dplyr::left_join(
      x = eval_frame,
      y = frame,
      by = id_names
    )
  }

  return(eval_frame)
}
signaux-faibles/MLsegmentr documentation built on Aug. 29, 2019, 2:22 p.m.