Commit | Line | Data |
---|---|---|
98e958ca | 1 | #' Plot curves |
e030a6e3 | 2 | #' |
102bcfda | 3 | #' Plot a range of curves in data. |
e030a6e3 | 4 | #' |
102bcfda | 5 | #' @inheritParams computeError |
e030a6e3 BA |
6 | #' @param indices Range of indices (integers or dates) |
7 | #' | |
8 | #' @export | |
1e20780e | 9 | plotCurves <- function(data, indices=seq_len(data$getSize())) |
e030a6e3 | 10 | { |
98e958ca | 11 | series = data$getSeries(indices) |
a5a3a294 | 12 | yrange = quantile(series, probs=c(0.025,0.975), na.rm=TRUE) |
e030a6e3 BA |
13 | par(mar=c(4.7,5,1,1), cex.axis=1.5, cex.lab=1.5) |
14 | for (i in seq_along(indices)) | |
15 | { | |
98e958ca | 16 | plot(series[,i], type="l", ylim=yrange, |
4e25de2c | 17 | xlab=ifelse(i==1,"Time (hours)",""), ylab=ifelse(i==1,"PM10","")) |
1e20780e | 18 | if (i < length(indices)) |
e030a6e3 BA |
19 | par(new=TRUE) |
20 | } | |
21 | } | |
22 | ||
af3b84f4 | 23 | #' Plot error |
3d69ff21 | 24 | #' |
102bcfda | 25 | #' Draw error graphs, potentially from several runs of \code{computeForecast()}. |
3d69ff21 | 26 | #' |
102bcfda | 27 | #' @param err Error as returned by \code{computeError()} |
09cf9c19 | 28 | #' @param cols Colors for each error (default: 1,2,3,...) |
3d69ff21 | 29 | #' |
98e958ca | 30 | #' @seealso \code{\link{plotCurves}}, \code{\link{plotPredReal}}, |
72b9c501 BA |
31 | #' \code{\link{plotSimils}}, \code{\link{plotFbox}}, \code{\link{computeFilaments}}, |
32 | #' \code{\link{plotFilamentsBox}}, \code{\link{plotRelVar}} | |
3d69ff21 BA |
33 | #' |
34 | #' @export | |
09cf9c19 | 35 | plotError <- function(err, cols=seq_along(err)) |
3d69ff21 | 36 | { |
09cf9c19 BA |
37 | if (!is.null(err$abs)) |
38 | err = list(err) | |
4e95ec8f | 39 | par(mfrow=c(2,2), mar=c(4.7,5,1,1), cex.axis=1.5, cex.lab=1.5, lwd=2) |
3d69ff21 | 40 | L = length(err) |
98e958ca | 41 | yrange = range( sapply(1:L, function(i) ( err[[i]]$abs$day ) ), na.rm=TRUE ) |
3d69ff21 BA |
42 | for (i in seq_len(L)) |
43 | { | |
4e25de2c BA |
44 | plot(err[[i]]$abs$day, type="l", xlab=ifelse(i==1,"Time (hours)",""), |
45 | ylab=ifelse(i==1,"Mean |y - y_hat|",""), ylim=yrange, col=cols[i]) | |
3d69ff21 BA |
46 | if (i < L) |
47 | par(new=TRUE) | |
48 | } | |
98e958ca | 49 | yrange = range( sapply(1:L, function(i) ( err[[i]]$abs$indices ) ), na.rm=TRUE ) |
3d69ff21 BA |
50 | for (i in seq_len(L)) |
51 | { | |
4e25de2c BA |
52 | plot(err[[i]]$abs$indices, type="l", xlab=ifelse(i==1,"Time (days)",""), |
53 | ylab=ifelse(i==1,"Mean |y - y_hat|",""), ylim=yrange, col=cols[i]) | |
3d69ff21 BA |
54 | if (i < L) |
55 | par(new=TRUE) | |
56 | } | |
98e958ca | 57 | yrange = range( sapply(1:L, function(i) ( err[[i]]$MAPE$day ) ), na.rm=TRUE ) |
3d69ff21 BA |
58 | for (i in seq_len(L)) |
59 | { | |
4e25de2c BA |
60 | plot(err[[i]]$MAPE$day, type="l", xlab=ifelse(i==1,"Time (hours)",""), |
61 | ylab=ifelse(i==1,"Mean MAPE",""), ylim=yrange, col=cols[i]) | |
3d69ff21 BA |
62 | if (i < L) |
63 | par(new=TRUE) | |
64 | } | |
98e958ca | 65 | yrange = range( sapply(1:L, function(i) ( err[[i]]$MAPE$indices ) ), na.rm=TRUE ) |
3d69ff21 BA |
66 | for (i in seq_len(L)) |
67 | { | |
4e25de2c BA |
68 | plot(err[[i]]$MAPE$indices, type="l", xlab=ifelse(i==1,"Time (days)",""), |
69 | ylab=ifelse(i==1,"Mean MAPE",""), ylim=yrange, col=cols[i]) | |
3d69ff21 BA |
70 | if (i < L) |
71 | par(new=TRUE) | |
72 | } | |
73 | } | |
74 | ||
98e958ca BA |
75 | #' Plot measured / predicted |
76 | #' | |
102bcfda | 77 | #' Plot measured curve (in black) and predicted curve (in blue). |
98e958ca | 78 | #' |
102bcfda | 79 | #' @inheritParams computeError |
98e958ca BA |
80 | #' @param index Index in forecasts (integer or date) |
81 | #' | |
82 | #' @export | |
83 | plotPredReal <- function(data, pred, index) | |
84 | { | |
72b9c501 | 85 | horizon = length(pred$getForecast(1)) |
98e958ca | 86 | measure = data$getSerie( pred$getIndexInData(index)+1 )[1:horizon] |
72b9c501 | 87 | prediction = pred$getForecast(index) |
98e958ca BA |
88 | yrange = range(measure, prediction) |
89 | par(mar=c(4.7,5,1,1), cex.axis=1.5, cex.lab=1.5, lwd=3) | |
4e25de2c | 90 | plot(measure, type="l", ylim=yrange, xlab="Time (hours)", ylab="PM10") |
98e958ca BA |
91 | par(new=TRUE) |
92 | plot(prediction, type="l", col="#0000FF", ylim=yrange, xlab="", ylab="") | |
93 | } | |
94 | ||
95 | #' Plot similarities | |
96 | #' | |
102bcfda | 97 | #' Plot histogram of similarities (weights), for 'Neighbors' method. |
98e958ca | 98 | #' |
102bcfda | 99 | #' @inheritParams computeError |
98e958ca BA |
100 | #' @param index Index in forecasts (integer or date) |
101 | #' | |
102 | #' @export | |
103 | plotSimils <- function(pred, index) | |
104 | { | |
105 | weights = pred$getParams(index)$weights | |
106 | if (is.null(weights)) | |
107 | stop("plotSimils only works on 'Neighbors' forecasts") | |
108 | par(mar=c(4.7,5,1,1), cex.axis=1.5, cex.lab=1.5) | |
4e25de2c | 109 | hist(pred$getParams(index)$weights, nclass=20, main="", xlab="Weight", ylab="Count") |
98e958ca BA |
110 | } |
111 | ||
af3b84f4 | 112 | #' Functional boxplot |
3d69ff21 | 113 | #' |
102bcfda | 114 | #' Draw the functional boxplot on the left, and bivariate plot on the right. |
3d69ff21 | 115 | #' |
102bcfda BA |
116 | #' @inheritParams computeError |
117 | #' @inheritParams plotCurves | |
3d69ff21 BA |
118 | #' |
119 | #' @export | |
98e958ca | 120 | plotFbox <- function(data, indices=seq_len(data$getSize())) |
3d69ff21 BA |
121 | { |
122 | if (!requireNamespace("rainbow", quietly=TRUE)) | |
123 | stop("Functional boxplot requires the rainbow package") | |
124 | ||
98e958ca BA |
125 | series_matrix = data$getSeries(indices) |
126 | # Remove series with NAs | |
af3b84f4 BA |
127 | no_NAs_indices = sapply( 1:ncol(series_matrix), |
128 | function(i) all(!is.na(series_matrix[,i])) ) | |
99f83c9a | 129 | series_matrix = series_matrix[,no_NAs_indices] |
3d69ff21 BA |
130 | |
131 | series_fds = rainbow::fds(seq_len(nrow(series_matrix)), series_matrix) | |
fa8078f9 | 132 | par(mar=c(4.7,5,1,1), cex.axis=1.5, cex.lab=1.5) |
4e25de2c | 133 | rainbow::fboxplot(series_fds, "functional", "hdr", xlab="Time (hours)", ylab="PM10", |
3d69ff21 | 134 | plotlegend=FALSE, lwd=2) |
98e958ca BA |
135 | rainbow::fboxplot(series_fds, "bivariate", "hdr", plotlegend=FALSE) |
136 | } | |
137 | ||
138 | #' Compute filaments | |
139 | #' | |
102bcfda BA |
140 | #' Obtain similar days in the past, and (optionally) plot them -- as black as distances |
141 | #' are small. | |
98e958ca | 142 | #' |
102bcfda | 143 | #' @inheritParams computeError |
8f84543c | 144 | #' @param index Index in forecast (integer or date) |
98e958ca BA |
145 | #' @param limit Number of neighbors to consider |
146 | #' @param plot Should the result be plotted? | |
147 | #' | |
148 | #' @return A list with | |
149 | #' \itemize{ | |
150 | #' \item index : index of the current serie ('today') | |
151 | #' \item neighb_indices : indices of its neighbors | |
152 | #' \item colors : colors of neighbors curves (shades of gray) | |
153 | #' } | |
154 | #' | |
155 | #' @export | |
8f84543c | 156 | computeFilaments <- function(data, pred, index, limit=60, plot=TRUE) |
98e958ca | 157 | { |
8f84543c | 158 | ref_serie = data$getCenteredSerie( pred$getIndexInData(index) ) |
98e958ca BA |
159 | if (any(is.na(ref_serie))) |
160 | stop("computeFilaments requires a serie without NAs") | |
161 | ||
98e958ca | 162 | # Compute colors for each neighbor (from darkest to lightest) |
8f84543c BA |
163 | sorted_dists = sort(-log(pred$getParams(index)$weights), index.return=TRUE) |
164 | nn = min(limit, length(sorted_dists$x)) | |
165 | min_dist = min(sorted_dists$x[1:nn]) | |
166 | max_dist = max(sorted_dists$x[1:nn]) | |
167 | color_values = floor(19.5*(sorted_dists$x[1:nn]-min_dist)/(max_dist-min_dist)) + 1 | |
98e958ca BA |
168 | colors = gray.colors(20,0.1,0.9)[color_values] #TODO: 20 == magic number |
169 | ||
170 | if (plot) | |
171 | { | |
172 | # Complete series with (past and present) tomorrows | |
8f84543c BA |
173 | ref_serie = c(ref_serie, data$getCenteredSerie( pred$getIndexInData(index)+1 )) |
174 | centered_series = rbind( | |
175 | data$getCenteredSeries( pred$getParams(index)$indices ), | |
176 | data$getCenteredSeries( pred$getParams(index)$indices+1 ) ) | |
72b9c501 BA |
177 | yrange = range( ref_serie, |
178 | quantile(centered_series, probs=c(0.025,0.975), na.rm=TRUE) ) | |
98e958ca BA |
179 | par(mar=c(4.7,5,1,1), cex.axis=1.5, cex.lab=1.5, lwd=2) |
180 | for (i in nn:1) | |
181 | { | |
8f84543c | 182 | plot(centered_series[,sorted_dists$ix[i]], ylim=yrange, type="l", col=colors[i], |
4e25de2c | 183 | xlab=ifelse(i==1,"Time (hours)",""), ylab=ifelse(i==1,"Centered PM10","")) |
98e958ca BA |
184 | par(new=TRUE) |
185 | } | |
186 | # Also plot ref curve, in red | |
187 | plot(ref_serie, ylim=yrange, type="l", col="#FF0000", xlab="", ylab="") | |
6d50a76f | 188 | abline(v=24, lty=2, col=colors()[56], lwd=1) |
98e958ca BA |
189 | } |
190 | ||
8f84543c BA |
191 | list( |
192 | "index"=pred$getIndexInData(index), | |
193 | "neighb_indices"=pred$getParams(index)$indices[sorted_dists$ix[1:nn]], | |
194 | "colors"=colors) | |
fa8078f9 BA |
195 | } |
196 | ||
af3b84f4 | 197 | #' Functional boxplot on filaments |
fa8078f9 | 198 | #' |
102bcfda | 199 | #' Draw the functional boxplot on filaments obtained by \code{computeFilaments()}. |
fa8078f9 | 200 | #' |
102bcfda | 201 | #' @inheritParams computeError |
98e958ca | 202 | #' @param fil Output of \code{computeFilaments} |
fa8078f9 BA |
203 | #' |
204 | #' @export | |
4e25de2c | 205 | plotFilamentsBox = function(data, fil) |
fa8078f9 | 206 | { |
98e958ca BA |
207 | if (!requireNamespace("rainbow", quietly=TRUE)) |
208 | stop("Functional boxplot requires the rainbow package") | |
209 | ||
210 | series_matrix = rbind( | |
211 | data$getSeries(fil$neighb_indices), data$getSeries(fil$neighb_indices+1) ) | |
212 | series_fds = rainbow::fds(seq_len(nrow(series_matrix)), series_matrix) | |
213 | par(mar=c(4.7,5,1,1), cex.axis=1.5, cex.lab=1.5) | |
4e25de2c | 214 | rainbow::fboxplot(series_fds, "functional", "hdr", xlab="Time (hours)", ylab="PM10", |
98e958ca BA |
215 | plotlegend=FALSE, lwd=2) |
216 | ||
72b9c501 | 217 | # "Magic": http://stackoverflow.com/questions/13842560/get-xlim-from-a-plot-in-r |
fa8078f9 BA |
218 | usr <- par("usr") |
219 | yr <- (usr[4] - usr[3]) / 27 | |
98e958ca | 220 | par(new=TRUE) |
a5a3a294 | 221 | plot(c(data$getSerie(fil$index),data$getSerie(fil$index+1)), type="l", lwd=2, lty=2, |
fa8078f9 | 222 | ylim=c(usr[3] + yr, usr[4] - yr), xlab="", ylab="") |
d5fe1f30 | 223 | abline(v=24, lty=2, col=colors()[56]) |
3d69ff21 | 224 | } |
16b1c049 | 225 | |
af3b84f4 | 226 | #' Plot relative conditional variability / absolute variability |
16b1c049 | 227 | #' |
af3b84f4 | 228 | #' Draw the relative conditional variability / absolute variability based on filaments |
102bcfda | 229 | #' obtained by \code{computeFilaments()}. |
16b1c049 | 230 | #' |
102bcfda BA |
231 | #' @inheritParams computeError |
232 | #' @inheritParams plotFilamentsBox | |
16b1c049 BA |
233 | #' |
234 | #' @export | |
4e25de2c | 235 | plotRelVar = function(data, fil) |
16b1c049 | 236 | { |
98e958ca BA |
237 | ref_var = c( apply(data$getSeries(fil$neighb_indices),1,sd), |
238 | apply(data$getSeries(fil$neighb_indices+1),1,sd) ) | |
41196789 | 239 | fdays = .getNoNA2(data, 1, fil$index-1) |
72b9c501 BA |
240 | global_var = c( |
241 | apply(data$getSeries(fdays),1,sd), | |
242 | apply(data$getSeries(fdays+1),1,sd) ) | |
16b1c049 | 243 | |
af3b84f4 | 244 | yrange = range(ref_var, global_var) |
16b1c049 | 245 | par(mar=c(4.7,5,1,1), cex.axis=1.5, cex.lab=1.5) |
af3b84f4 | 246 | plot(ref_var, type="l", col=1, lwd=3, ylim=yrange, |
4e25de2c | 247 | xlab="Time (hours)", ylab="Standard deviation") |
16b1c049 | 248 | par(new=TRUE) |
98e958ca | 249 | plot(global_var, type="l", col=2, lwd=3, ylim=yrange, xlab="", ylab="") |
16b1c049 BA |
250 | abline(v=24, lty=2, col=colors()[56]) |
251 | } |