R/plotActivations.R

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

#' Visualize the change of connection weights between a specific outcome and all 
#' cues.
#' 
#' @description Visualize the activation or the change of activation per 
#' event.
#' @export
#' @import graphics
#' @import plotfunctions
#' @import grDevices
#' @param wmlist A list with weightmatrices, generated by 
#' \code{\link{RWlearning}} or \code{\link{updateWeights}}.
#' @param cueset String, which contains the combination of cues for which to 
#' calculate the activations for per 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. Note that specified values that are not in 
#' the weightmatrices 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 connection weights for non-existing connections. 
#' Typically set to 0.
#' @param add.labels Logical: whether or not to add labels for the lines. 
#' Defaults to TRUE, see examples.
#' @param add Logical: whether or not to add the lines to an existing plot. 
#' Defaults to FALSE (starting a new plot).
#' @param ... Optional graphical arguments, as specified in 
#' \code{\link[graphics]{par}}. These parameters are forwarded to the functions 
#' \code{\link[plotfunctions]{emptyPlot}}, \code{\link[graphics]{lines}}, and 
#' \code{\link[graphics]{text}}.
#' @return Optionally a list with label specifications is returned, which 
#' allows to plot your own labels. This may be helpful for very long labels, 
#' and for overlapping lines.
#' @seealso \code{\link{plotCueWeights}}, \code{\link{getWeightsByOutcome}}, 
#' \code{\link{getWeightsByCue}}
#' @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
#' # now use createTrainingData to sample from the specified frequencies: 
#' train <- createTrainingData(dat)
#' 
#' # this training data can be used train network:
#' wm <- RWlearning(train)
#' 
#' # plot connection weights for cue = 'cat':
#' plotActivations(wm, cueset="BG_cat_brown")
#' plotActivations(wm, cueset="BG_cat")
#' 
#' # plot your own labels:
#' labels <- plotActivations(wm, cues="BG_cat", add.labels=FALSE)
#' legend_margin('topright', legend=labels$labels, col=labels$col, 
#'     lwd=1, bty='n')
#' 
#' # change color and select outcomes:
#' out <- getValues(train$Outcomes, unique=TRUE)
#' out <- out[! out %in% "animal"]
#' labels <- plotActivations(wm, cues="BG_cat", 
#'     select.outcome=out, add.labels=FALSE, 
#' 	   ylim=c(-.25,1),col=alpha(1))
#' lab2 <- plotActivations(wm, cues="BG_cat", add.labels=FALSE, 
#'     select.outcomes="animal", add=TRUE, col=2, lwd=2, xpd=TRUE)
#' legend('topright', legend=c("animal", labels$labels), 
#'     col=c(lab2$col, labels$col), lwd=c(lab2$lwd, labels$lwd), 
#'     lty=c(lab2$lty, labels$lty), bty="n")
#' 

plotActivations <- function(wmlist, cueset, 
	split="_", select.outcomes = NULL, 
	init.value=0, add.labels=TRUE, add=FALSE,
	...){

	# check cueset:
	if(length(cueset) > 1){
		warning("Only the first specified cueset will be visualized.")
		cueset = cueset[1]
	}
	
	# get activations:
	dat <- getActivations(wmlist=wmlist, cueset=cueset, 
		split=split, select.outcomes=select.outcomes,
		init.value=init.value)
	dat <- dat[[1]]

	par <- list(...)

	xrange <- c(1, nrow(dat))
	yrange <- range(dat, na.rm=TRUE)
	col <- rainbow(ncol(dat))
	lty <- 1:ncol(dat)
	lwd <- rep(1, ncol(dat))

	if('xlim' %in% names(par)){
		xrange <- par[['xlim']]
		par[['xlim']] <- NULL
	}
	if('ylim' %in% names(par)){
		yrange <- par[['ylim']]
		par[['ylim']] <- NULL
	}
	if('col' %in% names(par)){
		col <- par[['col']]
		if(length(col)==1){
			col <- rep(col, ceiling(ncol(dat) / length(col)))[1:ncol(dat)]
		}
		par[['col']] <- NULL
	}
	if('lty' %in% names(par)){
		lty <- par[['lty']]
		if(length(lty)==1){
			lty <- rep(lty, ceiling(ncol(dat) / length(lty)))[1:ncol(dat)]
		}
		par[['lty']] <- NULL
	}
	if('lwd' %in% names(par)){
		lwd <- par[['lwd']]
		if(length(lwd)==1){
			lwd <- rep(lwd, ceiling(ncol(dat) / length(lwd)))[1:ncol(dat)]
		}
		par[['lwd']] <- NULL
	}


	if(!'main' %in% names(par)){
		par[['main']] <- sprintf("Cues: \"%s\"", cueset) 
	}
	if(!'xlab' %in% names(par)){
		par[['xlab']] <- "Input"
	}
	if(!'ylab' %in% names(par)){
		par[['ylab']] <- "Activation"
	}
	if(!'h0' %in% names(par)){
		par[['h0']] <- 0
	}


	line.par <- c("type", "pch", "bg", "cex", "lend", "ljoin", "lmitre") 
	label.par <- c("font", "adj", "pos", "offset", "vfont", "cex", "srt", 
		"family", "crt", "lheight") 

	plotspec <- list2str(x=names(par)[!names(par) %in% c(line.par, label.par)], par)
	if(plotspec != ""){
		plotspec <- paste(",", plotspec)
	}

	linespec <- list2str(line.par, par)
	if(linespec != ""){
		linespec <- paste(",", linespec)
	}

	labelspec <- list2str(label.par, par)
	if(labelspec != ""){
		labelspec <- paste(",", labelspec)
	}

	if(add==FALSE){
		eval(parse(text=sprintf("emptyPlot(xrange, yrange %s)", plotspec)))
	}

	for( i in 1:ncol(dat)){
		eval(parse(text=sprintf("lines(dat[,i], col=col[i], lty=lty[i], lwd=lwd[i] %s, xpd=NA)", linespec)))
	}

	if(add.labels){
		for( i in 1:ncol(dat)){
			eval(parse(text=sprintf("text(nrow(dat), dat[nrow(dat),i], labels=names(dat)[i], col=col[i] %s, xpd=NA)", labelspec)))
		}
	}
	invisible(list(labels=names(dat), 
		x=rep(nrow(dat),ncol(dat)), y=unlist(dat[nrow(dat),]),col=col, lty=lty, lwd=lwd))
}