[R-package] factor out lgb.check.r6.class() (#4343)

* [R-package] factor out lgb.check.r6.class()

* Predictor

R-package/R/lgb.Booster.R

@@ -45,7 +45,7 @@ Booster <- R6::R6Class(
         # Check if training dataset is not null
         if (!is.null(train_set)) {
           # Check if training dataset is lgb.Dataset or not
-          if (!lgb.check.r6.class(object = train_set, name = "lgb.Dataset")) {
+          if (!lgb.is.Dataset(train_set)) {
             stop("lgb.Booster: Can only use lgb.Dataset as training data")
           }
           train_set_handle <- train_set$.__enclos_env__$private$get_handle()
@@ -155,7 +155,7 @@ Booster <- R6::R6Class(
     add_valid = function(data, name) {
 
       # Check if data is lgb.Dataset
-      if (!lgb.check.r6.class(object = data, name = "lgb.Dataset")) {
+      if (!lgb.is.Dataset(data)) {
         stop("lgb.Booster.add_valid: Can only use lgb.Dataset as validation data")
       }
 
@@ -223,7 +223,7 @@ Booster <- R6::R6Class(
       if (!is.null(train_set)) {
 
         # Check if training set is lgb.Dataset
-        if (!lgb.check.r6.class(object = train_set, name = "lgb.Dataset")) {
+        if (!lgb.is.Dataset(train_set)) {
           stop("lgb.Booster.update: Only can use lgb.Dataset as training data")
         }
 
@@ -356,7 +356,7 @@ Booster <- R6::R6Class(
     eval = function(data, name, feval = NULL) {
 
       # Check if dataset is lgb.Dataset
-      if (!lgb.check.r6.class(object = data, name = "lgb.Dataset")) {
+      if (!lgb.is.Dataset(data)) {
         stop("lgb.Booster.eval: Can only use lgb.Dataset to eval")
       }
 

R-package/R/lgb.Dataset.R

@@ -38,10 +38,10 @@ Dataset <- R6::R6Class(
                           ...) {
 
       # validate inputs early to avoid unnecessary computation
-      if (!(is.null(reference) || lgb.check.r6.class(object = reference, name = "lgb.Dataset"))) {
+      if (!(is.null(reference) || lgb.is.Dataset(reference))) {
           stop("lgb.Dataset: If provided, reference must be a ", sQuote("lgb.Dataset"))
       }
-      if (!(is.null(predictor) || lgb.check.r6.class(object = predictor, name = "lgb.Predictor"))) {
+      if (!(is.null(predictor) || lgb.is.Predictor(predictor))) {
           stop("lgb.Dataset: If provided, predictor must be a ", sQuote("lgb.Predictor"))
       }
 
@@ -629,7 +629,7 @@ Dataset <- R6::R6Class(
       if (!is.null(reference)) {
 
         # Reference is unknown
-        if (!lgb.check.r6.class(object = reference, name = "lgb.Dataset")) {
+        if (!lgb.is.Dataset(reference)) {
           stop("set_reference: Can only use lgb.Dataset as a reference")
         }
 
@@ -699,7 +699,7 @@ Dataset <- R6::R6Class(
       if (!is.null(predictor)) {
 
         # Predictor is unknown
-        if (!lgb.check.r6.class(object = predictor, name = "lgb.Predictor")) {
+        if (!lgb.is.Predictor(predictor)) {
           stop("set_predictor: Can only use lgb.Predictor as predictor")
         }
 

R-package/R/utils.R

 lgb.is.Booster <- function(x) {
-  return(lgb.check.r6.class(object = x, name = "lgb.Booster"))
+  return(all(c("R6", "lgb.Booster") %in% class(x)))
 }
 
 lgb.is.Dataset <- function(x) {
-  return(lgb.check.r6.class(object = x, name = "lgb.Dataset"))
+  return(all(c("R6", "lgb.Dataset") %in% class(x)))
+}
+
+lgb.is.Predictor <- function(x) {
+  return(all(c("R6", "lgb.Predictor") %in% class(x)))
 }
 
 lgb.is.null.handle <- function(x) {
@@ -117,14 +121,6 @@ lgb.check_interaction_constraints <- function(interaction_constraints, column_na
 
 }
 
-
-lgb.check.r6.class <- function(object, name) {
-
-  # Check for non-existence of R6 class or named class
-  return(all(c("R6", name) %in% class(object)))
-
-}
-
 lgb.check.obj <- function(params, obj) {
 
   # List known objectives in a vector

R-package/tests/testthat/test_utils.R

-context("lgb.check.r6.class")
-
-test_that("lgb.check.r6.class() should return FALSE for NULL input", {
-    expect_false(lgb.check.r6.class(NULL, "lgb.Dataset"))
-})
-
-test_that("lgb.check.r6.class() should return FALSE for non-R6 inputs", {
-    x <- 5L
-    class(x) <- "lgb.Dataset"
-    expect_false(lgb.check.r6.class(x, "lgb.Dataset"))
-})
-
-test_that("lgb.check.r6.class() should correctly identify lgb.Dataset", {
-
-    data("agaricus.train", package = "lightgbm")
-    train <- agaricus.train
-    ds <- lgb.Dataset(train$data, label = train$label)
-    expect_true(lgb.check.r6.class(ds, "lgb.Dataset"))
-    expect_false(lgb.check.r6.class(ds, "lgb.Predictor"))
-    expect_false(lgb.check.r6.class(ds, "lgb.Booster"))
-})
-
 context("lgb.params2str")
 
 test_that("lgb.params2str() works as expected for empty lists", {