[R-package] Add tests on lgb.check.eval, lgb.unloader, and lgb.encode.char (#3235)

* [R-package] Add tests on lgb.check.eval, lgb.unloader, and lgb.encode.char

* remove accidental test file

* regenerated docs

R-package/DESCRIPTION

@@ -39,4 +39,4 @@ Imports:
     utils
 SystemRequirements:
     C++11
-RoxygenNote: 7.1.0
+RoxygenNote: 7.1.1

R-package/R/lgb.unloader.R

 #' @name lgb.unloader
-#' @title LightGBM unloading error fix
+#' @title Remove lightgbm and its objects from an environment
 #' @description Attempts to unload LightGBM packages so you can remove objects cleanly without
 #'              having to restart R. This is useful for instance if an object becomes stuck for no
 #'              apparent reason and you do not want to restart R to fix the lost object.
@@ -69,6 +69,6 @@ lgb.unloader <- function(restore = TRUE, wipe = FALSE, envir = .GlobalEnv) {
     library(lightgbm)
   }
 
-  invisible()
+  return(invisible(NULL))
 
 }

R-package/R/utils.R

@@ -11,12 +11,10 @@ lgb.is.null.handle <- function(x) {
 }
 
 lgb.encode.char <- function(arr, len) {
-
   if (!is.raw(arr)) {
-    stop("lgb.encode.char: Can only encode from raw type") # Not an object of type raw
+    stop("lgb.encode.char: Can only encode from raw type")
   }
-  rawToChar(arr[seq_len(len)]) # Return the conversion of raw type to character type
-
+  return(rawToChar(arr[seq_len(len)]))
 }
 
 # [description] Raise an error. Before raising that error, check for any error message
@@ -311,17 +309,26 @@ lgb.check.obj <- function(params, obj) {
 
 }
 
+# [description]
+#     make sure that "metric" is populated on params,
+#     and add any eval values to itt
+# [return]
+#     params, where "metric" is a list
 lgb.check.eval <- function(params, eval) {
 
-  # Check if metric is null, if yes put a list instead
   if (is.null(params$metric)) {
     params$metric <- list()
+  } else if (is.character(params$metric)) {
+    params$metric <- as.list(params$metric)
   }
 
-  # If 'eval' is a list or character vector, store it in 'metric'
-  if (is.character(eval) || identical(class(eval), "list")) {
+  if (is.character(eval)) {
     params$metric <- append(params$metric, eval)
   }
 
+  if (identical(class(eval), "list")) {
+    params$metric <- append(params$metric, unlist(eval))
+  }
+
   return(params)
 }

R-package/man/lgb.unloader.Rd

@@ -2,7 +2,7 @@
 % Please edit documentation in R/lgb.unloader.R
 \name{lgb.unloader}
 \alias{lgb.unloader}
-\title{LightGBM unloading error fix}
+\title{Remove lightgbm and its objects from an environment}
 \usage{
 lgb.unloader(restore = TRUE, wipe = FALSE, envir = .GlobalEnv)
 }

R-package/tests/testthat/test_lgb.unloader.R

+context("lgb.unloader")
+
+test_that("lgb.unloader works as expected", {
+    data(agaricus.train, package = "lightgbm")
+    train <- agaricus.train
+    dtrain <- lgb.Dataset(train$data, label = train$label)
+    bst <- lgb.train(
+        params = list(
+            objective = "regression"
+            , metric = "l2"
+        )
+        , data = dtrain
+        , nrounds = 1L
+        , min_data = 1L
+        , learning_rate = 1.0
+    )
+    expect_true(exists("bst"))
+    result <- lgb.unloader(restore = TRUE, wipe = TRUE, envir = environment())
+    expect_false(exists("bst"))
+    expect_null(result)
+})
+
+test_that("lgb.unloader finds all boosters and removes them", {
+    data(agaricus.train, package = "lightgbm")
+    train <- agaricus.train
+    dtrain <- lgb.Dataset(train$data, label = train$label)
+    bst1 <- lgb.train(
+        params = list(
+            objective = "regression"
+            , metric = "l2"
+        )
+        , data = dtrain
+        , nrounds = 1L
+        , min_data = 1L
+        , learning_rate = 1.0
+    )
+    bst2 <- lgb.train(
+        params = list(
+            objective = "regression"
+            , metric = "l2"
+        )
+        , data = dtrain
+        , nrounds = 1L
+        , min_data = 1L
+        , learning_rate = 1.0
+    )
+    expect_true(exists("bst1"))
+    expect_true(exists("bst2"))
+    lgb.unloader(restore = TRUE, wipe = TRUE, envir = environment())
+    expect_false(exists("bst1"))
+    expect_false(exists("bst2"))
+})

R-package/tests/testthat/test_utils.R

+context("lgb.encode.char")
+
+test_that("lgb.encode.char throws an informative error if it is passed a non-raw input", {
+    x <- "some-string"
+    expect_error({
+        lgb.encode.char(x)
+    }, regexp = "Can only encode from raw type")
+})
+
 context("lgb.check.r6.class")
 
 test_that("lgb.check.r6.class() should return FALSE for NULL input", {
@@ -68,3 +77,50 @@ test_that("lgb.last_error() correctly returns errors from the C++ side", {
         dvalid1$construct()
     }, regexp = "[LightGBM] [Fatal] Length of label is not same with #data", fixed = TRUE)
 })
+
+context("lgb.check.eval")
+
+test_that("lgb.check.eval works as expected with no metric", {
+    params <- lgb.check.eval(
+        params = list(device = "cpu")
+        , eval = "binary_error"
+    )
+    expect_named(params, c("device", "metric"))
+    expect_identical(params[["metric"]], list("binary_error"))
+})
+
+test_that("lgb.check.eval adds eval to metric in params", {
+    params <- lgb.check.eval(
+        params = list(metric = "auc")
+        , eval = "binary_error"
+    )
+    expect_named(params, "metric")
+    expect_identical(params[["metric"]], list("auc", "binary_error"))
+})
+
+test_that("lgb.check.eval adds eval to metric in params", {
+    params <- lgb.check.eval(
+        params = list(metric = "auc")
+        , eval = "binary_error"
+    )
+    expect_named(params, "metric")
+    expect_identical(params[["metric"]], list("auc", "binary_error"))
+})
+
+test_that("lgb.check.eval adds eval to metric in params if two evaluation names are provided", {
+    params <- lgb.check.eval(
+        params = list(metric = "auc")
+        , eval = c("binary_error", "binary_logloss")
+    )
+    expect_named(params, "metric")
+    expect_identical(params[["metric"]], list("auc", "binary_error", "binary_logloss"))
+})
+
+test_that("lgb.check.eval adds eval to metric in params if a list is provided", {
+    params <- lgb.check.eval(
+        params = list(metric = "auc")
+        , eval = list("binary_error", "binary_logloss")
+    )
+    expect_named(params, "metric")
+    expect_identical(params[["metric"]], list("auc", "binary_error", "binary_logloss"))
+})