R/activationsEvents.R

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

#' Calculate the activations for each learning event.
#' 
#' @description Calculate the activations for each learning event. 
#' The values are returned as data frame or as a list of data frames.
#' @export
#' @param wmlist A list with weightmatrices, generated by 
#' \code{\link{RWlearning}} or \code{\link{updateWeights}}, 
#' or a single weightmatrix (matrix). 
#' @param data Data frame with columns \code{Cues} and \code{Outcomes}. 
#' Number of rows should be the same as the number of weightmatrices 
#' in \code{wmlist}.
#' @param split String, separator between cues and/or outcomes.
#' @param fun Function to apply to the activations for events with 
#' multiple outcomes. By default (\code{fun=NULL}) the activation values 
#' for each outcome are returned. If there are learning events with 
#' multiple outcomes, the argument \code{return.list} will be 
#' automatically set to TRUE.
#' @param return.list Logical: whether or not the activation values are 
#' returned as list or as vector. Defaults to the value FALSE, 
#' returning a vector of activation values. 
#' But this also depends on the argument \code{fun} 
#' (see more info above).
#' @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 list of activation values (see \code{return.list} 
#' and \code{fun} for the specific conditions, and the examples below).
#' @author Jacolien van Rij
#' @seealso \code{\link{getWeightsByCue}},
#' \code{\link{getWeightsByOutcome}}
#' @family functions for calculating activations
#' @examples
#' # load example data:
#' data(dat)
#' 
#' # add obligatory columns Cues, Outcomes, and Frequency:
#' dat$Cues <- paste("BG", dat$Shape, dat$Color, sep="_")
#' dat$Outcomes <- dat$Category
#' dat$Frequency <- dat$Frequency1
#' head(dat)
#' 
#' # now use createTrainingData to sample from the specified frequencies: 
#' train <- createTrainingData(dat)
#' head(train)
#' 
#' # this training data can actually be used train network:
#' wm <- RWlearning(train)
#' 
#' # Now we calculate the activations for each event:
#' train$Activation <- activationsEvents(wm, train)
#' 
#' # With multiple outcomes per event, it is better not 
#' # to directly assign to a new column, as a list will 
#' # return. See the example below:
#' dat$Outcomes <- paste(dat$Shape, dat$Color, sep="_")
#' dat$Cues <- paste("BG", dat$Category, sep="_")
#' dat$Frequency <- dat$Frequency1
#' head(dat)
#' train <- createTrainingData(dat)
#' wm <- RWlearning(train)
#' # This code will elicit a warning message:
#' \dontrun{
#'     act <- activationsEvents(wm, train)
#' }
#' # this code will not elicit a warning:
#' act <- activationsEvents(wm, train, return.list=TRUE)
#' head(act)
#' # to assign one single activation value to each event,
#' # we could instead apply a function, for example, by
#' # taking the max activation per event:
#' train$maxAct <- activationsEvents(wm, train, fun="max")
#' 


activationsEvents <- function(wmlist, data, 
	split="_", fun=NULL, return.list=FALSE,
	init.value=0, normalize=FALSE){

	# check wmlist:
	if(!is.list(wmlist)){
		if(is.matrix(wmlist)){
			wmlist <- list(wmlist)
		}else{
			stop("Argument wmlist should be list of weightmatrices or a single weightmatrix.")
		}
	}
	if(length(wmlist)!=nrow(data)){
		stop("Argument wmlist should have same length as the number of rows in data.")
	}
	# check data:
	if(!"Cues" %in% colnames(data)){
		stop("Cannot find column 'Cues' in data.")
	}
	if(!"Outcomes" %in% colnames(data)){
		stop("Cannot find column 'Outcomes' in data.")
	}

	# check outcomes:
	outcomes <- strsplit(data[,"Outcomes"], split=split)
	check <- max(unlist(lapply(outcomes, function(x){return(length(x))})))

	# check fun:
	if(is.null(fun) & (check > 1) & (return.list==FALSE)){
		warning("Function will return list of activations, because in some events multiple outcomes occurred.")
		return.list=TRUE
	}


	# calculate raw activations:
	out <- mapply(function(cur.wm, cur.cues, cur.outcomes){
		return(activationsMatrix(wm=cur.wm, cues=cur.cues, 
			select.outcomes=cur.outcomes,
			split=split, init.value=init.value, normalize=normalize))
	}, wmlist, as.list(data[,"Cues"]), outcomes,
	SIMPLIFY = FALSE)

  	# apply function:
  	if(!is.null(fun)){
  		if(is.character(fun)){
  			eval(parse(text=sprintf(
  				"out <- lapply(out, function(x){return(%s(unlist(x), na.rm=TRUE))})",
  				fun)))
  		}else{
  			out <- lapply(out, fun)
  		}
  	}

  	# return:
  	if(return.list){
  		return(out)
  	}else{
  		return(unlist(out))
  	}
}