R/RWlearning.R

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

#' Function implementing the Rescorla-Wagner learning.
#' 
#' @export
#' @import utils
#' @param data A data frame with columns \code{Cues} and \code{Outcomes}.
#' @param wm A weightmatrix of class matrix, or a list with weight matrices. 
#' If not provided a new 
#' weightmatrix is returned. Note that the cues and outcomes do not 
#' necessarily need to be available as cues and outcomes in the weightmatrix: 
#' if not present, they will be added.
#' @param eta Learning parameter, typically set to 0.01. 
#' If \code{eta} is not specified and set to the value NULL, 
#' the values of \code{alpha}, \code{beta1}, and \code{beta2} 
#' determine the learning rate. However, changing these settings 
#' is generally not very useful (see Hoppe et al, submitted). 
#' @param lambda Constant constraining the connection strength.
#' @param progress Logical: whether or not showing a progress bar 
#' (may slow down the process).
#' @param alpha Learning parameter (scaling both positive and negative 
#' evidence adjustments), typically set to 0.1. Only used if 
#' \code{eta=NULL}.
#' @param beta1 Learning parameter for positive evidence, typically set to 
#' 0.1. Only used if \code{eta=NULL}.
#' @param beta2 Learning parameter for negative evidence, typically set to 
#' 0.1. Only used if \code{eta=NULL}.
#' @param ... Parameters for the function \code{\link{getValues}}.
#' @return A list with weightmatrices for each learning event.
#' @seealso \code{\link[ndl]{RescorlaWagner}}, \code{\link{updateWeights}}
#' @author Jacolien van Rij
#' @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)
#' 
#' # in R markdown or knitr reports the progress bar should be turned off:
#' wm <- RWlearning(train, progress=FALSE)
#' 
#' # Learning in steps is also possible:
#' wm <- RWlearning(train[1:20,])
#' getWM(wm)
#' length(wm)
#' 
#' train[21,c("Cues", "Outcomes")]
#' wm <- RWlearning(train[21,], wm=wm)
#' getWM(wm)
#' length(wm)
#' 

RWlearning <- function(data, wm=NULL, 
	eta = 0.01, lambda = 1, 
	alpha = 0.1, beta1 = 0.1, beta2 = 0.1,
	progress=TRUE, ...){
	
	if(!all(c("Cues", "Outcomes") %in% names(data))){
		stop("Specify a column Cues and a column Outcomes in data.")
	}

	out <- list()
	lout <- 0

	if(!is.null(wm)){
		if(is.list(wm)){
			out <- wm
			lout <- length(wm)
			wm <- wm[[length(wm)]]
		}
		if(!is.matrix(wm)){
			stop(sprintf("Argument wm cannot be class %s: wm should specify weight matrix or list of weight matrices.", class(wm)[1]))
		}
	}
	
	if(progress & (nrow(data) > 2)){
			pb <- txtProgressBar(style=3, min=1, max=nrow(data))
			step <- min( c( max( c(1, round(.01*nrow(data)) )), nrow(data)) )

			for(i in 1:nrow(data)){
				if((i %% step == 0) | i==1 | i == nrow(data)){
					setTxtProgressBar(pb, i)
				}
				wm <- updateWeights(cur.cues=getValues(data[i,]$Cues, ...), 
					cur.outcomes=getValues(data[i,]$Outcomes, ...), 
					wm=wm, eta=eta, lambda = lambda, 
					alpha = alpha, beta1 = beta1, beta2 = beta2)
				out[[length(out)+1]] = wm
			}
			close(pb)
	}else{
		for(i in 1:nrow(data)){
			wm <- updateWeights(cur.cues=getValues(data[i,]$Cues, ...), 
				cur.outcomes=getValues(data[i,]$Outcomes, ...), 
				wm=wm, eta=eta, lambda = lambda, 
				alpha = alpha, beta1 = beta1, beta2 = beta2)
			out[[length(out)+1]] = wm
		}
	}

	return(out)
}