diff --git a/DESCRIPTION b/DESCRIPTION index 1cd7683..2ad364c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -18,8 +18,7 @@ Authors@R: role = c("aut")), person(given = "Jorge", family = "Cimentada", - role = c("aut")) - ) + role = c("aut"))) Depends: R (>= 3.3.0) Imports: diff --git a/NEWS.md b/NEWS.md index 3d036a9..6e2145e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -10,6 +10,10 @@ - New `colpair_map()` allows for column comparisons using the values returned by an arbitrary function (@jameslairdsmith, #94). +- `correlate()` now works with single-column data.frames and numeric vectors (@antoine-sachet, #122). Note the `diagonal` argument is ignored in these 2 cases. + +- `network_plot()` now works with `cor_df` objects with only 1 or 2 columns (@antoine-sachet, #122) + # corrr 0.4.2 - Updates to work with tibble 3.0.0 and dplyr 1.0.0 diff --git a/R/cor_df.R b/R/cor_df.R index 0d17de4..7f26bbc 100644 --- a/R/cor_df.R +++ b/R/cor_df.R @@ -5,7 +5,7 @@ as_matrix.cor_df <- function(x, diagonal) { # Separate rownames row_name <- x$rowname - x <- x[, colnames(x) != "rowname"] + x <- x[colnames(x) != "rowname"] # Convert to matrix and set rownames class(x) <- "data.frame" x <- as.matrix(x) @@ -22,7 +22,7 @@ shave.cor_df <- function(x, upper = TRUE) { # Separate rownames row_name <- x$rowname - x <- x[, colnames(x) != "rowname"] + x <- x[colnames(x) != "rowname"] # Remove upper matrix if (upper) { @@ -93,7 +93,7 @@ focus_if.cor_df <- function(x, .predicate, ..., mirror = FALSE) { # Identify which variables to keep to_keep <- map_lgl( - x[, colnames(x) != "rowname"], + x[colnames(x) != "rowname"], .predicate, ... ) @@ -192,8 +192,16 @@ network_plot.cor_df <- function(rdf, rdf <- as_matrix(rdf, diagonal = 1) distance <- 1 - abs(rdf) - # Use multidimensional Scaling to obtain x and y coordinates for points. - points <- suppressWarnings(stats::cmdscale(distance)) + points <- if (ncol(rdf) == 1) { + # 1 var: a single central point + matrix(c(0, 0), ncol = 2, dimnames = list(colnames(rdf))) + } else if (ncol(rdf) == 2) { + # 2 vars: 2 opposing points + matrix(c(0, -0.1, 0, 0.1), ncol = 2, dimnames = list(colnames(rdf))) + } else { + # More than 2 vars: multidimensional scaling to obtain x and y coordinates for points. + suppressWarnings(stats::cmdscale(distance, k = 2)) + } if(ncol(points) < 2){ diff --git a/R/reshape.R b/R/reshape.R index e50f3c9..5577c26 100644 --- a/R/reshape.R +++ b/R/reshape.R @@ -124,7 +124,7 @@ stretch <- function(x, na.rm = FALSE, remove.dups = FALSE) { stretch.cor_df <- function(x, na.rm = FALSE, remove.dups = FALSE) { if(remove.dups) x <- shave(x) row_name <- x$rowname - x <- x[, colnames(x) != "rowname"] + x <- x[colnames(x) != "rowname"] tb <- imap_dfr(x, ~tibble(x = .y, y = row_name, r = .x)) if(na.rm) tb <- tb[!is.na(tb$r), ] if(remove.dups) { diff --git a/R/utility.R b/R/utility.R index efef515..e09d70c 100644 --- a/R/utility.R +++ b/R/utility.R @@ -20,13 +20,13 @@ as_cordf <- function(x, diagonal = NA) { } x <- as.data.frame(x) row_name <- x$rowname - x <- x[, colnames(x) != "rowname"] + x <- x[colnames(x) != "rowname"] rownames(x) <- row_name if(ncol(x) != nrow(x)) { stop("Input object x is not a square. ", "The number of columns must be equal to the number of rows.") } - diag(x) <- diagonal + if (ncol(x) > 1) diag(x) <- diagonal new_cordf(x, names(x)) } diff --git a/tests/testthat/test-as_cordf.R b/tests/testthat/test-as_cordf.R index 3e4e0ca..34aab94 100644 --- a/tests/testthat/test-as_cordf.R +++ b/tests/testthat/test-as_cordf.R @@ -18,3 +18,9 @@ test_that("Diagonal sets correctly", { expect_equal(all(is.na(diag(as.matrix(as_cordf(d, diagonal = NA)[, -1])))), TRUE) expect_equal(all(diag(as.matrix(as_cordf(d, diagonal = 100)[, -1] == 100))), TRUE) }) + +test_that("as_cordf handles single correlation", { + d1 <- cor(mtcars["cyl"]) + expect_s3_class(as_cordf(d1), "cor_df") + expect_equal(colnames(as_cordf(d1)), c("rowname", colnames(d1))) +}) diff --git a/tests/testthat/test-correlate.R b/tests/testthat/test-correlate.R index ea970f1..5062d56 100644 --- a/tests/testthat/test-correlate.R +++ b/tests/testthat/test-correlate.R @@ -18,3 +18,16 @@ test_that("Diagonal sets correctly", { expect_equal(all(is.na(diag(as.matrix(correlate(d, diagonal = NA)[, -1])))), TRUE) expect_equal(all(diag(as.matrix(correlate(d, diagonal = 100)[, -1] == 100))), TRUE) }) + + +test_that("correlate works with numeric vectors", { + expect_equal(correlate(x = 1:10, y = 1:10)[[2]], 1) + expect_equal(correlate(x = 1:10, y = -(1:10), diagonal = 0)[[2]], -1) +}) + +test_that("correlate works with a one-column data.frame", { + var <- "Sepal.Length" + expect_equal(correlate(datasets::iris[var])[[1]], var) + expect_equal(correlate(datasets::iris[var])[[2]], 1) + +}) diff --git a/tests/testthat/test-plots.R b/tests/testthat/test-plots.R index 12265ae..4bb34f5 100644 --- a/tests/testthat/test-plots.R +++ b/tests/testthat/test-plots.R @@ -2,16 +2,30 @@ d <- datasets::anscombe[, 1:7] d[1, 1] <- NA d <- correlate(d) -context("network") +context("network_plot") test_that("Network plot works", { expect_s3_class(network_plot(d), "ggplot") expect_s3_class(network_plot(d, colors = c("indianred2", "white", "skyblue1")), "ggplot") }) + +test_that("Network plot works with 2 variables", { + d2 <- correlate(datasets::anscombe[c("x1", "y1")]) + + expect_s3_class(network_plot(d2), "ggplot") + expect_s3_class(network_plot(d2, colors = c("indianred2", "white", "skyblue1")), "ggplot") +}) + +test_that("Network plot works with 1 variable", { + d1 <- correlate(datasets::anscombe["x1"]) + expect_s3_class(network_plot(d1), "ggplot") + expect_s3_class(network_plot(d1, colors = c("indianred2", "white", "skyblue1")), "ggplot") +}) + context("rplot") -test_that("Network plot works", { +test_that("rplot works", { expect_s3_class(rplot(d), "ggplot") expect_s3_class(rplot(d, colors = c("indianred2", "white", "skyblue1")), "ggplot") })