R/activationsMatrix.R

In edl: Toolbox for Error-Driven Learning Simulations with Two-Layer Networks

#' Calculate the activations for one or a set of cues.
#' 
#' @description Calculate the activations for one or a set of cues. 
#' The values are returned as vector or data frame.
#' @export
#' @param wm A weightmatrix, generated by 
#' \code{\link{RWlearning}} or \code{\link{updateWeights}}. 
#' @param cues String or vector of strings. Each string represents a set of 
#' cues, separated by \code{split}, for which the activations will be 
#' calculated. Note: the activations will be calculated for all provided cues 
#' together, assuming these occurred in one learning event.
#' @param split String, separator between cues.
#' @param select.outcomes Optional selection of outcomes to limit the 
#' number of activations that are returned. The value of NULL (default) will 
#' return all activations (for each outcome in \code{wm}). 
#' Note that specified values that are not in 
#' the weightmatrix will return the initial value without error or 
#' warning. Please use \code{\link{getValues}} for returning all 
#' outcomes in the data.
#' @param init.value Value of activations for non-existing connections. 
#' Typically set to 0.
#' @param normalize Logical: whether or not the activation is normalized by 
#' dividing the total activation by the number of cues. Default is FALSE. If 
#' set to TRUE, the activation reflects the average activation per cue.
#' @return Vector or data frame.
#' @author Jacolien van Rij
#' @seealso \code{\link{getWeightsByCue}},
#' \code{\link{getWeightsByOutcome}}
#' @family functions for calculating activations
#' @examples
#' # load example data:
#' data(dat)
#' 
#' # setup data:
#' newdat <- data.frame(Cues =paste("BG", dat$Shape, dat$Color, sep="_"),
#'    Outcomes  = dat$Category,
#'    Frequency = dat$Frequency2)
#' train  <- createTrainingData(newdat)
#' # learning:
#' wm     <- RWlearning(train)
#' 
#' # calculate activations for all outcomes:
#' mat    <- getWM(wm)
#' activationsMatrix(mat, cues="BG_tree_green")
#' # only accepts one set of cues - in this case all cues 
#' # are combined:
#' activationsMatrix(mat, cues=c("BG_tree", "BG_tree_brown"))
#' # ... which is the same as this:
#' activationsMatrix(mat, cues=c("BG", "BG", "tree", "tree", "brown"))
#' # now select one outcome:
#' activationsMatrix(mat, cues=c("BG", "tree"), select.outcomes="vehicle")
#' # cues/outcomes not in matrix:
#' activationsMatrix(mat, cues=c("na"), select.outcomes="new")
#' 

activationsMatrix <- function(wm, cues, 
	split="_", select.outcomes=NULL, 
	init.value=0, normalize=FALSE){
  	
  	# check wm:
  	if(! is.matrix(wm)){
  		stop("wm should be a matrix.")
  	}

  	# check outcomes:
  	cur.outcomes <- select.outcomes
  	if(is.null(select.outcomes)){
  		cur.outcomes <- sort( colnames(wm) )
  	}else{
  		cur.outcomes <- unlist(strsplit(select.outcomes, split=split))
  	}
  	
	# check cues:
	cur.cues <- unlist(strsplit(cues, split=split))
	vals <- rep(init.value, length(cur.outcomes))
	names(vals) <- cur.outcomes

	for(i in cur.outcomes){
		if(i %in% colnames(wm)){
			vals[i] <- sum(wm[cur.cues[cur.cues %in% row.names(wm)],i])+length(cur.cues[!cur.cues %in% row.names(wm)])*init.value
			if(normalize){
				vals[i] <- vals[i]/length(cur.cues)
			}
		}	
	}
	return( as.data.frame(t(vals)) )
}