pkg/R/b_LinearAlgorithm.R

   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         plotWeights_rn = function(station=1, start=1, ...)
  66         {
  67             "Weights plotting tailored for AirNormand reports"
  68
  69             if (is.character(station))
  70                 station = match(station, stations)
  71
  72             cols = c(
  73                 colors()[258], #CLM (vert)
  74                 colors()[258], #GAM
  75                 colors()[258], #CLM1
  76                 colors()[258], #CLM2
  77                 colors()[53], #S_AIRPARIF (orange)
  78                 colors()[53], #S_INERIS
  79                 colors()[28], #D_ESMERALDA (bleu)
  80                 colors()[28], #D_PREVAIR
  81                 colors()[28], #D_PREVAIR2
  82                 1 #PERSIST (noir)
  83             )
  84             #l : ligne, b : cercles, o : cercles+ligne
  85             plotTypes = rep("b", length(cols))
  86             ltypes = c(1,3,1,3,1,3,1,3,1,1)
  87             pchtypes = c(21,22,24,25,21,22,21,22,24,21)
  88
  89             #keep only full weights (1 to K)
  90             weights_ = weights[getNoNAindices(weights),]
  91             weights_ = weights_[start:nrow(weights_),]
  92
  93             #TODO: HACK for plotting for presentation...
  94             #should be: yRange = range(weights_, na.rm = TRUE)
  95             yRange = quantile(weights_, probs=c(0.02, 0.98))
  96
  97             par(mar=c(5,4.5,1,1), cex=1.5)
  98             for (j in 1:ncol(weights_))
  99             {
 100                 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, ...)
 101                 par(new=TRUE)
 102             }
 103             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)
 104             title(xlab="Time",ylab="Weight", cex.lab=1.6)
 105         },
 106
 107         plotWeightsByFamily_rn = function(station=1, type="Absolute", start=1, legend=TRUE, ...)
 108         {
 109             "Weights plotting for AirNormand reports, by family of experts. type == 'Relative' or 'Absolute'"
 110
 111             if (is.character(station))
 112                 station = match(station, stations)
 113
 114             #keep only full weights (1 to K)
 115             weights_ = weights[getNoNAindices(weights),]
 116             weights_ = weights_[start:nrow(weights_),]
 117
 118             summary = matrix(nrow=nrow(weights_), ncol=4)
 119             if (type == "Relative")
 120             {
 121                 summary[,1] = weights_[,1] + weights_[,2] + weights_[,3] + weights_[,4]
 122                 summary[,2] = weights_[,5] + weights_[,6]
 123                 summary[,3] = weights_[,7] + weights_[,8] + weights_[,9]
 124                 summary[,4] = weights_[,10]
 125             }
 126             else
 127             {
 128                 summary[,1] = abs(weights_[,1]) + abs(weights_[,2]) + abs(weights_[,3]) + abs(weights_[,4])
 129                 summary[,2] = abs(weights_[,5]) + abs(weights_[,6])
 130                 summary[,3] = abs(weights_[,7]) + abs(weights_[,8]) + abs(weights_[,9])
 131                 summary[,4] = abs(weights_[,10])
 132             }
 133
 134             cols = c(
 135                 colors()[258], #GAM,CLM,1,2 (vert)
 136                 colors()[53], #S_AIRPARIF,S_INERIS (orange)
 137                 colors()[28], #D_ESMERALDA,D_PREVAIR,D_PREVAIR2 (bleu)
 138                 1 #PERSIST
 139             )
 140             #l : ligne, b : cercles, o : cercles+ligne
 141             plotTypes = c("l", "l", "l", "l")
 142
 143             yRange = range(summary)
 144             par(mar=c(5,4.5,3,1), cex=1.5)
 145             for (j in 1:4)
 146             {
 147                 plot(summary[,j],xaxt="n",ylim=yRange,type=plotTypes[j],col=cols[j], xlab="", ylab="", cex.axis=1.5, lwd=2, ...)
 148                 par(new=TRUE)
 149             }
 150             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)
 151             title(xlab="Time",ylab=paste(type, "sum of weights"), cex.lab=1.6, main=paste(type, "sum of weights by family"))
 152             if (legend)
 153             {
 154                 legend("topright",  #title="Somme des poids par famille",
 155                     col=c(colors()[258], colors()[53], colors()[28], 1), lwd=2, cex=1.1,
 156                     lty=rep("solid",4),legend=c("Stat. Air Normand","Stat. others","Deterministic", "Persistence"))
 157             }
 158         }
 159     )
 160 )