From: Benjamin Auder Date: Wed, 17 May 2017 19:37:41 +0000 (+0200) Subject: prepare package for yearly report X-Git-Url: https://git.auder.net/game/pieces/cp.svg?a=commitdiff_plain;h=aa5397f16be60b338e303b26cfceb65defac3054;p=talweg.git prepare package for yearly report --- diff --git a/pkg/R/plot.R b/pkg/R/plot.R index d501d9e..b106e99 100644 --- a/pkg/R/plot.R +++ b/pkg/R/plot.R @@ -26,28 +26,42 @@ plotCurves <- function(data, indices=seq_len(data$getSize())) #' \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 diff --git a/reports/year2015.gj b/reports/year2015.gj index 63f8e41..58340e7 100644 --- a/reports/year2015.gj +++ b/reports/year2015.gj @@ -26,26 +26,7 @@ e2 = computeError(data, p2, P, H) e3 = computeError(data, p3, P, H) e4 = computeError(data, p4, P, H) options(repr.plot.width=9, repr.plot.height=7) -plotError(list(e1, e4, e3, e2), cols=c(1,2,colors()[258],4)) +plotError(list(e1, e4, e3, e2), cols=c(1,2,colors()[258],4), agg="month") # noir: Neighbors non-local (p1), bleu: Neighbors local (p2), # vert: moyenne (p3), rouge: persistence (p4) - -## TODO: plot modifié, retourner jour par jour et agréger au mois - -## TODO: garder éventuellement ça :: -sum_p23 = e2$abs$indices + e3$abs$indices -i_np = which.min(sum_p23) #indice de jour "facile" -i_p = which.max(sum_p23) #indice de jour "difficile" -% if P == 8: ------r -options(repr.plot.width=9, repr.plot.height=4) -par(mfrow=c(1,2)) - -plotPredReal(data, p1, i_np); title(paste("PredReal p1 day",i_np)) -plotPredReal(data, p1, i_p); title(paste("PredReal p1 day",i_p)) - -plotPredReal(data, p2, i_np); title(paste("PredReal p2 day",i_np)) -plotPredReal(data, p2, i_p); title(paste("PredReal p2 day",i_p)) - -# Bleu : prévue ; noir : réalisée (confondues jusqu'à predict_from-1)