X-Git-Url: https://git.auder.net/?p=talweg.git;a=blobdiff_plain;f=pkg%2FR%2Fplot.R;h=c8f7792cb05be2c4215bd93da8fac016b0b6e1ed;hp=9a7a1ee55181c14704a1cf59f587d22a7ca6944b;hb=af3b84f4cacade7d83221ca0249b546c50ddf340;hpb=5d83d8150dc135347d5ef39e5015b88f33fa9ee3 diff --git a/pkg/R/plot.R b/pkg/R/plot.R index 9a7a1ee..c8f7792 100644 --- a/pkg/R/plot.R +++ b/pkg/R/plot.R @@ -1,6 +1,6 @@ -#' @title plot curves +#' plot curves #' -#' @description Plot a range of curves in data +#' Plot a range of curves in data #' #' @param data Object of class Data #' @param indices Range of indices (integers or dates) @@ -24,9 +24,9 @@ plotCurves <- function(data, indices=seq_len(data$getSize())) } } -#' @title plot measured / predicted +#' plot measured / predicted #' -#' @description Plot measured curve (in black) and predicted curve (in red) +#' Plot measured curve (in black) and predicted curve (in red) #' #' @param data Object return by \code{getData} #' @param pred Object as returned by \code{computeForecast} @@ -44,9 +44,9 @@ plotPredReal <- function(data, pred, index) plot(pred$getSerie(index), type="l", col="#0000FF", ylim=yrange, xlab="", ylab="") } -#' @title Compute filaments +#' Compute filaments #' -#' @description Get similar days in the past + "past tomorrow", as black as distances are small +#' Get similar days in the past + "past tomorrow", as black as distances are small #' #' @param data Object as returned by \code{getData} #' @param index Index in data @@ -103,9 +103,9 @@ computeFilaments <- function(data, index, limit=60, plot=TRUE) list("indices"=c(fdays[ indices[plot_order] ],index), "colors"=colors) } -#' @title Plot similarities +#' Plot similarities #' -#' @description Plot histogram of similarities (weights) +#' Plot histogram of similarities (weights) #' #' @param pred Object as returned by \code{computeForecast} #' @param index Index in forecasts (not in data) @@ -120,15 +120,15 @@ plotSimils <- function(pred, index) hist(pred$getParams(index)$weights, nclass=20, xlab="Poids", ylab="Effectif") } -#' @title Plot error +#' Plot error #' -#' @description Draw error graphs, potentially from several runs of \code{computeForecast} +#' Draw error graphs, potentially from several runs of \code{computeForecast} #' #' @param err Error as returned by \code{computeError} #' @param cols Colors for each error (default: 1,2,3,...) #' -#' @seealso \code{\link{plotPredReal}}, \code{\link{plotFilaments}}, \code{\link{plotSimils}} -#' \code{\link{plotFbox}} +#' @seealso \code{\link{plotPredReal}},\code{\link{plotFilaments}} +#' \code{\link{plotSimils}},\code{\link{plotFbox}},\code{\link{plotRelativeVariability}} #' #' @export plotError <- function(err, cols=seq_along(err)) @@ -171,9 +171,9 @@ plotError <- function(err, cols=seq_along(err)) } } -#' @title Functional boxplot +#' Functional boxplot #' -#' @description Draw the functional boxplot on the left, and bivariate plot on the right +#' Draw the functional boxplot on the left, and bivariate plot on the right #' #' @param data Object return by \code{getData} #' @param fiter Optional filter: return TRUE on indices to process @@ -193,7 +193,8 @@ plotFbox <- function(data, filter=function(index) TRUE, plot_bivariate=TRUE) rep(NA,L) }) # TODO: merge with previous step: only one pass should be required - no_NAs_indices = sapply( 1:ncol(series_matrix), function(i) all(!is.na(series_matrix[,i])) ) + no_NAs_indices = sapply( 1:ncol(series_matrix), + function(i) all(!is.na(series_matrix[,i])) ) series_matrix = series_matrix[,no_NAs_indices] series_fds = rainbow::fds(seq_len(nrow(series_matrix)), series_matrix) @@ -206,9 +207,9 @@ plotFbox <- function(data, filter=function(index) TRUE, plot_bivariate=TRUE) rainbow::fboxplot(series_fds, "bivariate", "hdr", plotlegend=FALSE) } -#' @title Functional boxplot on filaments +#' Functional boxplot on filaments #' -#' @description Draw the functional boxplot on filaments obtained by \code{computeFilaments} +#' Draw the functional boxplot on filaments obtained by \code{computeFilaments} #' #' @param data Object return by \code{getData} #' @param indices Indices as output by \code{computeFilaments} @@ -226,10 +227,10 @@ plotFilamentsBox = function(data, indices, ...) ylim=c(usr[3] + yr, usr[4] - yr), xlab="", ylab="") } -#' @title Plot relative conditional variability / absolute variability +#' Plot relative conditional variability / absolute variability #' -#' @description Draw the relative conditional variability / absolute variability based on on -#' filaments obtained by \code{computeFilaments} +#' Draw the relative conditional variability / absolute variability based on filaments +#' obtained by \code{computeFilaments} #' #' @param data Object return by \code{getData} #' @param indices Indices as output by \code{computeFilaments} @@ -237,8 +238,6 @@ plotFilamentsBox = function(data, indices, ...) #' @export plotRelativeVariability = function(data, indices, ...) { - #plot left / right separated by vertical line brown dotted - #median of 3 runs for random length(indices) series ref_series = t( sapply(indices, function(i) { c( data$getSerie(i), data$getSerie(i+1) ) }) ) @@ -251,22 +250,12 @@ plotRelativeVariability = function(data, indices, ...) if ( !any(is.na(data$getSerie(i)) | is.na(data$getSerie(i+1))) ) fdays = c(fdays, i) } + global_var = c( apply(data$getSerie(fdays),2,sd), apply(data$getSerie(fdays+1),2,sd) ) - # TODO: 3 == magic number - random_var = matrix(nrow=3, ncol=48) - for (mc in seq_len(nrow(random_var))) - { - random_indices = sample(fdays, length(indices)) - random_series = t( sapply(random_indices, function(i) { - c( data$getSerie(i), data$getSerie(i+1) ) - }) ) - random_var[mc,] = apply(random_series, 2, sd) - } - random_var = apply(random_var, 2, median) - - yrange = range(ref_var, random_var) + 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") + plot(ref_var, type="l", col=1, lwd=3, ylim=yrange, + xlab="Temps (heures)", ylab="Écart-type") par(new=TRUE) plot(random_var, type="l", col=2, lwd=3, ylim=yrange, xlab="", ylab="") abline(v=24, lty=2, col=colors()[56])