R/margin_w.R

In mattansb/marginC: Create a multi-factor vector of weights

#' Create a multi-factor vector of weights
#'
#' Create a vector of weights for use in 'contrast()' by specifying marginal weights per factor.
#'
#' @author Mattan S. Ben-Shachar
#' @param ... vector(s) of marginal weights, the length of which must match the number of levels of the specified factor, and the name of which match the factor in .grid.
#' @param .grid optional grid object made with \code{\link[emmeans]{emmeans}}.
#'
#' @return a vector of weights, to be used in \code{\link[emmeans]{contrast}}.
#' @export
get_marginal_weights <- function(..., .grid = NULL) {
  factor_weights <- list(...)

  if(!is.null(.grid))
    factor_weights <- test_grid(factor_weights,grid = .grid)

  marginal_w <- build_mw(factor_weights)
  attr(marginal_w,'grid') <- .grid
  attr(marginal_w,'w') <- factor_weights
  class(marginal_w) <- c('mw','numeric')

  return(marginal_w)
}


#' Create a multi-factor vector of weights
#'
#' This is a short-named wrapper function for \code{\link[marginC]{get_marginal_weights}}.
#'
#' @author Mattan S. Ben-Shachar
#' @param ... args passed to get_marginal_weights
#'
#' @export
mw <- function(...) {
  get_marginal_weights(...)
}

#' Update the grid on a vector of marginal-weights
#'
#' Usful for applying the reference grid (for testing, etc) to a vector of marginal-weights (or a list of vectors) before passing to \code{\link[emmeans]{contrast}}
#'
#' @author Mattan S. Ben-Shachar
#' @param x a list of marginal-weights vectors
#' @param grid grid object made with \code{\link[emmeans]{emmeans}}.
#'
#' @export
#' @importFrom  magrittr %>%
#' @import purrr
update_grid <- function(x,grid){
  if(is.list(x)){
    new_mw <- map(x,~c(attr(.x,'w'),.grid = grid)) %>%
      map(~invoke(get_marginal_weights,.x))
  } else {
    new_mw <- c(attr(x,'w'),.grid = grid) %>%
      invoke(get_marginal_weights,.)
  }
  return(new_mw)
}