X-Git-Url: https://git.auder.net/?p=talweg.git;a=blobdiff_plain;f=pkg%2FR%2Fplot.R;h=0f895bd16483795302623b53ea983f3ab9c2cd92;hp=b5a8e4b636c1e146cda9207b8b6c124c83cca345;hb=HEAD;hpb=10886062b38b7373ce6f418b6df6da16badd9393 diff --git a/pkg/R/plot.R b/pkg/R/plot.R index b5a8e4b..0f895bd 100644 --- a/pkg/R/plot.R +++ b/pkg/R/plot.R @@ -20,34 +20,49 @@ plotCurves <- function(data, indices=seq_len(data$getSize())) #' #' @param err Error as returned by \code{computeError()} #' @param cols Colors for each error (default: 1,2,3,...) +#' @param agg Aggregation level ("day", "week" or "month") #' #' @seealso \code{\link{plotCurves}}, \code{\link{plotPredReal}}, #' \code{\link{plotSimils}}, \code{\link{plotFbox}}, \code{\link{computeFilaments}}, #' \code{\link{plotFilamentsBox}}, \code{\link{plotRelVar}} #' #' @export -plotError <- function(err, cols=seq_along(err)) +plotError <- function(err, cols=seq_along(err), agg="day") { if (!is.null(err$abs)) err = list(err) par(mfrow=c(2,2), mar=c(4.7,5,1,1), cex.axis=1.5, cex.lab=1.5) L = length(err) - yrange = range( sapply(1:L, function(i) ( err[[i]]$abs$day ) ), na.rm=TRUE ) - matplot( sapply( seq_len(L), function(i) err[[i]]$abs$day ), type="l", - xlab="Time (hours)", ylab="Mean |y - y_hat|", ylim=yrange, col=cols, lwd=2, lty=1 ) + yrange = range( sapply(1:L, function(i) err[[i]]$abs$day), na.rm=TRUE ) + matplot(sapply( seq_len(L), function(i) err[[i]]$abs$day ), type="l", + xlab="Time (hours)", ylab="Mean |y - y_hat|", ylim=yrange, col=cols, lwd=2, lty=1) - yrange = range( sapply(1:L, function(i) ( err[[i]]$abs$indices ) ), na.rm=TRUE ) - matplot( sapply( seq_len(L), function(i) err[[i]]$abs$indices ), type="l", - xlab="Time (days)", ylab="Mean |y - y_hat|", ylim=yrange, col=cols, lwd=2, lty=1 ) + agg_curves <- sapply( seq_len(L), function(i) { + curve <- err[[i]]$abs$indices + delta <- if (agg=="day") 1 else if (agg=="week") 7 else if (agg=="month") 30 + vapply( seq(1,length(curve),delta), function(i) { + mean(curve[i:(i+delta-1)], na.rm=TRUE) + }, vector("double",1), USE.NAMES=FALSE ) + }) + yrange = range(agg_curves, na.rm=TRUE) + matplot(agg_curves, type="l", xlab=paste("Time (",agg,"s)", sep=""), + ylab="Mean |y - y_hat|", ylim=yrange, col=cols, lwd=2, lty=1) - yrange = range( sapply(1:L, function(i) ( err[[i]]$MAPE$day ) ), na.rm=TRUE ) - matplot( sapply( seq_len(L), function(i) err[[i]]$MAPE$day ), type="l", - xlab="Time (hours)", ylab="Mean MAPE", ylim=yrange, col=cols, lwd=2, lty=1 ) + yrange = range( sapply(1:L, function(i) err[[i]]$MAPE$day), na.rm=TRUE ) + matplot(sapply( seq_len(L), function(i) err[[i]]$MAPE$day ), type="l", + xlab="Time (hours)", ylab="Mean MAPE", ylim=yrange, col=cols, lwd=2, lty=1) - yrange = range( sapply(1:L, function(i) ( err[[i]]$MAPE$indices ) ), na.rm=TRUE ) - matplot( sapply( seq_len(L), function(i) err[[i]]$MAPE$indices ), type="l", - xlab="Time (days)", ylab="Mean MAPE", ylim=yrange, col=cols, lwd=2, lty=1 ) + agg_curves <- sapply( seq_len(L), function(i) { + curve <- err[[i]]$MAPE$indices + delta <- if (agg=="day") 1 else if (agg=="week") 7 else if (agg=="month") 30 + vapply( seq(1,length(curve),delta), function(i) { + mean(curve[i:(i+delta-1)], na.rm=TRUE) + }, vector("double",1), USE.NAMES=FALSE ) + }) + yrange = range(agg_curves, na.rm=TRUE) + matplot(agg_curves, type="l", xlab=paste("Time (",agg,"s)", sep=""), + ylab="Mean MAPE", ylim=yrange, col=cols, lwd=2, lty=1) } #' Plot measured / predicted @@ -64,7 +79,8 @@ plotPredReal <- function(data, pred, index) measure = data$getSerie( pred$getIndexInData(index) )[1:length(pred$getForecast(1))] # Remove the common part, where prediction == measure - dot_mark <- ifelse(prediction[1]==measure[1], which.max(prediction==measure), 0) + dot_mark <- ifelse(prediction[1]==measure[1], + which.max(seq_along(prediction)[prediction==measure]), 0) prediction = prediction[(dot_mark+1):length(prediction)] measure = measure[(dot_mark+1):length(measure)]