diff --git a/R-package/R/lgb.Booster.R b/R-package/R/lgb.Booster.R index dc912477cd76..5aa02599606f 100644 --- a/R-package/R/lgb.Booster.R +++ b/R-package/R/lgb.Booster.R @@ -16,7 +16,12 @@ Booster <- R6::R6Class( if (!lgb.is.null.handle(x = private$handle)) { # Freeing up handle - lgb.call(fun_name = "LGBM_BoosterFree_R", ret = NULL, private$handle) + call_state <- 0L + .Call( + LGBM_BoosterFree_R + , private$handle + , call_state + ) private$handle <- NULL } @@ -49,11 +54,13 @@ Booster <- R6::R6Class( params <- modifyList(params, train_set$get_params()) params_str <- lgb.params2str(params = params) # Store booster handle - handle <- lgb.call( - fun_name = "LGBM_BoosterCreate_R" - , ret = handle + call_state <- 0L + .Call( + LGBM_BoosterCreate_R , train_set_handle , params_str + , handle + , call_state ) # Create private booster information @@ -66,11 +73,12 @@ Booster <- R6::R6Class( if (!is.null(private$init_predictor)) { # Merge booster - lgb.call( - fun_name = "LGBM_BoosterMerge_R" - , ret = NULL + call_state <- 0L + .Call( + LGBM_BoosterMerge_R , handle , private$init_predictor$.__enclos_env__$private$handle + , call_state ) } @@ -86,10 +94,12 @@ Booster <- R6::R6Class( } # Create booster from model - handle <- lgb.call( - fun_name = "LGBM_BoosterCreateFromModelfile_R" - , ret = handle + call_state <- 0L + .Call( + LGBM_BoosterCreateFromModelfile_R , lgb.c_str(x = modelfile) + , handle + , call_state ) } else if (!is.null(model_str)) { @@ -100,10 +110,12 @@ Booster <- R6::R6Class( } # Create booster from model - handle <- lgb.call( - fun_name = "LGBM_BoosterLoadModelFromString_R" - , ret = handle + call_state <- 0L + .Call( + LGBM_BoosterLoadModelFromString_R , lgb.c_str(x = model_str) + , handle + , call_state ) } else { @@ -129,10 +141,12 @@ Booster <- R6::R6Class( class(handle) <- "lgb.Booster.handle" private$handle <- handle private$num_class <- 1L - private$num_class <- lgb.call( - fun_name = "LGBM_BoosterGetNumClasses_R" - , ret = private$num_class + call_state <- 0L + .Call( + LGBM_BoosterGetNumClasses_R , private$handle + , private$num_class + , call_state ) } @@ -174,11 +188,12 @@ Booster <- R6::R6Class( } # Add validation data to booster - lgb.call( - fun_name = "LGBM_BoosterAddValidData_R" - , ret = NULL + call_state <- 0L + .Call( + LGBM_BoosterAddValidData_R , private$handle , data$.__enclos_env__$private$get_handle() + , call_state ) # Store private information @@ -201,11 +216,12 @@ Booster <- R6::R6Class( params <- modifyList(params, list(...)) params_str <- lgb.params2str(params = params) - lgb.call( - fun_name = "LGBM_BoosterResetParameter_R" - , ret = NULL + call_state <- 0L + .Call( + LGBM_BoosterResetParameter_R , private$handle , params_str + , call_state ) self$params <- params @@ -236,11 +252,12 @@ Booster <- R6::R6Class( } # Reset training data on booster - lgb.call( - fun_name = "LGBM_BoosterResetTrainingData_R" - , ret = NULL + call_state <- 0L + .Call( + LGBM_BoosterResetTrainingData_R , private$handle , train_set$.__enclos_env__$private$get_handle() + , call_state ) # Store private train set @@ -255,10 +272,11 @@ Booster <- R6::R6Class( stop("lgb.Booster.update: cannot update due to null objective function") } # Boost iteration from known objective - ret <- lgb.call( - fun_name = "LGBM_BoosterUpdateOneIter_R" - , ret = NULL + call_state <- 0L + .Call( + LGBM_BoosterUpdateOneIter_R , private$handle + , call_state ) } else { @@ -281,13 +299,14 @@ Booster <- R6::R6Class( } # Return custom boosting gradient/hessian - ret <- lgb.call( - fun_name = "LGBM_BoosterUpdateOneIterCustom_R" - , ret = NULL + call_state <- 0L + .Call( + LGBM_BoosterUpdateOneIterCustom_R , private$handle , gpair$grad , gpair$hess , length(gpair$grad) + , call_state ) } @@ -297,7 +316,7 @@ Booster <- R6::R6Class( private$is_predicted_cur_iter[[i]] <- FALSE } - return(ret) + return(invisible(self)) }, @@ -305,10 +324,11 @@ Booster <- R6::R6Class( rollback_one_iter = function() { # Return one iteration behind - lgb.call( - fun_name = "LGBM_BoosterRollbackOneIter_R" - , ret = NULL + call_state <- 0L + .Call( + LGBM_BoosterRollbackOneIter_R , private$handle + , call_state ) # Loop through each iteration @@ -324,13 +344,14 @@ Booster <- R6::R6Class( current_iter = function() { cur_iter <- 0L - return( - lgb.call( - fun_name = "LGBM_BoosterGetCurrentIteration_R" - , ret = cur_iter - , private$handle - ) + call_state <- 0L + .Call( + LGBM_BoosterGetCurrentIteration_R + , private$handle + , cur_iter + , call_state ) + return(cur_iter) }, @@ -338,13 +359,14 @@ Booster <- R6::R6Class( upper_bound = function() { upper_bound <- 0.0 - return( - lgb.call( - fun_name = "LGBM_BoosterGetUpperBoundValue_R" - , ret = upper_bound - , private$handle - ) + call_state <- 0L + .Call( + LGBM_BoosterGetUpperBoundValue_R + , private$handle + , upper_bound + , call_state ) + return(upper_bound) }, @@ -352,13 +374,14 @@ Booster <- R6::R6Class( lower_bound = function() { lower_bound <- 0.0 - return( - lgb.call( - fun_name = "LGBM_BoosterGetLowerBoundValue_R" - , ret = lower_bound - , private$handle - ) + call_state <- 0L + .Call( + LGBM_BoosterGetLowerBoundValue_R + , private$handle + , lower_bound + , call_state ) + return(lower_bound) }, @@ -454,13 +477,14 @@ Booster <- R6::R6Class( } # Save booster model - lgb.call( - fun_name = "LGBM_BoosterSaveModel_R" - , ret = NULL + call_state <- 0L + .Call( + LGBM_BoosterSaveModel_R , private$handle , as.integer(num_iteration) , as.integer(feature_importance_type) , lgb.c_str(x = filename) + , call_state ) return(invisible(self)) @@ -474,14 +498,43 @@ Booster <- R6::R6Class( num_iteration <- self$best_iter } - # Return model string - return( - lgb.call.return.str( - fun_name = "LGBM_BoosterSaveModelToString_R" + # Create buffer + buf_len <- as.integer(1024L * 1024L) + act_len <- 0L + buf <- raw(buf_len) + + # Call buffer + call_state <- 0L + .Call( + LGBM_BoosterSaveModelToString_R , private$handle , as.integer(num_iteration) , as.integer(feature_importance_type) + , buf_len + , act_len + , buf + , call_state + ) + + # Check for buffer content + if (act_len > buf_len) { + buf_len <- act_len + buf <- raw(buf_len) + call_state <- 0L + .Call( + LGBM_BoosterSaveModelToString_R + , private$handle + , as.integer(num_iteration) + , as.integer(feature_importance_type) + , buf_len + , act_len + , buf + , call_state ) + } + + return( + lgb.encode.char(arr = buf, len = act_len) ) }, @@ -494,13 +547,39 @@ Booster <- R6::R6Class( num_iteration <- self$best_iter } - return( - lgb.call.return.str( - fun_name = "LGBM_BoosterDumpModel_R" + buf_len <- as.integer(1024L * 1024L) + act_len <- 0L + buf <- raw(buf_len) + call_state <- 0L + .Call( + LGBM_BoosterDumpModel_R + , private$handle + , as.integer(num_iteration) + , as.integer(feature_importance_type) + , buf_len + , act_len + , buf + , call_state + ) + + if (act_len > buf_len) { + buf_len <- act_len + buf <- raw(buf_len) + call_state <- 0L + .Call( + LGBM_BoosterDumpModel_R , private$handle , as.integer(num_iteration) , as.integer(feature_importance_type) + , buf_len + , act_len + , buf + , call_state ) + } + + return( + lgb.encode.char(arr = buf, len = act_len) ) }, @@ -595,12 +674,14 @@ Booster <- R6::R6Class( if (is.null(private$predict_buffer[[data_name]])) { # Store predictions + call_state <- 0L npred <- 0L - npred <- lgb.call( - fun_name = "LGBM_BoosterGetNumPredict_R" - , ret = npred + .Call( + LGBM_BoosterGetNumPredict_R , private$handle , as.integer(idx - 1L) + , npred + , call_state ) private$predict_buffer[[data_name]] <- numeric(npred) @@ -610,11 +691,13 @@ Booster <- R6::R6Class( if (!private$is_predicted_cur_iter[[idx]]) { # Use buffer - private$predict_buffer[[data_name]] <- lgb.call( - fun_name = "LGBM_BoosterGetPredict_R" - , ret = private$predict_buffer[[data_name]] + call_state <- 0L + .Call( + LGBM_BoosterGetPredict_R , private$handle , as.integer(idx - 1L) + , private$predict_buffer[[data_name]] + , call_state ) private$is_predicted_cur_iter[[idx]] <- TRUE } @@ -629,10 +712,32 @@ Booster <- R6::R6Class( if (is.null(private$eval_names)) { # Get evaluation names - names <- lgb.call.return.str( - fun_name = "LGBM_BoosterGetEvalNames_R" + buf_len <- as.integer(1024L * 1024L) + act_len <- 0L + buf <- raw(buf_len) + call_state <- 0L + .Call( + LGBM_BoosterGetEvalNames_R , private$handle + , buf_len + , act_len + , buf + , call_state ) + if (act_len > buf_len) { + buf_len <- act_len + buf <- raw(buf_len) + call_state <- 0L + .Call( + LGBM_BoosterGetEvalNames_R + , private$handle + , buf_len + , act_len + , buf + , call_state + ) + } + names <- lgb.encode.char(arr = buf, len = act_len) # Check names' length if (nchar(names) > 0L) { @@ -673,11 +778,13 @@ Booster <- R6::R6Class( # Create evaluation values tmp_vals <- numeric(length(private$eval_names)) - tmp_vals <- lgb.call( - fun_name = "LGBM_BoosterGetEval_R" - , ret = tmp_vals + call_state <- 0L + .Call( + LGBM_BoosterGetEval_R , private$handle , as.integer(data_idx - 1L) + , tmp_vals + , call_state ) # Loop through all evaluation names diff --git a/R-package/R/lgb.Dataset.R b/R-package/R/lgb.Dataset.R index cfc1c9391139..07eae1b5ae8d 100644 --- a/R-package/R/lgb.Dataset.R +++ b/R-package/R/lgb.Dataset.R @@ -13,7 +13,12 @@ Dataset <- R6::R6Class( if (!lgb.is.null.handle(x = private$handle)) { # Freeing up handle - lgb.call(fun_name = "LGBM_DatasetFree_R", ret = NULL, private$handle) + call_state <- 0L + .Call( + LGBM_DatasetFree_R + , private$handle + , call_state + ) private$handle <- NULL } @@ -197,25 +202,29 @@ Dataset <- R6::R6Class( # Are we using a data file? if (is.character(private$raw_data)) { - handle <- lgb.call( - fun_name = "LGBM_DatasetCreateFromFile_R" - , ret = handle + call_state <- 0L + .Call( + LGBM_DatasetCreateFromFile_R , lgb.c_str(x = private$raw_data) , params_str , ref_handle + , handle + , call_state ) } else if (is.matrix(private$raw_data)) { # Are we using a matrix? - handle <- lgb.call( - fun_name = "LGBM_DatasetCreateFromMat_R" - , ret = handle + call_state <- 0L + .Call( + LGBM_DatasetCreateFromMat_R , private$raw_data , nrow(private$raw_data) , ncol(private$raw_data) , params_str , ref_handle + , handle + , call_state ) } else if (methods::is(private$raw_data, "dgCMatrix")) { @@ -223,9 +232,9 @@ Dataset <- R6::R6Class( stop("Cannot support large CSC matrix") } # Are we using a dgCMatrix (sparsed matrix column compressed) - handle <- lgb.call( - fun_name = "LGBM_DatasetCreateFromCSC_R" - , ret = handle + call_state <- 0L + .Call( + LGBM_DatasetCreateFromCSC_R , private$raw_data@p , private$raw_data@i , private$raw_data@x @@ -234,6 +243,8 @@ Dataset <- R6::R6Class( , nrow(private$raw_data) , params_str , ref_handle + , handle + , call_state ) } else { @@ -254,13 +265,15 @@ Dataset <- R6::R6Class( } # Construct subset - handle <- lgb.call( - fun_name = "LGBM_DatasetGetSubset_R" - , ret = handle + call_state <- 0L + .Call( + LGBM_DatasetGetSubset_R , ref_handle , c(private$used_indices) # Adding c() fixes issue in R v3.5 , length(private$used_indices) , params_str + , handle + , call_state ) } @@ -329,19 +342,22 @@ Dataset <- R6::R6Class( num_col <- 0L # Get numeric data and numeric features + call_state <- 0L + .Call( + LGBM_DatasetGetNumData_R + , private$handle + , num_row + , call_state + ) + call_state <- 0L + .Call( + LGBM_DatasetGetNumFeature_R + , private$handle + , num_col + , call_state + ) return( - c( - lgb.call( - fun_name = "LGBM_DatasetGetNumData_R" - , ret = num_row - , private$handle - ), - lgb.call( - fun_name = "LGBM_DatasetGetNumFeature_R" - , ret = num_col - , private$handle - ) - ) + c(num_row, num_col) ) } else if (is.matrix(private$raw_data) || methods::is(private$raw_data, "dgCMatrix")) { @@ -369,10 +385,32 @@ Dataset <- R6::R6Class( if (!lgb.is.null.handle(x = private$handle)) { # Get feature names and write them - cnames <- lgb.call.return.str( - fun_name = "LGBM_DatasetGetFeatureNames_R" - , private$handle + buf_len <- as.integer(1024L * 1024L) + act_len <- 0L + buf <- raw(buf_len) + call_state <- 0L + .Call( + LGBM_DatasetGetFeatureNames_R + , private$handle + , buf_len + , act_len + , buf + , call_state ) + if (act_len > buf_len) { + buf_len <- act_len + buf <- raw(buf_len) + call_state <- 0L + .Call( + LGBM_DatasetGetFeatureNames_R + , private$handle + , buf_len + , act_len + , buf + , call_state + ) + } + cnames <- lgb.encode.char(arr = buf, len = act_len) private$colnames <- as.character(base::strsplit(cnames, "\t")[[1L]]) return(private$colnames) @@ -413,11 +451,12 @@ Dataset <- R6::R6Class( # Merge names with tab separation merged_name <- paste0(as.list(private$colnames), collapse = "\t") - lgb.call( - fun_name = "LGBM_DatasetSetFeatureNames_R" - , ret = NULL + call_state <- 0L + .Call( + LGBM_DatasetSetFeatureNames_R , private$handle , lgb.c_str(x = merged_name) + , call_state ) } @@ -446,11 +485,13 @@ Dataset <- R6::R6Class( # Get field size of info info_len <- 0L - info_len <- lgb.call( - fun_name = "LGBM_DatasetGetFieldSize_R" - , ret = info_len + call_state <- 0L + .Call( + LGBM_DatasetGetFieldSize_R , private$handle , lgb.c_str(x = name) + , info_len + , call_state ) # Check if info is not empty @@ -464,11 +505,13 @@ Dataset <- R6::R6Class( numeric(info_len) # Numeric } - ret <- lgb.call( - fun_name = "LGBM_DatasetGetField_R" - , ret = ret + call_state <- 0L + .Call( + LGBM_DatasetGetField_R , private$handle , lgb.c_str(x = name) + , ret + , call_state ) private$info[[name]] <- ret @@ -505,13 +548,14 @@ Dataset <- R6::R6Class( if (length(info) > 0L) { - lgb.call( - fun_name = "LGBM_DatasetSetField_R" - , ret = NULL + call_state <- 0L + .Call( + LGBM_DatasetSetField_R , private$handle , lgb.c_str(x = name) , info , length(info) + , call_state ) private$version <- private$version + 1L @@ -558,11 +602,10 @@ Dataset <- R6::R6Class( tryCatch({ call_state <- 0L .Call( - "LGBM_DatasetUpdateParamChecking_R" + LGBM_DatasetUpdateParamChecking_R , lgb.params2str(params = private$params) , lgb.params2str(params = params) , call_state - , PACKAGE = "lib_lightgbm" ) }, error = function(e) { # If updating failed but raw data is not available, raise an error because @@ -660,11 +703,12 @@ Dataset <- R6::R6Class( # Store binary data self$construct() - lgb.call( - fun_name = "LGBM_DatasetSaveBinary_R" - , ret = NULL + call_state <- 0L + .Call( + LGBM_DatasetSaveBinary_R , private$handle , lgb.c_str(x = fname) + , call_state ) return(invisible(self)) } diff --git a/R-package/R/lgb.Predictor.R b/R-package/R/lgb.Predictor.R index ced408e410dd..0ca21f5eb51a 100644 --- a/R-package/R/lgb.Predictor.R +++ b/R-package/R/lgb.Predictor.R @@ -14,10 +14,11 @@ Predictor <- R6::R6Class( if (private$need_free_handle && !lgb.is.null.handle(x = private$handle)) { # Freeing up handle - lgb.call( - fun_name = "LGBM_BoosterFree_R" - , ret = NULL + call_state <- 0L + .Call( + LGBM_BoosterFree_R , private$handle + , call_state ) private$handle <- NULL @@ -38,10 +39,12 @@ Predictor <- R6::R6Class( if (is.character(modelfile)) { # Create handle on it - handle <- lgb.call( - fun_name = "LGBM_BoosterCreateFromModelfile_R" - , ret = handle + call_state <- 0L + .Call( + LGBM_BoosterCreateFromModelfile_R , lgb.c_str(x = modelfile) + , handle + , call_state ) private$need_free_handle <- TRUE @@ -69,13 +72,14 @@ Predictor <- R6::R6Class( current_iter = function() { cur_iter <- 0L - return( - lgb.call( - fun_name = "LGBM_BoosterGetCurrentIteration_R" - , ret = cur_iter - , private$handle - ) + call_state <- 0L + .Call( + LGBM_BoosterGetCurrentIteration_R + , private$handle + , cur_iter + , call_state ) + return(cur_iter) }, @@ -108,9 +112,9 @@ Predictor <- R6::R6Class( on.exit(unlink(tmp_filename), add = TRUE) # Predict from temporary file - lgb.call( - fun_name = "LGBM_BoosterPredictForFile_R" - , ret = NULL + call_state <- 0L + .Call( + LGBM_BoosterPredictForFile_R , private$handle , data , as.integer(header) @@ -121,6 +125,7 @@ Predictor <- R6::R6Class( , as.integer(num_iteration) , private$params , lgb.c_str(x = tmp_filename) + , call_state ) # Get predictions from file @@ -136,9 +141,9 @@ Predictor <- R6::R6Class( npred <- 0L # Check number of predictions to do - npred <- lgb.call( - fun_name = "LGBM_BoosterCalcNumPredict_R" - , ret = npred + call_state <- 0L + .Call( + LGBM_BoosterCalcNumPredict_R , private$handle , as.integer(num_row) , as.integer(rawscore) @@ -146,6 +151,8 @@ Predictor <- R6::R6Class( , as.integer(predcontrib) , as.integer(start_iteration) , as.integer(num_iteration) + , npred + , call_state ) # Pre-allocate empty vector @@ -158,9 +165,9 @@ Predictor <- R6::R6Class( if (storage.mode(data) != "double") { storage.mode(data) <- "double" } - preds <- lgb.call( - fun_name = "LGBM_BoosterPredictForMat_R" - , ret = preds + call_state <- 0L + .Call( + LGBM_BoosterPredictForMat_R , private$handle , data , as.integer(nrow(data)) @@ -171,6 +178,8 @@ Predictor <- R6::R6Class( , as.integer(start_iteration) , as.integer(num_iteration) , private$params + , preds + , call_state ) } else if (methods::is(data, "dgCMatrix")) { @@ -178,9 +187,9 @@ Predictor <- R6::R6Class( stop("Cannot support large CSC matrix") } # Check if data is a dgCMatrix (sparse matrix, column compressed format) - preds <- lgb.call( - fun_name = "LGBM_BoosterPredictForCSC_R" - , ret = preds + call_state <- 0L + .Call( + LGBM_BoosterPredictForCSC_R , private$handle , data@p , data@i @@ -194,6 +203,8 @@ Predictor <- R6::R6Class( , as.integer(start_iteration) , as.integer(num_iteration) , private$params + , preds + , call_state ) } else { diff --git a/R-package/R/utils.R b/R-package/R/utils.R index aa634d4eed17..38827b3fe9f2 100644 --- a/R-package/R/utils.R +++ b/R-package/R/utils.R @@ -33,11 +33,10 @@ lgb.last_error <- function() { act_len <- 0L err_msg <- raw(buf_len) err_msg <- .Call( - "LGBM_GetLastError_R" + LGBM_GetLastError_R , buf_len , act_len , err_msg - , PACKAGE = "lib_lightgbm" ) # Check error buffer @@ -45,11 +44,10 @@ lgb.last_error <- function() { buf_len <- act_len err_msg <- raw(buf_len) err_msg <- .Call( - "LGBM_GetLastError_R" + LGBM_GetLastError_R , buf_len , act_len , err_msg - , PACKAGE = "lib_lightgbm" ) } @@ -59,53 +57,6 @@ lgb.last_error <- function() { } -lgb.call <- function(fun_name, ret, ...) { - # Set call state to a zero value - call_state <- 0L - - # Check for a ret call - if (!is.null(ret)) { - call_state <- .Call( - fun_name - , ... - , ret - , call_state - , PACKAGE = "lib_lightgbm" - ) - } else { - call_state <- .Call( - fun_name - , ... - , call_state - , PACKAGE = "lib_lightgbm" - ) - } - - return(ret) - -} - -lgb.call.return.str <- function(fun_name, ...) { - - # Create buffer - buf_len <- as.integer(1024L * 1024L) - act_len <- 0L - buf <- raw(buf_len) - - # Call buffer - buf <- lgb.call(fun_name = fun_name, ret = buf, ..., buf_len, act_len) - - # Check for buffer content - if (act_len > buf_len) { - buf_len <- act_len - buf <- raw(buf_len) - buf <- lgb.call(fun_name = fun_name, ret = buf, ..., buf_len, act_len) - } - - return(lgb.encode.char(arr = buf, len = act_len)) - -} - lgb.params2str <- function(params, ...) { # Check for a list as input diff --git a/R-package/src/lightgbm_R.cpp b/R-package/src/lightgbm_R.cpp index 0e9fef5e3e67..86417aafb97d 100644 --- a/R-package/src/lightgbm_R.cpp +++ b/R-package/src/lightgbm_R.cpp @@ -724,6 +724,8 @@ static const R_CallMethodDef CallEntries[] = { {NULL, NULL, 0} }; +LIGHTGBM_C_EXPORT void R_init_lightgbm(DllInfo *dll); + void R_init_lightgbm(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); diff --git a/R-package/tests/testthat/test_dataset.R b/R-package/tests/testthat/test_dataset.R index f864785fa0a0..4e291074cefe 100644 --- a/R-package/tests/testthat/test_dataset.R +++ b/R-package/tests/testthat/test_dataset.R @@ -75,17 +75,20 @@ test_that("lgb.Dataset: Dataset should be able to construct from matrix and retu rawData <- matrix(runif(1000L), ncol = 10L) handle <- lgb.null.handle() ref_handle <- NULL - handle <- lightgbm:::lgb.call( - "LGBM_DatasetCreateFromMat_R" - , ret = handle + call_state <- 0L + .Call( + LGBM_DatasetCreateFromMat_R , rawData , nrow(rawData) , ncol(rawData) , lightgbm:::lgb.params2str(params = list()) , ref_handle + , handle + , call_state ) expect_false(is.na(handle)) - lgb.call("LGBM_DatasetFree_R", ret = NULL, handle) + call_state <- 0L + .Call(LGBM_DatasetFree_R, handle, call_state) handle <- NULL }) diff --git a/build_r.R b/build_r.R index a4eeee228c6b..1f6c52055bfa 100644 --- a/build_r.R +++ b/build_r.R @@ -369,6 +369,41 @@ description_contents <- gsub( ) writeLines(description_contents, DESCRIPTION_FILE) +# CMake-based builds can't currently use R's builtin routine registration, +# so have to update NAMESPACE manually, with a statement like this: +# +# useDynLib(lib_lightgbm, LGBM_GetLastError_R, LGBM_DatasetCreateFromFile_R, ...) +# +# See https://cran.r-project.org/doc/manuals/r-release/R-exts.html#useDynLib for +# documentation of this approach, where the NAMESPACE file uses a statement like +# useDynLib(foo, myRoutine, myOtherRoutine) +NAMESPACE_FILE <- file.path(TEMP_R_DIR, "NAMESPACE") +namespace_contents <- readLines(NAMESPACE_FILE) +dynlib_line <- grep( + pattern = "^useDynLib" + , x = namespace_contents +) + +c_api_contents <- readLines(file.path(TEMP_SOURCE_DIR, "src", "lightgbm_R.h")) +c_api_contents <- c_api_contents[grepl("^LIGHTGBM_C_EXPORT", c_api_contents)] +c_api_contents <- gsub( + pattern = "LIGHTGBM_C_EXPORT LGBM_SE " + , replacement = "" + , x = c_api_contents +) +c_api_symbols <- gsub( + pattern = "\\(" + , replacement = "" + , x = c_api_contents +) +dynlib_statement <- paste0( + "useDynLib(lib_lightgbm, " + , paste0(c_api_symbols, collapse = ", ") + , ")" +) +namespace_contents[dynlib_line] <- dynlib_statement +writeLines(namespace_contents, NAMESPACE_FILE) + # NOTE: --keep-empty-dirs is necessary to keep the deep paths expected # by CMake while also meeting the CRAN req to create object files # on demand