[aggexp.git] / pkg / R / b_LinearAlgorithm.R

#' @include b_Algorithm.R

#' @title Linear Algorithm
#'
#' @description Generic class to represent a linear algorithm. 
#' TODO: not needed in production environment; weights growing infinitely. 
#' Inherits \code{\link{Algorithm}}
#'
#' @field weights The matrix of weights (in rows) associated to each expert (in columns)
#'
LinearAlgorithm = setRefClass(
	Class = "LinearAlgorithm",

	fields = c(
		weights = "matrix"
	),

	contains = "Algorithm",

	methods = list(
		initialize = function(...)
		{
			callSuper(...)
			weights <<- matrix(nrow=0, ncol=ncol(data)-3)
		},

		appendWeight = function(weight)
		{
			"Append the last computed weights to the weights matrix, for further plotting"

			n = nrow(data)
			nx = n - nrow(subset(data, subset = (Date == data[n,"Date"])))
			x = data[(nx+1):n, !names(data) %in% c("Date","Measure","Station")]
			iy = getNoNAindices(x, 2)

			completedWeight = rep(NA, ncol(x))
			completedWeight[iy] = weight
			weights <<- rbind(weights, completedWeight)
		},

		plotWeights = function(station=1, start=1, ...)
		{
			"Plot the weights of each expert over time"

			if (is.character(station))
				station = match(station, stations)

			#keep only full weights (1 to K)
			weights_ = weights[getNoNAindices(weights),]
			weights_ = weights_[start:nrow(weights_),]

			yRange = range(weights_, na.rm=TRUE)
			K = ncol(weights_)
			cols = rainbow(K)
			par(mar=c(5,4.5,1,1), cex=1.5)
			for (i in 1:K)
			{
				plot(weights_[,i], type="l", xaxt="n", ylim=yRange, col=cols[i], xlab="", ylab="",cex.axis=1.5, ...)
				par(new=TRUE)
			}
			axis(side=1, at=seq(from=1,to=nrow(weights_),by=30), labels=seq(from=0,to=nrow(weights_),by=30) + start, cex.axis=1.5)
			title(xlab="Time",ylab="Weight", cex.lab=1.6)
		}
	)
)
Commit	Line	Data
b76a24cd BA	1	#' @include b_Algorithm.R
	2
	3	#' @title Linear Algorithm
	4	#'
	5	#' @description Generic class to represent a linear algorithm.
	6	#' TODO: not needed in production environment; weights growing infinitely.
	7	#' Inherits \code{\link{Algorithm}}
	8	#'
	9	#' @field weights The matrix of weights (in rows) associated to each expert (in columns)
	10	#'
	11	LinearAlgorithm = setRefClass(
	12	Class = "LinearAlgorithm",
	13
	14	fields = c(
	15	weights = "matrix"
	16	),
	17
	18	contains = "Algorithm",
	19
	20	methods = list(
	21	initialize = function(...)
	22	{
	23	callSuper(...)
	24	weights <<- matrix(nrow=0, ncol=ncol(data)-3)
	25	},
	26
	27	appendWeight = function(weight)
	28	{
	29	"Append the last computed weights to the weights matrix, for further plotting"
	30
	31	n = nrow(data)
	32	nx = n - nrow(subset(data, subset = (Date == data[n,"Date"])))
	33	x = data[(nx+1):n, !names(data) %in% c("Date","Measure","Station")]
	34	iy = getNoNAindices(x, 2)
	35
	36	completedWeight = rep(NA, ncol(x))
	37	completedWeight[iy] = weight
	38	weights <<- rbind(weights, completedWeight)
	39	},
	40
	41	plotWeights = function(station=1, start=1, ...)
	42	{
	43	"Plot the weights of each expert over time"
	44
	45	if (is.character(station))
	46	station = match(station, stations)
	47
	48	#keep only full weights (1 to K)
	49	weights_ = weights[getNoNAindices(weights),]
	50	weights_ = weights_[start:nrow(weights_),]
	51
	52	yRange = range(weights_, na.rm=TRUE)
	53	K = ncol(weights_)
	54	cols = rainbow(K)
	55	par(mar=c(5,4.5,1,1), cex=1.5)
	56	for (i in 1:K)
	57	{
	58	plot(weights_[,i], type="l", xaxt="n", ylim=yRange, col=cols[i], xlab="", ylab="",cex.axis=1.5, ...)
	59	par(new=TRUE)
	60	}
	61	axis(side=1, at=seq(from=1,to=nrow(weights_),by=30), labels=seq(from=0,to=nrow(weights_),by=30) + start, cex.axis=1.5)
	62	title(xlab="Time",ylab="Weight", cex.lab=1.6)
	63	}
	64	)
65	)