From 3ef57a58434294c33c63beb516e0f5050569f5e7 Mon Sep 17 00:00:00 2001 From: FRANCESC ROURA ADSERIAS Date: Thu, 27 Aug 2020 12:53:31 +0200 Subject: [PATCH 1/6] complete pct data.frame (it has to be multiple of 3) --- R/PlotForecastPDF.R | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/R/PlotForecastPDF.R b/R/PlotForecastPDF.R index 14e6cd3a..b7dbec6a 100644 --- a/R/PlotForecastPDF.R +++ b/R/PlotForecastPDF.R @@ -306,11 +306,29 @@ PlotForecastPDF <- function(fcst, tercile.limits, extreme.limits = NULL, obs = N tmp.dt <- data.table(tmp.df) pct <- tmp.dt[, .(pct = integrate(approxfun(x, ymax), lower = min(x), upper = max(x))$value), by = .(init, tercile)] + #------------------------ + # check number of probabilities = 3*npanels + #------------------------ + if (dim(pct)[1] %% 3 !=0){ + warning("There is not a percentage computed for every tercile cathegory") + dmy.i <- which(as.numeric(summary(pct$init)) == min(as.numeric(summary(pct$init)))) + init <- levels(factor(pct$init))[dmy.i] + dmy.t <- which(as.numeric(summary(pct$tercile)) == min(as.numeric(summary(pct$tercile)))) + terc <- levels(factor(pct$tercile))[dmy.t] + aux1 <- append(array(pct$init),init,after=0) + aux2 <- append(array(pct$tercile),terc,after=0) + aux3 <- append(array(pct$pct),rep(0.00001,length(terc)),after=0) + pct <- data.frame(init=aux1,tercile=aux2,pct=aux3) + pct <- as.data.table(pct) + } tot <- pct[, .(tot = sum(pct)), by = init] pct <- merge(pct, tot, by = "init") pct$pct <- round(100 * pct$pct/pct$tot, 0) pct$MLT <- pct[, .(MLT = pct == max(pct)), by = init]$MLT pct$lab.pos <- as.vector(apply(tercile.limits, 1, function(x) {c(min(x), mean(x), max(x))})) + if(min(pct$lab.pos) < min(tmp.df$x)){ + pct$lab.pos[which(pct$lab.pos < min(tmp.dt$x))] <- min(tmp.df$x) + } #------------------------ # Compute probability for extremes #------------------------ -- GitLab From e220a2191d7c53b30984ea9d00489f52215f8f91 Mon Sep 17 00:00:00 2001 From: FRANCESC ROURA ADSERIAS Date: Mon, 31 Aug 2020 18:01:13 +0200 Subject: [PATCH 2/6] tercile label error fixed --- R/PlotForecastPDF.R | 22 ++++------------------ 1 file changed, 4 insertions(+), 18 deletions(-) diff --git a/R/PlotForecastPDF.R b/R/PlotForecastPDF.R index b7dbec6a..dea6aa2d 100644 --- a/R/PlotForecastPDF.R +++ b/R/PlotForecastPDF.R @@ -306,29 +306,15 @@ PlotForecastPDF <- function(fcst, tercile.limits, extreme.limits = NULL, obs = N tmp.dt <- data.table(tmp.df) pct <- tmp.dt[, .(pct = integrate(approxfun(x, ymax), lower = min(x), upper = max(x))$value), by = .(init, tercile)] - #------------------------ - # check number of probabilities = 3*npanels - #------------------------ - if (dim(pct)[1] %% 3 !=0){ - warning("There is not a percentage computed for every tercile cathegory") - dmy.i <- which(as.numeric(summary(pct$init)) == min(as.numeric(summary(pct$init)))) - init <- levels(factor(pct$init))[dmy.i] - dmy.t <- which(as.numeric(summary(pct$tercile)) == min(as.numeric(summary(pct$tercile)))) - terc <- levels(factor(pct$tercile))[dmy.t] - aux1 <- append(array(pct$init),init,after=0) - aux2 <- append(array(pct$tercile),terc,after=0) - aux3 <- append(array(pct$pct),rep(0.00001,length(terc)),after=0) - pct <- data.frame(init=aux1,tercile=aux2,pct=aux3) - pct <- as.data.table(pct) - } tot <- pct[, .(tot = sum(pct)), by = init] + aa <- CJ(factor(levels(pct$init), levels = levels(pct$init)), factor(c("Below normal", "Normal", "Above normal"), levels = c("Below normal", "Normal", "Above normal"))) +colnames(aa) <- c("init","tercile") + pctt <- merge(pct, aa, by=c("init","tercile"), all.y=T) + pct <- pctt pct <- merge(pct, tot, by = "init") pct$pct <- round(100 * pct$pct/pct$tot, 0) pct$MLT <- pct[, .(MLT = pct == max(pct)), by = init]$MLT pct$lab.pos <- as.vector(apply(tercile.limits, 1, function(x) {c(min(x), mean(x), max(x))})) - if(min(pct$lab.pos) < min(tmp.df$x)){ - pct$lab.pos[which(pct$lab.pos < min(tmp.dt$x))] <- min(tmp.df$x) - } #------------------------ # Compute probability for extremes #------------------------ -- GitLab From 95c7c27b0ea2d5acfad927e6dbc81d7aa3928550 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lloren=C3=A7=20Lled=C3=B3?= Date: Tue, 1 Sep 2020 16:04:34 +0200 Subject: [PATCH 3/6] Moved the fix to the right place. Modified it to be a onliner. Commented it. Added 0 instead of NA to the missing columns. Included the same fix for pct2 (extremes). --- R/PlotForecastPDF.R | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/R/PlotForecastPDF.R b/R/PlotForecastPDF.R index dea6aa2d..7226212e 100644 --- a/R/PlotForecastPDF.R +++ b/R/PlotForecastPDF.R @@ -306,11 +306,13 @@ PlotForecastPDF <- function(fcst, tercile.limits, extreme.limits = NULL, obs = N tmp.dt <- data.table(tmp.df) pct <- tmp.dt[, .(pct = integrate(approxfun(x, ymax), lower = min(x), upper = max(x))$value), by = .(init, tercile)] + # include potentially missing groups + pct <- merge(pct, CJ(init = factor(levels(pct$init), levels = levels(pct$init)), + tercile = factor(c("Below normal", "Normal", "Above normal"), + levels = c("Below normal", "Normal", "Above normal"))), + by = c("init", "tercile"), all.y = T) + pct[is.na(pct),"pct"] <- 0 tot <- pct[, .(tot = sum(pct)), by = init] - aa <- CJ(factor(levels(pct$init), levels = levels(pct$init)), factor(c("Below normal", "Normal", "Above normal"), levels = c("Below normal", "Normal", "Above normal"))) -colnames(aa) <- c("init","tercile") - pctt <- merge(pct, aa, by=c("init","tercile"), all.y=T) - pct <- pctt pct <- merge(pct, tot, by = "init") pct$pct <- round(100 * pct$pct/pct$tot, 0) pct$MLT <- pct[, .(MLT = pct == max(pct)), by = init]$MLT @@ -321,15 +323,17 @@ colnames(aa) <- c("init","tercile") if (!is.null(extreme.limits)) { pct2 <- tmp.dt[, .(pct = integrate(approxfun(x, ymax), lower = min(x), upper = max(x))$value), by = .(init, extremes)] + # include potentially missing groups + pct2 <- merge(pct2, CJ(init = factor(levels(pct2$init), levels = levels(pct2$init)), + extremes = factor(c("Below P10", "Normal", "Above P90"), + levels = c("Below P10", "Normal", "Above P90"))), + by = c("init", "extremes"), all.y=T) + pct2[is.na(pct),"pct"] <- 0 tot2 <- pct2[, .(tot = sum(pct)), by = init] pct2 <- merge(pct2, tot2, by = "init") pct2$pct <- round(100 * pct2$pct/pct2$tot, 0) pct2$lab.pos <- as.vector(apply(extreme.limits, 1, function(x) {c(x[1], NA, x[2])})) pct2 <- merge(pct2, max.df, by = c("init", "extremes")) - # include potentially missing groups - pct2 <- pct2[CJ(factor(levels(pct2$init), levels = levels(pct2$init)), - factor(c("Below P10", "Normal", "Above P90"), - levels = c("Below P10", "Normal", "Above P90"))), ] } #------------------------ # Add probability labels for terciles -- GitLab From 30b6c2b36a6c5b59dce5fb16f712ffe2875f6730 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lloren=C3=A7=20Lled=C3=B3?= Date: Tue, 1 Sep 2020 16:35:55 +0200 Subject: [PATCH 4/6] After the previous fix of labels, the order of the fill colors needs to be reversed. --- R/PlotForecastPDF.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/PlotForecastPDF.R b/R/PlotForecastPDF.R index 7226212e..a2af8dd5 100644 --- a/R/PlotForecastPDF.R +++ b/R/PlotForecastPDF.R @@ -49,19 +49,19 @@ PlotForecastPDF <- function(fcst, tercile.limits, extreme.limits = NULL, obs = N #------------------------ color.set <- match.arg(color.set) if (color.set == "s2s4e") { - colorFill <- rev(c("#FF764D", "#b5b5b5", "#33BFD1")) + colorFill <- c("#FF764D", "#b5b5b5", "#33BFD1") colorHatch <- c("deepskyblue3", "indianred3") colorMember <- c("#ffff7f") colorObs <- "purple" colorLab <- c("blue", "red") } else if (color.set == "hydro") { - colorFill <- rev(c("#41CBC9", "#b5b5b5", "#FFAB38")) + colorFill <- c("#41CBC9", "#b5b5b5", "#FFAB38") colorHatch <- c("darkorange1", "deepskyblue3") colorMember <- c("#ffff7f") colorObs <- "purple" colorLab <- c("darkorange3", "blue") } else if (color.set == "ggplot") { - colorFill <- rev(ggColorHue(3)) + colorFill <- ggColorHue(3) colorHatch <- c("deepskyblue3", "indianred1") colorMember <- c("#ffff7f") colorObs <- "purple" -- GitLab From ea8da9956bd2b56fe3e6227e04e6482760843252 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lloren=C3=A7=20Lled=C3=B3?= Date: Wed, 2 Sep 2020 09:48:46 +0200 Subject: [PATCH 5/6] Fixed problem when merging a max.dt with less rows than pct2. --- R/PlotForecastPDF.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/PlotForecastPDF.R b/R/PlotForecastPDF.R index a2af8dd5..9cd4dfeb 100644 --- a/R/PlotForecastPDF.R +++ b/R/PlotForecastPDF.R @@ -333,7 +333,7 @@ PlotForecastPDF <- function(fcst, tercile.limits, extreme.limits = NULL, obs = N pct2 <- merge(pct2, tot2, by = "init") pct2$pct <- round(100 * pct2$pct/pct2$tot, 0) pct2$lab.pos <- as.vector(apply(extreme.limits, 1, function(x) {c(x[1], NA, x[2])})) - pct2 <- merge(pct2, max.df, by = c("init", "extremes")) + pct2 <- merge(pct2, max.df, by = c("init", "extremes"), all.x = T) } #------------------------ # Add probability labels for terciles -- GitLab From a3d932a837cbc62ed2c2b8aa6159698abaa7ec16 Mon Sep 17 00:00:00 2001 From: nperez Date: Mon, 26 Oct 2020 15:41:15 +0100 Subject: [PATCH 6/6] add tercile fix to News --- NEWS.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/NEWS.md b/NEWS.md index 722bd0e1..bcdf86dd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,9 @@ - New features: + PlotPDFsOLE includes parameters to modify legend style +- Fixes: + + PlotForecastPDF correctly displays terciles labels + ### CSTools 3.1.0 **Submission date to CRAN: 02-07-2020** -- GitLab