R unpacking operator

unpack.r

#' Unpack a list
#' 
#' Assigns variables in the environment \code{pos} that are extracted from \code{values}
#' 
#' @param extraction  A \code{\link{list}(val1, name = val2)} expression where values represent variable names to assign to
#'                    and (optional) names represent list elements to extract from \code{values}. A missing name means that
#'                    both variable name and extracted list element name are identical.
#' @param values      A named list containing values to extract.
#' @param pos         An environment or stack reference referring to one (see \code{\link{assign}}).
#' @return TRUE if all list members were extracted, else FALSE
#' @examples
#' list(a, b = c) %<-% list(a = 1, b = 2)
#' stopifnot(a == 1 && c == 2 && !exists('b'))
#' list(x, y) %<-% list(3, 4) -> exhaustive
#' stopifnot(x == 3 && y == 4 && exhaustive)
`%<-%` <- function(extraction, values, pos = -1) {
	extraction <- substitute(extraction)
	envir <- as.environment(pos)
	
	stopifnot(is.call(extraction))
	stopifnot(identical(extraction[[1]], quote(list)))
	
	extraction <- as.list(extraction)[-1]
	# names to assign the extracted members to
	var_names <- as.character(extraction)
	# list elements to be extracted
	members <-
		if (is.null(names(values)) && is.null(names(extraction))) {
			seq_along(extraction)
		} else {  # extract from named list
			stopifnot(!is.null(names(values)))
			stopifnot(all(names(values) != ''))
			nms <- if (is.null(names(extraction))) rep('', length(extraction)) else names(extraction)
			ifelse(nms == '', var_names, nms)
		}
	
	mapply(function(var_name, member) assign(var_name, values[[member]], pos, envir), var_names, members)
	
	invisible(length(var_names) == length(values))
}