From 09fa3d8613bb3ed4980f7ce8c2af3ccc15d46f78 Mon Sep 17 00:00:00 2001 From: JulienBretteville Date: Thu, 22 Aug 2019 09:56:29 +0200 Subject: [PATCH] #14 fixed You can now customize the color of your graphics with de plotFlowbased function --- R/graphs.R | 52 +++++++++++++++++++++++++++++------- man/plotFlowbased.Rd | 23 +++++++++++++++- tests/testthat/test-graphs.R | 7 +++++ 3 files changed, 71 insertions(+), 11 deletions(-) diff --git a/R/graphs.R b/R/graphs.R index 63eac60..086917d 100644 --- a/R/graphs.R +++ b/R/graphs.R @@ -278,6 +278,10 @@ clusterPlot <- function(data, #' @param ylim \code{numeric}, limits of x-axis (default = c(-10000, 10000)) #' @param width \code{character}, for rAmCharts only. Default to "420px" (set to "100/100" for dynamic resize) #' @param height \code{character}, for rAmCharts only. Default to "410px" (set to "100/100" for dynamic resize) +#' @param color \code{character}, default NULL, if you want to customize the +#' colors of the graphics, color has to be the same length as the number of +#' graphics you want. The colors can be written either in the format "red", "blue"... +#' or "#CC0000", "#00CC00"... #' #' @examples #' @@ -323,6 +327,22 @@ clusterPlot <- function(data, #' hours = c(3, 4), dates = c("2018-10-02"), #' hours2 = c(3, 4), dates2 = c("2018-10-02"), #' domainsNames = NULL, main = NULL) +#' +#' +#' # Examples with colors chosen +#' plotFlowbased(PLAN, country1 = "AT", country2 = "DE", +#' hubDrop = hubDrop, +#' hours = c(3), dates = c("2018-10-02", "2018-10-03"), +#' domainsNames = NULL, main = NULL, +#' color = c("#CC0000", "purple")) +#' +#' +#' plotFlowbased(PLAN, PLAN2 = PLAN3, country1 = "BE", country2 = "DE", +#' hubDrop = hubDrop, hubDrop2 = hubDrop2, +#' hours = c(3, 4), dates = c("2018-10-02"), +#' hours2 = c(3, 4), dates2 = c("2018-10-02"), +#' domainsNames = NULL, main = NULL, +#' color = c("blue", "grey", "green", "brown")) #' #' } #' @@ -342,7 +362,8 @@ plotFlowbased <- function(PLAN, xlim = c(-10000, 10000), ylim = c(-10000, 10000), main = NULL, - width = "420px", height = "410px"){ + width = "420px", height = "410px", + color = NULL){ # remove NOTE data.table Period <- NULL @@ -421,6 +442,13 @@ plotFlowbased <- function(PLAN, dataToGraph <- .givePlotData(VERT, VERT2, ctry1, ctry2, comb, domainsNames, hubnameDiff, hubnameDiff2) + if(!is.null(color)) { + if(length(color) != length(domainsNames)) { + stop(paste("If color is not null, it has to be the same length of the number", + "of graphics. There is currently", length(domainsNames), "graphics", + "and", length(color), "colors set")) + } + } rowMax <- max(unlist(lapply(dataToGraph, nrow))) dataToGraph <- lapply(dataToGraph, function(dta){ if(nrow(dta)',domainsNames[X],'
', - paste0(domainsNames[X], gsub("ptdf", " ", ctry1)), - ' :[[x]]
', - paste0(domainsNames[X], gsub("ptdf", " ", ctry2)), ' :[[y]]'), - bullet = 'circle', xField = paste0(domainsNames[X], " ", ctry1), - yField = paste0(domainsNames[X], " ", ctry2), - lineAlpha = 1, bullet = "bubble", bulletSize = 4, lineThickness = 3) - + graph <- amGraph(title = domainsNames[X], balloonText = + paste0('',domainsNames[X],'
', + paste0(domainsNames[X], gsub("ptdf", " ", ctry1)), + ' :[[x]]
', + paste0(domainsNames[X], gsub("ptdf", " ", ctry2)), ' :[[y]]'), + bullet = 'circle', xField = paste0(domainsNames[X], " ", ctry1), + yField = paste0(domainsNames[X], " ", ctry2), + lineAlpha = 1, bullet = "bubble", bulletSize = 4, lineThickness = 3) + if (!is.null(color)) { + graph@otherProperties$lineColor <- color[X] + } + # graph@otherProperties$lineColor <- "#0D8ECF" + graph }, USE.NAMES = FALSE) pipeR::pipeline( amXYChart(dataProvider = dataToGraph), diff --git a/man/plotFlowbased.Rd b/man/plotFlowbased.Rd index 2bd666a..9dbb90b 100644 --- a/man/plotFlowbased.Rd +++ b/man/plotFlowbased.Rd @@ -8,7 +8,7 @@ plotFlowbased(PLAN, PLAN2 = NULL, country1, country2, hours, dates, hours2 = NULL, dates2 = NULL, domainsNames = NULL, hubDrop = list(NL = c("BE", "DE", "FR", "AT")), hubDrop2 = NULL, xlim = c(-10000, 10000), ylim = c(-10000, 10000), main = NULL, - width = "420px", height = "410px") + width = "420px", height = "410px", color = NULL) } \arguments{ \item{PLAN}{\code{data.table}, at least ram, Date, Period and two ptdf columns : @@ -62,6 +62,11 @@ be sustracted} \item{width}{\code{character}, for rAmCharts only. Default to "420px" (set to "100/100" for dynamic resize)} \item{height}{\code{character}, for rAmCharts only. Default to "410px" (set to "100/100" for dynamic resize)} + +\item{color}{\code{character}, default NULL, if you want to customize the +colors of the graphics, color has to be the same length as the number of +graphics you want. The colors can be written either in the format "red", "blue"... +or "#CC0000", "#00CC00"...} } \description{ Plot flow-based domain(s) @@ -110,6 +115,22 @@ main = NULL) hours = c(3, 4), dates = c("2018-10-02"), hours2 = c(3, 4), dates2 = c("2018-10-02"), domainsNames = NULL, main = NULL) + + + # Examples with colors chosen + plotFlowbased(PLAN, country1 = "AT", country2 = "DE", + hubDrop = hubDrop, + hours = c(3), dates = c("2018-10-02", "2018-10-03"), + domainsNames = NULL, main = NULL, + color = c("#CC0000", "purple")) + + + plotFlowbased(PLAN, PLAN2 = PLAN3, country1 = "BE", country2 = "DE", + hubDrop = hubDrop, hubDrop2 = hubDrop2, + hours = c(3, 4), dates = c("2018-10-02"), + hours2 = c(3, 4), dates2 = c("2018-10-02"), + domainsNames = NULL, main = NULL, + color = c("blue", "grey", "green", "brown")) } diff --git a/tests/testthat/test-graphs.R b/tests/testthat/test-graphs.R index 77dfda5..577b3ff 100644 --- a/tests/testthat/test-graphs.R +++ b/tests/testthat/test-graphs.R @@ -79,6 +79,13 @@ test_that("clusterPlot", { domainsNames = NULL, main = NULL) expect_true("htmlwidget" %in% class(out3)) + expect_error(plotFlowbased( + PLAN, country1 = "BE", country2 = "DE", hubDrop = hubDrop, hours = c(4), + dates = c("2018-10-04"), main = NULL, color = c("green", "yellow"))) + out4 <- plotFlowbased( + PLAN, country1 = "BE", country2 = "DE", hubDrop = hubDrop, hours = c(4), + dates = c("2018-10-04"), main = NULL, color = c("yellow")) + expect_true("htmlwidget" %in% class(out4)) })