R/updateWeights.R

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

#' Function implementing the Rescorla-Wagner learning for a single learning 
#' event.
#' 
#' @description Function implementing the Rescorla-Wagner learning for a 
#' single learning event. A set of cues and outcomes are provided, and a 
#' weightmatrix that needs to be updated.
#' @export
#' @param cur.cues A vector with cues.
#' @param cur.outcomes A vector with outcomes.
#' @param wm A weightmatrix of class matrix. 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 alpha Learning parameter (scaling both positive and negative 
#' evidence adjustments), typically set to 0.1. 
#' @param beta1 Learning parameter for positive evidence, typically set to 
#' 0.1. 
#' @param beta2 Learning parameter for negative evidence, typically set to 
#' 0.1. 
#' @return A weightmatrix (matrix)
#' @seealso \code{\link[ndl]{RescorlaWagner}}, \code{\link{RWlearning}}
#' @author Jacolien van Rij, based on \code{\link[ndl]{RescorlaWagner}}
#' @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)
#' # retrieve trained network:
#' new <- getWM(wm)
#' 
#' train2 <- createTrainingData(dat)
#' updateWeights(getValues(train2$Cues[1]), 
#'     getValues(train2$Outcomes[1]), wm=new)
#' 
#' # comparison between eta and alpha, beta1, beta2:
#' check.cues <- c("BG", "car", "red")
#' new[check.cues,]
#' tmp1 <- updateWeights(check.cues, 
#'     c("vehicle", "animal"), wm=new)
#' tmp2 <- updateWeights(check.cues, 
#'     c("vehicle", "animal"), wm=new, eta=NULL)
#' tmp3 <- updateWeights(check.cues, 
#'     c("vehicle", "animal"), wm=new, beta1=0.2)
#' tmp4 <- updateWeights(check.cues, 
#'     c("vehicle", "animal"), wm=new, eta=NULL, beta1=0.2)
#' # these two should be the same:
#' tmp1[check.cues,]
#' tmp2[check.cues,]
#' # now we change beta2, but this does not change anything,
#' # because eta is being used:
#' tmp3[check.cues,]
#' # when we turn eta off, beta2 changes the values:
#' tmp4[check.cues,]
#' 

updateWeights <- function(cur.cues, cur.outcomes, 
	wm=NULL, eta=0.01, lambda = 1, 
	alpha = 0.1, beta1 = 0.1, beta2 = 0.1){
	
	bg <- getOption("background")
	cur.cues <- c(bg, cur.cues)

	# if no wm is specified, create new wm:
	if(is.null(wm)){
		wm <- createWM(cues=cur.cues, outcomes=cur.outcomes)
	}else{
		wm <- checkWM(cues=cur.cues, outcomes=cur.outcomes, wm=wm)
	}

	Vtotal = 0
	if(length(cur.cues) <= 1){
		Vtotal = wm[cur.cues,]
	}else{
		if(ncol(wm) > 1){
			Vtotal = colSums(wm[cur.cues,], na.rm = TRUE)
		}else{
			Vtotal = sum(wm[cur.cues,], na.rm = TRUE)
		}
	}

	Lambda = rep(0, ncol(wm))
	Lambda[which(colnames(wm) %in% cur.outcomes)] <- lambda

	# determine learning rate:
	lr = rep(eta, length(Lambda))
	if(is.null(eta)){
		lr = alpha * (beta1*Lambda + beta2*(lambda-Lambda))
	}
	
	wm[cur.cues,] =  wm[cur.cues,] + matrix( rep(lr * (Lambda - Vtotal), length(cur.cues)), nrow=length(cur.cues), byrow=TRUE )
	return(wm)
}