X-Git-Url: https://git.auder.net/?a=blobdiff_plain;f=pkg%2FR%2Fplot.R;h=5cb55b0099f4878edb3da7ec44a9004bcc858711;hb=99f83c9af27492f6fb9b10f51fb8704ed588f5c1;hp=e4147986d6432dae8733be59cf01a947f44b3cea;hpb=16b1c049a9c402544d7076cacfe6b00a3785b51f;p=talweg.git diff --git a/pkg/R/plot.R b/pkg/R/plot.R index e414798..5cb55b0 100644 --- a/pkg/R/plot.R +++ b/pkg/R/plot.R @@ -8,12 +8,12 @@ #' @export plotCurves <- function(data, indices=seq_len(data$getSize())) { - yrange = quantile( range( sapply( indices, function(i) { + yrange = quantile( sapply( indices, function(i) { serie = c(data$getCenteredSerie(i)) if (!all(is.na(serie))) range(serie, na.rm=TRUE) c() - }) ), probs=c(0.05,0.95) ) + }), probs=c(0.05,0.95) ) par(mar=c(4.7,5,1,1), cex.axis=1.5, cex.lab=1.5) for (i in seq_along(indices)) { @@ -29,7 +29,7 @@ plotCurves <- function(data, indices=seq_len(data$getSize())) #' @description Plot measured curve (in black) and predicted curve (in red) #' #' @param data Object return by \code{getData} -#' @param pred Object as returned by \code{getForecast} +#' @param pred Object as returned by \code{computeForecast} #' @param index Index in forecasts #' #' @export @@ -75,7 +75,7 @@ computeFilaments <- function(data, index, limit=60, plot=TRUE) sqrt( sum( (ref_serie - data$getCenteredSerie(i))^2 ) / L ) }) indices = sort(distances, index.return=TRUE)$ix[1:min(limit,length(distances))] - yrange = quantile( range( ref_serie, sapply( indices, function(i) { + yrange = quantile( c(ref_serie, sapply( indices, function(i) { ii = fdays_indices[i] serie = c(data$getCenteredSerie(ii), data$getCenteredSerie(ii+1)) if (!all(is.na(serie))) @@ -109,7 +109,7 @@ computeFilaments <- function(data, index, limit=60, plot=TRUE) #' #' @description Plot histogram of similarities (weights) #' -#' @param pred Object as returned by \code{getForecast} +#' @param pred Object as returned by \code{computeForecast} #' @param index Index in forecasts (not in data) #' #' @export @@ -124,9 +124,9 @@ plotSimils <- function(pred, index) #' @title Plot error #' -#' @description Draw error graphs, potentially from several runs of \code{getForecast} +#' @description Draw error graphs, potentially from several runs of \code{computeForecast} #' -#' @param err Error as returned by \code{getError} +#' @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}} @@ -196,13 +196,16 @@ plotFbox <- function(data, filter=function(index) TRUE, plot_bivariate=TRUE) end_index = data$getSize() - 1 } + L = length(data$getCenteredSerie(2)) series_matrix = sapply(start_index:end_index, function(index) { - as.matrix(data$getSerie(index)) + if (filter(index)) + as.matrix(data$getSerie(index)) + else + rep(NA,L) }) - # Remove NAs. + filter TODO: merge with previous step: only one pass required... - nas_indices = seq_len(ncol(series_matrix))[ sapply( 1:ncol(series_matrix), - function(index) ( !filter(index) || any(is.na(series_matrix[,index])) ) ) ] - series_matrix = series_matrix[,-nas_indices] + # 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])) ) + series_matrix = series_matrix[,no_NAs_indices] series_fds = rainbow::fds(seq_len(nrow(series_matrix)), series_matrix) if (plot_bivariate)