tests/testthat/test-ggmatrix_location.R

In ggobi/ggally: Extension to 'ggplot2'

expect_loc_grid <- function(loc, to_loc) {
  testthat::expect_equal(
    colnames(loc),
    colnames(to_loc)
  )
  testthat::expect_equal(
    nrow(loc),
    nrow(to_loc)
  )
  loc <- loc[order(loc$row, loc$col), ]
  to_loc <- to_loc[order(to_loc$row, to_loc$col), ]
  testthat::expect_equal(
    loc$row,
    to_loc$row
  )
  testthat::expect_equal(
    loc$col,
    to_loc$col
  )
}
expect_rows_cols <- function(loc, rows, cols) {
  to_loc <- expand.grid(row = rows, col = cols)
  expect_loc_grid(loc, to_loc)
}

test_that("rows work", {
  pm <- ggpairs(tips)

  expect_rows_cols(
    ggmatrix_location(pm, rows = c(3, 5)),
    rows = c(3, 5),
    cols = 1:7
  )
  expect_rows_cols(
    ggmatrix_location(pm, rows = 1),
    rows = 1,
    cols = 1:7
  )

  expect_error(
    ggmatrix_location(pm, rows = TRUE),
    "numeric"
  )
  expect_error(
    ggmatrix_location(pm, rows = "1"),
    "numeric"
  )
})


test_that("cols work", {
  pm <- ggpairs(tips)

  expect_rows_cols(
    ggmatrix_location(pm, cols = c(3, 5)),
    rows = 1:7,
    cols = c(3, 5)
  )
  expect_rows_cols(
    ggmatrix_location(pm, cols = 1),
    rows = 1:7,
    cols = 1
  )

  expect_error(
    ggmatrix_location(pm, cols = TRUE),
    "numeric"
  )
  expect_error(
    ggmatrix_location(pm, cols = "1"),
    "numeric"
  )
})


test_that("location logical", {
  pm <- ggpairs(tips)

  expect_loc_grid(
    ggmatrix_location(pm, location = TRUE),
    expand.grid(row = 1:7, col = 1:7)
  )
  expect_warning(
    ggmatrix_location(pm, location = FALSE)
  )
})

test_that("location character", {
  pm <- ggpairs(tips)
  to_loc <- expand.grid(row = 1:7, col = 1:7)

  expect_loc_grid(
    ggmatrix_location(pm, location = "all"),
    to_loc
  )
  expect_loc_grid(
    ggmatrix_location(pm, location = "none"),
    subset(to_loc, FALSE)
  )
  expect_loc_grid(
    ggmatrix_location(pm, location = "upper"),
    subset(to_loc, col > row)
  )
  expect_loc_grid(
    ggmatrix_location(pm, location = "lower"),
    subset(to_loc, col < row)
  )
  expect_loc_grid(
    ggmatrix_location(pm, location = "diag"),
    subset(to_loc, col == row)
  )

  expect_error(
    ggmatrix_location(pm, location = "unknown")
  )
})


test_that("location matrix", {
  pm <- ggpairs(tips)
  to_loc <- subset(expand.grid(row = 1:7, col = 1:7), row %in% c(3, 5) | col %in% c(3, 5))

  mat <- matrix(FALSE, nrow = 7, ncol = 7, byrow = TRUE)
  mat[, c(3, 5)] <- TRUE
  mat[c(3, 5), ] <- TRUE

  expect_loc_grid(
    ggmatrix_location(pm, location = mat),
    to_loc
  )
  expect_loc_grid(
    ggmatrix_location(pm, location = as.data.frame(mat)),
    to_loc
  )

  mat2 <- mat
  mat2[TRUE] <- FALSE
  expect_loc_grid(
    ggmatrix_location(pm, location = mat2),
    subset(to_loc, FALSE)
  )

  expect_error(
    ggmatrix_location(pm, location = mat[, 1:6])
  )
  expect_error(
    ggmatrix_location(pm, location = mat[1:6, ])
  )
  expect_error(
    ggmatrix_location(pm, location = cbind(mat, 1))
  )
  expect_error(
    ggmatrix_location(pm, location = rbind(mat, 1))
  )
})



test_that("location matrix", {
  pm <- ggpairs(tips)
  to_loc <- expand.grid(row = 1:7, col = 1:7)

  expect_loc_grid(
    ggmatrix_location(pm),
    expand.grid(row = 1:7, col = 1:7)
  )

  expect_error(
    ggmatrix_location(pm, location = expand.grid(row = 1:7, col = 2:8))
  )
  expect_error(
    ggmatrix_location(pm, location = expand.grid(row = 2:8, col = 1:7))
  )

  expect_error(
    ggmatrix_location(pm, location = expand.grid(row = 1:7, col = 0:6))
  )
  expect_error(
    ggmatrix_location(pm, location = expand.grid(row = 0:6, col = 1:7))
  )

  expect_error(
    ggmatrix_location(pm, location = expand.grid(row = 1:7, col = c(1:6, NA)))
  )
  expect_error(
    ggmatrix_location(pm, location = expand.grid(row = c(1:6, NA), col = 1:7))
  )
})


test_that("location recursion", {
  pm <- ggpairs(tips)
  to_loc <- expand.grid(row = 1:7, col = 1:7)

  expect_loc_grid(
    ggmatrix_location(pm),
    expand.grid(row = 1:7, col = 1:7)
  )

  expect_loc_grid(
    ggmatrix_location(pm, location = ggmatrix_location(pm)),
    expand.grid(row = 1:7, col = 1:7)
  )
})