rename pkg --> aggexp
[aggexp.git] / aggexp / 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 )