From f4b01611ad79d5a77b7e96e49a92f1ba6e883503 Mon Sep 17 00:00:00 2001 From: Viliam Simko Date: Mon, 2 May 2016 14:19:15 +0200 Subject: [PATCH 1/7] colorlegend refactoring --- R/colorlegend.R | 36 ++++++++++++++++++++++-------------- 1 file changed, 22 insertions(+), 14 deletions(-) diff --git a/R/colorlegend.R b/R/colorlegend.R index 2006da9..12fb145 100644 --- a/R/colorlegend.R +++ b/R/colorlegend.R @@ -20,20 +20,28 @@ #' @keywords hplot #' @author Taiyun Wei #' @export -colorlegend <- function(colbar, labels, at = NULL, - xlim = c(0, 1), ylim = c(0, 1), vertical = TRUE, ratio.colbar = 0.4, - lim.segment = NULL, align = c("c", "l", "r"), addlabels = TRUE, - ...) { - - if (is.null(at) & addlabels) { +colorlegend <- function( + colbar, + labels, + at = NULL, + xlim = c(0, 1), + ylim = c(0, 1), + vertical = TRUE, + ratio.colbar = 0.4, + lim.segment = NULL, + align = c("c", "l", "r"), + addlabels = TRUE, + ...) +{ + if (is.null(at) && addlabels) { at <- seq(0L, 1L, length = length(labels)) } if (is.null(lim.segment)) { - lim.segment <- ratio.colbar + c(0, ratio.colbar / 5) + lim.segment <- ratio.colbar + c(0, ratio.colbar * .2) } - if (any(at < 0L) | any(at > 1L)) { + if (any(at < 0L) || any(at > 1L)) { stop("at should be between 0 and 1") } @@ -57,11 +65,10 @@ colorlegend <- function(colbar, labels, at = NULL, rep(xlim[1] + xgap * rat1, len), yyy[-1], col = colbar, border = colbar) rect(xlim[1], ylim[1], xlim[1] + xgap * rat1, ylim[2], border = "black") - - pos.xlabel <- rep(xlim[1] + xgap * max(rat2, rat1), length(at)) segments(xlim[1] + xgap * rat2[1], at, xlim[1] + xgap * rat2[2], at) if (addlabels) { + pos.xlabel <- rep(xlim[1] + xgap * max(rat2, rat1), length(at)) switch(align, l = text(pos.xlabel, y = at, labels = labels, pos = 4, ...), r = text(xlim[2], y = at, labels = labels, pos = 2, ...), @@ -69,18 +76,19 @@ colorlegend <- function(colbar, labels, at = NULL, stop("programming error - should not have reached this line!") ) } - } + } else { - if (!vertical) { at <- at * xgap + xlim[1] xxx <- seq(xlim[1], xlim[2], length = len + 1) + rect(xxx[1:len], rep(ylim[2] - rat1 * ygap, len), - xxx[-1], rep(ylim[2], len), col = colbar, border = colbar) + xxx[-1], rep(ylim[2], len), + col = colbar, border = colbar) rect(xlim[1], ylim[2] - rat1 * ygap, xlim[2], ylim[2], border = "black") - pos.ylabel <- rep(ylim[2] - ygap * max(rat2, rat1), length(at)) segments(at, ylim[2] - ygap * rat2[1], at, ylim[2] - ygap * rat2[2]) if (addlabels) { + pos.ylabel <- rep(ylim[2] - ygap * max(rat2, rat1), length(at)) switch(align, l = text(x = at, y = pos.ylabel, labels = labels, pos = 1, ...), r = text(x = at, y = ylim[1], labels = labels, pos = 2, ...), From 05635c481c5c494722c19b6d686e647db6437ad0 Mon Sep 17 00:00:00 2001 From: Viliam Simko Date: Mon, 2 May 2016 14:25:43 +0200 Subject: [PATCH 2/7] corrRect.hclust refactoring --- R/corrRect.hclust.R | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/R/corrRect.hclust.R b/R/corrRect.hclust.R index 99d64e7..9624366 100644 --- a/R/corrRect.hclust.R +++ b/R/corrRect.hclust.R @@ -22,7 +22,11 @@ #' @keywords hplot #' @author Taiyun Wei #' @export -corrRect.hclust <- function(corr, k = 2, col = "black", lwd = 2, +corrRect.hclust <- function( + corr, + k = 2, + col = "black", + lwd = 2, method = c("complete", "ward", "ward.D", "ward.D2", "single", "average", "mcquitty", "median", "centroid") ) { @@ -32,7 +36,10 @@ corrRect.hclust <- function(corr, k = 2, col = "black", lwd = 2, hc <- cutree(tree, k = k) clustab <- table(hc)[unique(hc[tree$order])] cu <- c(0, cumsum(clustab)) - mat <- cbind(cu[-(k + 1)] + 0.5, n - cu[-(k + 1)] + 0.5, - cu[-1] + 0.5, n - cu[-1] + 0.5) - rect(mat[,1], mat[,2], mat[,3], mat[,4], border = col, lwd = lwd) + + rect(cu[-(k + 1)] + 0.5, + n - cu[-(k + 1)] + 0.5, + cu[-1] + 0.5, + n - cu[-1] + 0.5, + border = col, lwd = lwd) } From 5e2d7474b27e46d4ac642242c27f8e42315ae071 Mon Sep 17 00:00:00 2001 From: Viliam Simko Date: Mon, 6 Jun 2016 09:56:20 +0200 Subject: [PATCH 3/7] fixed minor typo in the test description --- tests/testthat/test-corrplot.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-corrplot.R b/tests/testthat/test-corrplot.R index 9b3e4e9..0241728 100644 --- a/tests/testthat/test-corrplot.R +++ b/tests/testthat/test-corrplot.R @@ -34,7 +34,7 @@ test_that("Issue #20: plotmath expressions in rownames / colnames", { corrplot(M) }) -test_that("Issues #21: plotCI=rect incompatible with some methods", { +test_that("Issue #21: plotCI=rect incompatible with some methods", { M <- cor(mtcars) L <- M - 0.1 U <- M + 0.1 From 73de0c9507d617efdc46bc789304f1ad1178c54f Mon Sep 17 00:00:00 2001 From: Viliam Simko Date: Mon, 6 Jun 2016 09:57:27 +0200 Subject: [PATCH 4/7] changed `[-1,1]` to `[0,1]` for `lim.segment` parameter + added param check --- R/colorlegend.R | 8 ++++++-- man/colorlegend.Rd | 2 +- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/R/colorlegend.R b/R/colorlegend.R index 12fb145..33e8536 100644 --- a/R/colorlegend.R +++ b/R/colorlegend.R @@ -10,7 +10,7 @@ #' @param ratio.colbar The width ratio of colorbar to the total colorlegend #' (including colorbar, segments and labels). #' @param lim.segment Vector (quantile) of length 2, the elements should be in -#' [-1,1], giving segments coordinates ranges. +#' [0,1], giving segments coordinates ranges. #' @param align Character, alignment type of labels, \code{"l"} means left, #' \code{"c"} means center and \code{"r"} right. #' @param addlabels Logical, whether add text label or not. @@ -45,7 +45,11 @@ colorlegend <- function( stop("at should be between 0 and 1") } - if (any(lim.segment < 0L) | any(lim.segment > 1L)) { + if (length(lim.segment) != 2) { + stop("lim.segment should be a vector of length 2") + } + + if (any(lim.segment < 0L) || any(lim.segment > 1L)) { stop("lim.segment should be between 0 and 1") } diff --git a/man/colorlegend.Rd b/man/colorlegend.Rd index ee63e2c..ba89e61 100644 --- a/man/colorlegend.Rd +++ b/man/colorlegend.Rd @@ -26,7 +26,7 @@ for details.} (including colorbar, segments and labels).} \item{lim.segment}{Vector (quantile) of length 2, the elements should be in -[-1,1], giving segments coordinates ranges.} +[0,1], giving segments coordinates ranges.} \item{align}{Character, alignment type of labels, \code{"l"} means left, \code{"c"} means center and \code{"r"} right.} From 884eee2f9b4cd0c8e5eb282ed0d7e92e9470f76b Mon Sep 17 00:00:00 2001 From: Viliam Simko Date: Mon, 6 Jun 2016 09:57:43 +0200 Subject: [PATCH 5/7] added test for lim.segment parameter --- tests/testthat/test-colorlegend.R | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/tests/testthat/test-colorlegend.R b/tests/testthat/test-colorlegend.R index a5b9348..4db202c 100644 --- a/tests/testthat/test-colorlegend.R +++ b/tests/testthat/test-colorlegend.R @@ -16,3 +16,26 @@ test_that("Calling colorlegend without first calling plot should fail", { expect_error(colorlegend(rainbow(100), 0:9), regexp = "plot.new has not been called yet") }) + +test_that("Issue #64: lim.segment in function colorlegend()", { + plot(0, type = "n") + + expect_error(colorlegend(rainbow(100), 0:9, lim.segment = 1), + regexp = "should be a vector of length 2") + + expect_error(colorlegend(rainbow(100), 0:9, lim.segment = c(1,2,3)), + regexp = "should be a vector of length 2") + + # lim.segment[1] >= 0 + expect_error(colorlegend(rainbow(100), 0:9, lim.segment = c(-0.1, 0)), + regexp = "should be between 0 and 1") + + # lim.segment[2] <= 1 + expect_error(colorlegend(rainbow(100), 0:9, lim.segment = c(0, 1.1)), + regexp = "should be between 0 and 1") + + # automatic lim.segment + expect_silent(colorlegend(rainbow(100), 0:9, lim.segment = NULL)) + + expect_silent(colorlegend(rainbow(100), 0:9, lim.segment = c(0,1))) +}) From 0fda7b38ca42898077f33249279428944328c0b8 Mon Sep 17 00:00:00 2001 From: Viliam Simko Date: Mon, 6 Jun 2016 09:58:40 +0200 Subject: [PATCH 6/7] updated version number --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0b046bc..d9b8511 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: corrplot Type: Package Title: Visualization of a Correlation Matrix -Version: 0.78 +Version: 0.79 Author: Taiyun Wei, Viliam Simko Suggests: seriation, From 0d65d39a18cdcec4633233fb0e5597982542513f Mon Sep 17 00:00:00 2001 From: Viliam Simko Date: Mon, 6 Jun 2016 10:17:25 +0200 Subject: [PATCH 7/7] added test for horizontal colorlegend and `at` parameter limits --- tests/testthat/test-colorlegend.R | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/tests/testthat/test-colorlegend.R b/tests/testthat/test-colorlegend.R index 4db202c..060e7c6 100644 --- a/tests/testthat/test-colorlegend.R +++ b/tests/testthat/test-colorlegend.R @@ -6,6 +6,7 @@ pdf(NULL) test_that("Basic usage of colorlegend", { plot(0, type = "n") expect_silent(colorlegend(rainbow(100), 0:9)) + expect_silent(colorlegend(rainbow(100), 0:9, vertical = FALSE)) }) test_that("Calling colorlegend without first calling plot should fail", { @@ -39,3 +40,12 @@ test_that("Issue #64: lim.segment in function colorlegend()", { expect_silent(colorlegend(rainbow(100), 0:9, lim.segment = c(0,1))) }) + +test_that("Parameter `at` should be between 0 and 1", { + plot(0, type = "n") + + expect_error(colorlegend(rainbow(100), 0:2, at = c(-1,.5,.8)), + regexp = "should be between 0 and 1") + + expect_silent(colorlegend(rainbow(100), 0:2, at = c(0,.5,.8))) +})