X-Git-Url: https://git.auder.net/?a=blobdiff_plain;f=pkg%2FR%2Fplot.R;h=5ea4843fe96e6808661c0e79fe2639521f6b8cad;hb=72b9c50162bcdcf6c99fbb8b2ec6ea9ba98379cb;hp=4cafd7d5f9dc6bdbb71c7e8d648beec1a10c371a;hpb=d4841a3f15f94ce0520559aed9466c9c3f259d68;p=talweg.git diff --git a/pkg/R/plot.R b/pkg/R/plot.R index 4cafd7d..5ea4843 100644 --- a/pkg/R/plot.R +++ b/pkg/R/plot.R @@ -14,7 +14,7 @@ plotCurves <- function(data, indices=seq_len(data$getSize())) for (i in seq_along(indices)) { plot(series[,i], type="l", ylim=yrange, - xlab=ifelse(i==1,"Temps (en heures)",""), ylab=ifelse(i==1,"PM10","")) + xlab=ifelse(i==1,"Time (hours)",""), ylab=ifelse(i==1,"PM10","")) if (i < length(indices)) par(new=TRUE) } @@ -28,8 +28,8 @@ plotCurves <- function(data, indices=seq_len(data$getSize())) #' @param cols Colors for each error (default: 1,2,3,...) #' #' @seealso \code{\link{plotCurves}}, \code{\link{plotPredReal}}, -#' \code{\link{plotSimils}}, \code{\link{plotFbox}}, -#' \code{\link{computeFilaments}, }\code{\link{plotFilamentsBox}}, \code{\link{plotRelVar}} +#' \code{\link{plotSimils}}, \code{\link{plotFbox}}, \code{\link{computeFilaments}}, +#' \code{\link{plotFilamentsBox}}, \code{\link{plotRelVar}} #' #' @export plotError <- function(err, cols=seq_along(err)) @@ -41,32 +41,32 @@ plotError <- function(err, cols=seq_along(err)) yrange = range( sapply(1:L, function(i) ( err[[i]]$abs$day ) ), na.rm=TRUE ) for (i in seq_len(L)) { - plot(err[[i]]$abs$day, type="l", xlab=ifelse(i==1,"Temps (heures)",""), - ylab=ifelse(i==1,"Moyenne |y - y_hat|",""), ylim=yrange, col=cols[i]) + plot(err[[i]]$abs$day, type="l", xlab=ifelse(i==1,"Time (hours)",""), + ylab=ifelse(i==1,"Mean |y - y_hat|",""), ylim=yrange, col=cols[i]) if (i < L) par(new=TRUE) } yrange = range( sapply(1:L, function(i) ( err[[i]]$abs$indices ) ), na.rm=TRUE ) for (i in seq_len(L)) { - plot(err[[i]]$abs$indices, type="l", xlab=ifelse(i==1,"Temps (jours)",""), - ylab=ifelse(i==1,"Moyenne |y - y_hat|",""), ylim=yrange, col=cols[i]) + plot(err[[i]]$abs$indices, type="l", xlab=ifelse(i==1,"Time (days)",""), + ylab=ifelse(i==1,"Mean |y - y_hat|",""), ylim=yrange, col=cols[i]) if (i < L) par(new=TRUE) } yrange = range( sapply(1:L, function(i) ( err[[i]]$MAPE$day ) ), na.rm=TRUE ) for (i in seq_len(L)) { - plot(err[[i]]$MAPE$day, type="l", xlab=ifelse(i==1,"Temps (heures)",""), - ylab=ifelse(i==1,"MAPE moyen",""), ylim=yrange, col=cols[i]) + plot(err[[i]]$MAPE$day, type="l", xlab=ifelse(i==1,"Time (hours)",""), + ylab=ifelse(i==1,"Mean MAPE",""), ylim=yrange, col=cols[i]) if (i < L) par(new=TRUE) } yrange = range( sapply(1:L, function(i) ( err[[i]]$MAPE$indices ) ), na.rm=TRUE ) for (i in seq_len(L)) { - plot(err[[i]]$MAPE$indices, type="l", xlab=ifelse(i==1,"Temps (jours)",""), - ylab=ifelse(i==1,"MAPE moyen",""), ylim=yrange, col=cols[i]) + plot(err[[i]]$MAPE$indices, type="l", xlab=ifelse(i==1,"Time (days)",""), + ylab=ifelse(i==1,"Mean MAPE",""), ylim=yrange, col=cols[i]) if (i < L) par(new=TRUE) } @@ -83,12 +83,12 @@ plotError <- function(err, cols=seq_along(err)) #' @export plotPredReal <- function(data, pred, index) { - horizon = length(pred$getSerie(1)) + horizon = length(pred$getForecast(1)) measure = data$getSerie( pred$getIndexInData(index)+1 )[1:horizon] - prediction = pred$getSerie(index) + prediction = pred$getForecast(index) yrange = range(measure, prediction) par(mar=c(4.7,5,1,1), cex.axis=1.5, cex.lab=1.5, lwd=3) - plot(measure, type="l", ylim=yrange, xlab="Temps (en heures)", ylab="PM10") + plot(measure, type="l", ylim=yrange, xlab="Time (hours)", ylab="PM10") par(new=TRUE) plot(prediction, type="l", col="#0000FF", ylim=yrange, xlab="", ylab="") } @@ -107,7 +107,7 @@ plotSimils <- function(pred, index) if (is.null(weights)) stop("plotSimils only works on 'Neighbors' forecasts") par(mar=c(4.7,5,1,1), cex.axis=1.5, cex.lab=1.5) - hist(pred$getParams(index)$weights, nclass=20, main="", xlab="Poids", ylab="Effectif") + hist(pred$getParams(index)$weights, nclass=20, main="", xlab="Weight", ylab="Count") } #' Functional boxplot @@ -116,7 +116,6 @@ plotSimils <- function(pred, index) #' #' @param data Object return by \code{getData} #' @param indices integer or date indices to process -#' @param plot_bivariate Should the bivariate plot appear? #' #' @export plotFbox <- function(data, indices=seq_len(data$getSize())) @@ -132,7 +131,7 @@ plotFbox <- function(data, indices=seq_len(data$getSize())) series_fds = rainbow::fds(seq_len(nrow(series_matrix)), series_matrix) par(mar=c(4.7,5,1,1), cex.axis=1.5, cex.lab=1.5) - rainbow::fboxplot(series_fds, "functional", "hdr", xlab="Temps (heures)", ylab="PM10", + rainbow::fboxplot(series_fds, "functional", "hdr", xlab="Time (hours)", ylab="PM10", plotlegend=FALSE, lwd=2) rainbow::fboxplot(series_fds, "bivariate", "hdr", plotlegend=FALSE) } @@ -176,12 +175,13 @@ computeFilaments <- function(data, pred, index, limit=60, plot=TRUE) centered_series = rbind( data$getCenteredSeries( pred$getParams(index)$indices ), data$getCenteredSeries( pred$getParams(index)$indices+1 ) ) - yrange = range( ref_serie, quantile(centered_series, probs=c(0.025,0.975), na.rm=TRUE) ) + yrange = range( ref_serie, + quantile(centered_series, probs=c(0.025,0.975), na.rm=TRUE) ) par(mar=c(4.7,5,1,1), cex.axis=1.5, cex.lab=1.5, lwd=2) for (i in nn:1) { plot(centered_series[,sorted_dists$ix[i]], ylim=yrange, type="l", col=colors[i], - xlab=ifelse(i==1,"Temps (en heures)",""), ylab=ifelse(i==1,"PM10 centré","")) + xlab=ifelse(i==1,"Time (hours)",""), ylab=ifelse(i==1,"Centered PM10","")) par(new=TRUE) } # Also plot ref curve, in red @@ -203,7 +203,7 @@ computeFilaments <- function(data, pred, index, limit=60, plot=TRUE) #' @param fil Output of \code{computeFilaments} #' #' @export -plotFilamentsBox = function(data, fil, ...) +plotFilamentsBox = function(data, fil) { if (!requireNamespace("rainbow", quietly=TRUE)) stop("Functional boxplot requires the rainbow package") @@ -212,10 +212,10 @@ plotFilamentsBox = function(data, fil, ...) data$getSeries(fil$neighb_indices), data$getSeries(fil$neighb_indices+1) ) series_fds = rainbow::fds(seq_len(nrow(series_matrix)), series_matrix) par(mar=c(4.7,5,1,1), cex.axis=1.5, cex.lab=1.5) - rainbow::fboxplot(series_fds, "functional", "hdr", xlab="Temps (heures)", ylab="PM10", + rainbow::fboxplot(series_fds, "functional", "hdr", xlab="Time (hours)", ylab="PM10", plotlegend=FALSE, lwd=2) - # "Magic" found at http://stackoverflow.com/questions/13842560/get-xlim-from-a-plot-in-r + # "Magic": http://stackoverflow.com/questions/13842560/get-xlim-from-a-plot-in-r usr <- par("usr") yr <- (usr[4] - usr[3]) / 27 par(new=TRUE) @@ -233,17 +233,19 @@ plotFilamentsBox = function(data, fil, ...) #' @param fil Output of \code{computeFilaments} #' #' @export -plotRelVar = function(data, fil, ...) +plotRelVar = function(data, fil) { ref_var = c( apply(data$getSeries(fil$neighb_indices),1,sd), apply(data$getSeries(fil$neighb_indices+1),1,sd) ) fdays = getNoNA2(data, 1, fil$index-1) - global_var = c( apply(data$getSeries(fdays),1,sd), apply(data$getSeries(fdays+1),1,sd) ) + global_var = c( + apply(data$getSeries(fdays),1,sd), + apply(data$getSeries(fdays+1),1,sd) ) yrange = range(ref_var, global_var) par(mar=c(4.7,5,1,1), cex.axis=1.5, cex.lab=1.5) plot(ref_var, type="l", col=1, lwd=3, ylim=yrange, - xlab="Temps (heures)", ylab="Écart-type") + xlab="Time (hours)", ylab="Standard deviation") par(new=TRUE) plot(global_var, type="l", col=2, lwd=3, ylim=yrange, xlab="", ylab="") abline(v=24, lty=2, col=colors()[56])