# tests/testthat/test-greenclust-main.R In JeffJetton/greenclust: Combine Categories Using Greenacre's Method

```context("greenclust (main function)")
library(greenclust)

# Test matrix
m <- matrix(c(1:15, rep(c(0, 20, 25), 5), 45:31), ncol=3)
colnames(m) <- c("yes", "no", "unknown")
rownames(m) <- state.name[seq(3, by=3, length.out=nrow(m))]

test_that("greenclust stops when x has dimensions less than 3x2", {
expect_error(greenclust(matrix(c(4, 8), nrow=1)), "rows")
expect_error(greenclust(matrix(c(4, 8), ncol=1)), "rows")
expect_error(greenclust(matrix(1:4, ncol=2)), "rows")
expect_error(greenclust(matrix(1:8, ncol=1)), "columns")
})

test_that("greenclust stops when x is not a matrix or data frame", {
expect_error(greenclust(NULL), "non-null", fixed=TRUE)
expect_error(greenclust(NA), "non-null", fixed=TRUE)
expect_error(greenclust(matrix(c(1:3, NA, 5:7, NA, 9), ncol=3)),
"non-null", fixed=TRUE)
expect_error(greenclust("abc"), "matrix")
expect_error(greenclust(c("a", "b", "c"), "matrix"))
expect_error(greenclust(c("a", "b", "c"), "matrix"))
expect_error(greenclust(1:20), "matrix")
expect_error(greenclust(list(a=matrix(1:6, ncol=2),
b=matrix(1:12, ncol=3))), "matrix")
})

test_that("greenclust stops when x is non-numeric or has negative/non-finite values", {
expect_error(greenclust(matrix(rep("foo", 20), ncol=4)), "numeric")
expect_error(greenclust(matrix(c(1:3, NaN, 5:8, NaN), ncol=3)), "x must be")
expect_error(greenclust(matrix(-10:9, ncol=4)), "negative")
expect_error(greenclust(matrix(c(-Inf, 1:7, Inf), ncol=3)), "finite")
})

test_that("greenclust stops when x has negative row or column sums", {
expect_error(greenclust(matrix(c(0:4, 0, 10:13), ncol=2)),
"all row totals must be greater than zero")
expect_error(greenclust(matrix(c(rep(0, 5), 1:10), ncol=3)),
"all column totals must be greater than zero")
})

test_that("greenclust creates rownames when none are provided", {
g <- greenclust(matrix(1:12, ncol=2))
expect_equal(g\$labels, as.character(1:6))
})

test_that("greenclust returns a valid greenclust/hclust object", {
g <- greenclust(m)
expect_is(g, "greenclust")
expect_is(g, "hclust")
expect_output(str(g), "List of 8")
expect_output(str(g), "\\\$ height +: num \\[1\\:")
expect_output(str(g), "\\\$ order +: int \\[1\\:")
expect_output(str(g), "\\\$ labels +: chr \\[1\\:")
expect_output(str(g), "\\\$ call +: language greenclust\\(x = m\\)")
expect_output(str(g), "\\\$ dist.method: chr")
expect_output(str(g), "\\\$ p.values +: num \\[1\\:")
expect_output(str(g), "\\\$ tie +: logi \\[1\\:")
expect_equal(ncol(g\$merge), 2)
expect_equal(length(g\$height), length(g\$tie))
expect_equal(length(g\$order), length(g\$labels))
expect_equal(nrow(g\$merge), length(g\$p.values) + 1)
})

test_that("greenclust works when verbose=TRUE", {
expect_output(greenclust(matrix(1:6, ncol=2), verbose=TRUE),
"Step 1\\:")
expect_output(greenclust(matrix(1:6, ncol=2), verbose=TRUE),
"Cluster 1")
})

test_that("greenclust gives expected results on a test matrix", {
g <- greenclust(m)
expect_equal(length(unique(g\$order)), nrow(m))
expect_equal(min(g\$order), 1)
expect_equal(max(g\$order), nrow(m))
# We don't really care about the order of the merged rows...
expect_equal(g\$merge[1, ] %in% c(-14, -15), c(TRUE, TRUE))
expect_equal(g\$merge[14, ] %in% c(12, 13), c(TRUE, TRUE))
expect_equal(sum(g\$tie), 1)
expect_equal(round(min(log(g\$p.values))), -59)
expect_equal(round(sum(g\$height) * 100), 183)
})

test_that("greenclust gives expected results when being passed a data frame", {
df <- as.data.frame(m)
g <- greenclust(df)
expect_equal(length(unique(g\$order)), nrow(df))
expect_equal(min(g\$order), 1)
expect_equal(max(g\$order), nrow(df))
# We don't really care about the order of the merged rows...
expect_equal(g\$merge[1, ] %in% c(-14, -15), c(TRUE, TRUE))
expect_equal(g\$merge[14, ] %in% c(12, 13), c(TRUE, TRUE))
expect_equal(sum(g\$tie), 1)
expect_equal(round(min(log(g\$p.values))), -59)
expect_equal(round(sum(g\$height) * 100), 183)
})

test_that("greenclust correctly handles Yates's correction", {
m2 <- matrix(c(10, 10, 90, 40, 20, 20), nrow=3)
g <- greenclust(m2, correct=TRUE)
# This is what the table should be once it gets to 2x2...
m3 <- matrix(c(90, 20, 20, 60), nrow=2)
suppressWarnings(p <- chisq.test(m3)\$p.value)
expect_equal(g\$p.values, p)
})
```
JeffJetton/greenclust documentation built on Oct. 27, 2019, 9:36 a.m.