R/Ternary.R

In f-santi/plot3logit: Ternary Plots for Trinomial Regression Models

#' Draw a change in the probability distribution on an existing plot
#'
#' Given the first two probabilities of a trinomial distribution
#' before and after a change, [effect()] adds an arrow to an existing
#' ternary plot. If the probability distribution does not change, a
#' point (instead of an arrow) is added to the plot.
#'
#' @param x,y `numeric` vectors of the first two probabilities. If
#'   the probability distribution is unchanged, `x` and `y` should
#'   have length one.
#' @param length length of the edges of the arrow head (in inches).
#' @param ... other graphical parameters such as `xpd` and the line
#'   characteristics `lend`, `ljoin` and `lmitre`. See
#'   [graphics::par()].
#'
#' @section Warning:
#' Only when [effect()] is passed to [Ternary::AddToTernary()]
#' as the first argument, arrows and points are drawn consistently
#' with ternary coordinate system, otherwise `effect` draws both
#' arrows and points according to a Cartesian coorinate system
#' centered on \eqn{(0,0.5,0.5)}.
#'
#' @keywords internal
effect <- function(x, y, ..., length = 0.05) {
  if (length(x) > 1) { arrows(x[1], y[1], x[2], y[2], ..., length = length) }
  else { points(x, y, ...) }
}



#' Draw a field on an existing ternary plot
#'
#' [TernaryField()] adds the vector field returned by [field3logit()] to an
#' existing ternary plot generated by [Ternary::TernaryPlot()]. 
#'
#' @inheritParams field3logit
#' @inheritParams add_confregions
#' @param field object of class `field3logit` as returned by
#'   [field3logit()].
#' @param conf if `FALSE` confidence regions are not drawn, even if available;
#'   if `TRUE` confidence regions are drawn only if available; if a `numeric`
#'   value is passed, confidence regions at the specified confidence level
#'   are computed (if not already available) and drawn.
#' @param conf.args graphical parameters of confidence regions to be passed
#'   to [`Ternary::TernaryPolygon()`][Ternary::AddToTernary].
#'
#' @returns An object of class `field3logit` with confidence regions included,
#' if computed within [TernaryField()].
#'
#' @seealso [field3logit()].
#'
#' @examples
#' library(nnet)
#' data(cross_1year)
#'
#' mod0 <- nnet::multinom(employment_sit ~ gender + finalgrade, data = cross_1year)
#' field0 <- field3logit(mod0, 'genderFemale')
#'
#' TernaryPlot()
#' TernaryField(field0)
#'
#' @export
TernaryField <- function(field, ..., length = 0.05, conf = FALSE, 
  npoints = 100, conf.args = list()) {
  	
  # Check the input
  if (!inherits(field, c('field3logit', 'multifield3logit'))) {
  	warning('A non-standard object "field" has been processed.')
  }
  
  # Handle the argument "conf"
  if ((conf == TRUE) & is.null(field$conf)) { conf <- FALSE }
  if (is.numeric(conf)) {
  	conflevel <- conf
  	conf <- (conf > 0) & (conf < 1)
  	if (conf & (field$conf != conflevel)) {
  	  field %<>% add_confregions(conflevel, npoints)
    }
  }
  
  # Simplify the field
  field %>%
    use_series('effects') %>%
    simplify_field3logit -> depo
    
  if (all(is.na(depo[[1]]$to))) {
  	depo %>%
  	  lapply(function(x) { x$from }) %>%
  	  purrr::reduce(rbind) %>%
  	  TernaryPoints(...)
  } else {
    depo %>%
      lapply(function(w) {
      	if (conf) {
      	  list(
        	    col = grDevices::rgb(0, 0, 1, 0.2),
      	    border = NA
      	  ) %>%
      	    modifyList(conf.args) %>%
      	    modifyList(list(coordinates = w$confregion)) %>%
      	    do.call('TernaryPolygon', .)
      	}
      	
      	w %>%
      	  `[`(c('from', 'to')) %>%
      	  AddToTernary(effect, ., ..., length = length)
      })
  }
  
  invisible(field)
}