Skip to content

GitLab

Commit 1f7b06b9 authored by James Lamb's avatar James Lamb Committed by Nikita Titov
Browse files

[R-package][ci] Added more R linters (fixes #2477) (#2533) 



* Added more linters on R code

* started working on implicit integers

* finished style changes to handle implicit integers

* regenned documentation and added concatenation linter

* changed channel for r-lintr

* try building stringi before lintr

* trying to get libicui18n

* trying another thing

* trying conda-forge again

* added re-install of stringi

* uncommented other stages

* Update .ci/test.sh
Co-Authored-By: default avatarNikita Titov <nekit94-08@mail.ru>

* removed apt update and changed lintr version floor

* get lintr from CRAN

* R needs to come before C++ linting

* testing lintr install from CRAN

* trying one more thing

* more verbose

* order might matter

* removed commented code

* cleaned up linting block in test.sh

* grouped conda install calls and fixed a few integer array things
parent 11f9682b
Hide whitespace changes
Inline Side-by-side
Showing with 352 additions and 334 deletions
.ci/lint_r_code.R
View file @ 1f7b06b9
...@@ -4,7 +4,7 @@ library(lintr) ...@@ -4,7 +4,7 @@ library(lintr)
args <- commandArgs( args <- commandArgs(
trailingOnly = TRUE trailingOnly = TRUE
) )
SOURCE_DIR <- args[[1]] SOURCE_DIR <- args[[1L]]
FILES_TO_LINT <- list.files( FILES_TO_LINT <- list.files(
path = SOURCE_DIR path = SOURCE_DIR
...@@ -17,22 +17,34 @@ FILES_TO_LINT <- list.files( ...@@ -17,22 +17,34 @@ FILES_TO_LINT <- list.files(
) )
LINTERS_TO_USE <- list( LINTERS_TO_USE <- list(
"closed_curly" = lintr::closed_curly_linter "assignment" = lintr::assignment_linter
, "closed_curly" = lintr::closed_curly_linter
, "equals_na" = lintr::equals_na_linter
, "function_left" = lintr::function_left_parentheses_linter
, "commas" = lintr::commas_linter
, "concatenation" = lintr::unneeded_concatenation_linter
, "implicit_integers" = lintr::implicit_integer_linter
, "infix_spaces" = lintr::infix_spaces_linter , "infix_spaces" = lintr::infix_spaces_linter
, "long_lines" = lintr::line_length_linter(length = 120) , "long_lines" = lintr::line_length_linter(length = 120L)
, "tabs" = lintr::no_tab_linter , "tabs" = lintr::no_tab_linter
, "open_curly" = lintr::open_curly_linter , "open_curly" = lintr::open_curly_linter
, "paren_brace_linter" = lintr::paren_brace_linter
, "semicolon" = lintr::semicolon_terminator_linter
, "seq" = lintr::seq_linter
, "single_quotes" = lintr::single_quotes_linter
, "spaces_inside" = lintr::spaces_inside_linter , "spaces_inside" = lintr::spaces_inside_linter
, "spaces_left_parens" = lintr::spaces_left_parentheses_linter , "spaces_left_parens" = lintr::spaces_left_parentheses_linter
, "todo_comments" = lintr::todo_comment_linter
, "trailing_blank" = lintr::trailing_blank_lines_linter , "trailing_blank" = lintr::trailing_blank_lines_linter
, "trailing_white" = lintr::trailing_whitespace_linter , "trailing_white" = lintr::trailing_whitespace_linter
, "true_false" = lintr::T_and_F_symbol_linter
) )
cat(sprintf("Found %i R files to lint\n", length(FILES_TO_LINT))) cat(sprintf("Found %i R files to lint\n", length(FILES_TO_LINT)))
results <- c() results <- NULL
for (r_file in FILES_TO_LINT){ for (r_file in FILES_TO_LINT) {
this_result <- lintr::lint( this_result <- lintr::lint(
filename = r_file filename = r_file
...@@ -52,7 +64,7 @@ for (r_file in FILES_TO_LINT){ ...@@ -52,7 +64,7 @@ for (r_file in FILES_TO_LINT){
issues_found <- length(results) issues_found <- length(results)
if (issues_found > 0){ if (issues_found > 0L) {
cat("\n") cat("\n")
print(results) print(results)
} }
......
.ci/test.sh
View file @ 1f7b06b9
...@@ -50,11 +50,14 @@ if [[ $TRAVIS == "true" ]] && [[ $TASK == "check-docs" ]]; then ...@@ -50,11 +50,14 @@ if [[ $TRAVIS == "true" ]] && [[ $TASK == "check-docs" ]]; then
exit 0 exit 0
fi fi
if [[ $TASK == "lint" ]]; then if [[ $TRAVIS == "true" ]] && [[ $TASK == "lint" ]]; then
conda install -q -y -n $CONDA_ENV \ conda install -q -y -n $CONDA_ENV \
pycodestyle \ pycodestyle \
pydocstyle \ pydocstyle \
r-lintr r-stringi # stringi needs to be installed separate from r-lintr to avoid issues like 'unable to load shared object stringi.so'
conda install -q -y -n $CONDA_ENV \
-c conda-forge \
r-lintr>=2.0
pip install --user cpplint pip install --user cpplint
echo "Linting Python code" echo "Linting Python code"
pycodestyle --ignore=E501,W503 --exclude=./compute,./.nuget . || exit -1 pycodestyle --ignore=E501,W503 --exclude=./compute,./.nuget . || exit -1
......
R-package/R/aliases.R
View file @ 1f7b06b9
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
# lazy evaluation (so it doesn't matter what order R sources files during installation). # lazy evaluation (so it doesn't matter what order R sources files during installation).
# [return] A named list, where each key is a main LightGBM parameter and each value is a character # [return] A named list, where each key is a main LightGBM parameter and each value is a character
# vector of corresponding aliases. # vector of corresponding aliases.
.PARAMETER_ALIASES <- function(){ .PARAMETER_ALIASES <- function() {
return(list( return(list(
"boosting" = c( "boosting" = c(
"boosting" "boosting"
......
R-package/R/callback.R
View file @ 1f7b06b9
...@@ -9,7 +9,7 @@ CB_ENV <- R6::R6Class( ...@@ -9,7 +9,7 @@ CB_ENV <- R6::R6Class(
end_iteration = NULL, end_iteration = NULL,
eval_list = list(), eval_list = list(),
eval_err_list = list(), eval_err_list = list(),
best_iter = -1, best_iter = -1L,
best_score = NA, best_score = NA,
met_early_stop = FALSE met_early_stop = FALSE
) )
...@@ -30,7 +30,7 @@ cb.reset.parameters <- function(new_params) { ...@@ -30,7 +30,7 @@ cb.reset.parameters <- function(new_params) {
init <- function(env) { init <- function(env) {
# Store boosting rounds # Store boosting rounds
nrounds <<- env$end_iteration - env$begin_iteration + 1 nrounds <<- env$end_iteration - env$begin_iteration + 1L
# Check for model environment # Check for model environment
if (is.null(env$model)) { stop("Env should have a ", sQuote("model")) } if (is.null(env$model)) { stop("Env should have a ", sQuote("model")) }
...@@ -60,7 +60,7 @@ cb.reset.parameters <- function(new_params) { ...@@ -60,7 +60,7 @@ cb.reset.parameters <- function(new_params) {
if (is.function(p)) { if (is.function(p)) {
# Check if requires at least two arguments # Check if requires at least two arguments
if (length(formals(p)) != 2) { if (length(formals(p)) != 2L) {
stop("Parameter ", sQuote(n), " is a function but not of two arguments") stop("Parameter ", sQuote(n), " is a function but not of two arguments")
} }
...@@ -117,7 +117,7 @@ cb.reset.parameters <- function(new_params) { ...@@ -117,7 +117,7 @@ cb.reset.parameters <- function(new_params) {
format.eval.string <- function(eval_res, eval_err = NULL) { format.eval.string <- function(eval_res, eval_err = NULL) {
# Check for empty evaluation string # Check for empty evaluation string
if (is.null(eval_res) || length(eval_res) == 0) { if (is.null(eval_res) || length(eval_res) == 0L) {
stop("no evaluation results") stop("no evaluation results")
} }
...@@ -133,7 +133,7 @@ format.eval.string <- function(eval_res, eval_err = NULL) { ...@@ -133,7 +133,7 @@ format.eval.string <- function(eval_res, eval_err = NULL) {
merge.eval.string <- function(env) { merge.eval.string <- function(env) {
# Check length of evaluation list # Check length of evaluation list
if (length(env$eval_list) <= 0) { if (length(env$eval_list) <= 0L) {
return("") return("")
} }
...@@ -141,7 +141,7 @@ merge.eval.string <- function(env) { ...@@ -141,7 +141,7 @@ merge.eval.string <- function(env) {
msg <- list(sprintf("[%d]:", env$iteration)) msg <- list(sprintf("[%d]:", env$iteration))
# Set if evaluation error # Set if evaluation error
is_eval_err <- length(env$eval_err_list) > 0 is_eval_err <- length(env$eval_err_list) > 0L
# Loop through evaluation list # Loop through evaluation list
for (j in seq_along(env$eval_list)) { for (j in seq_along(env$eval_list)) {
...@@ -162,25 +162,25 @@ merge.eval.string <- function(env) { ...@@ -162,25 +162,25 @@ merge.eval.string <- function(env) {
} }
cb.print.evaluation <- function(period = 1) { cb.print.evaluation <- function(period = 1L) {
# Create callback # Create callback
callback <- function(env) { callback <- function(env) {
# Check if period is at least 1 or more # Check if period is at least 1 or more
if (period > 0) { if (period > 0L) {
# Store iteration # Store iteration
i <- env$iteration i <- env$iteration
# Check if iteration matches moduo # Check if iteration matches moduo
if ( (i - 1) %% period == 0 || is.element(i, c(env$begin_iteration, env$end_iteration))) { if ((i - 1L) %% period == 0L || is.element(i, c(env$begin_iteration, env$end_iteration))) {
# Merge evaluation string # Merge evaluation string
msg <- merge.eval.string(env) msg <- merge.eval.string(env)
# Check if message is existing # Check if message is existing
if (nchar(msg) > 0) { if (nchar(msg) > 0L) {
cat(merge.eval.string(env), "\n") cat(merge.eval.string(env), "\n")
} }
...@@ -205,15 +205,15 @@ cb.record.evaluation <- function() { ...@@ -205,15 +205,15 @@ cb.record.evaluation <- function() {
callback <- function(env) { callback <- function(env) {
# Return empty if empty evaluation list # Return empty if empty evaluation list
if (length(env$eval_list) <= 0) { if (length(env$eval_list) <= 0L) {
return() return()
} }
# Set if evaluation error # Set if evaluation error
is_eval_err <- length(env$eval_err_list) > 0 is_eval_err <- length(env$eval_err_list) > 0L
# Check length of recorded evaluation # Check length of recorded evaluation
if (length(env$model$record_evals) == 0) { if (length(env$model$record_evals) == 0L) {
# Loop through each evaluation list element # Loop through each evaluation list element
for (j in seq_along(env$eval_list)) { for (j in seq_along(env$eval_list)) {
...@@ -290,7 +290,7 @@ cb.early.stop <- function(stopping_rounds, verbose = TRUE) { ...@@ -290,7 +290,7 @@ cb.early.stop <- function(stopping_rounds, verbose = TRUE) {
eval_len <<- length(env$eval_list) eval_len <<- length(env$eval_list)
# Early stopping cannot work without metrics # Early stopping cannot work without metrics
if (eval_len == 0) { if (eval_len == 0L) {
stop("For early stopping, valids must have at least one element") stop("For early stopping, valids must have at least one element")
} }
...@@ -301,7 +301,7 @@ cb.early.stop <- function(stopping_rounds, verbose = TRUE) { ...@@ -301,7 +301,7 @@ cb.early.stop <- function(stopping_rounds, verbose = TRUE) {
# Maximization or minimization task # Maximization or minimization task
factor_to_bigger_better <<- rep.int(1.0, eval_len) factor_to_bigger_better <<- rep.int(1.0, eval_len)
best_iter <<- rep.int(-1, eval_len) best_iter <<- rep.int(-1L, eval_len)
best_score <<- rep.int(-Inf, eval_len) best_score <<- rep.int(-Inf, eval_len)
best_msg <<- list() best_msg <<- list()
......
R-package/R/lgb.Booster.R
View file @ 1f7b06b9
...@@ -4,7 +4,7 @@ Booster <- R6::R6Class( ...@@ -4,7 +4,7 @@ Booster <- R6::R6Class(
cloneable = FALSE, cloneable = FALSE,
public = list( public = list(
best_iter = -1, best_iter = -1L,
best_score = NA, best_score = NA,
record_evals = list(), record_evals = list(),
...@@ -55,7 +55,7 @@ Booster <- R6::R6Class( ...@@ -55,7 +55,7 @@ Booster <- R6::R6Class(
# Create private booster information # Create private booster information
private$train_set <- train_set private$train_set <- train_set
private$num_dataset <- 1 private$num_dataset <- 1L
private$init_predictor <- train_set$.__enclos_env__$private$predictor private$init_predictor <- train_set$.__enclos_env__$private$predictor
# Check if predictor is existing # Check if predictor is existing
...@@ -176,7 +176,7 @@ Booster <- R6::R6Class( ...@@ -176,7 +176,7 @@ Booster <- R6::R6Class(
# Store private information # Store private information
private$valid_sets <- c(private$valid_sets, data) private$valid_sets <- c(private$valid_sets, data)
private$name_valid_sets <- c(private$name_valid_sets, name) private$name_valid_sets <- c(private$name_valid_sets, name)
private$num_dataset <- private$num_dataset + 1 private$num_dataset <- private$num_dataset + 1L
private$is_predicted_cur_iter <- c(private$is_predicted_cur_iter, FALSE) private$is_predicted_cur_iter <- c(private$is_predicted_cur_iter, FALSE)
# Return self # Return self
...@@ -229,7 +229,7 @@ Booster <- R6::R6Class( ...@@ -229,7 +229,7 @@ Booster <- R6::R6Class(
) )
# Store private train set # Store private train set
private$train_set = train_set private$train_set <- train_set
} }
...@@ -249,13 +249,13 @@ Booster <- R6::R6Class( ...@@ -249,13 +249,13 @@ Booster <- R6::R6Class(
} }
if (!private$set_objective_to_none) { if (!private$set_objective_to_none) {
self$reset_parameter(params = list(objective = "none")) self$reset_parameter(params = list(objective = "none"))
private$set_objective_to_none = TRUE private$set_objective_to_none <- TRUE
} }
# Perform objective calculation # Perform objective calculation
gpair <- fobj(private$inner_predict(1), private$train_set) gpair <- fobj(private$inner_predict(1L), private$train_set)
# Check for gradient and hessian as list # Check for gradient and hessian as list
if (is.null(gpair$grad) || is.null(gpair$hess)){ if (is.null(gpair$grad) || is.null(gpair$hess)) {
stop("lgb.Booster.update: custom objective should stop("lgb.Booster.update: custom objective should
return a list with attributes (hess, grad)") return a list with attributes (hess, grad)")
} }
...@@ -322,13 +322,13 @@ Booster <- R6::R6Class( ...@@ -322,13 +322,13 @@ Booster <- R6::R6Class(
} }
# Check for identical data # Check for identical data
data_idx <- 0 data_idx <- 0L
if (identical(data, private$train_set)) { if (identical(data, private$train_set)) {
data_idx <- 1 data_idx <- 1L
} else { } else {
# Check for validation data # Check for validation data
if (length(private$valid_sets) > 0) { if (length(private$valid_sets) > 0L) {
# Loop through each validation set # Loop through each validation set
for (i in seq_along(private$valid_sets)) { for (i in seq_along(private$valid_sets)) {
...@@ -337,7 +337,7 @@ Booster <- R6::R6Class( ...@@ -337,7 +337,7 @@ Booster <- R6::R6Class(
if (identical(data, private$valid_sets[[i]])) { if (identical(data, private$valid_sets[[i]])) {
# Found identical data, skip # Found identical data, skip
data_idx <- i + 1 data_idx <- i + 1L
break break
} }
...@@ -349,7 +349,7 @@ Booster <- R6::R6Class( ...@@ -349,7 +349,7 @@ Booster <- R6::R6Class(
} }
# Check if evaluation was not done # Check if evaluation was not done
if (data_idx == 0) { if (data_idx == 0L) {
# Add validation data by name # Add validation data by name
self$add_valid(data, name) self$add_valid(data, name)
...@@ -364,17 +364,17 @@ Booster <- R6::R6Class( ...@@ -364,17 +364,17 @@ Booster <- R6::R6Class(
# Evaluation training data # Evaluation training data
eval_train = function(feval = NULL) { eval_train = function(feval = NULL) {
private$inner_eval(private$name_train_set, 1, feval) private$inner_eval(private$name_train_set, 1L, feval)
}, },
# Evaluation validation data # Evaluation validation data
eval_valid = function(feval = NULL) { eval_valid = function(feval = NULL) {
# Create ret list # Create ret list
ret = list() ret <- list()
# Check if validation is empty # Check if validation is empty
if (length(private$valid_sets) <= 0) { if (length(private$valid_sets) <= 0L) {
return(ret) return(ret)
} }
...@@ -382,7 +382,7 @@ Booster <- R6::R6Class( ...@@ -382,7 +382,7 @@ Booster <- R6::R6Class(
for (i in seq_along(private$valid_sets)) { for (i in seq_along(private$valid_sets)) {
ret <- append( ret <- append(
x = ret x = ret
, values = private$inner_eval(private$name_valid_sets[[i]], i + 1, feval) , values = private$inner_eval(private$name_valid_sets[[i]], i + 1L, feval)
) )
} }
...@@ -491,8 +491,8 @@ Booster <- R6::R6Class( ...@@ -491,8 +491,8 @@ Booster <- R6::R6Class(
name_valid_sets = list(), name_valid_sets = list(),
predict_buffer = list(), predict_buffer = list(),
is_predicted_cur_iter = list(), is_predicted_cur_iter = list(),
num_class = 1, num_class = 1L,
num_dataset = 0, num_dataset = 0L,
init_predictor = NULL, init_predictor = NULL,
eval_names = NULL, eval_names = NULL,
higher_better_inner_eval = NULL, higher_better_inner_eval = NULL,
...@@ -504,8 +504,8 @@ Booster <- R6::R6Class( ...@@ -504,8 +504,8 @@ Booster <- R6::R6Class(
data_name <- private$name_train_set data_name <- private$name_train_set
# Check for id bigger than 1 # Check for id bigger than 1
if (idx > 1) { if (idx > 1L) {
data_name <- private$name_valid_sets[[idx - 1]] data_name <- private$name_valid_sets[[idx - 1L]]
} }
# Check for unknown dataset (over the maximum provided range) # Check for unknown dataset (over the maximum provided range)
...@@ -522,7 +522,7 @@ Booster <- R6::R6Class( ...@@ -522,7 +522,7 @@ Booster <- R6::R6Class(
"LGBM_BoosterGetNumPredict_R" "LGBM_BoosterGetNumPredict_R"
, ret = npred , ret = npred
, private$handle , private$handle
, as.integer(idx - 1) , as.integer(idx - 1L)
) )
private$predict_buffer[[data_name]] <- numeric(npred) private$predict_buffer[[data_name]] <- numeric(npred)
...@@ -536,7 +536,7 @@ Booster <- R6::R6Class( ...@@ -536,7 +536,7 @@ Booster <- R6::R6Class(
"LGBM_BoosterGetPredict_R" "LGBM_BoosterGetPredict_R"
, ret = private$predict_buffer[[data_name]] , ret = private$predict_buffer[[data_name]]
, private$handle , private$handle
, as.integer(idx - 1) , as.integer(idx - 1L)
) )
private$is_predicted_cur_iter[[idx]] <- TRUE private$is_predicted_cur_iter[[idx]] <- TRUE
} }
...@@ -558,10 +558,10 @@ Booster <- R6::R6Class( ...@@ -558,10 +558,10 @@ Booster <- R6::R6Class(
) )
# Check names' length # Check names' length
if (nchar(names) > 0) { if (nchar(names) > 0L) {
# Parse and store privately names # Parse and store privately names
names <- strsplit(names, "\t")[[1]] names <- strsplit(names, "\t")[[1L]]
private$eval_names <- names private$eval_names <- names
private$higher_better_inner_eval <- grepl("^ndcg|^map|^auc$", names) private$higher_better_inner_eval <- grepl("^ndcg|^map|^auc$", names)
...@@ -589,7 +589,7 @@ Booster <- R6::R6Class( ...@@ -589,7 +589,7 @@ Booster <- R6::R6Class(
ret <- list() ret <- list()
# Check evaluation names existence # Check evaluation names existence
if (length(private$eval_names) > 0) { if (length(private$eval_names) > 0L) {
# Create evaluation values # Create evaluation values
tmp_vals <- numeric(length(private$eval_names)) tmp_vals <- numeric(length(private$eval_names))
...@@ -597,7 +597,7 @@ Booster <- R6::R6Class( ...@@ -597,7 +597,7 @@ Booster <- R6::R6Class(
"LGBM_BoosterGetEval_R" "LGBM_BoosterGetEval_R"
, ret = tmp_vals , ret = tmp_vals
, private$handle , private$handle
, as.integer(data_idx - 1) , as.integer(data_idx - 1L)
) )
# Loop through all evaluation names # Loop through all evaluation names
...@@ -627,8 +627,8 @@ Booster <- R6::R6Class( ...@@ -627,8 +627,8 @@ Booster <- R6::R6Class(
data <- private$train_set data <- private$train_set
# Check if data to assess is existing differently # Check if data to assess is existing differently
if (data_idx > 1) { if (data_idx > 1L) {
data <- private$valid_sets[[data_idx - 1]] data <- private$valid_sets[[data_idx - 1L]]
} }
# Perform function evaluation # Perform function evaluation
...@@ -671,14 +671,13 @@ Booster <- R6::R6Class( ...@@ -671,14 +671,13 @@ Booster <- R6::R6Class(
#' prediction outputs per case. #' prediction outputs per case.
#' @param ... Additional named arguments passed to the \code{predict()} method of #' @param ... Additional named arguments passed to the \code{predict()} method of
#' the \code{lgb.Booster} object passed to \code{object}. #' the \code{lgb.Booster} object passed to \code{object}.
#' @return #' @return For regression or binary classification, it returns a vector of length \code{nrows(data)}.
#' For regression or binary classification, it returns a vector of length \code{nrows(data)}. #' For multiclass classification, either a \code{num_class * nrows(data)} vector or
#' For multiclass classification, either a \code{num_class * nrows(data)} vector or #' a \code{(nrows(data), num_class)} dimension matrix is returned, depending on
#' a \code{(nrows(data), num_class)} dimension matrix is returned, depending on #' the \code{reshape} value.
#' the \code{reshape} value.
#' #'
#' When \code{predleaf = TRUE}, the output is a matrix object with the #' When \code{predleaf = TRUE}, the output is a matrix object with the
#' number of columns corresponding to the number of trees. #' number of columns corresponding to the number of trees.
#' #'
#' @examples #' @examples
#' library(lightgbm) #' library(lightgbm)
...@@ -693,11 +692,11 @@ Booster <- R6::R6Class( ...@@ -693,11 +692,11 @@ Booster <- R6::R6Class(
#' model <- lgb.train( #' model <- lgb.train(
#' params = params #' params = params
#' , data = dtrain #' , data = dtrain
#' , nrounds = 10 #' , nrounds = 10L
#' , valids = valids #' , valids = valids
#' , min_data = 1 #' , min_data = 1L
#' , learning_rate = 1 #' , learning_rate = 1.0
#' , early_stopping_rounds = 5 #' , early_stopping_rounds = 5L
#' ) #' )
#' preds <- predict(model, test$data) #' preds <- predict(model, test$data)
#' #'
...@@ -755,11 +754,11 @@ predict.lgb.Booster <- function(object, ...@@ -755,11 +754,11 @@ predict.lgb.Booster <- function(object,
#' model <- lgb.train( #' model <- lgb.train(
#' params = params #' params = params
#' , data = dtrain #' , data = dtrain
#' , nrounds = 10 #' , nrounds = 10L
#' , valids = valids #' , valids = valids
#' , min_data = 1 #' , min_data = 1L
#' , learning_rate = 1 #' , learning_rate = 1.0
#' , early_stopping_rounds = 5 #' , early_stopping_rounds = 5L
#' ) #' )
#' lgb.save(model, "model.txt") #' lgb.save(model, "model.txt")
#' load_booster <- lgb.load(filename = "model.txt") #' load_booster <- lgb.load(filename = "model.txt")
...@@ -768,7 +767,7 @@ predict.lgb.Booster <- function(object, ...@@ -768,7 +767,7 @@ predict.lgb.Booster <- function(object,
#' #'
#' @rdname lgb.load #' @rdname lgb.load
#' @export #' @export
lgb.load <- function(filename = NULL, model_str = NULL){ lgb.load <- function(filename = NULL, model_str = NULL) {
if (is.null(filename) && is.null(model_str)) { if (is.null(filename) && is.null(model_str)) {
stop("lgb.load: either filename or model_str must be given") stop("lgb.load: either filename or model_str must be given")
...@@ -815,17 +814,17 @@ lgb.load <- function(filename = NULL, model_str = NULL){ ...@@ -815,17 +814,17 @@ lgb.load <- function(filename = NULL, model_str = NULL){
#' model <- lgb.train( #' model <- lgb.train(
#' params = params #' params = params
#' , data = dtrain #' , data = dtrain
#' , nrounds = 10 #' , nrounds = 10L
#' , valids = valids #' , valids = valids
#' , min_data = 1 #' , min_data = 1L
#' , learning_rate = 1 #' , learning_rate = 1.0
#' , early_stopping_rounds = 5 #' , early_stopping_rounds = 5L
#' ) #' )
#' lgb.save(model, "model.txt") #' lgb.save(model, "model.txt")
#' #'
#' @rdname lgb.save #' @rdname lgb.save
#' @export #' @export
lgb.save <- function(booster, filename, num_iteration = NULL){ lgb.save <- function(booster, filename, num_iteration = NULL) {
# Check if booster is booster # Check if booster is booster
if (!lgb.is.Booster(booster)) { if (!lgb.is.Booster(booster)) {
...@@ -864,17 +863,17 @@ lgb.save <- function(booster, filename, num_iteration = NULL){ ...@@ -864,17 +863,17 @@ lgb.save <- function(booster, filename, num_iteration = NULL){
#' model <- lgb.train( #' model <- lgb.train(
#' params = params #' params = params
#' , data = dtrain #' , data = dtrain
#' , nrounds = 10 #' , nrounds = 10L
#' , valids = valids #' , valids = valids
#' , min_data = 1 #' , min_data = 1L
#' , learning_rate = 1 #' , learning_rate = 1.0
#' , early_stopping_rounds = 5 #' , early_stopping_rounds = 5L
#' ) #' )
#' json_model <- lgb.dump(model) #' json_model <- lgb.dump(model)
#' #'
#' @rdname lgb.dump #' @rdname lgb.dump
#' @export #' @export
lgb.dump <- function(booster, num_iteration = NULL){ lgb.dump <- function(booster, num_iteration = NULL) {
# Check if booster is booster # Check if booster is booster
if (!lgb.is.Booster(booster)) { if (!lgb.is.Booster(booster)) {
...@@ -910,11 +909,11 @@ lgb.dump <- function(booster, num_iteration = NULL){ ...@@ -910,11 +909,11 @@ lgb.dump <- function(booster, num_iteration = NULL){
#' model <- lgb.train( #' model <- lgb.train(
#' params = params #' params = params
#' , data = dtrain #' , data = dtrain
#' , nrounds = 10 #' , nrounds = 10L
#' , valids = valids #' , valids = valids
#' , min_data = 1 #' , min_data = 1L
#' , learning_rate = 1 #' , learning_rate = 1.0
#' , early_stopping_rounds = 5 #' , early_stopping_rounds = 5L
#' ) #' )
#' lgb.get.eval.result(model, "test", "l2") #' lgb.get.eval.result(model, "test", "l2")
#' @rdname lgb.get.eval.result #' @rdname lgb.get.eval.result
...@@ -956,7 +955,7 @@ lgb.get.eval.result <- function(booster, data_name, eval_name, iters = NULL, is_ ...@@ -956,7 +955,7 @@ lgb.get.eval.result <- function(booster, data_name, eval_name, iters = NULL, is_
# Parse iteration and booster delta # Parse iteration and booster delta
iters <- as.integer(iters) iters <- as.integer(iters)
delta <- booster$record_evals$start_iter - 1 delta <- booster$record_evals$start_iter - 1.0
iters <- iters - delta iters <- iters - delta
# Return requested result # Return requested result
......
R-package/R/lgb.Dataset.R
View file @ 1f7b06b9
...@@ -140,10 +140,10 @@ Dataset <- R6::R6Class( ...@@ -140,10 +140,10 @@ Dataset <- R6::R6Class(
# Check for character name # Check for character name
if (is.character(private$categorical_feature)) { if (is.character(private$categorical_feature)) {
cate_indices <- as.list(match(private$categorical_feature, private$colnames) - 1) cate_indices <- as.list(match(private$categorical_feature, private$colnames) - 1L)
# Provided indices, but some indices are not existing? # Provided indices, but some indices are not existing?
if (sum(is.na(cate_indices)) > 0) { if (sum(is.na(cate_indices)) > 0L) {
stop( stop(
"lgb.self.get.handle: supplied an unknown feature in categorical_feature: " "lgb.self.get.handle: supplied an unknown feature in categorical_feature: "
, sQuote(private$categorical_feature[is.na(cate_indices)]) , sQuote(private$categorical_feature[is.na(cate_indices)])
...@@ -164,7 +164,7 @@ Dataset <- R6::R6Class( ...@@ -164,7 +164,7 @@ Dataset <- R6::R6Class(
} }
# Store indices as [0, n-1] indexed instead of [1, n] indexed # Store indices as [0, n-1] indexed instead of [1, n] indexed
cate_indices <- as.list(private$categorical_feature - 1) cate_indices <- as.list(private$categorical_feature - 1L)
} }
...@@ -221,7 +221,7 @@ Dataset <- R6::R6Class( ...@@ -221,7 +221,7 @@ Dataset <- R6::R6Class(
) )
} else if (methods::is(private$raw_data, "dgCMatrix")) { } else if (methods::is(private$raw_data, "dgCMatrix")) {
if (length(private$raw_data@p) > 2147483647) { if (length(private$raw_data@p) > 2147483647L) {
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)
...@@ -300,13 +300,13 @@ Dataset <- R6::R6Class( ...@@ -300,13 +300,13 @@ Dataset <- R6::R6Class(
} }
# Get private information # Get private information
if (length(private$info) > 0) { if (length(private$info) > 0L) {
# Set infos # Set infos
for (i in seq_along(private$info)) { for (i in seq_along(private$info)) {
p <- private$info[i] p <- private$info[i]
self$setinfo(names(p), p[[1]]) self$setinfo(names(p), p[[1L]])
} }
...@@ -361,7 +361,7 @@ Dataset <- R6::R6Class( ...@@ -361,7 +361,7 @@ Dataset <- R6::R6Class(
# Get feature names and write them # Get feature names and write them
cnames <- lgb.call.return.str("LGBM_DatasetGetFeatureNames_R", private$handle) cnames <- lgb.call.return.str("LGBM_DatasetGetFeatureNames_R", private$handle)
private$colnames <- as.character(base::strsplit(cnames, "\t")[[1]]) private$colnames <- as.character(base::strsplit(cnames, "\t")[[1L]])
private$colnames private$colnames
} 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")) {
...@@ -391,7 +391,7 @@ Dataset <- R6::R6Class( ...@@ -391,7 +391,7 @@ Dataset <- R6::R6Class(
# Check empty column names # Check empty column names
colnames <- as.character(colnames) colnames <- as.character(colnames)
if (length(colnames) == 0) { if (length(colnames) == 0L) {
return(invisible(self)) return(invisible(self))
} }
...@@ -422,14 +422,14 @@ Dataset <- R6::R6Class( ...@@ -422,14 +422,14 @@ Dataset <- R6::R6Class(
INFONAMES <- c("label", "weight", "init_score", "group") INFONAMES <- c("label", "weight", "init_score", "group")
# Check if attribute key is in the known attribute list # Check if attribute key is in the known attribute list
if (!is.character(name) || length(name) != 1 || !name %in% INFONAMES) { if (!is.character(name) || length(name) != 1L || !name %in% INFONAMES) {
stop("getinfo: name must one of the following: ", paste0(sQuote(INFONAMES), collapse = ", ")) stop("getinfo: name must one of the following: ", paste0(sQuote(INFONAMES), collapse = ", "))
} }
# Check for info name and handle # Check for info name and handle
if (is.null(private$info[[name]])) { if (is.null(private$info[[name]])) {
if (lgb.is.null.handle(private$handle)){ if (lgb.is.null.handle(private$handle)) {
stop("Cannot perform getinfo before constructing Dataset.") stop("Cannot perform getinfo before constructing Dataset.")
} }
...@@ -443,7 +443,7 @@ Dataset <- R6::R6Class( ...@@ -443,7 +443,7 @@ Dataset <- R6::R6Class(
) )
# Check if info is not empty # Check if info is not empty
if (info_len > 0) { if (info_len > 0L) {
# Get back fields # Get back fields
ret <- NULL ret <- NULL
...@@ -476,7 +476,7 @@ Dataset <- R6::R6Class( ...@@ -476,7 +476,7 @@ Dataset <- R6::R6Class(
INFONAMES <- c("label", "weight", "init_score", "group") INFONAMES <- c("label", "weight", "init_score", "group")
# Check if attribute key is in the known attribute list # Check if attribute key is in the known attribute list
if (!is.character(name) || length(name) != 1 || !name %in% INFONAMES) { if (!is.character(name) || length(name) != 1L || !name %in% INFONAMES) {
stop("setinfo: name must one of the following: ", paste0(sQuote(INFONAMES), collapse = ", ")) stop("setinfo: name must one of the following: ", paste0(sQuote(INFONAMES), collapse = ", "))
} }
...@@ -492,7 +492,7 @@ Dataset <- R6::R6Class( ...@@ -492,7 +492,7 @@ Dataset <- R6::R6Class(
if (!lgb.is.null.handle(private$handle) && !is.null(info)) { if (!lgb.is.null.handle(private$handle) && !is.null(info)) {
if (length(info) > 0) { if (length(info) > 0L) {
lgb.call( lgb.call(
"LGBM_DatasetSetField_R" "LGBM_DatasetSetField_R"
...@@ -851,7 +851,7 @@ dim.lgb.Dataset <- function(x, ...) { ...@@ -851,7 +851,7 @@ dim.lgb.Dataset <- function(x, ...) {
#' lgb.Dataset.construct(dtrain) #' lgb.Dataset.construct(dtrain)
#' dimnames(dtrain) #' dimnames(dtrain)
#' colnames(dtrain) #' colnames(dtrain)
#' colnames(dtrain) <- make.names(1:ncol(train$data)) #' colnames(dtrain) <- make.names(seq_len(ncol(train$data)))
#' print(dtrain, verbose = TRUE) #' print(dtrain, verbose = TRUE)
#' #'
#' @rdname dimnames.lgb.Dataset #' @rdname dimnames.lgb.Dataset
...@@ -883,7 +883,7 @@ dimnames.lgb.Dataset <- function(x) { ...@@ -883,7 +883,7 @@ dimnames.lgb.Dataset <- function(x) {
} }
# Check for second value missing # Check for second value missing
if (is.null(value[[2]])) { if (is.null(value[[2L]])) {
# No column names # No column names
x$set_colnames(NULL) x$set_colnames(NULL)
...@@ -892,10 +892,10 @@ dimnames.lgb.Dataset <- function(x) { ...@@ -892,10 +892,10 @@ dimnames.lgb.Dataset <- function(x) {
} }
# Check for unmatching column size # Check for unmatching column size
if (ncol(x) != length(value[[2]])) { if (ncol(x) != length(value[[2L]])) {
stop( stop(
"can't assign " "can't assign "
, sQuote(length(value[[2]])) , sQuote(length(value[[2L]]))
, " colnames to an lgb.Dataset with " , " colnames to an lgb.Dataset with "
, sQuote(ncol(x)) , sQuote(ncol(x))
, " columns" , " columns"
...@@ -903,7 +903,7 @@ dimnames.lgb.Dataset <- function(x) { ...@@ -903,7 +903,7 @@ dimnames.lgb.Dataset <- function(x) {
} }
# Set column names properly, and return # Set column names properly, and return
x$set_colnames(value[[2]]) x$set_colnames(value[[2L]])
x x
} }
...@@ -924,7 +924,7 @@ dimnames.lgb.Dataset <- function(x) { ...@@ -924,7 +924,7 @@ dimnames.lgb.Dataset <- function(x) {
#' train <- agaricus.train #' train <- agaricus.train
#' dtrain <- lgb.Dataset(train$data, label = train$label) #' dtrain <- lgb.Dataset(train$data, label = train$label)
#' #'
#' dsub <- lightgbm::slice(dtrain, 1:42) #' dsub <- lightgbm::slice(dtrain, seq_len(42L))
#' lgb.Dataset.construct(dsub) #' lgb.Dataset.construct(dsub)
#' labels <- lightgbm::getinfo(dsub, "label") #' labels <- lightgbm::getinfo(dsub, "label")
#' #'
...@@ -1059,7 +1059,7 @@ setinfo.lgb.Dataset <- function(dataset, name, info, ...) { ...@@ -1059,7 +1059,7 @@ setinfo.lgb.Dataset <- function(dataset, name, info, ...) {
#' dtrain <- lgb.Dataset(train$data, label = train$label) #' dtrain <- lgb.Dataset(train$data, label = train$label)
#' lgb.Dataset.save(dtrain, "lgb.Dataset.data") #' lgb.Dataset.save(dtrain, "lgb.Dataset.data")
#' dtrain <- lgb.Dataset("lgb.Dataset.data") #' dtrain <- lgb.Dataset("lgb.Dataset.data")
#' lgb.Dataset.set.categorical(dtrain, 1:2) #' lgb.Dataset.set.categorical(dtrain, 1L:2L)
#' #'
#' @rdname lgb.Dataset.set.categorical #' @rdname lgb.Dataset.set.categorical
#' @export #' @export
......
R-package/R/lgb.Predictor.R
View file @ 1f7b06b9
...@@ -84,14 +84,14 @@ Predictor <- R6::R6Class( ...@@ -84,14 +84,14 @@ Predictor <- R6::R6Class(
# Check if number of iterations is existing - if not, then set it to -1 (use all) # Check if number of iterations is existing - if not, then set it to -1 (use all)
if (is.null(num_iteration)) { if (is.null(num_iteration)) {
num_iteration <- -1 num_iteration <- -1L
} }
# Set temporary variable # Set temporary variable
num_row <- 0L num_row <- 0L
# Check if data is a file name and not a matrix # Check if data is a file name and not a matrix
if (identical(class(data), "character") && length(data) == 1) { if (identical(class(data), "character") && length(data) == 1L) {
# Data is a filename, create a temporary file with a "lightgbm_" pattern in it # Data is a filename, create a temporary file with a "lightgbm_" pattern in it
tmp_filename <- tempfile(pattern = "lightgbm_") tmp_filename <- tempfile(pattern = "lightgbm_")
...@@ -156,7 +156,7 @@ Predictor <- R6::R6Class( ...@@ -156,7 +156,7 @@ Predictor <- R6::R6Class(
) )
} else if (methods::is(data, "dgCMatrix")) { } else if (methods::is(data, "dgCMatrix")) {
if (length(data@p) > 2147483647) { if (length(data@p) > 2147483647L) {
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)
...@@ -187,11 +187,11 @@ Predictor <- R6::R6Class( ...@@ -187,11 +187,11 @@ Predictor <- R6::R6Class(
} }
# Check if number of rows is strange (not a multiple of the dataset rows) # Check if number of rows is strange (not a multiple of the dataset rows)
if (length(preds) %% num_row != 0) { if (length(preds) %% num_row != 0L) {
stop( stop(
"predict: prediction length " "predict: prediction length "
, sQuote(length(preds)) , sQuote(length(preds))
," is not a multiple of nrows(data): " , " is not a multiple of nrows(data): "
, sQuote(num_row) , sQuote(num_row)
) )
} }
...@@ -207,7 +207,7 @@ Predictor <- R6::R6Class( ...@@ -207,7 +207,7 @@ Predictor <- R6::R6Class(
# Predict leaves only, reshaping is mandatory # Predict leaves only, reshaping is mandatory
preds <- matrix(preds, ncol = npred_per_case, byrow = TRUE) preds <- matrix(preds, ncol = npred_per_case, byrow = TRUE)
} else if (reshape && npred_per_case > 1) { } else if (reshape && npred_per_case > 1L) {
# Predict with data reshaping # Predict with data reshaping
preds <- matrix(preds, ncol = npred_per_case, byrow = TRUE) preds <- matrix(preds, ncol = npred_per_case, byrow = TRUE)
......
R-package/R/lgb.cv.R
View file @ 1f7b06b9
...@@ -3,7 +3,7 @@ CVBooster <- R6::R6Class( ...@@ -3,7 +3,7 @@ CVBooster <- R6::R6Class(
classname = "lgb.CVBooster", classname = "lgb.CVBooster",
cloneable = FALSE, cloneable = FALSE,
public = list( public = list(
best_iter = -1, best_iter = -1L,
best_score = NA, best_score = NA,
record_evals = list(), record_evals = list(),
boosters = list(), boosters = list(),
...@@ -64,34 +64,35 @@ CVBooster <- R6::R6Class( ...@@ -64,34 +64,35 @@ CVBooster <- R6::R6Class(
#' model <- lgb.cv( #' model <- lgb.cv(
#' params = params #' params = params
#' , data = dtrain #' , data = dtrain
#' , nrounds = 10 #' , nrounds = 10L
#' , nfold = 3 #' , nfold = 3L
#' , min_data = 1 #' , min_data = 1L
#' , learning_rate = 1 #' , learning_rate = 1.0
#' , early_stopping_rounds = 5 #' , early_stopping_rounds = 5L
#' ) #' )
#' @export #' @export
lgb.cv <- function(params = list(), lgb.cv <- function(params = list()
data, , data
nrounds = 10, , nrounds = 10L
nfold = 3, , nfold = 3L
label = NULL, , label = NULL
weight = NULL, , weight = NULL
obj = NULL, , obj = NULL
eval = NULL, , eval = NULL
verbose = 1, , verbose = 1L
record = TRUE, , record = TRUE
eval_freq = 1L, , eval_freq = 1L
showsd = TRUE, , shows = TRUE
stratified = TRUE, , stratified = TRUE
folds = NULL, , folds = NULL
init_model = NULL, , init_model = NULL
colnames = NULL, , colnames = NULL
categorical_feature = NULL, , categorical_feature = NULL
early_stopping_rounds = NULL, , early_stopping_rounds = NULL
callbacks = list(), , callbacks = list()
reset_data = FALSE, , reset_data = FALSE
...) { , ...
) {
# Setup temporary variables # Setup temporary variables
addiction_params <- list(...) addiction_params <- list(...)
...@@ -102,7 +103,7 @@ lgb.cv <- function(params = list(), ...@@ -102,7 +103,7 @@ lgb.cv <- function(params = list(),
fobj <- NULL fobj <- NULL
feval <- NULL feval <- NULL
if (nrounds <= 0) { if (nrounds <= 0L) {
stop("nrounds should be greater than zero") stop("nrounds should be greater than zero")
} }
...@@ -131,16 +132,16 @@ lgb.cv <- function(params = list(), ...@@ -131,16 +132,16 @@ lgb.cv <- function(params = list(),
} }
# Set the iteration to start from / end to (and check for boosting from a trained model, again) # Set the iteration to start from / end to (and check for boosting from a trained model, again)
begin_iteration <- 1 begin_iteration <- 1L
if (!is.null(predictor)) { if (!is.null(predictor)) {
begin_iteration <- predictor$current_iter() + 1 begin_iteration <- predictor$current_iter() + 1L
} }
# Check for number of rounds passed as parameter - in case there are multiple ones, take only the first one # Check for number of rounds passed as parameter - in case there are multiple ones, take only the first one
n_trees <- .PARAMETER_ALIASES()[["num_iterations"]] n_trees <- .PARAMETER_ALIASES()[["num_iterations"]]
if (any(names(params) %in% n_trees)) { if (any(names(params) %in% n_trees)) {
end_iteration <- begin_iteration + params[[which(names(params) %in% n_trees)[1]]] - 1 end_iteration <- begin_iteration + params[[which(names(params) %in% n_trees)[1L]]] - 1L
} else { } else {
end_iteration <- begin_iteration + nrounds - 1 end_iteration <- begin_iteration + nrounds - 1L
} }
# Check for training dataset type correctness # Check for training dataset type correctness
...@@ -179,7 +180,7 @@ lgb.cv <- function(params = list(), ...@@ -179,7 +180,7 @@ lgb.cv <- function(params = list(),
if (!is.null(folds)) { if (!is.null(folds)) {
# Check for list of folds or for single value # Check for list of folds or for single value
if (!is.list(folds) || length(folds) < 2) { if (!is.list(folds) || length(folds) < 2L) {
stop(sQuote("folds"), " must be a list with 2 or more elements that are vectors of indices for each CV-fold") stop(sQuote("folds"), " must be a list with 2 or more elements that are vectors of indices for each CV-fold")
} }
...@@ -189,7 +190,7 @@ lgb.cv <- function(params = list(), ...@@ -189,7 +190,7 @@ lgb.cv <- function(params = list(),
} else { } else {
# Check fold value # Check fold value
if (nfold <= 1) { if (nfold <= 1L) {
stop(sQuote("nfold"), " must be > 1") stop(sQuote("nfold"), " must be > 1")
} }
...@@ -206,7 +207,7 @@ lgb.cv <- function(params = list(), ...@@ -206,7 +207,7 @@ lgb.cv <- function(params = list(),
} }
# Add printing log callback # Add printing log callback
if (verbose > 0 && eval_freq > 0) { if (verbose > 0L && eval_freq > 0L) {
callbacks <- add.cb(callbacks, cb.print.evaluation(eval_freq)) callbacks <- add.cb(callbacks, cb.print.evaluation(eval_freq))
} }
...@@ -220,7 +221,7 @@ lgb.cv <- function(params = list(), ...@@ -220,7 +221,7 @@ lgb.cv <- function(params = list(),
early_stop <- .PARAMETER_ALIASES()[["early_stopping_round"]] early_stop <- .PARAMETER_ALIASES()[["early_stopping_round"]]
early_stop_param_indx <- names(params) %in% early_stop early_stop_param_indx <- names(params) %in% early_stop
if (any(early_stop_param_indx)) { if (any(early_stop_param_indx)) {
first_early_stop_param <- which(early_stop_param_indx)[[1]] first_early_stop_param <- which(early_stop_param_indx)[[1L]]
first_early_stop_param_name <- names(params)[[first_early_stop_param]] first_early_stop_param_name <- names(params)[[first_early_stop_param]]
early_stopping_rounds <- params[[first_early_stop_param_name]] early_stopping_rounds <- params[[first_early_stop_param_name]]
} }
...@@ -232,20 +233,20 @@ lgb.cv <- function(params = list(), ...@@ -232,20 +233,20 @@ lgb.cv <- function(params = list(),
using_dart <- any( using_dart <- any(
sapply( sapply(
X = boosting_param_names X = boosting_param_names
, FUN = function(param){ , FUN = function(param) {
identical(params[[param]], 'dart') identical(params[[param]], "dart")
} }
) )
) )
# Cannot use early stopping with 'dart' boosting # Cannot use early stopping with 'dart' boosting
if (using_dart){ if (using_dart) {
warning("Early stopping is not available in 'dart' mode.") warning("Early stopping is not available in 'dart' mode.")
using_early_stopping_via_args <- FALSE using_early_stopping_via_args <- FALSE
# Remove the cb.early.stop() function if it was passed in to callbacks # Remove the cb.early.stop() function if it was passed in to callbacks
callbacks <- Filter( callbacks <- Filter(
f = function(cb_func){ f = function(cb_func) {
!identical(attr(cb_func, "name"), "cb.early.stop") !identical(attr(cb_func, "name"), "cb.early.stop")
} }
, x = callbacks , x = callbacks
...@@ -253,7 +254,7 @@ lgb.cv <- function(params = list(), ...@@ -253,7 +254,7 @@ lgb.cv <- function(params = list(),
} }
# If user supplied early_stopping_rounds, add the early stopping callback # If user supplied early_stopping_rounds, add the early stopping callback
if (using_early_stopping_via_args){ if (using_early_stopping_via_args) {
callbacks <- add.cb( callbacks <- add.cb(
callbacks callbacks
, cb.early.stop( , cb.early.stop(
...@@ -267,7 +268,7 @@ lgb.cv <- function(params = list(), ...@@ -267,7 +268,7 @@ lgb.cv <- function(params = list(),
cb <- categorize.callbacks(callbacks) cb <- categorize.callbacks(callbacks)
# Construct booster using a list apply, check if requires group or not # Construct booster using a list apply, check if requires group or not
if (!is.list(folds[[1]])) { if (!is.list(folds[[1L]])) {
bst_folds <- lapply(seq_along(folds), function(k) { bst_folds <- lapply(seq_along(folds), function(k) {
dtest <- slice(data, folds[[k]]) dtest <- slice(data, folds[[k]])
dtrain <- slice(data, seq_len(nrow(data))[-folds[[k]]]) dtrain <- slice(data, seq_len(nrow(data))[-folds[[k]]])
...@@ -345,12 +346,12 @@ lgb.cv <- function(params = list(), ...@@ -345,12 +346,12 @@ lgb.cv <- function(params = list(),
} }
if (record && is.na(env$best_score)) { if (record && is.na(env$best_score)) {
if (env$eval_list[[1]]$higher_better[1] == TRUE) { if (env$eval_list[[1L]]$higher_better[1L] == TRUE) {
cv_booster$best_iter <- unname(which.max(unlist(cv_booster$record_evals[[2]][[1]][[1]]))) cv_booster$best_iter <- unname(which.max(unlist(cv_booster$record_evals[[2L]][[1L]][[1L]])))
cv_booster$best_score <- cv_booster$record_evals[[2]][[1]][[1]][[cv_booster$best_iter]] cv_booster$best_score <- cv_booster$record_evals[[2L]][[1L]][[1L]][[cv_booster$best_iter]]
} else { } else {
cv_booster$best_iter <- unname(which.min(unlist(cv_booster$record_evals[[2]][[1]][[1]]))) cv_booster$best_iter <- unname(which.min(unlist(cv_booster$record_evals[[2L]][[1L]][[1L]])))
cv_booster$best_score <- cv_booster$record_evals[[2]][[1]][[1]][[cv_booster$best_iter]] cv_booster$best_score <- cv_booster$record_evals[[2L]][[1L]][[1L]][[cv_booster$best_iter]]
} }
} }
...@@ -398,7 +399,7 @@ generate.cv.folds <- function(nfold, nrows, stratified, label, group, params) { ...@@ -398,7 +399,7 @@ generate.cv.folds <- function(nfold, nrows, stratified, label, group, params) {
# Loop through each fold # Loop through each fold
for (i in seq_len(nfold)) { for (i in seq_len(nfold)) {
kstep <- length(rnd_idx) %/% (nfold - i + 1) kstep <- length(rnd_idx) %/% (nfold - i + 1L)
folds[[i]] <- rnd_idx[seq_len(kstep)] folds[[i]] <- rnd_idx[seq_len(kstep)]
rnd_idx <- rnd_idx[-seq_len(kstep)] rnd_idx <- rnd_idx[-seq_len(kstep)]
} }
...@@ -423,7 +424,7 @@ generate.cv.folds <- function(nfold, nrows, stratified, label, group, params) { ...@@ -423,7 +424,7 @@ generate.cv.folds <- function(nfold, nrows, stratified, label, group, params) {
# Loop through each fold # Loop through each fold
for (i in seq_len(nfold)) { for (i in seq_len(nfold)) {
kstep <- length(rnd_idx) %/% (nfold - i + 1) kstep <- length(rnd_idx) %/% (nfold - i + 1L)
folds[[i]] <- list( folds[[i]] <- list(
fold = which(ungrouped %in% rnd_idx[seq_len(kstep)]) fold = which(ungrouped %in% rnd_idx[seq_len(kstep)])
, group = rnd_idx[seq_len(kstep)] , group = rnd_idx[seq_len(kstep)]
...@@ -442,7 +443,7 @@ generate.cv.folds <- function(nfold, nrows, stratified, label, group, params) { ...@@ -442,7 +443,7 @@ generate.cv.folds <- function(nfold, nrows, stratified, label, group, params) {
# It was borrowed from caret::lgb.stratified.folds and simplified # It was borrowed from caret::lgb.stratified.folds and simplified
# by always returning an unnamed list of fold indices. # by always returning an unnamed list of fold indices.
#' @importFrom stats quantile #' @importFrom stats quantile
lgb.stratified.folds <- function(y, k = 10) { lgb.stratified.folds <- function(y, k = 10L) {
## Group the numeric data based on their magnitudes ## Group the numeric data based on their magnitudes
## and sample within those groups. ## and sample within those groups.
...@@ -455,15 +456,15 @@ lgb.stratified.folds <- function(y, k = 10) { ...@@ -455,15 +456,15 @@ lgb.stratified.folds <- function(y, k = 10) {
if (is.numeric(y)) { if (is.numeric(y)) {
cuts <- length(y) %/% k cuts <- length(y) %/% k
if (cuts < 2) { if (cuts < 2L) {
cuts <- 2 cuts <- 2L
} }
if (cuts > 5) { if (cuts > 5L) {
cuts <- 5 cuts <- 5L
} }
y <- cut( y <- cut(
y y
, unique(stats::quantile(y, probs = seq.int(0, 1, length.out = cuts))) , unique(stats::quantile(y, probs = seq.int(0.0, 1.0, length.out = cuts)))
, include.lowest = TRUE , include.lowest = TRUE
) )
...@@ -489,7 +490,7 @@ lgb.stratified.folds <- function(y, k = 10) { ...@@ -489,7 +490,7 @@ lgb.stratified.folds <- function(y, k = 10) {
seqVector <- rep(seq_len(k), numInClass[i] %/% k) seqVector <- rep(seq_len(k), numInClass[i] %/% k)
## Add enough random integers to get length(seqVector) == numInClass[i] ## Add enough random integers to get length(seqVector) == numInClass[i]
if (numInClass[i] %% k > 0) { if (numInClass[i] %% k > 0L) {
seqVector <- c(seqVector, sample.int(k, numInClass[i] %% k)) seqVector <- c(seqVector, sample.int(k, numInClass[i] %% k))
} }
...@@ -513,15 +514,15 @@ lgb.stratified.folds <- function(y, k = 10) { ...@@ -513,15 +514,15 @@ lgb.stratified.folds <- function(y, k = 10) {
lgb.merge.cv.result <- function(msg, showsd = TRUE) { lgb.merge.cv.result <- function(msg, showsd = TRUE) {
# Get CV message length # Get CV message length
if (length(msg) == 0) { if (length(msg) == 0L) {
stop("lgb.cv: size of cv result error") stop("lgb.cv: size of cv result error")
} }
# Get evaluation message length # Get evaluation message length
eval_len <- length(msg[[1]]) eval_len <- length(msg[[1L]])
# Is evaluation message empty? # Is evaluation message empty?
if (eval_len == 0) { if (eval_len == 0L) {
stop("lgb.cv: should provide at least one metric for CV") stop("lgb.cv: should provide at least one metric for CV")
} }
...@@ -532,7 +533,7 @@ lgb.merge.cv.result <- function(msg, showsd = TRUE) { ...@@ -532,7 +533,7 @@ lgb.merge.cv.result <- function(msg, showsd = TRUE) {
}) })
# Get evaluation # Get evaluation
ret_eval <- msg[[1]] ret_eval <- msg[[1L]]
# Go through evaluation length items # Go through evaluation length items
for (j in seq_len(eval_len)) { for (j in seq_len(eval_len)) {
...@@ -549,7 +550,7 @@ lgb.merge.cv.result <- function(msg, showsd = TRUE) { ...@@ -549,7 +550,7 @@ lgb.merge.cv.result <- function(msg, showsd = TRUE) {
for (j in seq_len(eval_len)) { for (j in seq_len(eval_len)) {
ret_eval_err <- c( ret_eval_err <- c(
ret_eval_err ret_eval_err
, sqrt(mean(eval_result[[j]] ^ 2) - mean(eval_result[[j]]) ^ 2) , sqrt(mean(eval_result[[j]] ^ 2L) - mean(eval_result[[j]]) ^ 2L)
) )
} }
......
R-package/R/lgb.importance.R
View file @ 1f7b06b9
...@@ -24,12 +24,12 @@ ...@@ -24,12 +24,12 @@
#' params <- list( #' params <- list(
#' objective = "binary" #' objective = "binary"
#' , learning_rate = 0.01 #' , learning_rate = 0.01
#' , num_leaves = 63 #' , num_leaves = 63L
#' , max_depth = -1 #' , max_depth = -1L
#' , min_data_in_leaf = 1 #' , min_data_in_leaf = 1L
#' , min_sum_hessian_in_leaf = 1 #' , min_sum_hessian_in_leaf = 1.0
#' ) #' )
#' model <- lgb.train(params, dtrain, 10) #' model <- lgb.train(params, dtrain, 10L)
#' #'
#' tree_imp1 <- lgb.importance(model, percentage = TRUE) #' tree_imp1 <- lgb.importance(model, percentage = TRUE)
#' tree_imp2 <- lgb.importance(model, percentage = FALSE) #' tree_imp2 <- lgb.importance(model, percentage = FALSE)
...@@ -62,8 +62,8 @@ lgb.importance <- function(model, percentage = TRUE) { ...@@ -62,8 +62,8 @@ lgb.importance <- function(model, percentage = TRUE) {
# Sort features by Gain # Sort features by Gain
data.table::setorderv( data.table::setorderv(
x = tree_imp_dt x = tree_imp_dt
, cols = c("Gain") , cols = "Gain"
, order = -1 , order = -1L
) )
# Check if relative values are requested # Check if relative values are requested
......
R-package/R/lgb.interprete.R
View file @ 1f7b06b9
...@@ -7,18 +7,18 @@ ...@@ -7,18 +7,18 @@
#' @param idxset an integer vector of indices of rows needed. #' @param idxset an integer vector of indices of rows needed.
#' @param num_iteration number of iteration want to predict with, NULL or <= 0 means use best iteration. #' @param num_iteration number of iteration want to predict with, NULL or <= 0 means use best iteration.
#' #'
#' @return #' @return For regression, binary classification and lambdarank model, a \code{list} of \code{data.table}
#' #' with the following columns:
#' For regression, binary classification and lambdarank model, a \code{list} of \code{data.table} with the following columns: #' \itemize{
#' \itemize{ #' \item \code{Feature} Feature names in the model.
#' \item \code{Feature} Feature names in the model. #' \item \code{Contribution} The total contribution of this feature's splits.
#' \item \code{Contribution} The total contribution of this feature's splits. #' }
#' } #' For multiclass classification, a \code{list} of \code{data.table} with the Feature column and
#' For multiclass classification, a \code{list} of \code{data.table} with the Feature column and Contribution columns to each class. #' Contribution columns to each class.
#' #'
#' @examples #' @examples
#' Sigmoid <- function(x) 1 / (1 + exp(-x)) #' Sigmoid <- function(x) 1.0 / (1.0 + exp(-x))
#' Logit <- function(x) log(x / (1 - x)) #' Logit <- function(x) log(x / (1.0 - x))
#' data(agaricus.train, package = "lightgbm") #' data(agaricus.train, package = "lightgbm")
#' train <- agaricus.train #' train <- agaricus.train
#' dtrain <- lgb.Dataset(train$data, label = train$label) #' dtrain <- lgb.Dataset(train$data, label = train$label)
...@@ -29,14 +29,14 @@ ...@@ -29,14 +29,14 @@
#' params <- list( #' params <- list(
#' objective = "binary" #' objective = "binary"
#' , learning_rate = 0.01 #' , learning_rate = 0.01
#' , num_leaves = 63 #' , num_leaves = 63L
#' , max_depth = -1 #' , max_depth = -1L
#' , min_data_in_leaf = 1 #' , min_data_in_leaf = 1L
#' , min_sum_hessian_in_leaf = 1 #' , min_sum_hessian_in_leaf = 1.0
#' ) #' )
#' model <- lgb.train(params, dtrain, 10) #' model <- lgb.train(params, dtrain, 10L)
#' #'
#' tree_interpretation <- lgb.interprete(model, test$data, 1:5) #' tree_interpretation <- lgb.interprete(model, test$data, 1L:5L)
#' #'
#' @importFrom data.table as.data.table #' @importFrom data.table as.data.table
#' @export #' @export
...@@ -71,8 +71,8 @@ lgb.interprete <- function(model, ...@@ -71,8 +71,8 @@ lgb.interprete <- function(model,
# Get list of trees # Get list of trees
tree_index_mat_list <- lapply( tree_index_mat_list <- lapply(
X = leaf_index_mat_list X = leaf_index_mat_list
, FUN = function(x){ , FUN = function(x) {
matrix(seq_len(length(x)) - 1, ncol = num_class, byrow = TRUE) matrix(seq_len(length(x)) - 1L, ncol = num_class, byrow = TRUE)
} }
) )
...@@ -106,8 +106,8 @@ single.tree.interprete <- function(tree_dt, ...@@ -106,8 +106,8 @@ single.tree.interprete <- function(tree_dt,
node_dt <- single_tree_dt[!is.na(split_index), .(split_index, split_feature, node_parent, internal_value)] node_dt <- single_tree_dt[!is.na(split_index), .(split_index, split_feature, node_parent, internal_value)]
# Prepare sequences # Prepare sequences
feature_seq <- character(0) feature_seq <- character(0L)
value_seq <- numeric(0) value_seq <- numeric(0L)
# Get to root from leaf # Get to root from leaf
leaf_to_root <- function(parent_id, current_value) { leaf_to_root <- function(parent_id, current_value) {
...@@ -185,15 +185,15 @@ single.row.interprete <- function(tree_dt, num_class, tree_index_mat, leaf_index ...@@ -185,15 +185,15 @@ single.row.interprete <- function(tree_dt, num_class, tree_index_mat, leaf_index
next_interp_dt <- multiple.tree.interprete( next_interp_dt <- multiple.tree.interprete(
tree_dt = tree_dt tree_dt = tree_dt
, tree_index = tree_index_mat[,i] , tree_index = tree_index_mat[, i]
, leaf_index = leaf_index_mat[,i] , leaf_index = leaf_index_mat[, i]
) )
if (num_class > 1){ if (num_class > 1L) {
data.table::setnames( data.table::setnames(
next_interp_dt next_interp_dt
, old = "Contribution" , old = "Contribution"
, new = paste("Class", i - 1) , new = paste("Class", i - 1L)
) )
} }
...@@ -202,29 +202,29 @@ single.row.interprete <- function(tree_dt, num_class, tree_index_mat, leaf_index ...@@ -202,29 +202,29 @@ single.row.interprete <- function(tree_dt, num_class, tree_index_mat, leaf_index
} }
# Check for numbe rof classes larger than 1 # Check for numbe rof classes larger than 1
if (num_class == 1) { if (num_class == 1L) {
# First interpretation element # First interpretation element
tree_interpretation_dt <- tree_interpretation[[1]] tree_interpretation_dt <- tree_interpretation[[1L]]
} else { } else {
# Full interpretation elements # Full interpretation elements
tree_interpretation_dt <- Reduce( tree_interpretation_dt <- Reduce(
f = function(x, y){ f = function(x, y) {
merge(x, y, by = "Feature", all = TRUE) merge(x, y, by = "Feature", all = TRUE)
} }
, x = tree_interpretation , x = tree_interpretation
) )
# Loop throughout each tree # Loop throughout each tree
for (j in 2:ncol(tree_interpretation_dt)) { for (j in 2L:ncol(tree_interpretation_dt)) {
data.table::set( data.table::set(
tree_interpretation_dt tree_interpretation_dt
, i = which(is.na(tree_interpretation_dt[[j]])) , i = which(is.na(tree_interpretation_dt[[j]]))
, j = j , j = j
, value = 0 , value = 0.0
) )
} }
......
R-package/R/lgb.model.dt.tree.R
View file @ 1f7b06b9
...@@ -38,12 +38,12 @@ ...@@ -38,12 +38,12 @@
#' params <- list( #' params <- list(
#' objective = "binary" #' objective = "binary"
#' , learning_rate = 0.01 #' , learning_rate = 0.01
#' , num_leaves = 63 #' , num_leaves = 63L
#' , max_depth = -1 #' , max_depth = -1L
#' , min_data_in_leaf = 1 #' , min_data_in_leaf = 1L
#' , min_sum_hessian_in_leaf = 1 #' , min_sum_hessian_in_leaf = 1.0
#' ) #' )
#' model <- lgb.train(params, dtrain, 10) #' model <- lgb.train(params, dtrain, 10L)
#' #'
#' tree_dt <- lgb.model.dt.tree(model) #' tree_dt <- lgb.model.dt.tree(model)
#' #'
...@@ -74,7 +74,7 @@ lgb.model.dt.tree <- function(model, num_iteration = NULL) { ...@@ -74,7 +74,7 @@ lgb.model.dt.tree <- function(model, num_iteration = NULL) {
# Since the index comes from C++ (which is 0-indexed), be sure # Since the index comes from C++ (which is 0-indexed), be sure
# to add 1 (e.g. index 28 means the 29th feature in feature_names) # to add 1 (e.g. index 28 means the 29th feature in feature_names)
split_feature_indx <- tree_dt[, split_feature] + 1 split_feature_indx <- tree_dt[, split_feature] + 1L
# Get corresponding feature names. Positions in split_feature_indx # Get corresponding feature names. Positions in split_feature_indx
# which are NA will result in an NA feature name # which are NA will result in an NA feature name
...@@ -97,21 +97,21 @@ single.tree.parse <- function(lgb_tree) { ...@@ -97,21 +97,21 @@ single.tree.parse <- function(lgb_tree) {
# Setup initial default data.table with default types # Setup initial default data.table with default types
env <- new.env(parent = emptyenv()) env <- new.env(parent = emptyenv())
env$single_tree_dt <- data.table::data.table( env$single_tree_dt <- data.table::data.table(
tree_index = integer(0) tree_index = integer(0L)
, depth = integer(0) , depth = integer(0L)
, split_index = integer(0) , split_index = integer(0L)
, split_feature = integer(0) , split_feature = integer(0L)
, node_parent = integer(0) , node_parent = integer(0L)
, leaf_index = integer(0) , leaf_index = integer(0L)
, leaf_parent = integer(0) , leaf_parent = integer(0L)
, split_gain = numeric(0) , split_gain = numeric(0L)
, threshold = numeric(0) , threshold = numeric(0L)
, decision_type = character(0) , decision_type = character(0L)
, default_left = character(0) , default_left = character(0L)
, internal_value = integer(0) , internal_value = integer(0L)
, internal_count = integer(0) , internal_count = integer(0L)
, leaf_value = integer(0) , leaf_value = integer(0L)
, leaf_count = integer(0) , leaf_count = integer(0L)
) )
# start tree traversal # start tree traversal
pre_order_traversal(env, tree_node_leaf, current_depth, parent_index) pre_order_traversal(env, tree_node_leaf, current_depth, parent_index)
......
R-package/R/lgb.plot.importance.R
View file @ 1f7b06b9
...@@ -24,23 +24,24 @@ ...@@ -24,23 +24,24 @@
#' params <- list( #' params <- list(
#' objective = "binary" #' objective = "binary"
#' , learning_rate = 0.01 #' , learning_rate = 0.01
#' , num_leaves = 63 #' , num_leaves = 63L
#' , max_depth = -1 #' , max_depth = -1L
#' , min_data_in_leaf = 1 #' , min_data_in_leaf = 1L
#' , min_sum_hessian_in_leaf = 1 #' , min_sum_hessian_in_leaf = 1.0
#' ) #' )
#' #'
#' model <- lgb.train(params, dtrain, 10) #' model <- lgb.train(params, dtrain, 10)
#' #'
#' tree_imp <- lgb.importance(model, percentage = TRUE) #' tree_imp <- lgb.importance(model, percentage = TRUE)
#' lgb.plot.importance(tree_imp, top_n = 10, measure = "Gain") #' lgb.plot.importance(tree_imp, top_n = 10L, measure = "Gain")
#' @importFrom graphics barplot par #' @importFrom graphics barplot par
#' @export #' @export
lgb.plot.importance <- function(tree_imp, lgb.plot.importance <- function(tree_imp,
top_n = 10, top_n = 10L,
measure = "Gain", measure = "Gain",
left_margin = 10, left_margin = 10L,
cex = NULL) { cex = NULL
) {
# Check for measurement (column names) correctness # Check for measurement (column names) correctness
measure <- match.arg( measure <- match.arg(
...@@ -53,11 +54,11 @@ lgb.plot.importance <- function(tree_imp, ...@@ -53,11 +54,11 @@ lgb.plot.importance <- function(tree_imp,
top_n <- min(top_n, nrow(tree_imp)) top_n <- min(top_n, nrow(tree_imp))
# Parse importance # Parse importance
tree_imp <- tree_imp[order(abs(get(measure)), decreasing = TRUE),][seq_len(top_n),] tree_imp <- tree_imp[order(abs(get(measure)), decreasing = TRUE), ][seq_len(top_n), ]
# Attempt to setup a correct cex # Attempt to setup a correct cex
if (is.null(cex)) { if (is.null(cex)) {
cex <- 2.5 / log2(1 + top_n) cex <- 2.5 / log2(1.0 + top_n)
} }
# Refresh plot # Refresh plot
...@@ -66,15 +67,15 @@ lgb.plot.importance <- function(tree_imp, ...@@ -66,15 +67,15 @@ lgb.plot.importance <- function(tree_imp,
graphics::par( graphics::par(
mar = c( mar = c(
op$mar[1] op$mar[1L]
, left_margin , left_margin
, op$mar[3] , op$mar[3L]
, op$mar[4] , op$mar[4L]
) )
) )
# Do plot # Do plot
tree_imp[.N:1, tree_imp[.N:1L,
graphics::barplot( graphics::barplot(
height = get(measure) height = get(measure)
, names.arg = Feature , names.arg = Feature
...@@ -83,7 +84,7 @@ lgb.plot.importance <- function(tree_imp, ...@@ -83,7 +84,7 @@ lgb.plot.importance <- function(tree_imp,
, main = "Feature Importance" , main = "Feature Importance"
, xlab = measure , xlab = measure
, cex.names = cex , cex.names = cex
, las = 1 , las = 1L
)] )]
# Return invisibly # Return invisibly
......
R-package/R/lgb.plot.interpretation.R
View file @ 1f7b06b9
...@@ -17,8 +17,8 @@ ...@@ -17,8 +17,8 @@
#' #'
#' @examples #' @examples
#' library(lightgbm) #' library(lightgbm)
#' Sigmoid <- function(x) {1 / (1 + exp(-x))} #' Sigmoid <- function(x) {1.0 / (1.0 + exp(-x))}
#' Logit <- function(x) {log(x / (1 - x))} #' Logit <- function(x) {log(x / (1.0 - x))}
#' data(agaricus.train, package = "lightgbm") #' data(agaricus.train, package = "lightgbm")
#' train <- agaricus.train #' train <- agaricus.train
#' dtrain <- lgb.Dataset(train$data, label = train$label) #' dtrain <- lgb.Dataset(train$data, label = train$label)
...@@ -29,26 +29,26 @@ ...@@ -29,26 +29,26 @@
#' params <- list( #' params <- list(
#' objective = "binary" #' objective = "binary"
#' , learning_rate = 0.01 #' , learning_rate = 0.01
#' , num_leaves = 63 #' , num_leaves = 63L
#' , max_depth = -1 #' , max_depth = -1L
#' , min_data_in_leaf = 1 #' , min_data_in_leaf = 1L
#' , min_sum_hessian_in_leaf = 1 #' , min_sum_hessian_in_leaf = 1.0
#' ) #' )
#' model <- lgb.train(params, dtrain, 10) #' model <- lgb.train(params, dtrain, 10L)
#' #'
#' tree_interpretation <- lgb.interprete(model, test$data, 1:5) #' tree_interpretation <- lgb.interprete(model, test$data, 1L:5L)
#' lgb.plot.interpretation(tree_interpretation[[1]], top_n = 10) #' lgb.plot.interpretation(tree_interpretation[[1L]], top_n = 10L)
#' @importFrom data.table setnames #' @importFrom data.table setnames
#' @importFrom graphics barplot par #' @importFrom graphics barplot par
#' @export #' @export
lgb.plot.interpretation <- function(tree_interpretation_dt, lgb.plot.interpretation <- function(tree_interpretation_dt,
top_n = 10, top_n = 10L,
cols = 1, cols = 1L,
left_margin = 10, left_margin = 10L,
cex = NULL) { cex = NULL) {
# Get number of columns # Get number of columns
num_class <- ncol(tree_interpretation_dt) - 1 num_class <- ncol(tree_interpretation_dt) - 1L
# Refresh plot # Refresh plot
op <- graphics::par(no.readonly = TRUE) op <- graphics::par(no.readonly = TRUE)
...@@ -57,7 +57,7 @@ lgb.plot.interpretation <- function(tree_interpretation_dt, ...@@ -57,7 +57,7 @@ lgb.plot.interpretation <- function(tree_interpretation_dt,
# Do some magic plotting # Do some magic plotting
bottom_margin <- 3.0 bottom_margin <- 3.0
top_margin <- 2.0 top_margin <- 2.0
right_margin <- op$mar[4] right_margin <- op$mar[4L]
graphics::par( graphics::par(
mar = c( mar = c(
...@@ -69,7 +69,7 @@ lgb.plot.interpretation <- function(tree_interpretation_dt, ...@@ -69,7 +69,7 @@ lgb.plot.interpretation <- function(tree_interpretation_dt,
) )
# Check for number of classes # Check for number of classes
if (num_class == 1) { if (num_class == 1L) {
# Only one class, plot straight away # Only one class, plot straight away
multiple.tree.plot.interpretation( multiple.tree.plot.interpretation(
...@@ -95,7 +95,7 @@ lgb.plot.interpretation <- function(tree_interpretation_dt, ...@@ -95,7 +95,7 @@ lgb.plot.interpretation <- function(tree_interpretation_dt,
for (i in seq_len(num_class)) { for (i in seq_len(num_class)) {
# Prepare interpretation, perform T, get the names, and plot straight away # Prepare interpretation, perform T, get the names, and plot straight away
plot_dt <- tree_interpretation_dt[, c(1, i + 1), with = FALSE] plot_dt <- tree_interpretation_dt[, c(1L, i + 1L), with = FALSE]
data.table::setnames( data.table::setnames(
plot_dt plot_dt
, old = names(plot_dt) , old = names(plot_dt)
...@@ -104,7 +104,7 @@ lgb.plot.interpretation <- function(tree_interpretation_dt, ...@@ -104,7 +104,7 @@ lgb.plot.interpretation <- function(tree_interpretation_dt,
multiple.tree.plot.interpretation( multiple.tree.plot.interpretation(
plot_dt plot_dt
, top_n = top_n , top_n = top_n
, title = paste("Class", i - 1) , title = paste("Class", i - 1L)
, cex = cex , cex = cex
) )
...@@ -119,24 +119,24 @@ multiple.tree.plot.interpretation <- function(tree_interpretation, ...@@ -119,24 +119,24 @@ multiple.tree.plot.interpretation <- function(tree_interpretation,
cex) { cex) {
# Parse tree # Parse tree
tree_interpretation <- tree_interpretation[order(abs(Contribution), decreasing = TRUE),][seq_len(min(top_n, .N)),] tree_interpretation <- tree_interpretation[order(abs(Contribution), decreasing = TRUE), ][seq_len(min(top_n, .N)), ]
# Attempt to setup a correct cex # Attempt to setup a correct cex
if (is.null(cex)) { if (is.null(cex)) {
cex <- 2.5 / log2(1 + top_n) cex <- 2.5 / log2(1.0 + top_n)
} }
# Do plot # Do plot
tree_interpretation[.N:1, tree_interpretation[.N:1L,
graphics::barplot( graphics::barplot(
height = Contribution height = Contribution
, names.arg = Feature , names.arg = Feature
, horiz = TRUE , horiz = TRUE
, col = ifelse(Contribution > 0, "firebrick", "steelblue") , col = ifelse(Contribution > 0L, "firebrick", "steelblue")
, border = NA , border = NA
, main = title , main = title
, cex.names = cex , cex.names = cex
, las = 1 , las = 1L
)] )]
# Return invisibly # Return invisibly
......
R-package/R/lgb.prepare.R
View file @ 1f7b06b9
...@@ -41,13 +41,13 @@ lgb.prepare <- function(data) { ...@@ -41,13 +41,13 @@ lgb.prepare <- function(data) {
# Convert characters to factors only (we can change them to numeric after) # Convert characters to factors only (we can change them to numeric after)
is_char <- which(list_classes == "character") is_char <- which(list_classes == "character")
if (length(is_char) > 0) { if (length(is_char) > 0L) {
data[, (is_char) := lapply(.SD, function(x) {as.numeric(as.factor(x))}), .SDcols = is_char] data[, (is_char) := lapply(.SD, function(x) {as.numeric(as.factor(x))}), .SDcols = is_char]
} }
# Convert factors to numeric (integer is more efficient actually) # Convert factors to numeric (integer is more efficient actually)
is_fact <- c(which(list_classes == "factor"), is_char) is_fact <- c(which(list_classes == "factor"), is_char)
if (length(is_fact) > 0) { if (length(is_fact) > 0L) {
data[, (is_fact) := lapply(.SD, function(x) {as.numeric(x)}), .SDcols = is_fact] data[, (is_fact) := lapply(.SD, function(x) {as.numeric(x)}), .SDcols = is_fact]
} }
...@@ -61,13 +61,13 @@ lgb.prepare <- function(data) { ...@@ -61,13 +61,13 @@ lgb.prepare <- function(data) {
# Convert characters to factors to numeric (integer is more efficient actually) # Convert characters to factors to numeric (integer is more efficient actually)
is_char <- which(list_classes == "character") is_char <- which(list_classes == "character")
if (length(is_char) > 0) { if (length(is_char) > 0L) {
data[is_char] <- lapply(data[is_char], function(x) {as.numeric(as.factor(x))}) data[is_char] <- lapply(data[is_char], function(x) {as.numeric(as.factor(x))})
} }
# Convert factors to numeric (integer is more efficient actually) # Convert factors to numeric (integer is more efficient actually)
is_fact <- which(list_classes == "factor") is_fact <- which(list_classes == "factor")
if (length(is_fact) > 0) { if (length(is_fact) > 0L) {
data[is_fact] <- lapply(data[is_fact], function(x) {as.numeric(x)}) data[is_fact] <- lapply(data[is_fact], function(x) {as.numeric(x)})
} }
......
R-package/R/lgb.prepare2.R
View file @ 1f7b06b9
...@@ -41,17 +41,17 @@ lgb.prepare2 <- function(data) { ...@@ -41,17 +41,17 @@ lgb.prepare2 <- function(data) {
if (inherits(data, "data.table")) { if (inherits(data, "data.table")) {
# Get data classes # Get data classes
list_classes <- vapply(data, class, character(1)) list_classes <- vapply(data, class, character(1L))
# Convert characters to factors only (we can change them to numeric after) # Convert characters to factors only (we can change them to numeric after)
is_char <- which(list_classes == "character") is_char <- which(list_classes == "character")
if (length(is_char) > 0) { if (length(is_char) > 0L) {
data[, (is_char) := lapply(.SD, function(x) {as.integer(as.factor(x))}), .SDcols = is_char] data[, (is_char) := lapply(.SD, function(x) {as.integer(as.factor(x))}), .SDcols = is_char]
} }
# Convert factors to numeric (integer is more efficient actually) # Convert factors to numeric (integer is more efficient actually)
is_fact <- c(which(list_classes == "factor"), is_char) is_fact <- c(which(list_classes == "factor"), is_char)
if (length(is_fact) > 0) { if (length(is_fact) > 0L) {
data[, (is_fact) := lapply(.SD, function(x) {as.integer(x)}), .SDcols = is_fact] data[, (is_fact) := lapply(.SD, function(x) {as.integer(x)}), .SDcols = is_fact]
} }
...@@ -61,17 +61,17 @@ lgb.prepare2 <- function(data) { ...@@ -61,17 +61,17 @@ lgb.prepare2 <- function(data) {
if (inherits(data, "data.frame")) { if (inherits(data, "data.frame")) {
# Get data classes # Get data classes
list_classes <- vapply(data, class, character(1)) list_classes <- vapply(data, class, character(1L))
# Convert characters to factors to numeric (integer is more efficient actually) # Convert characters to factors to numeric (integer is more efficient actually)
is_char <- which(list_classes == "character") is_char <- which(list_classes == "character")
if (length(is_char) > 0) { if (length(is_char) > 0L) {
data[is_char] <- lapply(data[is_char], function(x) {as.integer(as.factor(x))}) data[is_char] <- lapply(data[is_char], function(x) {as.integer(as.factor(x))})
} }
# Convert factors to numeric (integer is more efficient actually) # Convert factors to numeric (integer is more efficient actually)
is_fact <- which(list_classes == "factor") is_fact <- which(list_classes == "factor")
if (length(is_fact) > 0) { if (length(is_fact) > 0L) {
data[is_fact] <- lapply(data[is_fact], function(x) {as.integer(x)}) data[is_fact] <- lapply(data[is_fact], function(x) {as.integer(x)})
} }
......
R-package/R/lgb.prepare_rules.R
View file @ 1f7b06b9
...@@ -21,16 +21,16 @@ ...@@ -21,16 +21,16 @@
#' str(new_iris$data) #' str(new_iris$data)
#' #'
#' data(iris) # Erase iris dataset #' data(iris) # Erase iris dataset
#' iris$Species[1] <- "NEW FACTOR" # Introduce junk factor (NA) #' iris$Species[1L] <- "NEW FACTOR" # Introduce junk factor (NA)
#' #'
#' # Use conversion using known rules #' # Use conversion using known rules
#' # Unknown factors become 0, excellent for sparse datasets #' # Unknown factors become 0, excellent for sparse datasets
#' newer_iris <- lgb.prepare_rules(data = iris, rules = new_iris$rules) #' newer_iris <- lgb.prepare_rules(data = iris, rules = new_iris$rules)
#' #'
#' # Unknown factor is now zero, perfect for sparse datasets #' # Unknown factor is now zero, perfect for sparse datasets
#' newer_iris$data[1, ] # Species became 0 as it is an unknown factor #' newer_iris$data[1L, ] # Species became 0 as it is an unknown factor
#' #'
#' newer_iris$data[1, 5] <- 1 # Put back real initial value #' newer_iris$data[1L, 5L] <- 1.0 # Put back real initial value
#' #'
#' # Is the newly created dataset equal? YES! #' # Is the newly created dataset equal? YES!
#' all.equal(new_iris$data, newer_iris$data) #' all.equal(new_iris$data, newer_iris$data)
...@@ -39,9 +39,9 @@ ...@@ -39,9 +39,9 @@
#' data(iris) # Erase iris dataset #' data(iris) # Erase iris dataset
#' #'
#' # We remapped values differently #' # We remapped values differently
#' personal_rules <- list(Species = c("setosa" = 3, #' personal_rules <- list(Species = c("setosa" = 3L,
#' "versicolor" = 2, #' "versicolor" = 2L,
#' "virginica" = 1)) #' "virginica" = 1L))
#' newest_iris <- lgb.prepare_rules(data = iris, rules = personal_rules) #' newest_iris <- lgb.prepare_rules(data = iris, rules = personal_rules)
#' str(newest_iris$data) # SUCCESS! #' str(newest_iris$data) # SUCCESS!
#' #'
...@@ -59,21 +59,21 @@ lgb.prepare_rules <- function(data, rules = NULL) { ...@@ -59,21 +59,21 @@ lgb.prepare_rules <- function(data, rules = NULL) {
for (i in names(rules)) { for (i in names(rules)) {
data.table::set(data, j = i, value = unname(rules[[i]][data[[i]]])) data.table::set(data, j = i, value = unname(rules[[i]][data[[i]]]))
data[[i]][is.na(data[[i]])] <- 0 # Overwrite NAs by 0s data[[i]][is.na(data[[i]])] <- 0L # Overwrite NAs by 0s
} }
} else { } else {
# Get data classes # Get data classes
list_classes <- vapply(data, class, character(1)) list_classes <- vapply(data, class, character(1L))
# Map characters/factors # Map characters/factors
is_fix <- which(list_classes %in% c("character", "factor")) is_fix <- which(list_classes %in% c("character", "factor"))
rules <- list() rules <- list()
# Need to create rules? # Need to create rules?
if (length(is_fix) > 0) { if (length(is_fix) > 0L) {
# Go through all characters/factors # Go through all characters/factors
for (i in is_fix) { for (i in is_fix) {
...@@ -114,7 +114,7 @@ lgb.prepare_rules <- function(data, rules = NULL) { ...@@ -114,7 +114,7 @@ lgb.prepare_rules <- function(data, rules = NULL) {
for (i in names(rules)) { for (i in names(rules)) {
data[[i]] <- unname(rules[[i]][data[[i]]]) data[[i]] <- unname(rules[[i]][data[[i]]])
data[[i]][is.na(data[[i]])] <- 0 # Overwrite NAs by 0s data[[i]][is.na(data[[i]])] <- 0L # Overwrite NAs by 0s
} }
...@@ -124,14 +124,14 @@ lgb.prepare_rules <- function(data, rules = NULL) { ...@@ -124,14 +124,14 @@ lgb.prepare_rules <- function(data, rules = NULL) {
if (inherits(data, "data.frame")) { if (inherits(data, "data.frame")) {
# Get data classes # Get data classes
list_classes <- vapply(data, class, character(1)) list_classes <- vapply(data, class, character(1L))
# Map characters/factors # Map characters/factors
is_fix <- which(list_classes %in% c("character", "factor")) is_fix <- which(list_classes %in% c("character", "factor"))
rules <- list() rules <- list()
# Need to create rules? # Need to create rules?
if (length(is_fix) > 0) { if (length(is_fix) > 0L) {
# Go through all characters/factors # Go through all characters/factors
for (i in is_fix) { for (i in is_fix) {
......
R-package/R/lgb.prepare_rules2.R
View file @ 1f7b06b9
...@@ -24,16 +24,16 @@ ...@@ -24,16 +24,16 @@
#' str(new_iris$data) #' str(new_iris$data)
#' #'
#' data(iris) # Erase iris dataset #' data(iris) # Erase iris dataset
#' iris$Species[1] <- "NEW FACTOR" # Introduce junk factor (NA) #' iris$Species[1L] <- "NEW FACTOR" # Introduce junk factor (NA)
#' #'
#' # Use conversion using known rules #' # Use conversion using known rules
#' # Unknown factors become 0, excellent for sparse datasets #' # Unknown factors become 0, excellent for sparse datasets
#' newer_iris <- lgb.prepare_rules2(data = iris, rules = new_iris$rules) #' newer_iris <- lgb.prepare_rules2(data = iris, rules = new_iris$rules)
#' #'
#' # Unknown factor is now zero, perfect for sparse datasets #' # Unknown factor is now zero, perfect for sparse datasets
#' newer_iris$data[1, ] # Species became 0 as it is an unknown factor #' newer_iris$data[1L, ] # Species became 0 as it is an unknown factor
#' #'
#' newer_iris$data[1, 5] <- 1 # Put back real initial value #' newer_iris$data[1L, 5L] <- 1.0 # Put back real initial value
#' #'
#' # Is the newly created dataset equal? YES! #' # Is the newly created dataset equal? YES!
#' all.equal(new_iris$data, newer_iris$data) #' all.equal(new_iris$data, newer_iris$data)
...@@ -73,14 +73,14 @@ lgb.prepare_rules2 <- function(data, rules = NULL) { ...@@ -73,14 +73,14 @@ lgb.prepare_rules2 <- function(data, rules = NULL) {
} else { } else {
# Get data classes # Get data classes
list_classes <- vapply(data, class, character(1)) list_classes <- vapply(data, class, character(1L))
# Map characters/factors # Map characters/factors
is_fix <- which(list_classes %in% c("character", "factor")) is_fix <- which(list_classes %in% c("character", "factor"))
rules <- list() rules <- list()
# Need to create rules? # Need to create rules?
if (length(is_fix) > 0) { if (length(is_fix) > 0L) {
# Go through all characters/factors # Go through all characters/factors
for (i in is_fix) { for (i in is_fix) {
...@@ -130,14 +130,14 @@ lgb.prepare_rules2 <- function(data, rules = NULL) { ...@@ -130,14 +130,14 @@ lgb.prepare_rules2 <- function(data, rules = NULL) {
if (inherits(data, "data.frame")) { if (inherits(data, "data.frame")) {
# Get data classes # Get data classes
list_classes <- vapply(data, class, character(1)) list_classes <- vapply(data, class, character(1L))
# Map characters/factors # Map characters/factors
is_fix <- which(list_classes %in% c("character", "factor")) is_fix <- which(list_classes %in% c("character", "factor"))
rules <- list() rules <- list()
# Need to create rules? # Need to create rules?
if (length(is_fix) > 0) { if (length(is_fix) > 0L) {
# Go through all characters/factors # Go through all characters/factors
for (i in is_fix) { for (i in is_fix) {
......
R-package/R/lgb.train.R
View file @ 1f7b06b9
...@@ -41,20 +41,20 @@ ...@@ -41,20 +41,20 @@
#' model <- lgb.train( #' model <- lgb.train(
#' params = params #' params = params
#' , data = dtrain #' , data = dtrain
#' , nrounds = 10 #' , nrounds = 10L
#' , valids = valids #' , valids = valids
#' , min_data = 1 #' , min_data = 1L
#' , learning_rate = 1 #' , learning_rate = 1.0
#' , early_stopping_rounds = 5 #' , early_stopping_rounds = 5L
#' ) #' )
#' @export #' @export
lgb.train <- function(params = list(), lgb.train <- function(params = list(),
data, data,
nrounds = 10, nrounds = 10L,
valids = list(), valids = list(),
obj = NULL, obj = NULL,
eval = NULL, eval = NULL,
verbose = 1, verbose = 1L,
record = TRUE, record = TRUE,
eval_freq = 1L, eval_freq = 1L,
init_model = NULL, init_model = NULL,
...@@ -74,7 +74,7 @@ lgb.train <- function(params = list(), ...@@ -74,7 +74,7 @@ lgb.train <- function(params = list(),
fobj <- NULL fobj <- NULL
feval <- NULL feval <- NULL
if (nrounds <= 0) { if (nrounds <= 0L) {
stop("nrounds should be greater than zero") stop("nrounds should be greater than zero")
} }
...@@ -103,16 +103,16 @@ lgb.train <- function(params = list(), ...@@ -103,16 +103,16 @@ lgb.train <- function(params = list(),
} }
# Set the iteration to start from / end to (and check for boosting from a trained model, again) # Set the iteration to start from / end to (and check for boosting from a trained model, again)
begin_iteration <- 1 begin_iteration <- 1L
if (!is.null(predictor)) { if (!is.null(predictor)) {
begin_iteration <- predictor$current_iter() + 1 begin_iteration <- predictor$current_iter() + 1L
} }
# Check for number of rounds passed as parameter - in case there are multiple ones, take only the first one # Check for number of rounds passed as parameter - in case there are multiple ones, take only the first one
n_trees <- .PARAMETER_ALIASES()[["num_iterations"]] n_trees <- .PARAMETER_ALIASES()[["num_iterations"]]
if (any(names(params) %in% n_trees)) { if (any(names(params) %in% n_trees)) {
end_iteration <- begin_iteration + params[[which(names(params) %in% n_trees)[1]]] - 1 end_iteration <- begin_iteration + params[[which(names(params) %in% n_trees)[1L]]] - 1L
} else { } else {
end_iteration <- begin_iteration + nrounds - 1 end_iteration <- begin_iteration + nrounds - 1L
} }
# Check for training dataset type correctness # Check for training dataset type correctness
...@@ -121,12 +121,12 @@ lgb.train <- function(params = list(), ...@@ -121,12 +121,12 @@ lgb.train <- function(params = list(),
} }
# Check for validation dataset type correctness # Check for validation dataset type correctness
if (length(valids) > 0) { if (length(valids) > 0L) {
# One or more validation dataset # One or more validation dataset
# Check for list as input and type correctness by object # Check for list as input and type correctness by object
if (!is.list(valids) || !all(vapply(valids, lgb.is.Dataset, logical(1)))) { if (!is.list(valids) || !all(vapply(valids, lgb.is.Dataset, logical(1L)))) {
stop("lgb.train: valids must be a list of lgb.Dataset elements") stop("lgb.train: valids must be a list of lgb.Dataset elements")
} }
...@@ -162,7 +162,7 @@ lgb.train <- function(params = list(), ...@@ -162,7 +162,7 @@ lgb.train <- function(params = list(),
reduced_valid_sets <- list() reduced_valid_sets <- list()
# Parse validation datasets # Parse validation datasets
if (length(valids) > 0) { if (length(valids) > 0L) {
# Loop through all validation datasets using name # Loop through all validation datasets using name
for (key in names(valids)) { for (key in names(valids)) {
...@@ -187,12 +187,12 @@ lgb.train <- function(params = list(), ...@@ -187,12 +187,12 @@ lgb.train <- function(params = list(),
} }
# Add printing log callback # Add printing log callback
if (verbose > 0 && eval_freq > 0) { if (verbose > 0L && eval_freq > 0L) {
callbacks <- add.cb(callbacks, cb.print.evaluation(eval_freq)) callbacks <- add.cb(callbacks, cb.print.evaluation(eval_freq))
} }
# Add evaluation log callback # Add evaluation log callback
if (record && length(valids) > 0) { if (record && length(valids) > 0L) {
callbacks <- add.cb(callbacks, cb.record.evaluation()) callbacks <- add.cb(callbacks, cb.record.evaluation())
} }
...@@ -201,7 +201,7 @@ lgb.train <- function(params = list(), ...@@ -201,7 +201,7 @@ lgb.train <- function(params = list(),
early_stop <- .PARAMETER_ALIASES()[["early_stopping_round"]] early_stop <- .PARAMETER_ALIASES()[["early_stopping_round"]]
early_stop_param_indx <- names(params) %in% early_stop early_stop_param_indx <- names(params) %in% early_stop
if (any(early_stop_param_indx)) { if (any(early_stop_param_indx)) {
first_early_stop_param <- which(early_stop_param_indx)[[1]] first_early_stop_param <- which(early_stop_param_indx)[[1L]]
first_early_stop_param_name <- names(params)[[first_early_stop_param]] first_early_stop_param_name <- names(params)[[first_early_stop_param]]
early_stopping_rounds <- params[[first_early_stop_param_name]] early_stopping_rounds <- params[[first_early_stop_param_name]]
} }
...@@ -213,20 +213,20 @@ lgb.train <- function(params = list(), ...@@ -213,20 +213,20 @@ lgb.train <- function(params = list(),
using_dart <- any( using_dart <- any(
sapply( sapply(
X = boosting_param_names X = boosting_param_names
, FUN = function(param){ , FUN = function(param) {
identical(params[[param]], 'dart') identical(params[[param]], "dart")
} }
) )
) )
# Cannot use early stopping with 'dart' boosting # Cannot use early stopping with 'dart' boosting
if (using_dart){ if (using_dart) {
warning("Early stopping is not available in 'dart' mode.") warning("Early stopping is not available in 'dart' mode.")
using_early_stopping_via_args <- FALSE using_early_stopping_via_args <- FALSE
# Remove the cb.early.stop() function if it was passed in to callbacks # Remove the cb.early.stop() function if it was passed in to callbacks
callbacks <- Filter( callbacks <- Filter(
f = function(cb_func){ f = function(cb_func) {
!identical(attr(cb_func, "name"), "cb.early.stop") !identical(attr(cb_func, "name"), "cb.early.stop")
} }
, x = callbacks , x = callbacks
...@@ -234,7 +234,7 @@ lgb.train <- function(params = list(), ...@@ -234,7 +234,7 @@ lgb.train <- function(params = list(),
} }
# If user supplied early_stopping_rounds, add the early stopping callback # If user supplied early_stopping_rounds, add the early stopping callback
if (using_early_stopping_via_args){ if (using_early_stopping_via_args) {
callbacks <- add.cb( callbacks <- add.cb(
callbacks callbacks
, cb.early.stop( , cb.early.stop(
...@@ -279,7 +279,7 @@ lgb.train <- function(params = list(), ...@@ -279,7 +279,7 @@ lgb.train <- function(params = list(),
eval_list <- list() eval_list <- list()
# Collection: Has validation dataset? # Collection: Has validation dataset?
if (length(valids) > 0) { if (length(valids) > 0L) {
# Validation has training dataset? # Validation has training dataset?
if (vaild_contain_train) { if (vaild_contain_train) {
...@@ -305,13 +305,13 @@ lgb.train <- function(params = list(), ...@@ -305,13 +305,13 @@ lgb.train <- function(params = list(),
# When early stopping is not activated, we compute the best iteration / score ourselves by # When early stopping is not activated, we compute the best iteration / score ourselves by
# selecting the first metric and the first dataset # selecting the first metric and the first dataset
if (record && length(valids) > 0 && is.na(env$best_score)) { if (record && length(valids) > 0L && is.na(env$best_score)) {
if (env$eval_list[[1]]$higher_better[1] == TRUE) { if (env$eval_list[[1L]]$higher_better[1L] == TRUE) {
booster$best_iter <- unname(which.max(unlist(booster$record_evals[[2]][[1]][[1]]))) booster$best_iter <- unname(which.max(unlist(booster$record_evals[[2L]][[1L]][[1L]])))
booster$best_score <- booster$record_evals[[2]][[1]][[1]][[booster$best_iter]] booster$best_score <- booster$record_evals[[2L]][[1L]][[1L]][[booster$best_iter]]
} else { } else {
booster$best_iter <- unname(which.min(unlist(booster$record_evals[[2]][[1]][[1]]))) booster$best_iter <- unname(which.min(unlist(booster$record_evals[[2L]][[1L]][[1L]])))
booster$best_score <- booster$record_evals[[2]][[1]][[1]][[booster$best_iter]] booster$best_score <- booster$record_evals[[2L]][[1L]][[1L]][[booster$best_iter]]
} }
} }
......
R-package/R/lgb.unloader.R
View file @ 1f7b06b9
#' LightGBM unloading error fix #' LightGBM unloading error fix
#' #'
#' 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. #' 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.
#' #'
#' @param restore Whether to reload \code{LightGBM} immediately after detaching from R. #' @param restore Whether to reload \code{LightGBM} immediately after detaching from R.
#' Defaults to \code{TRUE} which means automatically reload \code{LightGBM} once #' Defaults to \code{TRUE} which means automatically reload \code{LightGBM} once
...@@ -25,11 +27,11 @@ ...@@ -25,11 +27,11 @@
#' model <- lgb.train( #' model <- lgb.train(
#' params = params #' params = params
#' , data = dtrain #' , data = dtrain
#' , nrounds = 10 #' , nrounds = 10L
#' , valids = valids #' , valids = valids
#' , min_data = 1 #' , min_data = 1L
#' , learning_rate = 1 #' , learning_rate = 1.0
#' , early_stopping_rounds = 5 #' , early_stopping_rounds = 5L
#' ) #' )
#' #'
#' \dontrun{ #' \dontrun{
...@@ -50,13 +52,13 @@ lgb.unloader <- function(restore = TRUE, wipe = FALSE, envir = .GlobalEnv) { ...@@ -50,13 +52,13 @@ lgb.unloader <- function(restore = TRUE, wipe = FALSE, envir = .GlobalEnv) {
# Should we wipe variables? (lgb.Booster, lgb.Dataset) # Should we wipe variables? (lgb.Booster, lgb.Dataset)
if (wipe) { if (wipe) {
boosters <- Filter( boosters <- Filter(
f = function(x){ f = function(x) {
inherits(get(x, envir = envir), "lgb.Booster") inherits(get(x, envir = envir), "lgb.Booster")
} }
, x = ls(envir = envir) , x = ls(envir = envir)
) )
datasets <- Filter( datasets <- Filter(
f = function(x){ f = function(x) {
inherits(get(x, envir = envir), "lgb.Dataset") inherits(get(x, envir = envir), "lgb.Dataset")
} }
, x = ls(envir = envir) , x = ls(envir = envir)
......
R-package/R/lightgbm.R
View file @ 1f7b06b9
...@@ -48,8 +48,8 @@ lightgbm <- function(data, ...@@ -48,8 +48,8 @@ lightgbm <- function(data,
label = NULL, label = NULL,
weight = NULL, weight = NULL,
params = list(), params = list(),
nrounds = 10, nrounds = 10L,
verbose = 1, verbose = 1L,
eval_freq = 1L, eval_freq = 1L,
early_stopping_rounds = NULL, early_stopping_rounds = NULL,
save_name = "lightgbm.model", save_name = "lightgbm.model",
...@@ -59,7 +59,7 @@ lightgbm <- function(data, ...@@ -59,7 +59,7 @@ lightgbm <- function(data,
# Set data to a temporary variable # Set data to a temporary variable
dtrain <- data dtrain <- data
if (nrounds <= 0) { if (nrounds <= 0L) {
stop("nrounds should be greater than zero") stop("nrounds should be greater than zero")
} }
# Check whether data is lgb.Dataset, if not then create lgb.Dataset manually # Check whether data is lgb.Dataset, if not then create lgb.Dataset manually
...@@ -69,8 +69,8 @@ lightgbm <- function(data, ...@@ -69,8 +69,8 @@ lightgbm <- function(data,
# Set validation as oneself # Set validation as oneself
valids <- list() valids <- list()
if (verbose > 0) { if (verbose > 0L) {
valids$train = dtrain valids$train <- dtrain
} }
# Train a model using the regular way # Train a model using the regular way
......
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