diff --git a/R/plot.R b/R/plot.R index a2c1b14..21dddb6 100644 --- a/R/plot.R +++ b/R/plot.R @@ -360,7 +360,10 @@ tsPlot <- function(x, table = NULL, variable = NULL, elements = NULL, ) uni_ele <- unique(dt$element) - variable2Axe <- uni_ele[grepl(paste(paste0("(", variable2Axe, ")"), collapse = "|"), uni_ele)] + if(!is.null(variable2Axe) && length(variable2Axe) > 0){ + label_variable2Axe <- variable2Axe + variable2Axe <- uni_ele[grepl(paste(paste0("(", variable2Axe, ")"), collapse = "|"), uni_ele)] + } # BP 2017 # if(length(main) > 0){ @@ -379,6 +382,7 @@ tsPlot <- function(x, table = NULL, variable = NULL, elements = NULL, timeStep = timeStep, variable = variable, variable2Axe = variable2Axe, + label_variable2Axe = label_variable2Axe, typeConfInt = typeConfInt, confInt = confInt, minValue = minValue, diff --git a/R/plot_stats.R b/R/plot_stats.R index 1bcbfb2..d3e31b7 100644 --- a/R/plot_stats.R +++ b/R/plot_stats.R @@ -1,5 +1,6 @@ .plotMonotone <- function(dt, timeStep, variable, variable2Axe = NULL, typeConfInt = FALSE, confInt = NULL, maxValue, - main = NULL, ylab = NULL, highlight = FALSE, stepPlot = FALSE, drawPoints = FALSE, language = "en", ...) { + main = NULL, ylab = NULL, highlight = FALSE, stepPlot = FALSE, drawPoints = FALSE, language = "en", + label_variable2Axe = NULL, ...) { uniqueElements <- as.character(sort(unique(dt$element))) plotConfInt <- FALSE @@ -37,13 +38,21 @@ main <- paste(.getLabelLanguage("Monotone of", language), variable) } + if(!is.null(variable2Axe) && length(variable2Axe) > 0){ + ylab2 <- paste0(label_variable2Axe, collapse = " ; ") + } else { + ylab2 <- NULL + } + .plotStat(dt, ylab = ylab, main = main, uniqueElements = uniqueElements, variable2Axe = variable2Axe, - plotConfInt = plotConfInt, highlight = highlight, stepPlot = stepPlot, drawPoints = drawPoints, ...) + plotConfInt = plotConfInt, highlight = highlight, stepPlot = stepPlot, drawPoints = drawPoints, + ylab2 = ylab2, ...) } .density <- function(dt, timeStep, variable, variable2Axe = NULL, minValue = NULL, maxValue = NULL, - main = NULL, ylab = NULL, highlight = FALSE, stepPlot = FALSE, drawPoints = FALSE, language = "en", ...) { + main = NULL, ylab = NULL, highlight = FALSE, stepPlot = FALSE, drawPoints = FALSE, + language = "en", label_variable2Axe = NULL, ...) { uniqueElements <- as.character(sort(unique(dt$element))) @@ -59,7 +68,14 @@ variable <- paste0(variable, collapse = " ; ") if (is.null(ylab)){ - ylab <- .getLabelLanguage("Density", language) + # ylab <- .getLabelLanguage("Density", language) + ylab <- variable + } + + if(!is.null(variable2Axe) && length(variable2Axe) > 0){ + ylab2 <- paste0(label_variable2Axe, collapse = " ; ") + } else { + ylab2 <- NULL } if (is.null(main) | isTRUE(all.equal("", main))){ @@ -67,7 +83,7 @@ } .plotStat(dt, ylab = ylab, main = main, uniqueElements = uniqueElements,variable2Axe = variable2Axe, - highlight = highlight, stepPlot = stepPlot, drawPoints = drawPoints,...) + highlight = highlight, stepPlot = stepPlot, drawPoints = drawPoints, ylab2 = ylab2, ...) } @@ -128,7 +144,7 @@ .plotStat <- function(dt, ylab, main, colors, uniqueElements, legend, legendItemsPerRow, width, height, plotConfInt = FALSE, highlight = FALSE, - stepPlot = FALSE, drawPoints = FALSE,variable2Axe = NULL, language = "en", ...) { + stepPlot = FALSE, drawPoints = FALSE,variable2Axe = NULL, language = "en", ylab2 = NULL, ...) { dt <- dcast(dt, x ~ element, value.var = "y") if (is.null(colors)) { @@ -170,18 +186,19 @@ } } - if(highlight) - { + if(highlight){ g <- g %>% dyHighlight(highlightSeriesOpts = list(strokeWidth = 2)) } + if(!is.null(ylab2)){ + g <- g %>% dyAxis("y2", label = ylab2) + } + if (plotConfInt) { for (v in uniqueElements) { axis = NULL - if(length(variable2Axe)>0) - { - if(v%in%variable2Axe) - { + if(length(variable2Axe)>0){ + if(v%in%variable2Axe){ axis <- "y2" } } diff --git a/R/plot_ts.R b/R/plot_ts.R index 2278041..0c419cf 100644 --- a/R/plot_ts.R +++ b/R/plot_ts.R @@ -16,7 +16,8 @@ #' #' @noRd #' -.plotTS <- function(dt, timeStep, variable, variable2Axe = NULL, typeConfInt = FALSE, +.plotTS <- function(dt, timeStep, variable, variable2Axe = NULL, + typeConfInt = FALSE, confInt = 0, maxValue, colors = NULL, main = NULL, @@ -24,7 +25,8 @@ legend = TRUE, legendItemsPerRow = 5, group = NULL, - width = NULL, height = NULL, highlight = FALSE, stepPlot = FALSE, drawPoints = FALSE, language = language, ...) { + width = NULL, height = NULL, highlight = FALSE, stepPlot = FALSE, drawPoints = FALSE, + language = language, label_variable2Axe = NULL, ...) { uniqueElements <- as.character(sort(unique(dt$element))) plotConfInt <- FALSE @@ -34,11 +36,11 @@ # If dt contains several Monte-Carlo scenario, compute aggregate statistics if (!is.null(dt$mcYear)) { if (confInt == 0) { - + dt <- dt[, .(value = mean(value)), by = .(element, time)] } else { - + plotConfInt <- TRUE alpha <- (1 - confInt) / 2 dt <- dt[, .(value = c(mean(value), quantile(value, c(alpha, 1 - alpha))), @@ -48,19 +50,26 @@ } } } - + dt <- dcast(dt, time ~ element, value.var = "value") # Graphical parameters - if(length(uniqueElements)> 1) - { - variable <- paste0(uniqueElements, collapse = " ; ") - }else{ + if(is.null(ylab)){ + ylab <- paste0(variable, collapse = " ; ") + } + + ind_2_axes <- FALSE + if(!is.null(variable2Axe) && length(variable2Axe) > 0){ + ind_2_axes <- TRUE + ylab_2 <- paste0(label_variable2Axe, collapse = " ; ") + } + + if(length(uniqueElements)> 1){ + variable <- paste0(uniqueElements, collapse = " ; ") + } else { variable <- paste0(uniqueElements, " - ", variable) - } - if (is.null(ylab)) ylab <- variable if (is.null(main) | isTRUE(all.equal("", main))){ main <- paste(.getLabelLanguage("Evolution of", language), variable) } @@ -106,20 +115,20 @@ } } - if(highlight) - { + if(highlight){ g <- g %>% dyHighlight(highlightSeriesOpts = list(strokeWidth = 2)) } + if(ind_2_axes){ + g <- g %>% dyAxis("y2", label = ylab_2) + } if (plotConfInt) { for (v in uniqueElements) { axis = NULL - if(length(variable2Axe)>0) - { - if(v%in%variable2Axe) - { - axis <- "y2" - } + if(length(variable2Axe) > 0){ + if(v %in% variable2Axe){ + axis <- "y2" + } } g <- g %>% dySeries(paste0(v, c("_l", "", "_u")), axis = axis) }