--- /dev/null
+#' @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)
+ },
+
+ plotWeights_rn = function(station=1, start=1, ...)
+ {
+ "Weights plotting tailored for AirNormand reports"
+
+ if (is.character(station))
+ station = match(station, stations)
+
+ cols = c(
+ colors()[258], #CLM (vert)
+ colors()[258], #GAM
+ colors()[258], #CLM1
+ colors()[258], #CLM2
+ colors()[53], #S_AIRPARIF (orange)
+ colors()[53], #S_INERIS
+ colors()[28], #D_ESMERALDA (bleu)
+ colors()[28], #D_PREVAIR
+ colors()[28], #D_PREVAIR2
+ 1 #PERSIST (noir)
+ )
+ #l : ligne, b : cercles, o : cercles+ligne
+ plotTypes = rep("b", length(cols))
+ ltypes = c(1,3,1,3,1,3,1,3,1,1)
+ pchtypes = c(21,22,24,25,21,22,21,22,24,21)
+
+ #keep only full weights (1 to K)
+ weights_ = weights[getNoNAindices(weights),]
+ weights_ = weights_[start:nrow(weights_),]
+
+ #TODO: HACK for plotting for presentation...
+ #should be: yRange = range(weights_, na.rm = TRUE)
+ yRange = quantile(weights_, probs=c(0.02, 0.98))
+
+ par(mar=c(5,4.5,1,1), cex=1.5)
+ for (j in 1:ncol(weights_))
+ {
+ plot(weights_[,j],xaxt="n",ylim=yRange,type=plotTypes[j],col=cols[j],bg=cols[j],lty=ltypes[j],pch=pchtypes[j],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)
+ },
+
+ plotWeightsByFamily_rn = function(station=1, type="Absolute", start=1, legend=TRUE, ...)
+ {
+ "Weights plotting for AirNormand reports, by family of experts. type == 'Relative' or 'Absolute'"
+
+ if (is.character(station))
+ station = match(station, stations)
+
+ #keep only full weights (1 to K)
+ weights_ = weights[getNoNAindices(weights),]
+ weights_ = weights_[start:nrow(weights_),]
+
+ summary = matrix(nrow=nrow(weights_), ncol=4)
+ if (type == "Relative")
+ {
+ summary[,1] = weights_[,1] + weights_[,2] + weights_[,3] + weights_[,4]
+ summary[,2] = weights_[,5] + weights_[,6]
+ summary[,3] = weights_[,7] + weights_[,8] + weights_[,9]
+ summary[,4] = weights_[,10]
+ }
+ else
+ {
+ summary[,1] = abs(weights_[,1]) + abs(weights_[,2]) + abs(weights_[,3]) + abs(weights_[,4])
+ summary[,2] = abs(weights_[,5]) + abs(weights_[,6])
+ summary[,3] = abs(weights_[,7]) + abs(weights_[,8]) + abs(weights_[,9])
+ summary[,4] = abs(weights_[,10])
+ }
+
+ cols = c(
+ colors()[258], #GAM,CLM,1,2 (vert)
+ colors()[53], #S_AIRPARIF,S_INERIS (orange)
+ colors()[28], #D_ESMERALDA,D_PREVAIR,D_PREVAIR2 (bleu)
+ 1 #PERSIST
+ )
+ #l : ligne, b : cercles, o : cercles+ligne
+ plotTypes = c("l", "l", "l", "l")
+
+ yRange = range(summary)
+ par(mar=c(5,4.5,3,1), cex=1.5)
+ for (j in 1:4)
+ {
+ plot(summary[,j],xaxt="n",ylim=yRange,type=plotTypes[j],col=cols[j], xlab="", ylab="", cex.axis=1.5, lwd=2, ...)
+ 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=paste(type, "sum of weights"), cex.lab=1.6, main=paste(type, "sum of weights by family"))
+ if (legend)
+ {
+ legend("topright", #title="Somme des poids par famille",
+ col=c(colors()[258], colors()[53], colors()[28], 1), lwd=2, cex=1.1,
+ lty=rep("solid",4),legend=c("Stat. Air Normand","Stat. others","Deterministic", "Persistence"))
+ }
+ }
+ )
+)
projects / aggexp.git / blobdiff