almost finished debug

[talweg.git] / pkg / R / plot.R

diff --git a/pkg/R/plot.R b/pkg/R/plot.R
index 9a7a1ee..c8f7792 100644 (file)
--- 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])