lgb.Dataset.R 30.6 KB
Newer Older
Guolin Ke's avatar
Guolin Ke committed
1
Dataset <- R6Class(
2
  classname = "lgb.Dataset",
3
  cloneable = TRUE,
Guolin Ke's avatar
Guolin Ke committed
4
  public = list(
5
    
6
7
8
    # Logical to check whether a dataset can be used re-modeled in-memory as another Dataset or not
    remodel = TRUE,
    
9
    # Finalize will free up the handles
Guolin Ke's avatar
Guolin Ke committed
10
    finalize = function() {
11
12
      
      # Check the need for freeing handle
Guolin Ke's avatar
Guolin Ke committed
13
      if (!lgb.is.null.handle(private$handle)) {
14
15
        
        # Freeing up handle
Guolin Ke's avatar
Guolin Ke committed
16
17
        lgb.call("LGBM_DatasetFree_R", ret = NULL, private$handle)
        private$handle <- NULL
18
        
Guolin Ke's avatar
Guolin Ke committed
19
      }
20
      
Guolin Ke's avatar
Guolin Ke committed
21
    },
22
23
    
    # Initialize will create a starter dataset
Guolin Ke's avatar
Guolin Ke committed
24
    initialize = function(data,
25
26
27
                          params = list(),
                          reference = NULL,
                          colnames = NULL,
28
                          categorical_feature = NULL,
29
30
31
32
                          predictor = NULL,
                          free_raw_data = TRUE,
                          used_indices = NULL,
                          info = list(),
Guolin Ke's avatar
Guolin Ke committed
33
                          ...) {
34
35
      
      # Check for additional parameters
36
      additional_params <- list(...)
37
38
39
40
41
      
      # Create known attributes list
      INFO_KEYS <- c("label", "weight", "init_score", "group")
      
      # Check if attribute key is in the known attribute list
42
      for (key in names(additional_params)) {
43
44
        
        # Key existing
45
        if (key %in% INFO_KEYS) {
46
47
          
          # Store as info
48
          info[[key]] <- additional_params[[key]]
49
          
Guolin Ke's avatar
Guolin Ke committed
50
        } else {
51
52
          
          # Store as param
53
          params[[key]] <- additional_params[[key]]
54
          
Guolin Ke's avatar
Guolin Ke committed
55
        }
56
        
Guolin Ke's avatar
Guolin Ke committed
57
      }
58
59
      
      # Check for dataset reference
Guolin Ke's avatar
Guolin Ke committed
60
61
      if (!is.null(reference)) {
        if (!lgb.check.r6.class(reference, "lgb.Dataset")) {
62
          stop("lgb.Dataset: Can only use ", sQuote("lgb.Dataset"), " as reference")
Guolin Ke's avatar
Guolin Ke committed
63
64
        }
      }
65
66
      
      # Check for predictor reference
Guolin Ke's avatar
Guolin Ke committed
67
68
      if (!is.null(predictor)) {
        if (!lgb.check.r6.class(predictor, "lgb.Predictor")) {
69
          stop("lgb.Dataset: Only can use ", sQuote("lgb.Predictor"), " as predictor")
Guolin Ke's avatar
Guolin Ke committed
70
71
        }
      }
72
73
74
75
      
      # Setup private attributes
      private$raw_data <- data
      private$params <- params
Guolin Ke's avatar
Guolin Ke committed
76
      private$reference <- reference
77
      private$colnames <- colnames
78

79
      private$categorical_feature <- categorical_feature
80
81
82
83
84
      private$predictor <- predictor
      private$free_raw_data <- free_raw_data
      private$used_indices <- used_indices
      private$info <- info
      
Guolin Ke's avatar
Guolin Ke committed
85
    },
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
    
    create_valid = function(data,
                            info = list(),
                            ...) {
      
      # Create new dataset
      ret <- Dataset$new(data,
                         private$params,
                         self,
                         private$colnames,
                         private$categorical_feature,
                         private$predictor,
                         private$free_raw_data,
                         NULL,
                         info,
                         ...)
      
      # Return ret
104
      return(invisible(ret))
105
      
Guolin Ke's avatar
Guolin Ke committed
106
    },
107
108
    
    # Dataset constructor
Guolin Ke's avatar
Guolin Ke committed
109
    construct = function() {
110
111
      
      # Check for handle null
Guolin Ke's avatar
Guolin Ke committed
112
      if (!lgb.is.null.handle(private$handle)) {
113
        return(invisible(self))
Guolin Ke's avatar
Guolin Ke committed
114
      }
115
      
Guolin Ke's avatar
Guolin Ke committed
116
117
      # Get feature names
      cnames <- NULL
118
      if (is.matrix(private$raw_data) || is(private$raw_data, "dgCMatrix")) {
Guolin Ke's avatar
Guolin Ke committed
119
120
        cnames <- colnames(private$raw_data)
      }
121
      
Guolin Ke's avatar
Guolin Ke committed
122
      # set feature names if not exist
123
      if (is.null(private$colnames) && !is.null(cnames)) {
Guolin Ke's avatar
Guolin Ke committed
124
125
        private$colnames <- as.character(cnames)
      }
126
      
127
128
      # Get categorical feature index
      if (!is.null(private$categorical_feature)) {
129
130
        
        # Check for character name
131
        if (typeof(private$categorical_feature) == "character") {
132
          
133
            cate_indices <- as.list(match(private$categorical_feature, private$colnames) - 1)
134
135
            
            # Provided indices, but some indices are not existing?
136
137
138
            if (sum(is.na(cate_indices)) > 0) {
              stop("lgb.self.get.handle: supplied an unknown feature in categorical_feature: ", sQuote(private$categorical_feature[is.na(cate_indices)]))
            }
139
            
140
          } else {
141
142
            
            # Check if more categorical features were output over the feature space
143
144
145
            if (max(private$categorical_feature) > length(private$colnames)) {
              stop("lgb.self.get.handle: supplied a too large value in categorical_feature: ", max(private$categorical_feature), " but only ", length(private$colnames), " features")
            }
146
147
            
            # Store indices as [0, n-1] indexed instead of [1, n] indexed
148
            cate_indices <- as.list(private$categorical_feature - 1)
149
            
150
          }
151
152
        
        # Store indices for categorical features
153
        private$params$categorical_feature <- cate_indices
154
        
155
      }
156
      
Guolin Ke's avatar
Guolin Ke committed
157
158
      # Check has header or not
      has_header <- FALSE
159
160
      if (!is.null(private$params$has_header) || !is.null(private$params$header)) {
        if (tolower(as.character(private$params$has_header)) == "true" || tolower(as.character(private$params$header)) == "true") {
Guolin Ke's avatar
Guolin Ke committed
161
162
163
          has_header <- TRUE
        }
      }
164
      
Guolin Ke's avatar
Guolin Ke committed
165
166
      # Generate parameter str
      params_str <- lgb.params2str(private$params)
167
168
      
      # Get handle of reference dataset
Guolin Ke's avatar
Guolin Ke committed
169
170
171
172
      ref_handle <- NULL
      if (!is.null(private$reference)) {
        ref_handle <- private$reference$.__enclos_env__$private$get_handle()
      }
Guolin Ke's avatar
Guolin Ke committed
173
      handle <- 0.0
174
175
      
      # Not subsetting
Guolin Ke's avatar
Guolin Ke committed
176
      if (is.null(private$used_indices)) {
177
178
        
        # Are we using a data file?
179
        if (is.character(private$raw_data)) {
180
181
182
183
184
185
186
          
          handle <- lgb.call("LGBM_DatasetCreateFromFile_R",
                             ret = handle,
                             lgb.c_str(private$raw_data),
                             params_str,
                             ref_handle)
          
Guolin Ke's avatar
Guolin Ke committed
187
        } else if (is.matrix(private$raw_data)) {
188
189
190
191
192
193
194
195
196
197
          
          # Are we using a matrix?
          handle <- lgb.call("LGBM_DatasetCreateFromMat_R",
                             ret = handle,
                             private$raw_data,
                             nrow(private$raw_data),
                             ncol(private$raw_data),
                             params_str,
                             ref_handle)
          
198
        } else if (is(private$raw_data, "dgCMatrix")) {
199
200
201
202
203
204
205
206
207
208
209
210
211
          
          # Are we using a dgCMatrix (sparsed matrix column compressed)
          handle <- lgb.call("LGBM_DatasetCreateFromCSC_R",
                             ret = handle,
                             private$raw_data@p,
                             private$raw_data@i,
                             private$raw_data@x,
                             length(private$raw_data@p),
                             length(private$raw_data@x),
                             nrow(private$raw_data),
                             params_str,
                             ref_handle)
          
Guolin Ke's avatar
Guolin Ke committed
212
        } else {
213
214
215
216
          
          # Unknown data type
          stop("lgb.Dataset.construct: does not support constructing from ", sQuote(class(private$raw_data)))
          
Guolin Ke's avatar
Guolin Ke committed
217
        }
218
        
Guolin Ke's avatar
Guolin Ke committed
219
      } else {
220
221
        
        # Reference is empty
Guolin Ke's avatar
Guolin Ke committed
222
        if (is.null(private$reference)) {
223
          stop("lgb.Dataset.construct: reference cannot be NULL for constructing data subset")
Guolin Ke's avatar
Guolin Ke committed
224
        }
225
226
227
228
229
230
231
232
233
        
        # Construct subset
        handle <- lgb.call("LGBM_DatasetGetSubset_R",
                           ret = handle,
                           ref_handle,
                           private$used_indices,
                           length(private$used_indices),
                           params_str)
        
Guolin Ke's avatar
Guolin Ke committed
234
      }
Guolin Ke's avatar
Guolin Ke committed
235
236
237
      if (lgb.is.null.handle(handle)) {
        stop("lgb.Dataset.construct: cannot create Dataset handle")
      }
238
      # Setup class and private type
Guolin Ke's avatar
Guolin Ke committed
239
240
      class(handle) <- "lgb.Dataset.handle"
      private$handle <- handle
241
242
243
244
245
      
      # Set feature names
      if (!is.null(private$colnames)) {
        self$set_colnames(private$colnames)
      }
246

247
248
249
250
      # Load init score if requested
      if (!is.null(private$predictor) && is.null(private$used_indices)) {
        
        # Setup initial scores
251
        init_score <- private$predictor$predict(private$raw_data, rawscore = TRUE, reshape = TRUE)
252
253
        
        # Not needed to transpose, for is col_marjor
Guolin Ke's avatar
Guolin Ke committed
254
255
        init_score <- as.vector(init_score)
        private$info$init_score <- init_score
256
257
258
259
260
261
        
      }
      
      # Should we free raw data?
      if (isTRUE(private$free_raw_data)) {
        private$raw_data <- NULL
Guolin Ke's avatar
Guolin Ke committed
262
      }
263
264
      
      # Get private information
Guolin Ke's avatar
Guolin Ke committed
265
      if (length(private$info) > 0) {
266
267
        
        # Set infos
268
        for (i in seq_along(private$info)) {
269
          
Guolin Ke's avatar
Guolin Ke committed
270
271
          p <- private$info[i]
          self$setinfo(names(p), p[[1]])
272
          
Guolin Ke's avatar
Guolin Ke committed
273
        }
274
        
Guolin Ke's avatar
Guolin Ke committed
275
      }
276
277
      
      # Get label information existence
Guolin Ke's avatar
Guolin Ke committed
278
279
280
      if (is.null(self$getinfo("label"))) {
        stop("lgb.Dataset.construct: label should be set")
      }
281
      
282
283
284
      # Forcefully block construction
      self$remodel <- FALSE
      
285
286
      # Return self
      return(invisible(self))
287
      
Guolin Ke's avatar
Guolin Ke committed
288
    },
289
290
    
    # Dimension function
Guolin Ke's avatar
Guolin Ke committed
291
    dim = function() {
292
293
      
      # Check for handle
Guolin Ke's avatar
Guolin Ke committed
294
      if (!lgb.is.null.handle(private$handle)) {
295
        
296
297
        num_row <- 0L
        num_col <- 0L
298
299
300
301
302
        
        # Get numeric data and numeric features
        c(lgb.call("LGBM_DatasetGetNumData_R", ret = num_row, private$handle),
          lgb.call("LGBM_DatasetGetNumFeature_R", ret = num_col, private$handle))
        
303
      } else if (is.matrix(private$raw_data) || is(private$raw_data, "dgCMatrix")) {
304
305
        
        # Check if dgCMatrix (sparse matrix column compressed)
306
        dim(private$raw_data)
307
        
Guolin Ke's avatar
Guolin Ke committed
308
      } else {
309
310
311
312
        
        # Trying to work with unknown dimensions is not possible
        stop("dim: cannot get dimensions before dataset has been constructed, please call lgb.Dataset.construct explicitly")
        
Guolin Ke's avatar
Guolin Ke committed
313
      }
314
      
Guolin Ke's avatar
Guolin Ke committed
315
    },
316
317
    
    # Get column names
Guolin Ke's avatar
Guolin Ke committed
318
    get_colnames = function() {
319
320
      
      # Check for handle
Guolin Ke's avatar
Guolin Ke committed
321
      if (!lgb.is.null.handle(private$handle)) {
322
323
        
        # Get feature names and write them
324
325
326
        cnames <- lgb.call.return.str("LGBM_DatasetGetFeatureNames_R", private$handle)
        private$colnames <- as.character(base::strsplit(cnames, "\t")[[1]])
        private$colnames
327
        
328
      } else if (is.matrix(private$raw_data) || is(private$raw_data, "dgCMatrix")) {
329
330
        
        # Check if dgCMatrix (sparse matrix column compressed)
331
        colnames(private$raw_data)
332
        
Guolin Ke's avatar
Guolin Ke committed
333
      } else {
334
335
336
337
        
        # Trying to work with unknown dimensions is not possible
        stop("dim: cannot get dimensions before dataset has been constructed, please call lgb.Dataset.construct explicitly")
        
Guolin Ke's avatar
Guolin Ke committed
338
      }
339
      
Guolin Ke's avatar
Guolin Ke committed
340
    },
341
342
    
    # Set column names
Guolin Ke's avatar
Guolin Ke committed
343
    set_colnames = function(colnames) {
344
345
346
      
      # Check column names non-existence
      if (is.null(colnames)) {
347
        return(invisible(self))
348
349
350
      }
      
      # Check empty column names
Guolin Ke's avatar
Guolin Ke committed
351
      colnames <- as.character(colnames)
352
      if (length(colnames) == 0) {
353
        return(invisible(self))
354
355
356
      }
      
      # Write column names
Guolin Ke's avatar
Guolin Ke committed
357
358
      private$colnames <- colnames
      if (!lgb.is.null.handle(private$handle)) {
359
360
        
        # Merge names with tab separation
Guolin Ke's avatar
Guolin Ke committed
361
362
363
364
365
        merged_name <- paste0(as.list(private$colnames), collapse = "\t")
        lgb.call("LGBM_DatasetSetFeatureNames_R",
                 ret = NULL,
                 private$handle,
                 lgb.c_str(merged_name))
366
        
Guolin Ke's avatar
Guolin Ke committed
367
      }
368
369
      
      # Return self
370
      return(invisible(self))
371
      
Guolin Ke's avatar
Guolin Ke committed
372
    },
373
374
    
    # Get information
Guolin Ke's avatar
Guolin Ke committed
375
    getinfo = function(name) {
376
377
      
      # Create known attributes list
378
      INFONAMES <- c("label", "weight", "init_score", "group")
379
380
381
382
      
      # Check if attribute key is in the known attribute list
      if (!is.character(name) || length(name) != 1 || !name %in% INFONAMES) {
        stop("getinfo: name must one of the following: ", paste0(sQuote(INFONAMES), collapse = ", "))
Guolin Ke's avatar
Guolin Ke committed
383
      }
384
385
      
      # Check for info name and handle
386
      if (is.null(private$info[[name]]) && !lgb.is.null.handle(private$handle)) {
387
388
        
        # Get field size of info
389
        info_len <- 0L
390
391
392
393
        info_len <- lgb.call("LGBM_DatasetGetFieldSize_R",
                             ret = info_len,
                             private$handle,
                             lgb.c_str(name))
394
395
        
        # Check if info is not empty
Guolin Ke's avatar
Guolin Ke committed
396
        if (info_len > 0) {
397
398
          
          # Get back fields
Guolin Ke's avatar
Guolin Ke committed
399
          ret <- NULL
400
401
402
403
404
405
          ret <- if (name == "group") {
            integer(info_len) # Integer
          } else {
            numeric(info_len) # Numeric
          }
          
406
407
408
409
          ret <- lgb.call("LGBM_DatasetGetField_R",
                          ret = ret,
                          private$handle,
                          lgb.c_str(name))
410
          
Guolin Ke's avatar
Guolin Ke committed
411
          private$info[[name]] <- ret
412
          
Guolin Ke's avatar
Guolin Ke committed
413
414
        }
      }
415
      
416
      private$info[[name]]
417
      
Guolin Ke's avatar
Guolin Ke committed
418
    },
419
420
    
    # Set information
Guolin Ke's avatar
Guolin Ke committed
421
    setinfo = function(name, info) {
422
423
      
      # Create known attributes list
424
      INFONAMES <- c("label", "weight", "init_score", "group")
425
426
427
428
429
430
431
432
433
434
435
436
437
438
      
      # Check if attribute key is in the known attribute list
      if (!is.character(name) || length(name) != 1 || !name %in% INFONAMES) {
        stop("setinfo: name must one of the following: ", paste0(sQuote(INFONAMES), collapse = ", "))
      }
      
      # Check for type of information
      info <- if (name == "group") {
        as.integer(info) # Integer
      } else {
        as.numeric(info) # Numeric
      }
      
      # Store information privately
Guolin Ke's avatar
Guolin Ke committed
439
      private$info[[name]] <- info
440
      
441
      if (!lgb.is.null.handle(private$handle) && !is.null(info)) {
442
        
Guolin Ke's avatar
Guolin Ke committed
443
        if (length(info) > 0) {
444
445
446
447
448
449
450
451
          
          lgb.call("LGBM_DatasetSetField_R",
                   ret = NULL,
                   private$handle,
                   lgb.c_str(name),
                   info,
                   length(info))
          
Guolin Ke's avatar
Guolin Ke committed
452
        }
453
        
Guolin Ke's avatar
Guolin Ke committed
454
      }
455
456
      
      # Return self
457
      return(invisible(self))
458
      
Guolin Ke's avatar
Guolin Ke committed
459
    },
460
461
    
    # Slice dataset
Guolin Ke's avatar
Guolin Ke committed
462
    slice = function(idxset, ...) {
463
464
465
466
467
468
469
470
471
472
473
474
475
      
      # Perform slicing
      Dataset$new(NULL,
                  private$params,
                  self,
                  private$colnames,
                  private$categorical_feature,
                  private$predictor,
                  private$free_raw_data,
                  idxset,
                  NULL,
                  ...)
      
Guolin Ke's avatar
Guolin Ke committed
476
    },
477
478
    
    # Update parameters
479
    update_params = function(params) {
480
481
      
      # Parameter updating
Guolin Ke's avatar
Guolin Ke committed
482
      private$params <- modifyList(private$params, params)
483
      return(invisible(self))
484
      
Guolin Ke's avatar
Guolin Ke committed
485
    },
486
487
    
    # Set categorical feature parameter
488
    set_categorical_feature = function(categorical_feature) {
489
490
491
      
      # Check for identical input
      if (identical(private$categorical_feature, categorical_feature)) {
492
        return(invisible(self))
493
494
495
      }
      
      # Check for empty data
496
      if (is.null(private$raw_data)) {
497
498
        stop("set_categorical_feature: cannot set categorical feature after freeing raw data,
          please set ", sQuote("free_raw_data = FALSE"), " when you construct lgb.Dataset")
499
      }
500
501
      
      # Overwrite categorical features
502
      private$categorical_feature <- categorical_feature
503
504
      
      # Finalize and return self
505
      self$finalize()
506
      return(invisible(self))
507
      
508
    },
509
510
    
    # Set reference
Guolin Ke's avatar
Guolin Ke committed
511
    set_reference = function(reference) {
512
513
      
      # Set known references
514
      self$set_categorical_feature(reference$.__enclos_env__$private$categorical_feature)
Guolin Ke's avatar
Guolin Ke committed
515
516
      self$set_colnames(reference$get_colnames())
      private$set_predictor(reference$.__enclos_env__$private$predictor)
517
518
519
      
      # Check for identical references
      if (identical(private$reference, reference)) {
520
        return(invisible(self))
521
522
523
      }
      
      # Check for empty data
Guolin Ke's avatar
Guolin Ke committed
524
      if (is.null(private$raw_data)) {
525
526
527
528
        
        stop("set_reference: cannot set reference after freeing raw data,
          please set ", sQuote("free_raw_data = FALSE"), " when you construct lgb.Dataset")
        
Guolin Ke's avatar
Guolin Ke committed
529
      }
530
531
      
      # Check for non-existing reference
Guolin Ke's avatar
Guolin Ke committed
532
      if (!is.null(reference)) {
533
534
        
        # Reference is unknown
Guolin Ke's avatar
Guolin Ke committed
535
        if (!lgb.check.r6.class(reference, "lgb.Dataset")) {
536
          stop("set_reference: Can only use lgb.Dataset as a reference")
Guolin Ke's avatar
Guolin Ke committed
537
        }
538
        
Guolin Ke's avatar
Guolin Ke committed
539
      }
540
541
      
      # Store reference
Guolin Ke's avatar
Guolin Ke committed
542
      private$reference <- reference
543
544
      
      # Finalize and return self
Guolin Ke's avatar
Guolin Ke committed
545
      self$finalize()
546
      return(invisible(self))
547
      
Guolin Ke's avatar
Guolin Ke committed
548
    },
549
550
    
    # Save binary model
Guolin Ke's avatar
Guolin Ke committed
551
    save_binary = function(fname) {
552
553
      
      # Store binary data
Guolin Ke's avatar
Guolin Ke committed
554
555
556
557
558
      self$construct()
      lgb.call("LGBM_DatasetSaveBinary_R",
               ret = NULL,
               private$handle,
               lgb.c_str(fname))
559
      return(invisible(self))
Guolin Ke's avatar
Guolin Ke committed
560
    }
561
    
Guolin Ke's avatar
Guolin Ke committed
562
563
  ),
  private = list(
564
565
566
567
568
    handle = NULL,
    raw_data = NULL,
    params = list(),
    reference = NULL,
    colnames = NULL,
569
    categorical_feature = NULL,
570
571
572
573
574
575
576
577
578
579
580
581
    predictor = NULL,
    free_raw_data = TRUE,
    used_indices = NULL,
    info = NULL,
    
    # Get handle
    get_handle = function() {
      
      # Get handle and construct if needed
      if (lgb.is.null.handle(private$handle)) {
        self$construct()
      }
582
      private$handle
583
      
Guolin Ke's avatar
Guolin Ke committed
584
    },
585
586
    
    # Set predictor
Guolin Ke's avatar
Guolin Ke committed
587
    set_predictor = function(predictor) {
588
589
590
      
      # Return self is identical predictor
      if (identical(private$predictor, predictor)) {
591
        return(invisible(self))
592
593
594
      }
      
      # Check for empty data
Guolin Ke's avatar
Guolin Ke committed
595
      if (is.null(private$raw_data)) {
596
597
        stop("set_predictor: cannot set predictor after free raw data,
          please set ", sQuote("free_raw_data = FALSE"), " when you construct lgb.Dataset")
Guolin Ke's avatar
Guolin Ke committed
598
      }
599
600
      
      # Check for empty predictor
Guolin Ke's avatar
Guolin Ke committed
601
      if (!is.null(predictor)) {
602
603
        
        # Predictor is unknown
Guolin Ke's avatar
Guolin Ke committed
604
        if (!lgb.check.r6.class(predictor, "lgb.Predictor")) {
605
          stop("set_predictor: Can only use lgb.Predictor as predictor")
Guolin Ke's avatar
Guolin Ke committed
606
        }
607
        
Guolin Ke's avatar
Guolin Ke committed
608
      }
609
610
      
      # Store predictor
Guolin Ke's avatar
Guolin Ke committed
611
      private$predictor <- predictor
612
613
      
      # Finalize and return self
Guolin Ke's avatar
Guolin Ke committed
614
      self$finalize()
615
      return(invisible(self))
616
      
Guolin Ke's avatar
Guolin Ke committed
617
    }
618
    
Guolin Ke's avatar
Guolin Ke committed
619
620
621
  )
)

wxchan's avatar
wxchan committed
622
#' Construct lgb.Dataset object
Guolin Ke's avatar
Guolin Ke committed
623
#'
wxchan's avatar
wxchan committed
624
#' Construct lgb.Dataset object from dense matrix, sparse matrix
Guolin Ke's avatar
Guolin Ke committed
625
626
627
628
629
630
#' or local file (that was created previously by saving an \code{lgb.Dataset}).
#'
#' @param data a \code{matrix} object, a \code{dgCMatrix} object or a character representing a filename
#' @param params a list of parameters
#' @param reference reference dataset
#' @param colnames names of columns
631
#' @param categorical_feature categorical features
Guolin Ke's avatar
Guolin Ke committed
632
633
634
#' @param free_raw_data TRUE for need to free raw data after construct
#' @param info a list of information of the lgb.Dataset object
#' @param ... other information to pass to \code{info} or parameters pass to \code{params}
635
#' 
Guolin Ke's avatar
Guolin Ke committed
636
#' @return constructed dataset
637
#' 
Guolin Ke's avatar
Guolin Ke committed
638
#' @examples
639
#' \dontrun{
640
641
642
643
644
645
646
#' library(lightgbm)
#' data(agaricus.train, package = "lightgbm")
#' train <- agaricus.train
#' dtrain <- lgb.Dataset(train$data, label = train$label)
#' lgb.Dataset.save(dtrain, "lgb.Dataset.data")
#' dtrain <- lgb.Dataset("lgb.Dataset.data")
#' lgb.Dataset.construct(dtrain)
647
#' }
648
#' 
Guolin Ke's avatar
Guolin Ke committed
649
650
#' @export
lgb.Dataset <- function(data,
651
652
653
                        params = list(),
                        reference = NULL,
                        colnames = NULL,
654
                        categorical_feature = NULL,
655
656
                        free_raw_data = TRUE,
                        info = list(),
Guolin Ke's avatar
Guolin Ke committed
657
                        ...) {
658
659
  
  # Create new dataset
660
  invisible(Dataset$new(data,
661
662
663
664
665
666
667
668
              params,
              reference,
              colnames,
              categorical_feature,
              NULL,
              free_raw_data,
              NULL,
              info,
669
              ...))
670
  
Guolin Ke's avatar
Guolin Ke committed
671
672
}

wxchan's avatar
wxchan committed
673
#' Construct validation data
674
#' 
wxchan's avatar
wxchan committed
675
#' Construct validation data according to training data
676
#' 
Guolin Ke's avatar
Guolin Ke committed
677
678
679
680
#' @param dataset \code{lgb.Dataset} object, training data
#' @param data a \code{matrix} object, a \code{dgCMatrix} object or a character representing a filename
#' @param info a list of information of the lgb.Dataset object
#' @param ... other information to pass to \code{info}.
681
#' 
Guolin Ke's avatar
Guolin Ke committed
682
#' @return constructed dataset
683
#' 
Guolin Ke's avatar
Guolin Ke committed
684
#' @examples
685
#' \dontrun{
686
687
688
689
690
691
692
#' library(lightgbm)
#' 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)
693
#' }
694
#' 
Guolin Ke's avatar
Guolin Ke committed
695
#' @export
696
697
698
lgb.Dataset.create.valid <- function(dataset, data, info = list(), ...) {
  
  # Check if dataset is not a dataset
699
700
  if (!lgb.is.Dataset(dataset)) {
    stop("lgb.Dataset.create.valid: input data should be an lgb.Dataset object")
Guolin Ke's avatar
Guolin Ke committed
701
  }
702
703
  
  # Create validation dataset
704
  invisible(dataset$create_valid(data, info, ...))
705
  
706
}
Guolin Ke's avatar
Guolin Ke committed
707

708
#' Construct Dataset explicitly
709
#' 
Guolin Ke's avatar
Guolin Ke committed
710
#' @param dataset Object of class \code{lgb.Dataset}
711
#' 
Guolin Ke's avatar
Guolin Ke committed
712
#' @examples
713
#' \dontrun{
714
715
716
717
718
#' library(lightgbm)
#' data(agaricus.train, package = "lightgbm")
#' train <- agaricus.train
#' dtrain <- lgb.Dataset(train$data, label = train$label)
#' lgb.Dataset.construct(dtrain)
719
#' }
720
#' 
Guolin Ke's avatar
Guolin Ke committed
721
722
#' @export
lgb.Dataset.construct <- function(dataset) {
723
724
  
  # Check if dataset is not a dataset
725
726
  if (!lgb.is.Dataset(dataset)) {
    stop("lgb.Dataset.construct: input data should be an lgb.Dataset object")
Guolin Ke's avatar
Guolin Ke committed
727
  }
728
729
  
  # Construct the dataset
730
  invisible(dataset$construct())
731
  
Guolin Ke's avatar
Guolin Ke committed
732
733
}

734
#' Dimensions of an lgb.Dataset
735
#' 
Guolin Ke's avatar
Guolin Ke committed
736
737
738
#' Returns a vector of numbers of rows and of columns in an \code{lgb.Dataset}.
#' @param x Object of class \code{lgb.Dataset}
#' @param ... other parameters
739
#' 
Guolin Ke's avatar
Guolin Ke committed
740
#' @return a vector of numbers of rows and of columns
741
#' 
Guolin Ke's avatar
Guolin Ke committed
742
743
744
#' @details
#' Note: since \code{nrow} and \code{ncol} internally use \code{dim}, they can also
#' be directly used with an \code{lgb.Dataset} object.
745
#' 
Guolin Ke's avatar
Guolin Ke committed
746
#' @examples
747
748
749
750
751
752
753
754
755
#' \dontrun{
#' library(lightgbm)
#' data(agaricus.train, package = "lightgbm")
#' train <- agaricus.train
#' dtrain <- lgb.Dataset(train$data, label = train$label)
#' 
#' stopifnot(nrow(dtrain) == nrow(train$data))
#' stopifnot(ncol(dtrain) == ncol(train$data))
#' stopifnot(all(dim(dtrain) == dim(train$data)))
756
#' }
757
#' 
Guolin Ke's avatar
Guolin Ke committed
758
759
760
#' @rdname dim
#' @export
dim.lgb.Dataset <- function(x, ...) {
761
762
  
  # Check if dataset is not a dataset
763
764
  if (!lgb.is.Dataset(x)) {
    stop("dim.lgb.Dataset: input data should be an lgb.Dataset object")
Guolin Ke's avatar
Guolin Ke committed
765
  }
766
767
  
  # Return dimensions
768
  x$dim()
769
  
Guolin Ke's avatar
Guolin Ke committed
770
771
772
773
774
}

#' Handling of column names of \code{lgb.Dataset}
#'
#' Only column names are supported for \code{lgb.Dataset}, thus setting of
775
#' row names would have no effect and returned row names would be NULL.
Guolin Ke's avatar
Guolin Ke committed
776
777
778
779
780
781
782
783
784
785
#'
#' @param x object of class \code{lgb.Dataset}
#' @param value a list of two elements: the first one is ignored
#'        and the second one is column names
#'
#' @details
#' Generic \code{dimnames} methods are used by \code{colnames}.
#' Since row names are irrelevant, it is recommended to use \code{colnames} directly.
#'
#' @examples
786
787
788
789
790
791
792
793
794
795
#' \dontrun{
#' library(lightgbm)
#' data(agaricus.train, package = "lightgbm")
#' train <- agaricus.train
#' dtrain <- lgb.Dataset(train$data, label = train$label)
#' lgb.Dataset.construct(dtrain)
#' dimnames(dtrain)
#' colnames(dtrain)
#' colnames(dtrain) <- make.names(1:ncol(train$data))
#' print(dtrain, verbose = TRUE)
796
#' }
797
#' 
Guolin Ke's avatar
Guolin Ke committed
798
799
800
#' @rdname dimnames.lgb.Dataset
#' @export
dimnames.lgb.Dataset <- function(x) {
801
802
  
  # Check if dataset is not a dataset
803
804
  if (!lgb.is.Dataset(x)) {
    stop("dimnames.lgb.Dataset: input data should be an lgb.Dataset object")
Guolin Ke's avatar
Guolin Ke committed
805
  }
806
807
  
  # Return dimension names
808
  list(NULL, x$get_colnames())
809
  
Guolin Ke's avatar
Guolin Ke committed
810
811
812
813
814
}

#' @rdname dimnames.lgb.Dataset
#' @export
`dimnames<-.lgb.Dataset` <- function(x, value) {
815
816
817
  
  # Check if invalid element list
  if (!is.list(value) || length(value) != 2L) {
818
    stop("invalid ", sQuote("value"), " given: must be a list of two elements")
819
820
821
822
823
824
825
826
  }
  
  # Check for unknown row names
  if (!is.null(value[[1L]])) {
    stop("lgb.Dataset does not have rownames")
  }
  
  # Check for second value missing
Guolin Ke's avatar
Guolin Ke committed
827
  if (is.null(value[[2]])) {
828
829
    
    # No column names
Guolin Ke's avatar
Guolin Ke committed
830
831
    x$set_colnames(NULL)
    return(x)
832
833
834
835
836
837
    
  }
  
  # Check for unmatching column size
  if (ncol(x) != length(value[[2]])) {
    stop("can't assign ", sQuote(length(value[[2]])), " colnames to an lgb.Dataset with ", sQuote(ncol(x)), " columns")
Guolin Ke's avatar
Guolin Ke committed
838
  }
839
840
  
  # Set column names properly, and return
Guolin Ke's avatar
Guolin Ke committed
841
  x$set_colnames(value[[2]])
842
  x
843
  
Guolin Ke's avatar
Guolin Ke committed
844
845
}

846
#' Slice a dataset
847
#' 
848
#' Get a new \code{lgb.Dataset} containing the specified rows of
Guolin Ke's avatar
Guolin Ke committed
849
#' orginal lgb.Dataset object
850
#' 
Guolin Ke's avatar
Guolin Ke committed
851
852
853
854
#' @param dataset Object of class "lgb.Dataset"
#' @param idxset a integer vector of indices of rows needed
#' @param ... other parameters (currently not used)
#' @return constructed sub dataset
855
#' 
Guolin Ke's avatar
Guolin Ke committed
856
#' @examples
857
#' \dontrun{
858
859
860
861
862
863
864
#' library(lightgbm)
#' data(agaricus.train, package = "lightgbm")
#' train <- agaricus.train
#' dtrain <- lgb.Dataset(train$data, label = train$label)
#' 
#' dsub <- lightgbm::slice(dtrain, 1:42)
#' labels <- lightgbm::getinfo(dsub, "label")
865
#' }
866
#' 
Guolin Ke's avatar
Guolin Ke committed
867
#' @export
868
869
870
slice <- function(dataset, ...) {
  UseMethod("slice")
}
Guolin Ke's avatar
Guolin Ke committed
871
872
873
874

#' @rdname slice
#' @export
slice.lgb.Dataset <- function(dataset, idxset, ...) {
875
876
  
  # Check if dataset is not a dataset
877
878
  if (!lgb.is.Dataset(dataset)) {
    stop("slice.lgb.Dataset: input dataset should be an lgb.Dataset object")
Guolin Ke's avatar
Guolin Ke committed
879
  }
880
881
  
  # Return sliced set
882
  invisible(dataset$slice(idxset, ...))
883
  
Guolin Ke's avatar
Guolin Ke committed
884
885
886
}

#' Get information of an lgb.Dataset object
887
#' 
Guolin Ke's avatar
Guolin Ke committed
888
889
890
891
#' @param dataset Object of class \code{lgb.Dataset}
#' @param name the name of the information field to get (see details)
#' @param ... other parameters
#' @return info data
892
#' 
Guolin Ke's avatar
Guolin Ke committed
893
894
#' @details
#' The \code{name} field can be one of the following:
895
#' 
Guolin Ke's avatar
Guolin Ke committed
896
897
898
899
900
901
#' \itemize{
#'     \item \code{label}: label lightgbm learn from ;
#'     \item \code{weight}: to do a weight rescale ;
#'     \item \code{group}: group size
#'     \item \code{init_score}: initial score is the base prediction lightgbm will boost from ;
#' }
902
#' 
Guolin Ke's avatar
Guolin Ke committed
903
#' @examples
904
#' \dontrun{
905
906
907
908
909
910
911
912
913
914
915
#' library(lightgbm)
#' data(agaricus.train, package = "lightgbm")
#' train <- agaricus.train
#' dtrain <- lgb.Dataset(train$data, label = train$label)
#' lgb.Dataset.construct(dtrain)
#' 
#' labels <- lightgbm::getinfo(dtrain, "label")
#' lightgbm::setinfo(dtrain, "label", 1 - labels)
#' 
#' labels2 <- lightgbm::getinfo(dtrain, "label")
#' stopifnot(all(labels2 == 1 - labels))
916
#' }
917
#' 
Guolin Ke's avatar
Guolin Ke committed
918
#' @export
919
920
921
getinfo <- function(dataset, ...) {
  UseMethod("getinfo")
}
Guolin Ke's avatar
Guolin Ke committed
922
923
924
925

#' @rdname getinfo
#' @export
getinfo.lgb.Dataset <- function(dataset, name, ...) {
926
927
  
  # Check if dataset is not a dataset
928
929
  if (!lgb.is.Dataset(dataset)) {
    stop("getinfo.lgb.Dataset: input dataset should be an lgb.Dataset object")
Guolin Ke's avatar
Guolin Ke committed
930
  }
931
932
  
  # Return information
933
  dataset$getinfo(name)
934
  
Guolin Ke's avatar
Guolin Ke committed
935
936
937
}

#' Set information of an lgb.Dataset object
938
#' 
Guolin Ke's avatar
Guolin Ke committed
939
940
941
942
943
#' @param dataset Object of class "lgb.Dataset"
#' @param name the name of the field to get
#' @param info the specific field of information to set
#' @param ... other parameters
#' @return passed object
944
#' 
Guolin Ke's avatar
Guolin Ke committed
945
946
#' @details
#' The \code{name} field can be one of the following:
947
#' 
Guolin Ke's avatar
Guolin Ke committed
948
949
950
951
952
953
#' \itemize{
#'     \item \code{label}: label lightgbm learn from ;
#'     \item \code{weight}: to do a weight rescale ;
#'     \item \code{init_score}: initial score is the base prediction lightgbm will boost from ;
#'     \item \code{group}.
#' }
954
#' 
Guolin Ke's avatar
Guolin Ke committed
955
#' @examples
956
#' \dontrun{
957
958
959
960
961
962
963
964
965
966
967
#' library(lightgbm)
#' data(agaricus.train, package = "lightgbm")
#' train <- agaricus.train
#' dtrain <- lgb.Dataset(train$data, label = train$label)
#' lgb.Dataset.construct(dtrain)
#' 
#' labels <- lightgbm::getinfo(dtrain, "label")
#' lightgbm::setinfo(dtrain, "label", 1 - labels)
#' 
#' labels2 <- lightgbm::getinfo(dtrain, "label")
#' stopifnot(all.equal(labels2, 1 - labels))
968
#' }
969
#' 
Guolin Ke's avatar
Guolin Ke committed
970
#' @export
971
972
973
setinfo <- function(dataset, ...) {
  UseMethod("setinfo")
}
Guolin Ke's avatar
Guolin Ke committed
974
975
976
977

#' @rdname setinfo
#' @export
setinfo.lgb.Dataset <- function(dataset, name, info, ...) {
978
979
  
  # Check if dataset is not a dataset
980
981
  if (!lgb.is.Dataset(dataset)) {
    stop("setinfo.lgb.Dataset: input dataset should be an lgb.Dataset object")
Guolin Ke's avatar
Guolin Ke committed
982
  }
983
984
  
  # Set information
985
  invisible(dataset$setinfo(name, info))
Guolin Ke's avatar
Guolin Ke committed
986
987
}

988
#' Set categorical feature of \code{lgb.Dataset}
989
#' 
990
991
#' @param dataset object of class \code{lgb.Dataset}
#' @param categorical_feature categorical features
992
#' 
993
#' @return passed dataset
994
#' 
995
996
#' @examples
#' \dontrun{
997
998
999
1000
1001
1002
1003
#' library(lightgbm)
#' data(agaricus.train, package = "lightgbm")
#' train <- agaricus.train
#' dtrain <- lgb.Dataset(train$data, label = train$label)
#' lgb.Dataset.save(dtrain, "lgb.Dataset.data")
#' dtrain <- lgb.Dataset("lgb.Dataset.data")
#' lgb.Dataset.set.categorical(dtrain, 1:2)
1004
#' }
1005
#' 
1006
1007
1008
#' @rdname lgb.Dataset.set.categorical
#' @export
lgb.Dataset.set.categorical <- function(dataset, categorical_feature) {
1009
1010
  
  # Check if dataset is not a dataset
1011
1012
1013
  if (!lgb.is.Dataset(dataset)) {
    stop("lgb.Dataset.set.categorical: input dataset should be an lgb.Dataset object")
  }
1014
1015
  
  # Set categoricals
1016
  invisible(dataset$set_categorical_feature(categorical_feature))
1017
  
1018
1019
}

1020
#' Set reference of \code{lgb.Dataset}
1021
#' 
1022
#' If you want to use validation data, you should set reference to training data
1023
#' 
Guolin Ke's avatar
Guolin Ke committed
1024
1025
#' @param dataset object of class \code{lgb.Dataset}
#' @param reference object of class \code{lgb.Dataset}
1026
#' 
Guolin Ke's avatar
Guolin Ke committed
1027
#' @return passed dataset
1028
#' 
Guolin Ke's avatar
Guolin Ke committed
1029
#' @examples
1030
#' \dontrun{
1031
1032
1033
1034
1035
1036
1037
1038
#' library(lightgbm)
#' 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(test$data, test = train$label)
#' lgb.Dataset.set.reference(dtest, dtrain)
1039
#' }
1040
#' 
Guolin Ke's avatar
Guolin Ke committed
1041
1042
1043
#' @rdname lgb.Dataset.set.reference
#' @export
lgb.Dataset.set.reference <- function(dataset, reference) {
1044
1045
  
  # Check if dataset is not a dataset
1046
1047
  if (!lgb.is.Dataset(dataset)) {
    stop("lgb.Dataset.set.reference: input dataset should be an lgb.Dataset object")
Guolin Ke's avatar
Guolin Ke committed
1048
  }
1049
1050
  
  # Set reference
1051
  invisible(dataset$set_reference(reference))
Guolin Ke's avatar
Guolin Ke committed
1052
1053
}

1054
#' Save \code{lgb.Dataset} to a binary file
1055
#' 
Guolin Ke's avatar
Guolin Ke committed
1056
1057
#' @param dataset object of class \code{lgb.Dataset}
#' @param fname object filename of output file
1058
#' 
Guolin Ke's avatar
Guolin Ke committed
1059
#' @return passed dataset
1060
#' 
Guolin Ke's avatar
Guolin Ke committed
1061
#' @examples
1062
#' 
1063
#' \dontrun{
1064
1065
1066
1067
1068
#' library(lightgbm)
#' data(agaricus.train, package = "lightgbm")
#' train <- agaricus.train
#' dtrain <- lgb.Dataset(train$data, label = train$label)
#' lgb.Dataset.save(dtrain, "data.bin")
1069
#' }
1070
#' 
Guolin Ke's avatar
Guolin Ke committed
1071
1072
1073
#' @rdname lgb.Dataset.save
#' @export
lgb.Dataset.save <- function(dataset, fname) {
1074
1075
  
  # Check if dataset is not a dataset
1076
1077
  if (!lgb.is.Dataset(dataset)) {
    stop("lgb.Dataset.set: input dataset should be an lgb.Dataset object")
Guolin Ke's avatar
Guolin Ke committed
1078
  }
1079
1080
  
  # File-type is not matching
1081
1082
  if (!is.character(fname)) {
    stop("lgb.Dataset.set: fname should be a character or a file connection")
Guolin Ke's avatar
Guolin Ke committed
1083
  }
1084
1085
  
  # Store binary
1086
  invisible(dataset$save_binary(fname))
Guolin Ke's avatar
Guolin Ke committed
1087
}