R/getWM.R

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

#' Retrieve all cues from a vector of text strings.
#' 
#' @export
#' @param wmlist A list with weightmatrices for each learning event, 
#' generated by \code{\link{RWlearning}}.
#' @param event Numeric: for which event to return the weight matrix. 
#' Defaults to NULL, which wil return the last weight matrix.
#' @return A matrix with connection weights between cues (rows) and outcomes.
#' @author Jacolien van Rij
#' @seealso \code{\link{RWlearning}}, \code{\link{getWeightsByCue}}, 
#' \code{\link{getWeightsByOutcome}}
#' @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)
#' dim(dat)
#' 
#' # now use createTrainingData to sample from the specified frequencies: 
#' train <- createTrainingData(dat)
#' 
#' # this training data can actually be used train network:
#' wm <- RWlearning(train)
#' 
#' # final weight matrix:
#' getWM(wm)
#' # ... which is the same as:
#' wm[[length(wm)]]
#' # 25th learning event:
#' getWM(wm, event=25)
#' # ... which is the same as:
#' wm[[25]]
#' 


getWM <- function(wmlist, event=NULL){
	if(!is.list(wmlist)){
		stop("Argument wmlist should specify a list with weight matrices.")
	}

	cues <- getCues(wmlist)
	outcomes <- getOutcomes(wmlist)

	if(!is.null(event)){
		if(event[1] > length(wmlist)){
			warning(
				sprintf("wmlist contains only %d learning events. The value of event (%d) is ignored, and the last weight matrix is returned.",
				length(wmlist), event))
			return(wmlist[[length(wmlist)]])
		}else{
			out <- wmlist[[event[1]]]
			add.cues <- cues[!cues %in% rownames(out)]
			add.out  <- outcomes[!outcomes %in% colnames(out)]
			if(length(add.cues)>0){
				r.out <- c(rownames(out), add.cues)
				out <- rbind(out, matrix(rep(0, ncol(out)*length(add.cues)), ncol=ncol(out)))
				rownames(out) <- r.out
			}
			if(length(add.out)>0){
				c.out <- c(colnames(out), add.out)
				out <- cbind(out, matrix(rep(0, nrow(out)*length(add.out)), nrow=nrow(out)))
				colnames(out) <- c.out
			}
			return(out)
		}
	}else{
		return(wmlist[[length(wmlist)]])
	}
}