Merge pull request #93 from selkamand/7-add-unit-tests

7 add unit tests

R/gg1d.R

@@ -113,7 +113,8 @@ gg1d <- function(
     data[[col_id]] <- seq_len(nrow(data))
   } else {
     assertions::assert_string(col_id)
-    assertions::assert_names_include(data, names = col_id)
+    assertions::assert_names_include(data, names = col_id, msg = "Column {.code {col_id}} does not exist in your dataset. Please set the {.arg col_id} argument to a valid column name.")
+    assertions::assert_no_duplicates(data[[col_id]])
   }
 
 
@@ -148,7 +149,7 @@ gg1d <- function(
     if (verbose >=1) cli::cli_alert_info("Sorting X axis by: Order of appearance")
   } else {
     assertions::assert_string(col_sort)
-    assertions::assert_names_include(data, names = col_sort)
+    assertions::assert_names_include(data, names = col_sort, msg = "Column {.code {col_sort}} does not exist in your dataset. Please set the {.arg col_sort} argument to a valid column name.")
 
     if(verbose >=1){ cli::cli_bullets(c(
       "*" = "Sorting X axis by: {.strong {col_sort}}",
@@ -520,7 +521,6 @@ choose_colours <- function(data, palettes, plottable, ndistinct, coltype, colour
     }
     })
 
-
   return(colors)
 
 }

R/gg1d_options.R

@@ -96,7 +96,7 @@ gg1d_options <- function(
   if (!is.null(legend_ncol)) assertions::assert_number(legend_ncol)
   if (!is.null(legend_title_size)) assertions::assert_number(legend_title_size)
   if(!is.null(legend_ncol) & !is.null(legend_nrow)) {
-    cli::cli_alert_warning("Both {.arg legend_ncol} and {.arg legend_nrow} were supplied. {.arg legend_nrow} will be ignored.  Explicitly set one of these arguments to NULL to avoid this warning message")
+    cli::cli_warn(c("!"="Both {.arg legend_ncol} and {.arg legend_nrow} were supplied. {.arg legend_nrow} will be ignored.  Explicitly set one of these arguments to NULL to avoid this warning message"))
     legend_nrow <- NULL
   }
 

tests/testthat/test-gg1d.R

@@ -41,3 +41,118 @@ cli::test_that_cli("gg1d doesn't warn about columns the user isn't interested in
 })
 
 
+
+# Newtests ----------------------------------------------------------------
+
+# Mock Data
+mock_data <- data.frame(
+  ID = 1:10,
+  Category = rep(c("A", "B", "C", "D", "E"), 2),
+  Numeric = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10),
+  Logical = c(TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, FALSE, FALSE, TRUE, FALSE),
+  Tooltip = letters[1:10],
+  stringsAsFactors = FALSE
+)
+
+# Core Tests
+test_that("gg1d returns a plot object", {
+  result <- expect_no_error(gg1d(data = mock_data, col_id = "ID", verbose = FALSE))
+  expect_s3_class(result, "girafe") # Assuming the output is interactive by default
+})
+
+test_that("gg1d handles missing col_id gracefully", {
+  result <- expect_no_error(gg1d(data = mock_data, verbose = FALSE))
+  expect_s3_class(result, "girafe")
+})
+
+test_that("gg1d filters columns based on maxlevels", {
+  result <- gg1d(data = mock_data, maxlevels = 4, debug_return_col_info = TRUE, verbose = FALSE)
+  expect_false("Category" %in% result$colnames[result$plottable])
+})
+
+test_that("gg1d applies ignore_column_regex", {
+  data <- mock_data
+  colnames(data)[2] <- "IgnoreMe_ignore"
+  result <- gg1d(data = data, debug_return_col_info = TRUE, verbose = FALSE)
+  expect_false("IgnoreMe_ignore" %in% result$colnames[result$plottable])
+})
+
+test_that("gg1d limits the number of plottable columns", {
+  data <- mock_data
+  for (i in 1:20) {
+    data[[paste0("Col", i)]] <- rnorm(10)
+  }
+  expect_error(
+    gg1d(data = data, max_plottable_cols = 10, verbose = FALSE),
+    "Autoplotting > 10 fields by `gg1d` is not recommended"
+  )
+})
+
+test_that("gg1d validates palettes input", {
+  palettes <- list(
+    Category = c(A = "red", B = "green", C="blue", D="black", E="purple")
+  )
+  result <- gg1d(data = mock_data, palettes = palettes, debug_return_col_info = TRUE, verbose = FALSE)
+  expect_equal(result$palette[[which(result$colnames == "Category")]], palettes$Category)
+
+  # Throws error if missing colours for any values
+  palettes_incomplete <- list(
+    Category = c(A = "red", B = "green", C="blue", D="black", "purple")
+  )
+  expect_error(gg1d(data = mock_data, palettes = palettes_incomplete, verbose = FALSE), "missing 1 required name: `E`")
+
+})
+
+
+test_that("gg1d raises error for invalid column inputs", {
+  expect_error(gg1d(data = mock_data, col_sort = "NonExistentCol", verbose = FALSE), "Column `NonExistentCol` does not exist in your dataset. Please set the `col_sort` argument to a valid column name.")
+  expect_error(gg1d(data = mock_data, col_id = "NonExistentCol", verbose = FALSE), "Column `NonExistentCol` does not exist in your dataset. Please set the `col_id` argument to a valid column name.")
+})
+
+
+test_that("gg1d returns column information when debug_return_col_info is TRUE", {
+  result <- gg1d(data = mock_data, debug_return_col_info = TRUE, verbose = FALSE)
+  expect_s3_class(result, "data.frame")
+  expect_true(all(c("colnames", "coltype", "plottable", "palette") %in% colnames(result)))
+})
+
+test_that("gg1d handles logical columns with default logical colors", {
+  result <- gg1d(data = mock_data, debug_return_col_info = TRUE, verbose = FALSE)
+  expect_equal(
+    result$palette[[which(result$colnames == "Logical")]],
+    c("TRUE" = "#648fff", "FALSE" = "#dc267f")
+  )
+})
+
+
+test_that("gg1d gracefully handles non-plottable datasets", {
+  data <- data.frame(category = LETTERS)
+  expect_error(gg1d(data = data, verbose = FALSE), "No plottable columns found")
+})
+
+
+# Edge Cases
+test_that("gg1d warns about too many unique levels in categorical data", {
+  data <- data.frame(ID = 1:10, TooManyLevels = as.factor(1:10))
+  suppressMessages(expect_message(
+    gg1d(data = data, maxlevels = 5, debug_return_col_info = TRUE, verbose = TRUE),
+    "must have <= 5 unique values"
+  ))
+})
+
+
+test_that("gg1d can handle interactive and static plot settings", {
+  interactive_plot <- gg1d(data = mock_data, interactive = TRUE, verbose = FALSE)
+  expect_s3_class(interactive_plot, "girafe")
+
+  static_plot <- gg1d(data = mock_data, interactive = FALSE, verbose = FALSE)
+  expect_s3_class(static_plot, "ggplot")
+})
+
+#
+test_that("gg1d correctly applies column tooltips", {
+  data <- mock_data
+  colnames(data)[5] <- "Category_tooltip"
+  result <- gg1d(data = data, debug_return_col_info = TRUE, verbose = FALSE)
+  expect_equal(result$coltooltip[[which(result$colnames == "Category")]], "Category_tooltip")
+})

tests/testthat/test-gg1d_options.R

@@ -0,0 +1,43 @@
+test_that("gg1d_options returns a list with the correct structure", {
+
+  # Runs without error
+  expect_no_error(gg1d_options())
+
+  opts <- gg1d_options()
+
+  # Class Checks
+  expect_type(opts, "list")
+  expect_s3_class(opts, "gg1d_options")
+})
+
+test_that("gg1d_options handles legend_nrow and legend_ncol conflict", {
+
+  # Warn user they constrained both legend rows and columns (and that only legend_ncol will be used)
+  expect_warning(gg1d_options(legend_nrow = 2, legend_ncol = 3), regexp = "[bB]oth.* were supplied")
+
+
+  opts <- suppressWarnings(gg1d_options(legend_nrow = 2, legend_ncol = 3))
+
+  expect_null(opts$legend_nrow)
+  expect_equal(opts$legend_ncol, 3)
+})
+
+test_that("gg1d_options validates argument types correctly", {
+  expect_error(gg1d_options(show_legend = "not a boolean"), "show_legend")
+  expect_error(gg1d_options(legend_key_size = "not a number"), "legend_key_size")
+})
+
+test_that("gg1d_options warns if legend_nrow and legend_ncol are both set", {
+  expect_warning(gg1d_options(legend_nrow = 2, legend_ncol = 3), "legend_nrow")
+})
+
+
+test_that("gg1d_options correctly matches argument values", {
+  opts <- gg1d_options(legend_position = "left", transform_heatmap = "log10")
+  expect_equal(opts$legend_position, "left")
+  expect_equal(opts$transform_heatmap, "log10")
+
+  expect_error(gg1d_options(legend_position = "middle"), "legend_position")
+  expect_error(gg1d_options(transform_heatmap = "logarithm"), "transform_heatmap")
+})
+