Skip to content

GitLab

Unverified Commit b27dcfa4 authored by James Lamb's avatar James Lamb Committed by GitHub
Browse files

[R-package] prevent symbol lookup conflicts (fixes #4045) (#4155) 

* [R-package] prevent symbol lookup conflicts

* add unit tests

* only run test on Windows

* move to .Call() calls

* fix references

* testing registration for CMake builds

* revert NAMESPACE changes

* revert testing changes
parent 023dc53d
Hide whitespace changes
Inline Side-by-side
Showing with 351 additions and 198 deletions
R-package/R/lgb.Booster.R
View file @ b27dcfa4
...@@ -16,7 +16,12 @@ Booster <- R6::R6Class( ...@@ -16,7 +16,12 @@ Booster <- R6::R6Class(
if (!lgb.is.null.handle(x = private$handle)) { if (!lgb.is.null.handle(x = private$handle)) {
# Freeing up 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 private$handle <- NULL
} }
...@@ -49,11 +54,13 @@ Booster <- R6::R6Class( ...@@ -49,11 +54,13 @@ Booster <- R6::R6Class(
params <- modifyList(params, train_set$get_params()) params <- modifyList(params, train_set$get_params())
params_str <- lgb.params2str(params = params) params_str <- lgb.params2str(params = params)
# Store booster handle # Store booster handle
handle <- lgb.call( call_state <- 0L
fun_name = "LGBM_BoosterCreate_R" .Call(
, ret = handle LGBM_BoosterCreate_R
, train_set_handle , train_set_handle
, params_str , params_str
, handle
, call_state
) )
# Create private booster information # Create private booster information
...@@ -66,11 +73,12 @@ Booster <- R6::R6Class( ...@@ -66,11 +73,12 @@ Booster <- R6::R6Class(
if (!is.null(private$init_predictor)) { if (!is.null(private$init_predictor)) {
# Merge booster # Merge booster
lgb.call( call_state <- 0L
fun_name = "LGBM_BoosterMerge_R" .Call(
, ret = NULL LGBM_BoosterMerge_R
, handle , handle
, private$init_predictor$.__enclos_env__$private$handle , private$init_predictor$.__enclos_env__$private$handle
, call_state
) )
} }
...@@ -86,10 +94,12 @@ Booster <- R6::R6Class( ...@@ -86,10 +94,12 @@ Booster <- R6::R6Class(
} }
# Create booster from model # Create booster from model
handle <- lgb.call( call_state <- 0L
fun_name = "LGBM_BoosterCreateFromModelfile_R" .Call(
, ret = handle LGBM_BoosterCreateFromModelfile_R
, lgb.c_str(x = modelfile) , lgb.c_str(x = modelfile)
, handle
, call_state
) )
} else if (!is.null(model_str)) { } else if (!is.null(model_str)) {
...@@ -100,10 +110,12 @@ Booster <- R6::R6Class( ...@@ -100,10 +110,12 @@ Booster <- R6::R6Class(
} }
# Create booster from model # Create booster from model
handle <- lgb.call( call_state <- 0L
fun_name = "LGBM_BoosterLoadModelFromString_R" .Call(
, ret = handle LGBM_BoosterLoadModelFromString_R
, lgb.c_str(x = model_str) , lgb.c_str(x = model_str)
, handle
, call_state
) )
} else { } else {
...@@ -129,10 +141,12 @@ Booster <- R6::R6Class( ...@@ -129,10 +141,12 @@ Booster <- R6::R6Class(
class(handle) <- "lgb.Booster.handle" class(handle) <- "lgb.Booster.handle"
private$handle <- handle private$handle <- handle
private$num_class <- 1L private$num_class <- 1L
private$num_class <- lgb.call( call_state <- 0L
fun_name = "LGBM_BoosterGetNumClasses_R" .Call(
, ret = private$num_class LGBM_BoosterGetNumClasses_R
, private$handle , private$handle
, private$num_class
, call_state
) )
} }
...@@ -174,11 +188,12 @@ Booster <- R6::R6Class( ...@@ -174,11 +188,12 @@ Booster <- R6::R6Class(
} }
# Add validation data to booster # Add validation data to booster
lgb.call( call_state <- 0L
fun_name = "LGBM_BoosterAddValidData_R" .Call(
, ret = NULL LGBM_BoosterAddValidData_R
, private$handle , private$handle
, data$.__enclos_env__$private$get_handle() , data$.__enclos_env__$private$get_handle()
, call_state
) )
# Store private information # Store private information
...@@ -201,11 +216,12 @@ Booster <- R6::R6Class( ...@@ -201,11 +216,12 @@ Booster <- R6::R6Class(
params <- modifyList(params, list(...)) params <- modifyList(params, list(...))
params_str <- lgb.params2str(params = params) params_str <- lgb.params2str(params = params)
lgb.call( call_state <- 0L
fun_name = "LGBM_BoosterResetParameter_R" .Call(
, ret = NULL LGBM_BoosterResetParameter_R
, private$handle , private$handle
, params_str , params_str
, call_state
) )
self$params <- params self$params <- params
...@@ -236,11 +252,12 @@ Booster <- R6::R6Class( ...@@ -236,11 +252,12 @@ Booster <- R6::R6Class(
} }
# Reset training data on booster # Reset training data on booster
lgb.call( call_state <- 0L
fun_name = "LGBM_BoosterResetTrainingData_R" .Call(
, ret = NULL LGBM_BoosterResetTrainingData_R
, private$handle , private$handle
, train_set$.__enclos_env__$private$get_handle() , train_set$.__enclos_env__$private$get_handle()
, call_state
) )
# Store private train set # Store private train set
...@@ -255,10 +272,11 @@ Booster <- R6::R6Class( ...@@ -255,10 +272,11 @@ Booster <- R6::R6Class(
stop("lgb.Booster.update: cannot update due to null objective function") stop("lgb.Booster.update: cannot update due to null objective function")
} }
# Boost iteration from known objective # Boost iteration from known objective
ret <- lgb.call( call_state <- 0L
fun_name = "LGBM_BoosterUpdateOneIter_R" .Call(
, ret = NULL LGBM_BoosterUpdateOneIter_R
, private$handle , private$handle
, call_state
) )
} else { } else {
...@@ -281,13 +299,14 @@ Booster <- R6::R6Class( ...@@ -281,13 +299,14 @@ Booster <- R6::R6Class(
} }
# Return custom boosting gradient/hessian # Return custom boosting gradient/hessian
ret <- lgb.call( call_state <- 0L
fun_name = "LGBM_BoosterUpdateOneIterCustom_R" .Call(
, ret = NULL LGBM_BoosterUpdateOneIterCustom_R
, private$handle , private$handle
, gpair$grad , gpair$grad
, gpair$hess , gpair$hess
, length(gpair$grad) , length(gpair$grad)
, call_state
) )
} }
...@@ -297,7 +316,7 @@ Booster <- R6::R6Class( ...@@ -297,7 +316,7 @@ Booster <- R6::R6Class(
private$is_predicted_cur_iter[[i]] <- FALSE private$is_predicted_cur_iter[[i]] <- FALSE
} }
return(ret) return(invisible(self))
}, },
...@@ -305,10 +324,11 @@ Booster <- R6::R6Class( ...@@ -305,10 +324,11 @@ Booster <- R6::R6Class(
rollback_one_iter = function() { rollback_one_iter = function() {
# Return one iteration behind # Return one iteration behind
lgb.call( call_state <- 0L
fun_name = "LGBM_BoosterRollbackOneIter_R" .Call(
, ret = NULL LGBM_BoosterRollbackOneIter_R
, private$handle , private$handle
, call_state
) )
# Loop through each iteration # Loop through each iteration
...@@ -324,13 +344,14 @@ Booster <- R6::R6Class( ...@@ -324,13 +344,14 @@ Booster <- R6::R6Class(
current_iter = function() { current_iter = function() {
cur_iter <- 0L cur_iter <- 0L
return( call_state <- 0L
lgb.call( .Call(
fun_name = "LGBM_BoosterGetCurrentIteration_R" LGBM_BoosterGetCurrentIteration_R
, ret = cur_iter , private$handle
, private$handle , cur_iter
) , call_state
) )
return(cur_iter)
}, },
...@@ -338,13 +359,14 @@ Booster <- R6::R6Class( ...@@ -338,13 +359,14 @@ Booster <- R6::R6Class(
upper_bound = function() { upper_bound = function() {
upper_bound <- 0.0 upper_bound <- 0.0
return( call_state <- 0L
lgb.call( .Call(
fun_name = "LGBM_BoosterGetUpperBoundValue_R" LGBM_BoosterGetUpperBoundValue_R
, ret = upper_bound , private$handle
, private$handle , upper_bound
) , call_state
) )
return(upper_bound)
}, },
...@@ -352,13 +374,14 @@ Booster <- R6::R6Class( ...@@ -352,13 +374,14 @@ Booster <- R6::R6Class(
lower_bound = function() { lower_bound = function() {
lower_bound <- 0.0 lower_bound <- 0.0
return( call_state <- 0L
lgb.call( .Call(
fun_name = "LGBM_BoosterGetLowerBoundValue_R" LGBM_BoosterGetLowerBoundValue_R
, ret = lower_bound , private$handle
, private$handle , lower_bound
) , call_state
) )
return(lower_bound)
}, },
...@@ -454,13 +477,14 @@ Booster <- R6::R6Class( ...@@ -454,13 +477,14 @@ Booster <- R6::R6Class(
} }
# Save booster model # Save booster model
lgb.call( call_state <- 0L
fun_name = "LGBM_BoosterSaveModel_R" .Call(
, ret = NULL LGBM_BoosterSaveModel_R
, private$handle , private$handle
, as.integer(num_iteration) , as.integer(num_iteration)
, as.integer(feature_importance_type) , as.integer(feature_importance_type)
, lgb.c_str(x = filename) , lgb.c_str(x = filename)
, call_state
) )
return(invisible(self)) return(invisible(self))
...@@ -474,14 +498,43 @@ Booster <- R6::R6Class( ...@@ -474,14 +498,43 @@ Booster <- R6::R6Class(
num_iteration <- self$best_iter num_iteration <- self$best_iter
} }
# Return model string # Create buffer
return( buf_len <- as.integer(1024L * 1024L)
lgb.call.return.str( act_len <- 0L
fun_name = "LGBM_BoosterSaveModelToString_R" buf <- raw(buf_len)
# Call buffer
call_state <- 0L
.Call(
LGBM_BoosterSaveModelToString_R
, private$handle , private$handle
, as.integer(num_iteration) , as.integer(num_iteration)
, as.integer(feature_importance_type) , 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( ...@@ -494,13 +547,39 @@ Booster <- R6::R6Class(
num_iteration <- self$best_iter num_iteration <- self$best_iter
} }
return( buf_len <- as.integer(1024L * 1024L)
lgb.call.return.str( act_len <- 0L
fun_name = "LGBM_BoosterDumpModel_R" 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 , private$handle
, as.integer(num_iteration) , as.integer(num_iteration)
, as.integer(feature_importance_type) , 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( ...@@ -595,12 +674,14 @@ Booster <- R6::R6Class(
if (is.null(private$predict_buffer[[data_name]])) { if (is.null(private$predict_buffer[[data_name]])) {
# Store predictions # Store predictions
call_state <- 0L
npred <- 0L npred <- 0L
npred <- lgb.call( .Call(
fun_name = "LGBM_BoosterGetNumPredict_R" LGBM_BoosterGetNumPredict_R
, ret = npred
, private$handle , private$handle
, as.integer(idx - 1L) , as.integer(idx - 1L)
, npred
, call_state
) )
private$predict_buffer[[data_name]] <- numeric(npred) private$predict_buffer[[data_name]] <- numeric(npred)
...@@ -610,11 +691,13 @@ Booster <- R6::R6Class( ...@@ -610,11 +691,13 @@ Booster <- R6::R6Class(
if (!private$is_predicted_cur_iter[[idx]]) { if (!private$is_predicted_cur_iter[[idx]]) {
# Use buffer # Use buffer
private$predict_buffer[[data_name]] <- lgb.call( call_state <- 0L
fun_name = "LGBM_BoosterGetPredict_R" .Call(
, ret = private$predict_buffer[[data_name]] LGBM_BoosterGetPredict_R
, private$handle , private$handle
, as.integer(idx - 1L) , as.integer(idx - 1L)
, private$predict_buffer[[data_name]]
, call_state
) )
private$is_predicted_cur_iter[[idx]] <- TRUE private$is_predicted_cur_iter[[idx]] <- TRUE
} }
...@@ -629,10 +712,32 @@ Booster <- R6::R6Class( ...@@ -629,10 +712,32 @@ Booster <- R6::R6Class(
if (is.null(private$eval_names)) { if (is.null(private$eval_names)) {
# Get evaluation names # Get evaluation names
names <- lgb.call.return.str( buf_len <- as.integer(1024L * 1024L)
fun_name = "LGBM_BoosterGetEvalNames_R" act_len <- 0L
buf <- raw(buf_len)
call_state <- 0L
.Call(
LGBM_BoosterGetEvalNames_R
, private$handle , 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 # Check names' length
if (nchar(names) > 0L) { if (nchar(names) > 0L) {
...@@ -673,11 +778,13 @@ Booster <- R6::R6Class( ...@@ -673,11 +778,13 @@ Booster <- R6::R6Class(
# Create evaluation values # Create evaluation values
tmp_vals <- numeric(length(private$eval_names)) tmp_vals <- numeric(length(private$eval_names))
tmp_vals <- lgb.call( call_state <- 0L
fun_name = "LGBM_BoosterGetEval_R" .Call(
, ret = tmp_vals LGBM_BoosterGetEval_R
, private$handle , private$handle
, as.integer(data_idx - 1L) , as.integer(data_idx - 1L)
, tmp_vals
, call_state
) )
# Loop through all evaluation names # Loop through all evaluation names
......
R-package/R/lgb.Dataset.R
View file @ b27dcfa4
...@@ -13,7 +13,12 @@ Dataset <- R6::R6Class( ...@@ -13,7 +13,12 @@ Dataset <- R6::R6Class(
if (!lgb.is.null.handle(x = private$handle)) { if (!lgb.is.null.handle(x = private$handle)) {
# Freeing up 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 private$handle <- NULL
} }
...@@ -197,25 +202,29 @@ Dataset <- R6::R6Class( ...@@ -197,25 +202,29 @@ Dataset <- R6::R6Class(
# Are we using a data file? # Are we using a data file?
if (is.character(private$raw_data)) { if (is.character(private$raw_data)) {
handle <- lgb.call( call_state <- 0L
fun_name = "LGBM_DatasetCreateFromFile_R" .Call(
, ret = handle LGBM_DatasetCreateFromFile_R
, lgb.c_str(x = private$raw_data) , lgb.c_str(x = private$raw_data)
, params_str , params_str
, ref_handle , ref_handle
, handle
, call_state
) )
} else if (is.matrix(private$raw_data)) { } else if (is.matrix(private$raw_data)) {
# Are we using a matrix? # Are we using a matrix?
handle <- lgb.call( call_state <- 0L
fun_name = "LGBM_DatasetCreateFromMat_R" .Call(
, ret = handle LGBM_DatasetCreateFromMat_R
, private$raw_data , private$raw_data
, nrow(private$raw_data) , nrow(private$raw_data)
, ncol(private$raw_data) , ncol(private$raw_data)
, params_str , params_str
, ref_handle , ref_handle
, handle
, call_state
) )
} else if (methods::is(private$raw_data, "dgCMatrix")) { } else if (methods::is(private$raw_data, "dgCMatrix")) {
...@@ -223,9 +232,9 @@ Dataset <- R6::R6Class( ...@@ -223,9 +232,9 @@ Dataset <- R6::R6Class(
stop("Cannot support large CSC matrix") stop("Cannot support large CSC matrix")
} }
# Are we using a dgCMatrix (sparsed matrix column compressed) # Are we using a dgCMatrix (sparsed matrix column compressed)
handle <- lgb.call( call_state <- 0L
fun_name = "LGBM_DatasetCreateFromCSC_R" .Call(
, ret = handle LGBM_DatasetCreateFromCSC_R
, private$raw_data@p , private$raw_data@p
, private$raw_data@i , private$raw_data@i
, private$raw_data@x , private$raw_data@x
...@@ -234,6 +243,8 @@ Dataset <- R6::R6Class( ...@@ -234,6 +243,8 @@ Dataset <- R6::R6Class(
, nrow(private$raw_data) , nrow(private$raw_data)
, params_str , params_str
, ref_handle , ref_handle
, handle
, call_state
) )
} else { } else {
...@@ -254,13 +265,15 @@ Dataset <- R6::R6Class( ...@@ -254,13 +265,15 @@ Dataset <- R6::R6Class(
} }
# Construct subset # Construct subset
handle <- lgb.call( call_state <- 0L
fun_name = "LGBM_DatasetGetSubset_R" .Call(
, ret = handle LGBM_DatasetGetSubset_R
, ref_handle , ref_handle
, c(private$used_indices) # Adding c() fixes issue in R v3.5 , c(private$used_indices) # Adding c() fixes issue in R v3.5
, length(private$used_indices) , length(private$used_indices)
, params_str , params_str
, handle
, call_state
) )
} }
...@@ -329,19 +342,22 @@ Dataset <- R6::R6Class( ...@@ -329,19 +342,22 @@ Dataset <- R6::R6Class(
num_col <- 0L num_col <- 0L
# Get numeric data and numeric features # 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( return(
c( c(num_row, num_col)
lgb.call(
fun_name = "LGBM_DatasetGetNumData_R"
, ret = num_row
, private$handle
),
lgb.call(
fun_name = "LGBM_DatasetGetNumFeature_R"
, ret = num_col
, private$handle
)
)
) )
} else if (is.matrix(private$raw_data) || methods::is(private$raw_data, "dgCMatrix")) { } else if (is.matrix(private$raw_data) || methods::is(private$raw_data, "dgCMatrix")) {
...@@ -369,10 +385,32 @@ Dataset <- R6::R6Class( ...@@ -369,10 +385,32 @@ Dataset <- R6::R6Class(
if (!lgb.is.null.handle(x = private$handle)) { if (!lgb.is.null.handle(x = private$handle)) {
# Get feature names and write them # Get feature names and write them
cnames <- lgb.call.return.str( buf_len <- as.integer(1024L * 1024L)
fun_name = "LGBM_DatasetGetFeatureNames_R" act_len <- 0L
, private$handle 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]]) private$colnames <- as.character(base::strsplit(cnames, "\t")[[1L]])
return(private$colnames) return(private$colnames)
...@@ -413,11 +451,12 @@ Dataset <- R6::R6Class( ...@@ -413,11 +451,12 @@ Dataset <- R6::R6Class(
# Merge names with tab separation # Merge names with tab separation
merged_name <- paste0(as.list(private$colnames), collapse = "\t") merged_name <- paste0(as.list(private$colnames), collapse = "\t")
lgb.call( call_state <- 0L
fun_name = "LGBM_DatasetSetFeatureNames_R" .Call(
, ret = NULL LGBM_DatasetSetFeatureNames_R
, private$handle , private$handle
, lgb.c_str(x = merged_name) , lgb.c_str(x = merged_name)
, call_state
) )
} }
...@@ -446,11 +485,13 @@ Dataset <- R6::R6Class( ...@@ -446,11 +485,13 @@ Dataset <- R6::R6Class(
# Get field size of info # Get field size of info
info_len <- 0L info_len <- 0L
info_len <- lgb.call( call_state <- 0L
fun_name = "LGBM_DatasetGetFieldSize_R" .Call(
, ret = info_len LGBM_DatasetGetFieldSize_R
, private$handle , private$handle
, lgb.c_str(x = name) , lgb.c_str(x = name)
, info_len
, call_state
) )
# Check if info is not empty # Check if info is not empty
...@@ -464,11 +505,13 @@ Dataset <- R6::R6Class( ...@@ -464,11 +505,13 @@ Dataset <- R6::R6Class(
numeric(info_len) # Numeric numeric(info_len) # Numeric
} }
ret <- lgb.call( call_state <- 0L
fun_name = "LGBM_DatasetGetField_R" .Call(
, ret = ret LGBM_DatasetGetField_R
, private$handle , private$handle
, lgb.c_str(x = name) , lgb.c_str(x = name)
, ret
, call_state
) )
private$info[[name]] <- ret private$info[[name]] <- ret
...@@ -505,13 +548,14 @@ Dataset <- R6::R6Class( ...@@ -505,13 +548,14 @@ Dataset <- R6::R6Class(
if (length(info) > 0L) { if (length(info) > 0L) {
lgb.call( call_state <- 0L
fun_name = "LGBM_DatasetSetField_R" .Call(
, ret = NULL LGBM_DatasetSetField_R
, private$handle , private$handle
, lgb.c_str(x = name) , lgb.c_str(x = name)
, info , info
, length(info) , length(info)
, call_state
) )
private$version <- private$version + 1L private$version <- private$version + 1L
...@@ -558,11 +602,10 @@ Dataset <- R6::R6Class( ...@@ -558,11 +602,10 @@ Dataset <- R6::R6Class(
tryCatch({ tryCatch({
call_state <- 0L call_state <- 0L
.Call( .Call(
"LGBM_DatasetUpdateParamChecking_R" LGBM_DatasetUpdateParamChecking_R
, lgb.params2str(params = private$params) , lgb.params2str(params = private$params)
, lgb.params2str(params = params) , lgb.params2str(params = params)
, call_state , call_state
, PACKAGE = "lib_lightgbm"
) )
}, error = function(e) { }, error = function(e) {
# If updating failed but raw data is not available, raise an error because # If updating failed but raw data is not available, raise an error because
...@@ -660,11 +703,12 @@ Dataset <- R6::R6Class( ...@@ -660,11 +703,12 @@ Dataset <- R6::R6Class(
# Store binary data # Store binary data
self$construct() self$construct()
lgb.call( call_state <- 0L
fun_name = "LGBM_DatasetSaveBinary_R" .Call(
, ret = NULL LGBM_DatasetSaveBinary_R
, private$handle , private$handle
, lgb.c_str(x = fname) , lgb.c_str(x = fname)
, call_state
) )
return(invisible(self)) return(invisible(self))
} }
......
R-package/R/lgb.Predictor.R
View file @ b27dcfa4
...@@ -14,10 +14,11 @@ Predictor <- R6::R6Class( ...@@ -14,10 +14,11 @@ Predictor <- R6::R6Class(
if (private$need_free_handle && !lgb.is.null.handle(x = private$handle)) { if (private$need_free_handle && !lgb.is.null.handle(x = private$handle)) {
# Freeing up handle # Freeing up handle
lgb.call( call_state <- 0L
fun_name = "LGBM_BoosterFree_R" .Call(
, ret = NULL LGBM_BoosterFree_R
, private$handle , private$handle
, call_state
) )
private$handle <- NULL private$handle <- NULL
...@@ -38,10 +39,12 @@ Predictor <- R6::R6Class( ...@@ -38,10 +39,12 @@ Predictor <- R6::R6Class(
if (is.character(modelfile)) { if (is.character(modelfile)) {
# Create handle on it # Create handle on it
handle <- lgb.call( call_state <- 0L
fun_name = "LGBM_BoosterCreateFromModelfile_R" .Call(
, ret = handle LGBM_BoosterCreateFromModelfile_R
, lgb.c_str(x = modelfile) , lgb.c_str(x = modelfile)
, handle
, call_state
) )
private$need_free_handle <- TRUE private$need_free_handle <- TRUE
...@@ -69,13 +72,14 @@ Predictor <- R6::R6Class( ...@@ -69,13 +72,14 @@ Predictor <- R6::R6Class(
current_iter = function() { current_iter = function() {
cur_iter <- 0L cur_iter <- 0L
return( call_state <- 0L
lgb.call( .Call(
fun_name = "LGBM_BoosterGetCurrentIteration_R" LGBM_BoosterGetCurrentIteration_R
, ret = cur_iter , private$handle
, private$handle , cur_iter
) , call_state
) )
return(cur_iter)
}, },
...@@ -108,9 +112,9 @@ Predictor <- R6::R6Class( ...@@ -108,9 +112,9 @@ Predictor <- R6::R6Class(
on.exit(unlink(tmp_filename), add = TRUE) on.exit(unlink(tmp_filename), add = TRUE)
# Predict from temporary file # Predict from temporary file
lgb.call( call_state <- 0L
fun_name = "LGBM_BoosterPredictForFile_R" .Call(
, ret = NULL LGBM_BoosterPredictForFile_R
, private$handle , private$handle
, data , data
, as.integer(header) , as.integer(header)
...@@ -121,6 +125,7 @@ Predictor <- R6::R6Class( ...@@ -121,6 +125,7 @@ Predictor <- R6::R6Class(
, as.integer(num_iteration) , as.integer(num_iteration)
, private$params , private$params
, lgb.c_str(x = tmp_filename) , lgb.c_str(x = tmp_filename)
, call_state
) )
# Get predictions from file # Get predictions from file
...@@ -136,9 +141,9 @@ Predictor <- R6::R6Class( ...@@ -136,9 +141,9 @@ Predictor <- R6::R6Class(
npred <- 0L npred <- 0L
# Check number of predictions to do # Check number of predictions to do
npred <- lgb.call( call_state <- 0L
fun_name = "LGBM_BoosterCalcNumPredict_R" .Call(
, ret = npred LGBM_BoosterCalcNumPredict_R
, private$handle , private$handle
, as.integer(num_row) , as.integer(num_row)
, as.integer(rawscore) , as.integer(rawscore)
...@@ -146,6 +151,8 @@ Predictor <- R6::R6Class( ...@@ -146,6 +151,8 @@ Predictor <- R6::R6Class(
, as.integer(predcontrib) , as.integer(predcontrib)
, as.integer(start_iteration) , as.integer(start_iteration)
, as.integer(num_iteration) , as.integer(num_iteration)
, npred
, call_state
) )
# Pre-allocate empty vector # Pre-allocate empty vector
...@@ -158,9 +165,9 @@ Predictor <- R6::R6Class( ...@@ -158,9 +165,9 @@ Predictor <- R6::R6Class(
if (storage.mode(data) != "double") { if (storage.mode(data) != "double") {
storage.mode(data) <- "double" storage.mode(data) <- "double"
} }
preds <- lgb.call( call_state <- 0L
fun_name = "LGBM_BoosterPredictForMat_R" .Call(
, ret = preds LGBM_BoosterPredictForMat_R
, private$handle , private$handle
, data , data
, as.integer(nrow(data)) , as.integer(nrow(data))
...@@ -171,6 +178,8 @@ Predictor <- R6::R6Class( ...@@ -171,6 +178,8 @@ Predictor <- R6::R6Class(
, as.integer(start_iteration) , as.integer(start_iteration)
, as.integer(num_iteration) , as.integer(num_iteration)
, private$params , private$params
, preds
, call_state
) )
} else if (methods::is(data, "dgCMatrix")) { } else if (methods::is(data, "dgCMatrix")) {
...@@ -178,9 +187,9 @@ Predictor <- R6::R6Class( ...@@ -178,9 +187,9 @@ Predictor <- R6::R6Class(
stop("Cannot support large CSC matrix") stop("Cannot support large CSC matrix")
} }
# Check if data is a dgCMatrix (sparse matrix, column compressed format) # Check if data is a dgCMatrix (sparse matrix, column compressed format)
preds <- lgb.call( call_state <- 0L
fun_name = "LGBM_BoosterPredictForCSC_R" .Call(
, ret = preds LGBM_BoosterPredictForCSC_R
, private$handle , private$handle
, data@p , data@p
, data@i , data@i
...@@ -194,6 +203,8 @@ Predictor <- R6::R6Class( ...@@ -194,6 +203,8 @@ Predictor <- R6::R6Class(
, as.integer(start_iteration) , as.integer(start_iteration)
, as.integer(num_iteration) , as.integer(num_iteration)
, private$params , private$params
, preds
, call_state
) )
} else { } else {
......
R-package/R/utils.R
View file @ b27dcfa4
...@@ -33,11 +33,10 @@ lgb.last_error <- function() { ...@@ -33,11 +33,10 @@ lgb.last_error <- function() {
act_len <- 0L act_len <- 0L
err_msg <- raw(buf_len) err_msg <- raw(buf_len)
err_msg <- .Call( err_msg <- .Call(
"LGBM_GetLastError_R" LGBM_GetLastError_R
, buf_len , buf_len
, act_len , act_len
, err_msg , err_msg
, PACKAGE = "lib_lightgbm"
) )
# Check error buffer # Check error buffer
...@@ -45,11 +44,10 @@ lgb.last_error <- function() { ...@@ -45,11 +44,10 @@ lgb.last_error <- function() {
buf_len <- act_len buf_len <- act_len
err_msg <- raw(buf_len) err_msg <- raw(buf_len)
err_msg <- .Call( err_msg <- .Call(
"LGBM_GetLastError_R" LGBM_GetLastError_R
, buf_len , buf_len
, act_len , act_len
, err_msg , err_msg
, PACKAGE = "lib_lightgbm"
) )
} }
...@@ -59,53 +57,6 @@ lgb.last_error <- function() { ...@@ -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, ...) { lgb.params2str <- function(params, ...) {
# Check for a list as input # Check for a list as input
......
R-package/src/lightgbm_R.cpp
View file @ b27dcfa4
...@@ -724,6 +724,8 @@ static const R_CallMethodDef CallEntries[] = { ...@@ -724,6 +724,8 @@ static const R_CallMethodDef CallEntries[] = {
{NULL, NULL, 0} {NULL, NULL, 0}
}; };
LIGHTGBM_C_EXPORT void R_init_lightgbm(DllInfo *dll);
void R_init_lightgbm(DllInfo *dll) { void R_init_lightgbm(DllInfo *dll) {
R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
R_useDynamicSymbols(dll, FALSE); R_useDynamicSymbols(dll, FALSE);
......
R-package/tests/testthat/test_dataset.R
View file @ b27dcfa4
...@@ -75,17 +75,20 @@ test_that("lgb.Dataset: Dataset should be able to construct from matrix and retu ...@@ -75,17 +75,20 @@ test_that("lgb.Dataset: Dataset should be able to construct from matrix and retu
rawData <- matrix(runif(1000L), ncol = 10L) rawData <- matrix(runif(1000L), ncol = 10L)
handle <- lgb.null.handle() handle <- lgb.null.handle()
ref_handle <- NULL ref_handle <- NULL
handle <- lightgbm:::lgb.call( call_state <- 0L
"LGBM_DatasetCreateFromMat_R" .Call(
, ret = handle LGBM_DatasetCreateFromMat_R
, rawData , rawData
, nrow(rawData) , nrow(rawData)
, ncol(rawData) , ncol(rawData)
, lightgbm:::lgb.params2str(params = list()) , lightgbm:::lgb.params2str(params = list())
, ref_handle , ref_handle
, handle
, call_state
) )
expect_false(is.na(handle)) 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 handle <- NULL
}) })
......
build_r.R
View file @ b27dcfa4
...@@ -369,6 +369,41 @@ description_contents <- gsub( ...@@ -369,6 +369,41 @@ description_contents <- gsub(
) )
writeLines(description_contents, DESCRIPTION_FILE) 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 # NOTE: --keep-empty-dirs is necessary to keep the deep paths expected
# by CMake while also meeting the CRAN req to create object files # by CMake while also meeting the CRAN req to create object files
# on demand # on demand
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment