lgb.train.R 12.6 KB
Newer Older
James Lamb's avatar
James Lamb committed
1
#' @name lgb.train
2
#' @title Main training logic for LightGBM
3
4
5
#' @description Low-level R interface to train a LightGBM model. Unlike \code{\link{lightgbm}},
#'              this function is focused on performance (e.g. speed, memory efficiency). It is also
#'              less likely to have breaking API changes in new releases than \code{\link{lightgbm}}.
James Lamb's avatar
James Lamb committed
6
#' @inheritParams lgb_shared_params
7
#' @param valids a list of \code{lgb.Dataset} objects, used for validation
8
#' @param record Boolean, TRUE will record iteration message to \code{booster$record_evals}
9
10
#' @param colnames Deprecated. See "Deprecated Arguments" section below.
#' @param categorical_feature Deprecated. See "Deprecated Arguments" section below.
11
12
13
14
#' @param callbacks List of callback functions that are applied at each iteration.
#' @param reset_data Boolean, setting it to TRUE (not the default value) will transform the
#'                   booster model into a predictor model which frees up memory and the
#'                   original datasets
15
#' @inheritSection lgb_shared_params Early Stopping
16
#' @return a trained booster model \code{lgb.Booster}.
17
#'
Guolin Ke's avatar
Guolin Ke committed
18
#' @examples
19
#' \donttest{
20
21
#' \dontshow{setLGBMthreads(2L)}
#' \dontshow{data.table::setDTthreads(1L)}
22
23
24
25
26
27
#' data(agaricus.train, package = "lightgbm")
#' train <- agaricus.train
#' dtrain <- lgb.Dataset(train$data, label = train$label)
#' data(agaricus.test, package = "lightgbm")
#' test <- agaricus.test
#' dtest <- lgb.Dataset.create.valid(dtrain, test$data, label = test$label)
28
29
30
31
32
#' params <- list(
#'   objective = "regression"
#'   , metric = "l2"
#'   , min_data = 1L
#'   , learning_rate = 1.0
33
#'   , num_threads = 2L
34
#' )
35
#' valids <- list(test = dtest)
36
37
38
#' model <- lgb.train(
#'   params = params
#'   , data = dtrain
39
#'   , nrounds = 5L
40
#'   , valids = valids
41
#'   , early_stopping_rounds = 3L
42
#' )
43
#' }
44
45
46
47
48
49
50
#'
#' @section Deprecated Arguments:
#'
#' A future release of \code{lightgbm} will remove support for passing arguments
#' \code{'categorical_feature'} and \code{'colnames'}. Pass those things to
#' \code{lgb.Dataset} instead.
#'
Guolin Ke's avatar
Guolin Ke committed
51
#' @export
52
53
lgb.train <- function(params = list(),
                      data,
54
                      nrounds = 100L,
55
56
57
                      valids = list(),
                      obj = NULL,
                      eval = NULL,
58
                      verbose = 1L,
59
60
61
62
63
                      record = TRUE,
                      eval_freq = 1L,
                      init_model = NULL,
                      colnames = NULL,
                      categorical_feature = NULL,
64
                      early_stopping_rounds = NULL,
65
                      callbacks = list(),
66
                      reset_data = FALSE,
67
                      serializable = TRUE) {
68

69
70
71
72
  # validate inputs early to avoid unnecessary computation
  if (nrounds <= 0L) {
    stop("nrounds should be greater than zero")
  }
73
  if (!.is_Dataset(x = data)) {
74
75
76
    stop("lgb.train: data must be an lgb.Dataset instance")
  }
  if (length(valids) > 0L) {
77
    if (!identical(class(valids), "list") || !all(vapply(valids, .is_Dataset, logical(1L)))) {
78
79
80
81
82
83
84
85
      stop("lgb.train: valids must be a list of lgb.Dataset elements")
    }
    evnames <- names(valids)
    if (is.null(evnames) || !all(nzchar(evnames))) {
      stop("lgb.train: each element of valids must have a name")
    }
  }

86
87
88
89
90
91
92
93
94
95
  # raise deprecation warnings if necessary
  # ref: https://github.com/microsoft/LightGBM/issues/6435
  args <- names(match.call())
  if ("categorical_feature" %in% args) {
    .emit_dataset_kwarg_warning("categorical_feature", "lgb.train")
  }
  if ("colnames" %in% args) {
    .emit_dataset_kwarg_warning("colnames", "lgb.train")
  }

96
97
98
99
  # set some parameters, resolving the way they were passed in with other parameters
  # in `params`.
  # this ensures that the model stored with Booster$save() correctly represents
  # what was passed in
100
  params <- .check_wrapper_param(
101
102
103
104
    main_param_name = "verbosity"
    , params = params
    , alternative_kwarg_value = verbose
  )
105
  params <- .check_wrapper_param(
106
107
108
109
    main_param_name = "num_iterations"
    , params = params
    , alternative_kwarg_value = nrounds
  )
110
  params <- .check_wrapper_param(
111
112
113
114
    main_param_name = "metric"
    , params = params
    , alternative_kwarg_value = NULL
  )
115
  params <- .check_wrapper_param(
116
117
    main_param_name = "objective"
    , params = params
118
    , alternative_kwarg_value = obj
119
  )
120
  params <- .check_wrapper_param(
121
122
123
124
125
126
    main_param_name = "early_stopping_round"
    , params = params
    , alternative_kwarg_value = early_stopping_rounds
  )
  early_stopping_rounds <- params[["early_stopping_round"]]

127
128
  # extract any function objects passed for objective or metric
  fobj <- NULL
129
  if (is.function(params$objective)) {
130
    fobj <- params$objective
131
    params$objective <- "none"
Guolin Ke's avatar
Guolin Ke committed
132
  }
133

134
  # If eval is a single function, store it as a 1-element list
135
  # (for backwards compatibility). If it is a list of functions, store
136
137
  # all of them. This makes it possible to pass any mix of strings like "auc"
  # and custom functions to eval
138
  params <- .check_eval(params = params, eval = eval)
139
  eval_functions <- list(NULL)
140
  if (is.function(eval)) {
141
142
143
144
145
146
147
    eval_functions <- list(eval)
  }
  if (methods::is(eval, "list")) {
    eval_functions <- Filter(
      f = is.function
      , x = eval
    )
148
  }
149

150
  # Init predictor to empty
Guolin Ke's avatar
Guolin Ke committed
151
  predictor <- NULL
152

153
  # Check for boosting from a trained model
154
  if (is.character(init_model)) {
155
    predictor <- Predictor$new(modelfile = init_model)
156
  } else if (.is_Booster(x = init_model)) {
Guolin Ke's avatar
Guolin Ke committed
157
158
    predictor <- init_model$to_predictor()
  }
159

160
  # Set the iteration to start from / end to (and check for boosting from a trained model, again)
161
  begin_iteration <- 1L
162
  if (!is.null(predictor)) {
163
    begin_iteration <- predictor$current_iter() + 1L
Guolin Ke's avatar
Guolin Ke committed
164
  }
165
  end_iteration <- begin_iteration + params[["num_iterations"]] - 1L
166

167
168
169
170
171
  # pop interaction_constraints off of params. It needs some preprocessing on the
  # R side before being passed into the Dataset object
  interaction_constraints <- params[["interaction_constraints"]]
  params["interaction_constraints"] <- NULL

172
173
  # Construct datasets, if needed
  data$update_params(params = params)
174
175
176
  if (!is.null(categorical_feature)) {
    data$set_categorical_feature(categorical_feature)
  }
177
178
  data$construct()

179
180
181
182
183
184
  # Check interaction constraints
  cnames <- NULL
  if (!is.null(colnames)) {
    cnames <- colnames
  } else if (!is.null(data$get_colnames())) {
    cnames <- data$get_colnames()
185
  }
186
  params[["interaction_constraints"]] <- .check_interaction_constraints(
187
    interaction_constraints = interaction_constraints
188
189
    , column_names = cnames
  )
190

191
  # Update parameters with parsed parameters
Guolin Ke's avatar
Guolin Ke committed
192
  data$update_params(params)
193

194
  # Create the predictor set
Guolin Ke's avatar
Guolin Ke committed
195
  data$.__enclos_env__$private$set_predictor(predictor)
196

197
198
199
200
  # Write column names
  if (!is.null(colnames)) {
    data$set_colnames(colnames)
  }
201

202
  valid_contain_train <- FALSE
203
204
  train_data_name <- "train"
  reduced_valid_sets <- list()
205

206
  # Parse validation datasets
207
  if (length(valids) > 0L) {
208

Guolin Ke's avatar
Guolin Ke committed
209
    for (key in names(valids)) {
210

211
      # Use names to get validation datasets
Guolin Ke's avatar
Guolin Ke committed
212
      valid_data <- valids[[key]]
213

214
      # Check for duplicate train/validation dataset
215
      if (identical(data, valid_data)) {
216
        valid_contain_train <- TRUE
217
        train_data_name <- key
Guolin Ke's avatar
Guolin Ke committed
218
219
        next
      }
220

221
      # Update parameters, data
Guolin Ke's avatar
Guolin Ke committed
222
223
224
      valid_data$update_params(params)
      valid_data$set_reference(data)
      reduced_valid_sets[[key]] <- valid_data
225

Guolin Ke's avatar
Guolin Ke committed
226
    }
227

Guolin Ke's avatar
Guolin Ke committed
228
  }
229

230
  # Add printing log callback
231
  if (params[["verbosity"]] > 0L && eval_freq > 0L) {
232
233
234
235
    callbacks <- .add_cb(
        cb_list = callbacks
        , cb = cb_print_evaluation(period = eval_freq)
    )
Guolin Ke's avatar
Guolin Ke committed
236
  }
237

238
  # Add evaluation log callback
239
  if (record && length(valids) > 0L) {
240
241
242
243
    callbacks <- .add_cb(
        cb_list = callbacks
        , cb = cb_record_evaluation()
    )
Guolin Ke's avatar
Guolin Ke committed
244
  }
245

246
  # Did user pass parameters that indicate they want to use early stopping?
247
  using_early_stopping <- !is.null(early_stopping_rounds) && early_stopping_rounds > 0L
248
249
250
251
252

  boosting_param_names <- .PARAMETER_ALIASES()[["boosting"]]
  using_dart <- any(
    sapply(
      X = boosting_param_names
253
254
      , FUN = function(param) {
        identical(params[[param]], "dart")
255
      }
256
257
258
259
    )
  )

  # Cannot use early stopping with 'dart' boosting
260
  if (using_dart) {
261
    warning("Early stopping is not available in 'dart' mode.")
262
    using_early_stopping <- FALSE
263

264
    # Remove the cb_early_stop() function if it was passed in to callbacks
265
    callbacks <- Filter(
266
      f = function(cb_func) {
267
        !identical(attr(cb_func, "name"), "cb_early_stop")
268
269
270
271
272
273
      }
      , x = callbacks
    )
  }

  # If user supplied early_stopping_rounds, add the early stopping callback
274
  if (using_early_stopping) {
275
    callbacks <- .add_cb(
276
      cb_list = callbacks
277
      , cb = cb_early_stop(
278
        stopping_rounds = early_stopping_rounds
279
        , first_metric_only = isTRUE(params[["first_metric_only"]])
280
        , verbose = params[["verbosity"]] > 0L
281
282
      )
    )
Guolin Ke's avatar
Guolin Ke committed
283
  }
284

285
  cb <- .categorize_callbacks(cb_list = callbacks)
286

287
  # Construct booster with datasets
288
  booster <- Booster$new(params = params, train_set = data)
289
  if (valid_contain_train) {
290
    booster$set_train_data_name(name = train_data_name)
291
  }
292

Guolin Ke's avatar
Guolin Ke committed
293
  for (key in names(reduced_valid_sets)) {
294
    booster$add_valid(data = reduced_valid_sets[[key]], name = key)
Guolin Ke's avatar
Guolin Ke committed
295
  }
296

297
298
299
  # Callback env
  env <- CB_ENV$new()
  env$model <- booster
Guolin Ke's avatar
Guolin Ke committed
300
  env$begin_iteration <- begin_iteration
301
  env$end_iteration <- end_iteration
302

303
  # Start training model using number of iterations to start and end with
304
  for (i in seq.int(from = begin_iteration, to = end_iteration)) {
305

306
    # Overwrite iteration in environment
Guolin Ke's avatar
Guolin Ke committed
307
308
    env$iteration <- i
    env$eval_list <- list()
309

310
311
312
313
    # Loop through "pre_iter" element
    for (f in cb$pre_iter) {
      f(env)
    }
314

315
    # Update one boosting iteration
316
    booster$update(fobj = fobj)
317

318
    # Prepare collection of evaluation results
Guolin Ke's avatar
Guolin Ke committed
319
    eval_list <- list()
320

321
    # Collection: Has validation dataset?
322
    if (length(valids) > 0L) {
323

324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
      # Get evaluation results with passed-in functions
      for (eval_function in eval_functions) {

        # Validation has training dataset?
        if (valid_contain_train) {
          eval_list <- append(eval_list, booster$eval_train(feval = eval_function))
        }

        eval_list <- append(eval_list, booster$eval_valid(feval = eval_function))
      }

      # Calling booster$eval_valid() will get
      # evaluation results with the metrics in params$metric by calling LGBM_BoosterGetEval_R",
      # so need to be sure that gets called, which it wouldn't be above if no functions
      # were passed in
      if (length(eval_functions) == 0L) {
        if (valid_contain_train) {
          eval_list <- append(eval_list, booster$eval_train(feval = eval_function))
        }
        eval_list <- append(eval_list, booster$eval_valid(feval = eval_function))
Guolin Ke's avatar
Guolin Ke committed
344
      }
345

Guolin Ke's avatar
Guolin Ke committed
346
    }
347

348
    # Write evaluation result in environment
Guolin Ke's avatar
Guolin Ke committed
349
    env$eval_list <- eval_list
350

351
352
353
354
    # Loop through env
    for (f in cb$post_iter) {
      f(env)
    }
355

356
    # Check for early stopping and break if needed
357
    if (env$met_early_stop) break
358

Guolin Ke's avatar
Guolin Ke committed
359
  }
360

361
362
363
364
  # check if any valids were given other than the training data
  non_train_valid_names <- names(valids)[!(names(valids) == train_data_name)]
  first_valid_name <- non_train_valid_names[1L]

365
366
  # When early stopping is not activated, we compute the best iteration / score ourselves by
  # selecting the first metric and the first dataset
367
  if (record && length(non_train_valid_names) > 0L && is.na(env$best_score)) {
368
369
370

    # when using a custom eval function, the metric name is returned from the
    # function, so figure it out from record_evals
371
    if (!is.null(eval_functions[1L])) {
372
373
374
375
376
      first_metric <- names(booster$record_evals[[first_valid_name]])[1L]
    } else {
      first_metric <- booster$.__enclos_env__$private$eval_names[1L]
    }

377
378
379
    .find_best <- which.min
    if (isTRUE(env$eval_list[[1L]]$higher_better[1L])) {
      .find_best <- which.max
380
    }
381
382
383
384
385
386
387
388
    booster$best_iter <- unname(
      .find_best(
        unlist(
          booster$record_evals[[first_valid_name]][[first_metric]][[.EVAL_KEY()]]
        )
      )
    )
    booster$best_score <- booster$record_evals[[first_valid_name]][[first_metric]][[.EVAL_KEY()]][[booster$best_iter]]
389
  }
390

391
392
  # Check for booster model conversion to predictor model
  if (reset_data) {
393

394
    # Store temporarily model data elsewhere
395
396
397
398
399
    booster_old <- list(
      best_iter = booster$best_iter
      , best_score = booster$best_score
      , record_evals = booster$record_evals
    )
400

401
402
403
404
405
    # Reload model
    booster <- lgb.load(model_str = booster$save_model_to_string())
    booster$best_iter <- booster_old$best_iter
    booster$best_score <- booster_old$best_score
    booster$record_evals <- booster_old$record_evals
406

407
  }
408

409
410
411
412
  if (serializable) {
    booster$save_raw()
  }

413
  return(booster)
414

Guolin Ke's avatar
Guolin Ke committed
415
}