R/getOutcomes.R

Defines functions getOutcomes

Documented in getOutcomes

#' Extract outcomes from list of weightmatrices.
#' 
#' @export
#' @param wmlist A list with weightmatrices, generated by 
#' \code{\link{RWlearning}} or \code{\link{updateWeights}}.
#' @param extra.check Logical: whether or not to collect all cues from all 
#' weightmatrices in the list. Note that this slows down the process and 
#' should not result in different findings. Default is FALSE.
#' @return Vector with outcomes.
#' @author Jacolien van Rij
#' @seealso \code{\link{getCues}}, \code{\link{getValues}}
#' @examples
#' # load example data:
#' data(dat)
#' # prepare training data:
#' dat$Cues <- paste("BG", dat$Shape, dat$Color, sep="_")
#' dat$Outcomes <- dat$Category
#' dat$Frequency <- dat$Frequency1
#' train <- createTrainingData(dat)
#' # learning:
#' wm <- RWlearning(train)
#' # retrieve cues from wm list:
#' getOutcomes(wm)
#' # or this version (which takes more time):
#' system.time({getOutcomes(wm, extra.check=TRUE)})
#' system.time({getOutcomes(wm)})
#' 

getOutcomes <- function(wmlist, extra.check=FALSE){
	out <- colnames(wmlist[[length(wmlist)]])
	if(extra.check){
		allout <- sort(unique(unlist(lapply(wmlist, function(x){return(colnames(x))}))))
		c1 <- out[!out %in% allout]
		c2 <- allout[!allout %in% out]

		if(length(c1)>0){
			warning(sprintf("Not all outcomes in allout: %s\n", paste(c1, collapse=",")))
		}
		if(length(c2)>0){
			warning(sprintf("Not all allout in out: %s\n", paste(c2, collapse=",")))
		}
		return(sort(unique(c(out, allout))))
	}else{
		return(out)
	}
}

Try the edl package in your browser

Any scripts or data that you put into this service are public.

edl documentation built on Sept. 20, 2021, 9:09 a.m.