lightgbm_R.cpp 44.5 KB
Newer Older
1
2
3
4
/*!
 * Copyright (c) 2017 Microsoft Corporation. All rights reserved.
 * Licensed under the MIT License. See LICENSE file in the project root for license information.
 */
5
6

#include "lightgbm_R.h"
Guolin Ke's avatar
Guolin Ke committed
7

8
9
10
11
12
13
14
#include <LightGBM/utils/common.h>
#include <LightGBM/utils/log.h>
#include <LightGBM/utils/openmp_wrapper.h>
#include <LightGBM/utils/text_reader.h>

#include <R_ext/Rdynload.h>

15
16
17
18
#define R_NO_REMAP
#define R_USE_C99_IN_CXX
#include <R_ext/Error.h>

19
20
#include <string>
#include <cstdio>
21
#include <cstdlib>
22
23
24
25
#include <cstring>
#include <memory>
#include <utility>
#include <vector>
26
#include <algorithm>
27

Guolin Ke's avatar
Guolin Ke committed
28
29
#define COL_MAJOR (0)

30
31
32
33
34
35
#define MAX_LENGTH_ERR_MSG 1024
char R_errmsg_buffer[MAX_LENGTH_ERR_MSG];
struct LGBM_R_ErrorClass { SEXP cont_token; };
void LGBM_R_save_exception_msg(const std::exception &err);
void LGBM_R_save_exception_msg(const std::string &err);

Guolin Ke's avatar
Guolin Ke committed
36
37
38
#define R_API_BEGIN() \
  try {
#define R_API_END() } \
39
40
41
42
43
44
  catch(LGBM_R_ErrorClass &cont) { R_ContinueUnwind(cont.cont_token); } \
  catch(std::exception& ex) { LGBM_R_save_exception_msg(ex); } \
  catch(std::string& ex) { LGBM_R_save_exception_msg(ex); } \
  catch(...) { Rf_error("unknown exception"); } \
  Rf_error(R_errmsg_buffer); \
  return R_NilValue; /* <- won't be reached */
Guolin Ke's avatar
Guolin Ke committed
45
46
47

#define CHECK_CALL(x) \
  if ((x) != 0) { \
48
    throw std::runtime_error(LGBM_GetLastError()); \
Guolin Ke's avatar
Guolin Ke committed
49
50
  }

51
52
53
54
55
56
57
58
59
60
61
62
63
64
// These are helper functions to allow doing a stack unwind
// after an R allocation error, which would trigger a long jump.
void LGBM_R_save_exception_msg(const std::exception &err) {
  std::snprintf(R_errmsg_buffer, MAX_LENGTH_ERR_MSG, "%s\n", err.what());
}

void LGBM_R_save_exception_msg(const std::string &err) {
  std::snprintf(R_errmsg_buffer, MAX_LENGTH_ERR_MSG, "%s\n", err.c_str());
}

SEXP wrapped_R_string(void *len) {
  return Rf_allocVector(STRSXP, *(reinterpret_cast<R_xlen_t*>(len)));
}

65
66
67
68
SEXP wrapped_R_raw(void *len) {
  return Rf_allocVector(RAWSXP, *(reinterpret_cast<R_xlen_t*>(len)));
}

69
70
71
72
73
74
75
76
SEXP wrapped_R_int(void *len) {
  return Rf_allocVector(INTSXP, *(reinterpret_cast<R_xlen_t*>(len)));
}

SEXP wrapped_R_real(void *len) {
  return Rf_allocVector(REALSXP, *(reinterpret_cast<R_xlen_t*>(len)));
}

77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
SEXP wrapped_Rf_mkChar(void *txt) {
  return Rf_mkChar(reinterpret_cast<char*>(txt));
}

void throw_R_memerr(void *ptr_cont_token, Rboolean jump) {
  if (jump) {
    LGBM_R_ErrorClass err{*(reinterpret_cast<SEXP*>(ptr_cont_token))};
    throw err;
  }
}

SEXP safe_R_string(R_xlen_t len, SEXP *cont_token) {
  return R_UnwindProtect(wrapped_R_string, reinterpret_cast<void*>(&len), throw_R_memerr, cont_token, *cont_token);
}

92
93
94
95
SEXP safe_R_raw(R_xlen_t len, SEXP *cont_token) {
  return R_UnwindProtect(wrapped_R_raw, reinterpret_cast<void*>(&len), throw_R_memerr, cont_token, *cont_token);
}

96
97
98
99
100
101
102
103
SEXP safe_R_int(R_xlen_t len, SEXP *cont_token) {
  return R_UnwindProtect(wrapped_R_int, reinterpret_cast<void*>(&len), throw_R_memerr, cont_token, *cont_token);
}

SEXP safe_R_real(R_xlen_t len, SEXP *cont_token) {
  return R_UnwindProtect(wrapped_R_real, reinterpret_cast<void*>(&len), throw_R_memerr, cont_token, *cont_token);
}

104
105
106
107
SEXP safe_R_mkChar(char *txt, SEXP *cont_token) {
  return R_UnwindProtect(wrapped_Rf_mkChar, reinterpret_cast<void*>(txt), throw_R_memerr, cont_token, *cont_token);
}

108
109
using LightGBM::Common::Split;
using LightGBM::Log;
Guolin Ke's avatar
Guolin Ke committed
110

111
112
113
114
SEXP LGBM_HandleIsNull_R(SEXP handle) {
  return Rf_ScalarLogical(R_ExternalPtrAddr(handle) == NULL);
}

115
116
117
118
void _DatasetFinalizer(SEXP handle) {
  LGBM_DatasetFree_R(handle);
}

119
120
121
122
123
124
125
126
SEXP LGBM_NullBoosterHandleError_R() {
  Rf_error(
      "Attempting to use a Booster which no longer exists and/or cannot be restored. "
      "This can happen if you have called Booster$finalize() "
      "or if this Booster was saved through saveRDS() using 'serializable=FALSE'.");
  return R_NilValue;
}

127
128
void _AssertBoosterHandleNotNull(SEXP handle) {
  if (Rf_isNull(handle) || !R_ExternalPtrAddr(handle)) {
129
    LGBM_NullBoosterHandleError_R();
130
131
132
133
134
135
136
137
138
139
140
141
  }
}

void _AssertDatasetHandleNotNull(SEXP handle) {
  if (Rf_isNull(handle) || !R_ExternalPtrAddr(handle)) {
    Rf_error(
      "Attempting to use a Dataset which no longer exists. "
      "This can happen if you have called Dataset$finalize() or if this Dataset was saved with saveRDS(). "
      "To avoid this error in the future, use lgb.Dataset.save() or Dataset$save_binary() to save lightgbm Datasets.");
  }
}

142
143
SEXP LGBM_DatasetCreateFromFile_R(SEXP filename,
  SEXP parameters,
144
  SEXP reference) {
145
  R_API_BEGIN();
146
  SEXP ret = PROTECT(R_MakeExternalPtr(nullptr, R_NilValue, R_NilValue));
Guolin Ke's avatar
Guolin Ke committed
147
  DatasetHandle handle = nullptr;
148
149
150
151
  DatasetHandle ref = nullptr;
  if (!Rf_isNull(reference)) {
    ref = R_ExternalPtrAddr(reference);
  }
152
153
154
  const char* filename_ptr = CHAR(PROTECT(Rf_asChar(filename)));
  const char* parameters_ptr = CHAR(PROTECT(Rf_asChar(parameters)));
  CHECK_CALL(LGBM_DatasetCreateFromFile(filename_ptr, parameters_ptr, ref, &handle));
155
  R_SetExternalPtrAddr(ret, handle);
156
  R_RegisterCFinalizerEx(ret, _DatasetFinalizer, TRUE);
157
  UNPROTECT(3);
158
  return ret;
159
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
160
161
}

162
163
164
SEXP LGBM_DatasetCreateFromCSC_R(SEXP indptr,
  SEXP indices,
  SEXP data,
165
166
167
  SEXP num_indptr,
  SEXP nelem,
  SEXP num_row,
168
  SEXP parameters,
169
  SEXP reference) {
170
  R_API_BEGIN();
171
  SEXP ret = PROTECT(R_MakeExternalPtr(nullptr, R_NilValue, R_NilValue));
172
173
174
  const int* p_indptr = INTEGER(indptr);
  const int* p_indices = INTEGER(indices);
  const double* p_data = REAL(data);
175
176
177
  int64_t nindptr = static_cast<int64_t>(Rf_asInteger(num_indptr));
  int64_t ndata = static_cast<int64_t>(Rf_asInteger(nelem));
  int64_t nrow = static_cast<int64_t>(Rf_asInteger(num_row));
178
  const char* parameters_ptr = CHAR(PROTECT(Rf_asChar(parameters)));
Guolin Ke's avatar
Guolin Ke committed
179
  DatasetHandle handle = nullptr;
180
181
182
183
  DatasetHandle ref = nullptr;
  if (!Rf_isNull(reference)) {
    ref = R_ExternalPtrAddr(reference);
  }
Guolin Ke's avatar
Guolin Ke committed
184
185
  CHECK_CALL(LGBM_DatasetCreateFromCSC(p_indptr, C_API_DTYPE_INT32, p_indices,
    p_data, C_API_DTYPE_FLOAT64, nindptr, ndata,
186
    nrow, parameters_ptr, ref, &handle));
187
  R_SetExternalPtrAddr(ret, handle);
188
  R_RegisterCFinalizerEx(ret, _DatasetFinalizer, TRUE);
189
  UNPROTECT(2);
190
  return ret;
191
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
192
193
}

194
SEXP LGBM_DatasetCreateFromMat_R(SEXP data,
195
196
  SEXP num_row,
  SEXP num_col,
197
  SEXP parameters,
198
  SEXP reference) {
199
  R_API_BEGIN();
200
  SEXP ret = PROTECT(R_MakeExternalPtr(nullptr, R_NilValue, R_NilValue));
201
202
  int32_t nrow = static_cast<int32_t>(Rf_asInteger(num_row));
  int32_t ncol = static_cast<int32_t>(Rf_asInteger(num_col));
203
  double* p_mat = REAL(data);
204
  const char* parameters_ptr = CHAR(PROTECT(Rf_asChar(parameters)));
Guolin Ke's avatar
Guolin Ke committed
205
  DatasetHandle handle = nullptr;
206
207
208
209
  DatasetHandle ref = nullptr;
  if (!Rf_isNull(reference)) {
    ref = R_ExternalPtrAddr(reference);
  }
Guolin Ke's avatar
Guolin Ke committed
210
  CHECK_CALL(LGBM_DatasetCreateFromMat(p_mat, C_API_DTYPE_FLOAT64, nrow, ncol, COL_MAJOR,
211
    parameters_ptr, ref, &handle));
212
  R_SetExternalPtrAddr(ret, handle);
213
  R_RegisterCFinalizerEx(ret, _DatasetFinalizer, TRUE);
214
  UNPROTECT(2);
215
  return ret;
216
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
217
218
}

219
SEXP LGBM_DatasetGetSubset_R(SEXP handle,
220
  SEXP used_row_indices,
221
  SEXP len_used_row_indices,
222
  SEXP parameters) {
223
  R_API_BEGIN();
224
  _AssertDatasetHandleNotNull(handle);
225
  SEXP ret = PROTECT(R_MakeExternalPtr(nullptr, R_NilValue, R_NilValue));
226
227
  int32_t len = static_cast<int32_t>(Rf_asInteger(len_used_row_indices));
  std::vector<int32_t> idxvec(len);
228
  // convert from one-based to zero-based index
Guolin Ke's avatar
Guolin Ke committed
229
#pragma omp parallel for schedule(static, 512) if (len >= 1024)
230
231
  for (int32_t i = 0; i < len; ++i) {
    idxvec[i] = static_cast<int32_t>(INTEGER(used_row_indices)[i] - 1);
Guolin Ke's avatar
Guolin Ke committed
232
  }
233
  const char* parameters_ptr = CHAR(PROTECT(Rf_asChar(parameters)));
Guolin Ke's avatar
Guolin Ke committed
234
  DatasetHandle res = nullptr;
235
  CHECK_CALL(LGBM_DatasetGetSubset(R_ExternalPtrAddr(handle),
236
    idxvec.data(), len, parameters_ptr,
Guolin Ke's avatar
Guolin Ke committed
237
    &res));
238
  R_SetExternalPtrAddr(ret, res);
239
  R_RegisterCFinalizerEx(ret, _DatasetFinalizer, TRUE);
240
  UNPROTECT(2);
241
  return ret;
242
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
243
244
}

245
SEXP LGBM_DatasetSetFeatureNames_R(SEXP handle,
246
  SEXP feature_names) {
247
  R_API_BEGIN();
248
  _AssertDatasetHandleNotNull(handle);
249
  auto vec_names = Split(CHAR(PROTECT(Rf_asChar(feature_names))), '\t');
Guolin Ke's avatar
Guolin Ke committed
250
251
252
253
254
  std::vector<const char*> vec_sptr;
  int len = static_cast<int>(vec_names.size());
  for (int i = 0; i < len; ++i) {
    vec_sptr.push_back(vec_names[i].c_str());
  }
255
  CHECK_CALL(LGBM_DatasetSetFeatureNames(R_ExternalPtrAddr(handle),
Guolin Ke's avatar
Guolin Ke committed
256
    vec_sptr.data(), len));
257
258
  UNPROTECT(1);
  return R_NilValue;
259
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
260
261
}

262
SEXP LGBM_DatasetGetFeatureNames_R(SEXP handle) {
263
264
  SEXP cont_token = PROTECT(R_MakeUnwindCont());
  R_API_BEGIN();
265
  _AssertDatasetHandleNotNull(handle);
266
  SEXP feature_names;
Guolin Ke's avatar
Guolin Ke committed
267
  int len = 0;
268
  CHECK_CALL(LGBM_DatasetGetNumFeature(R_ExternalPtrAddr(handle), &len));
269
  const size_t reserved_string_size = 256;
Guolin Ke's avatar
Guolin Ke committed
270
271
272
  std::vector<std::vector<char>> names(len);
  std::vector<char*> ptr_names(len);
  for (int i = 0; i < len; ++i) {
273
    names[i].resize(reserved_string_size);
Guolin Ke's avatar
Guolin Ke committed
274
275
276
    ptr_names[i] = names[i].data();
  }
  int out_len;
277
278
279
  size_t required_string_size;
  CHECK_CALL(
    LGBM_DatasetGetFeatureNames(
280
      R_ExternalPtrAddr(handle),
281
282
283
      len, &out_len,
      reserved_string_size, &required_string_size,
      ptr_names.data()));
284
285
286
287
288
289
290
291
292
  // if any feature names were larger than allocated size,
  // allow for a larger size and try again
  if (required_string_size > reserved_string_size) {
    for (int i = 0; i < len; ++i) {
      names[i].resize(required_string_size);
      ptr_names[i] = names[i].data();
    }
    CHECK_CALL(
      LGBM_DatasetGetFeatureNames(
293
        R_ExternalPtrAddr(handle),
294
295
296
297
298
299
        len,
        &out_len,
        required_string_size,
        &required_string_size,
        ptr_names.data()));
  }
Nikita Titov's avatar
Nikita Titov committed
300
  CHECK_EQ(len, out_len);
301
  feature_names = PROTECT(safe_R_string(static_cast<R_xlen_t>(len), &cont_token));
302
  for (int i = 0; i < len; ++i) {
303
    SET_STRING_ELT(feature_names, i, safe_R_mkChar(ptr_names[i], &cont_token));
304
  }
305
  UNPROTECT(2);
306
  return feature_names;
307
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
308
309
}

310
SEXP LGBM_DatasetSaveBinary_R(SEXP handle,
311
  SEXP filename) {
Guolin Ke's avatar
Guolin Ke committed
312
  R_API_BEGIN();
313
  _AssertDatasetHandleNotNull(handle);
314
  const char* filename_ptr = CHAR(PROTECT(Rf_asChar(filename)));
315
  CHECK_CALL(LGBM_DatasetSaveBinary(R_ExternalPtrAddr(handle),
316
317
318
    filename_ptr));
  UNPROTECT(1);
  return R_NilValue;
319
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
320
321
}

322
SEXP LGBM_DatasetFree_R(SEXP handle) {
Guolin Ke's avatar
Guolin Ke committed
323
  R_API_BEGIN();
324
  if (!Rf_isNull(handle) && R_ExternalPtrAddr(handle)) {
325
326
    CHECK_CALL(LGBM_DatasetFree(R_ExternalPtrAddr(handle)));
    R_ClearExternalPtr(handle);
Guolin Ke's avatar
Guolin Ke committed
327
  }
328
  return R_NilValue;
329
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
330
331
}

332
SEXP LGBM_DatasetSetField_R(SEXP handle,
333
  SEXP field_name,
334
  SEXP field_data,
335
  SEXP num_element) {
336
  R_API_BEGIN();
337
  _AssertDatasetHandleNotNull(handle);
338
  int len = Rf_asInteger(num_element);
339
  const char* name = CHAR(PROTECT(Rf_asChar(field_name)));
Guolin Ke's avatar
Guolin Ke committed
340
341
  if (!strcmp("group", name) || !strcmp("query", name)) {
    std::vector<int32_t> vec(len);
Guolin Ke's avatar
Guolin Ke committed
342
#pragma omp parallel for schedule(static, 512) if (len >= 1024)
Guolin Ke's avatar
Guolin Ke committed
343
    for (int i = 0; i < len; ++i) {
344
      vec[i] = static_cast<int32_t>(INTEGER(field_data)[i]);
Guolin Ke's avatar
Guolin Ke committed
345
    }
346
    CHECK_CALL(LGBM_DatasetSetField(R_ExternalPtrAddr(handle), name, vec.data(), len, C_API_DTYPE_INT32));
347
  } else if (!strcmp("init_score", name)) {
348
    CHECK_CALL(LGBM_DatasetSetField(R_ExternalPtrAddr(handle), name, REAL(field_data), len, C_API_DTYPE_FLOAT64));
Guolin Ke's avatar
Guolin Ke committed
349
350
  } else {
    std::vector<float> vec(len);
Guolin Ke's avatar
Guolin Ke committed
351
#pragma omp parallel for schedule(static, 512) if (len >= 1024)
Guolin Ke's avatar
Guolin Ke committed
352
    for (int i = 0; i < len; ++i) {
353
      vec[i] = static_cast<float>(REAL(field_data)[i]);
Guolin Ke's avatar
Guolin Ke committed
354
    }
355
    CHECK_CALL(LGBM_DatasetSetField(R_ExternalPtrAddr(handle), name, vec.data(), len, C_API_DTYPE_FLOAT32));
Guolin Ke's avatar
Guolin Ke committed
356
  }
357
358
  UNPROTECT(1);
  return R_NilValue;
359
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
360
361
}

362
SEXP LGBM_DatasetGetField_R(SEXP handle,
363
  SEXP field_name,
364
  SEXP field_data) {
365
  R_API_BEGIN();
366
  _AssertDatasetHandleNotNull(handle);
367
  const char* name = CHAR(PROTECT(Rf_asChar(field_name)));
Guolin Ke's avatar
Guolin Ke committed
368
369
370
  int out_len = 0;
  int out_type = 0;
  const void* res;
371
  CHECK_CALL(LGBM_DatasetGetField(R_ExternalPtrAddr(handle), name, &out_len, &res, &out_type));
Guolin Ke's avatar
Guolin Ke committed
372
373
374
  if (!strcmp("group", name) || !strcmp("query", name)) {
    auto p_data = reinterpret_cast<const int32_t*>(res);
    // convert from boundaries to size
Guolin Ke's avatar
Guolin Ke committed
375
#pragma omp parallel for schedule(static, 512) if (out_len >= 1024)
Guolin Ke's avatar
Guolin Ke committed
376
    for (int i = 0; i < out_len - 1; ++i) {
377
      INTEGER(field_data)[i] = p_data[i + 1] - p_data[i];
Guolin Ke's avatar
Guolin Ke committed
378
    }
Guolin Ke's avatar
Guolin Ke committed
379
380
  } else if (!strcmp("init_score", name)) {
    auto p_data = reinterpret_cast<const double*>(res);
Guolin Ke's avatar
Guolin Ke committed
381
#pragma omp parallel for schedule(static, 512) if (out_len >= 1024)
Guolin Ke's avatar
Guolin Ke committed
382
    for (int i = 0; i < out_len; ++i) {
383
      REAL(field_data)[i] = p_data[i];
Guolin Ke's avatar
Guolin Ke committed
384
    }
Guolin Ke's avatar
Guolin Ke committed
385
386
  } else {
    auto p_data = reinterpret_cast<const float*>(res);
Guolin Ke's avatar
Guolin Ke committed
387
#pragma omp parallel for schedule(static, 512) if (out_len >= 1024)
Guolin Ke's avatar
Guolin Ke committed
388
    for (int i = 0; i < out_len; ++i) {
389
      REAL(field_data)[i] = p_data[i];
Guolin Ke's avatar
Guolin Ke committed
390
391
    }
  }
392
393
  UNPROTECT(1);
  return R_NilValue;
394
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
395
396
}

397
SEXP LGBM_DatasetGetFieldSize_R(SEXP handle,
398
  SEXP field_name,
399
  SEXP out) {
400
  R_API_BEGIN();
401
  _AssertDatasetHandleNotNull(handle);
402
  const char* name = CHAR(PROTECT(Rf_asChar(field_name)));
Guolin Ke's avatar
Guolin Ke committed
403
404
405
  int out_len = 0;
  int out_type = 0;
  const void* res;
406
  CHECK_CALL(LGBM_DatasetGetField(R_ExternalPtrAddr(handle), name, &out_len, &res, &out_type));
Guolin Ke's avatar
Guolin Ke committed
407
408
409
  if (!strcmp("group", name) || !strcmp("query", name)) {
    out_len -= 1;
  }
410
  INTEGER(out)[0] = out_len;
411
412
  UNPROTECT(1);
  return R_NilValue;
413
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
414
415
}

416
417
SEXP LGBM_DatasetUpdateParamChecking_R(SEXP old_params,
  SEXP new_params) {
418
  R_API_BEGIN();
419
420
421
422
423
  const char* old_params_ptr = CHAR(PROTECT(Rf_asChar(old_params)));
  const char* new_params_ptr = CHAR(PROTECT(Rf_asChar(new_params)));
  CHECK_CALL(LGBM_DatasetUpdateParamChecking(old_params_ptr, new_params_ptr));
  UNPROTECT(2);
  return R_NilValue;
424
  R_API_END();
425
426
}

427
SEXP LGBM_DatasetGetNumData_R(SEXP handle, SEXP out) {
Guolin Ke's avatar
Guolin Ke committed
428
  R_API_BEGIN();
429
  _AssertDatasetHandleNotNull(handle);
430
  int nrow;
431
  CHECK_CALL(LGBM_DatasetGetNumData(R_ExternalPtrAddr(handle), &nrow));
432
  INTEGER(out)[0] = nrow;
433
  return R_NilValue;
434
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
435
436
}

437
SEXP LGBM_DatasetGetNumFeature_R(SEXP handle,
438
  SEXP out) {
Guolin Ke's avatar
Guolin Ke committed
439
  R_API_BEGIN();
440
  _AssertDatasetHandleNotNull(handle);
441
  int nfeature;
442
  CHECK_CALL(LGBM_DatasetGetNumFeature(R_ExternalPtrAddr(handle), &nfeature));
443
  INTEGER(out)[0] = nfeature;
444
  return R_NilValue;
445
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
446
447
}

448
449
450
451
452
453
454
455
456
457
458
SEXP LGBM_DatasetGetFeatureNumBin_R(SEXP handle, SEXP feature_idx, SEXP out) {
  R_API_BEGIN();
  _AssertDatasetHandleNotNull(handle);
  int feature = Rf_asInteger(feature_idx);
  int nbins;
  CHECK_CALL(LGBM_DatasetGetFeatureNumBin(R_ExternalPtrAddr(handle), feature, &nbins));
  INTEGER(out)[0] = nbins;
  return R_NilValue;
  R_API_END();
}

Guolin Ke's avatar
Guolin Ke committed
459
460
// --- start Booster interfaces

461
462
463
464
void _BoosterFinalizer(SEXP handle) {
  LGBM_BoosterFree_R(handle);
}

465
SEXP LGBM_BoosterFree_R(SEXP handle) {
Guolin Ke's avatar
Guolin Ke committed
466
  R_API_BEGIN();
467
  if (!Rf_isNull(handle) && R_ExternalPtrAddr(handle)) {
468
469
    CHECK_CALL(LGBM_BoosterFree(R_ExternalPtrAddr(handle)));
    R_ClearExternalPtr(handle);
Guolin Ke's avatar
Guolin Ke committed
470
  }
471
  return R_NilValue;
472
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
473
474
}

475
476
SEXP LGBM_BoosterCreate_R(SEXP train_data,
  SEXP parameters) {
477
  R_API_BEGIN();
478
  _AssertDatasetHandleNotNull(train_data);
479
  SEXP ret = PROTECT(R_MakeExternalPtr(nullptr, R_NilValue, R_NilValue));
480
  const char* parameters_ptr = CHAR(PROTECT(Rf_asChar(parameters)));
Guolin Ke's avatar
Guolin Ke committed
481
  BoosterHandle handle = nullptr;
482
  CHECK_CALL(LGBM_BoosterCreate(R_ExternalPtrAddr(train_data), parameters_ptr, &handle));
483
  R_SetExternalPtrAddr(ret, handle);
484
  R_RegisterCFinalizerEx(ret, _BoosterFinalizer, TRUE);
485
  UNPROTECT(2);
486
  return ret;
487
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
488
489
}

490
SEXP LGBM_BoosterCreateFromModelfile_R(SEXP filename) {
491
  R_API_BEGIN();
492
  SEXP ret = PROTECT(R_MakeExternalPtr(nullptr, R_NilValue, R_NilValue));
Guolin Ke's avatar
Guolin Ke committed
493
  int out_num_iterations = 0;
494
  const char* filename_ptr = CHAR(PROTECT(Rf_asChar(filename)));
Guolin Ke's avatar
Guolin Ke committed
495
  BoosterHandle handle = nullptr;
496
  CHECK_CALL(LGBM_BoosterCreateFromModelfile(filename_ptr, &out_num_iterations, &handle));
497
  R_SetExternalPtrAddr(ret, handle);
498
  R_RegisterCFinalizerEx(ret, _BoosterFinalizer, TRUE);
499
  UNPROTECT(2);
500
  return ret;
501
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
502
503
}

504
SEXP LGBM_BoosterLoadModelFromString_R(SEXP model_str) {
505
  R_API_BEGIN();
506
  SEXP ret = PROTECT(R_MakeExternalPtr(nullptr, R_NilValue, R_NilValue));
507
508
  SEXP temp = NULL;
  int n_protected = 1;
509
  int out_num_iterations = 0;
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
  const char* model_str_ptr = nullptr;
  switch (TYPEOF(model_str)) {
    case RAWSXP: {
      model_str_ptr = reinterpret_cast<const char*>(RAW(model_str));
      break;
    }
    case CHARSXP: {
      model_str_ptr = reinterpret_cast<const char*>(CHAR(model_str));
      break;
    }
    case STRSXP: {
      temp = PROTECT(STRING_ELT(model_str, 0));
      n_protected++;
      model_str_ptr = reinterpret_cast<const char*>(CHAR(temp));
    }
  }
Guolin Ke's avatar
Guolin Ke committed
526
  BoosterHandle handle = nullptr;
527
  CHECK_CALL(LGBM_BoosterLoadModelFromString(model_str_ptr, &out_num_iterations, &handle));
528
  R_SetExternalPtrAddr(ret, handle);
529
  R_RegisterCFinalizerEx(ret, _BoosterFinalizer, TRUE);
530
  UNPROTECT(n_protected);
531
  return ret;
532
  R_API_END();
533
534
}

535
536
SEXP LGBM_BoosterMerge_R(SEXP handle,
  SEXP other_handle) {
Guolin Ke's avatar
Guolin Ke committed
537
  R_API_BEGIN();
538
539
  _AssertBoosterHandleNotNull(handle);
  _AssertBoosterHandleNotNull(other_handle);
540
  CHECK_CALL(LGBM_BoosterMerge(R_ExternalPtrAddr(handle), R_ExternalPtrAddr(other_handle)));
541
  return R_NilValue;
542
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
543
544
}

545
546
SEXP LGBM_BoosterAddValidData_R(SEXP handle,
  SEXP valid_data) {
Guolin Ke's avatar
Guolin Ke committed
547
  R_API_BEGIN();
548
549
  _AssertBoosterHandleNotNull(handle);
  _AssertDatasetHandleNotNull(valid_data);
550
  CHECK_CALL(LGBM_BoosterAddValidData(R_ExternalPtrAddr(handle), R_ExternalPtrAddr(valid_data)));
551
  return R_NilValue;
552
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
553
554
}

555
556
SEXP LGBM_BoosterResetTrainingData_R(SEXP handle,
  SEXP train_data) {
Guolin Ke's avatar
Guolin Ke committed
557
  R_API_BEGIN();
558
559
  _AssertBoosterHandleNotNull(handle);
  _AssertDatasetHandleNotNull(train_data);
560
  CHECK_CALL(LGBM_BoosterResetTrainingData(R_ExternalPtrAddr(handle), R_ExternalPtrAddr(train_data)));
561
  return R_NilValue;
562
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
563
564
}

565
SEXP LGBM_BoosterResetParameter_R(SEXP handle,
566
  SEXP parameters) {
Guolin Ke's avatar
Guolin Ke committed
567
  R_API_BEGIN();
568
  _AssertBoosterHandleNotNull(handle);
569
  const char* parameters_ptr = CHAR(PROTECT(Rf_asChar(parameters)));
570
571
572
  CHECK_CALL(LGBM_BoosterResetParameter(R_ExternalPtrAddr(handle), parameters_ptr));
  UNPROTECT(1);
  return R_NilValue;
573
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
574
575
}

576
SEXP LGBM_BoosterGetNumClasses_R(SEXP handle,
577
  SEXP out) {
Guolin Ke's avatar
Guolin Ke committed
578
  R_API_BEGIN();
579
  _AssertBoosterHandleNotNull(handle);
580
  int num_class;
581
  CHECK_CALL(LGBM_BoosterGetNumClasses(R_ExternalPtrAddr(handle), &num_class));
582
  INTEGER(out)[0] = num_class;
583
  return R_NilValue;
584
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
585
586
}

587
588
589
590
591
592
593
594
595
SEXP LGBM_BoosterGetNumFeature_R(SEXP handle) {
  R_API_BEGIN();
  _AssertBoosterHandleNotNull(handle);
  int out = 0;
  CHECK_CALL(LGBM_BoosterGetNumFeature(R_ExternalPtrAddr(handle), &out));
  return Rf_ScalarInteger(out);
  R_API_END();
}

596
SEXP LGBM_BoosterUpdateOneIter_R(SEXP handle) {
Guolin Ke's avatar
Guolin Ke committed
597
  R_API_BEGIN();
598
  _AssertBoosterHandleNotNull(handle);
599
  int is_finished = 0;
600
  CHECK_CALL(LGBM_BoosterUpdateOneIter(R_ExternalPtrAddr(handle), &is_finished));
601
  return R_NilValue;
602
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
603
604
}

605
SEXP LGBM_BoosterUpdateOneIterCustom_R(SEXP handle,
606
607
  SEXP grad,
  SEXP hess,
608
  SEXP len) {
Guolin Ke's avatar
Guolin Ke committed
609
  R_API_BEGIN();
610
  _AssertBoosterHandleNotNull(handle);
611
  int is_finished = 0;
612
  int int_len = Rf_asInteger(len);
Guolin Ke's avatar
Guolin Ke committed
613
  std::vector<float> tgrad(int_len), thess(int_len);
Guolin Ke's avatar
Guolin Ke committed
614
#pragma omp parallel for schedule(static, 512) if (int_len >= 1024)
Guolin Ke's avatar
Guolin Ke committed
615
  for (int j = 0; j < int_len; ++j) {
616
617
    tgrad[j] = static_cast<float>(REAL(grad)[j]);
    thess[j] = static_cast<float>(REAL(hess)[j]);
Guolin Ke's avatar
Guolin Ke committed
618
  }
619
  CHECK_CALL(LGBM_BoosterUpdateOneIterCustom(R_ExternalPtrAddr(handle), tgrad.data(), thess.data(), &is_finished));
620
  return R_NilValue;
621
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
622
623
}

624
SEXP LGBM_BoosterRollbackOneIter_R(SEXP handle) {
Guolin Ke's avatar
Guolin Ke committed
625
  R_API_BEGIN();
626
  _AssertBoosterHandleNotNull(handle);
627
  CHECK_CALL(LGBM_BoosterRollbackOneIter(R_ExternalPtrAddr(handle)));
628
  return R_NilValue;
629
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
630
631
}

632
SEXP LGBM_BoosterGetCurrentIteration_R(SEXP handle,
633
  SEXP out) {
Guolin Ke's avatar
Guolin Ke committed
634
  R_API_BEGIN();
635
  _AssertBoosterHandleNotNull(handle);
636
  int out_iteration;
637
  CHECK_CALL(LGBM_BoosterGetCurrentIteration(R_ExternalPtrAddr(handle), &out_iteration));
638
  INTEGER(out)[0] = out_iteration;
639
  return R_NilValue;
640
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
641
642
}

643
SEXP LGBM_BoosterGetUpperBoundValue_R(SEXP handle,
644
  SEXP out_result) {
645
  R_API_BEGIN();
646
  _AssertBoosterHandleNotNull(handle);
647
  double* ptr_ret = REAL(out_result);
648
  CHECK_CALL(LGBM_BoosterGetUpperBoundValue(R_ExternalPtrAddr(handle), ptr_ret));
649
  return R_NilValue;
650
  R_API_END();
651
652
}

653
SEXP LGBM_BoosterGetLowerBoundValue_R(SEXP handle,
654
  SEXP out_result) {
655
  R_API_BEGIN();
656
  _AssertBoosterHandleNotNull(handle);
657
  double* ptr_ret = REAL(out_result);
658
  CHECK_CALL(LGBM_BoosterGetLowerBoundValue(R_ExternalPtrAddr(handle), ptr_ret));
659
  return R_NilValue;
660
  R_API_END();
661
662
}

663
SEXP LGBM_BoosterGetEvalNames_R(SEXP handle) {
664
665
  SEXP cont_token = PROTECT(R_MakeUnwindCont());
  R_API_BEGIN();
666
  _AssertBoosterHandleNotNull(handle);
667
  SEXP eval_names;
Guolin Ke's avatar
Guolin Ke committed
668
  int len;
669
  CHECK_CALL(LGBM_BoosterGetEvalCounts(R_ExternalPtrAddr(handle), &len));
670
  const size_t reserved_string_size = 128;
Guolin Ke's avatar
Guolin Ke committed
671
672
673
  std::vector<std::vector<char>> names(len);
  std::vector<char*> ptr_names(len);
  for (int i = 0; i < len; ++i) {
674
    names[i].resize(reserved_string_size);
Guolin Ke's avatar
Guolin Ke committed
675
676
    ptr_names[i] = names[i].data();
  }
677

Guolin Ke's avatar
Guolin Ke committed
678
  int out_len;
679
680
681
  size_t required_string_size;
  CHECK_CALL(
    LGBM_BoosterGetEvalNames(
682
      R_ExternalPtrAddr(handle),
683
684
685
      len, &out_len,
      reserved_string_size, &required_string_size,
      ptr_names.data()));
686
687
688
689
690
691
692
693
694
  // if any eval names were larger than allocated size,
  // allow for a larger size and try again
  if (required_string_size > reserved_string_size) {
    for (int i = 0; i < len; ++i) {
      names[i].resize(required_string_size);
      ptr_names[i] = names[i].data();
    }
    CHECK_CALL(
      LGBM_BoosterGetEvalNames(
695
        R_ExternalPtrAddr(handle),
696
697
698
699
700
701
        len,
        &out_len,
        required_string_size,
        &required_string_size,
        ptr_names.data()));
  }
Nikita Titov's avatar
Nikita Titov committed
702
  CHECK_EQ(out_len, len);
703
  eval_names = PROTECT(safe_R_string(static_cast<R_xlen_t>(len), &cont_token));
704
  for (int i = 0; i < len; ++i) {
705
    SET_STRING_ELT(eval_names, i, safe_R_mkChar(ptr_names[i], &cont_token));
706
  }
707
  UNPROTECT(2);
708
  return eval_names;
709
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
710
711
}

712
SEXP LGBM_BoosterGetEval_R(SEXP handle,
713
  SEXP data_idx,
714
  SEXP out_result) {
Guolin Ke's avatar
Guolin Ke committed
715
  R_API_BEGIN();
716
  _AssertBoosterHandleNotNull(handle);
Guolin Ke's avatar
Guolin Ke committed
717
  int len;
718
  CHECK_CALL(LGBM_BoosterGetEvalCounts(R_ExternalPtrAddr(handle), &len));
719
  double* ptr_ret = REAL(out_result);
Guolin Ke's avatar
Guolin Ke committed
720
  int out_len;
721
  CHECK_CALL(LGBM_BoosterGetEval(R_ExternalPtrAddr(handle), Rf_asInteger(data_idx), &out_len, ptr_ret));
Nikita Titov's avatar
Nikita Titov committed
722
  CHECK_EQ(out_len, len);
723
  return R_NilValue;
724
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
725
726
}

727
SEXP LGBM_BoosterGetNumPredict_R(SEXP handle,
728
  SEXP data_idx,
729
  SEXP out) {
Guolin Ke's avatar
Guolin Ke committed
730
  R_API_BEGIN();
731
  _AssertBoosterHandleNotNull(handle);
Guolin Ke's avatar
Guolin Ke committed
732
  int64_t len;
733
  CHECK_CALL(LGBM_BoosterGetNumPredict(R_ExternalPtrAddr(handle), Rf_asInteger(data_idx), &len));
734
  INTEGER(out)[0] = static_cast<int>(len);
735
  return R_NilValue;
736
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
737
738
}

739
SEXP LGBM_BoosterGetPredict_R(SEXP handle,
740
  SEXP data_idx,
741
  SEXP out_result) {
Guolin Ke's avatar
Guolin Ke committed
742
  R_API_BEGIN();
743
  _AssertBoosterHandleNotNull(handle);
744
  double* ptr_ret = REAL(out_result);
Guolin Ke's avatar
Guolin Ke committed
745
  int64_t out_len;
746
  CHECK_CALL(LGBM_BoosterGetPredict(R_ExternalPtrAddr(handle), Rf_asInteger(data_idx), &out_len, ptr_ret));
747
  return R_NilValue;
748
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
749
750
}

751
int GetPredictType(SEXP is_rawscore, SEXP is_leafidx, SEXP is_predcontrib) {
Guolin Ke's avatar
Guolin Ke committed
752
  int pred_type = C_API_PREDICT_NORMAL;
753
  if (Rf_asInteger(is_rawscore)) {
Guolin Ke's avatar
Guolin Ke committed
754
755
    pred_type = C_API_PREDICT_RAW_SCORE;
  }
756
  if (Rf_asInteger(is_leafidx)) {
Guolin Ke's avatar
Guolin Ke committed
757
758
    pred_type = C_API_PREDICT_LEAF_INDEX;
  }
759
  if (Rf_asInteger(is_predcontrib)) {
760
761
    pred_type = C_API_PREDICT_CONTRIB;
  }
Guolin Ke's avatar
Guolin Ke committed
762
763
764
  return pred_type;
}

765
SEXP LGBM_BoosterPredictForFile_R(SEXP handle,
766
  SEXP data_filename,
767
768
769
770
771
772
  SEXP data_has_header,
  SEXP is_rawscore,
  SEXP is_leafidx,
  SEXP is_predcontrib,
  SEXP start_iteration,
  SEXP num_iteration,
773
774
  SEXP parameter,
  SEXP result_filename) {
775
  R_API_BEGIN();
776
  _AssertBoosterHandleNotNull(handle);
777
778
779
  const char* data_filename_ptr = CHAR(PROTECT(Rf_asChar(data_filename)));
  const char* parameter_ptr = CHAR(PROTECT(Rf_asChar(parameter)));
  const char* result_filename_ptr = CHAR(PROTECT(Rf_asChar(result_filename)));
780
  int pred_type = GetPredictType(is_rawscore, is_leafidx, is_predcontrib);
781
782
783
784
785
  CHECK_CALL(LGBM_BoosterPredictForFile(R_ExternalPtrAddr(handle), data_filename_ptr,
    Rf_asInteger(data_has_header), pred_type, Rf_asInteger(start_iteration), Rf_asInteger(num_iteration), parameter_ptr,
    result_filename_ptr));
  UNPROTECT(3);
  return R_NilValue;
786
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
787
788
}

789
SEXP LGBM_BoosterCalcNumPredict_R(SEXP handle,
790
791
792
793
794
795
  SEXP num_row,
  SEXP is_rawscore,
  SEXP is_leafidx,
  SEXP is_predcontrib,
  SEXP start_iteration,
  SEXP num_iteration,
796
  SEXP out_len) {
Guolin Ke's avatar
Guolin Ke committed
797
  R_API_BEGIN();
798
  _AssertBoosterHandleNotNull(handle);
799
  int pred_type = GetPredictType(is_rawscore, is_leafidx, is_predcontrib);
Guolin Ke's avatar
Guolin Ke committed
800
  int64_t len = 0;
801
  CHECK_CALL(LGBM_BoosterCalcNumPredict(R_ExternalPtrAddr(handle), Rf_asInteger(num_row),
802
    pred_type, Rf_asInteger(start_iteration), Rf_asInteger(num_iteration), &len));
803
  INTEGER(out_len)[0] = static_cast<int>(len);
804
  return R_NilValue;
805
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
806
807
}

808
SEXP LGBM_BoosterPredictForCSC_R(SEXP handle,
809
810
811
  SEXP indptr,
  SEXP indices,
  SEXP data,
812
813
814
815
816
817
818
819
  SEXP num_indptr,
  SEXP nelem,
  SEXP num_row,
  SEXP is_rawscore,
  SEXP is_leafidx,
  SEXP is_predcontrib,
  SEXP start_iteration,
  SEXP num_iteration,
820
  SEXP parameter,
821
  SEXP out_result) {
822
  R_API_BEGIN();
823
  _AssertBoosterHandleNotNull(handle);
824
  int pred_type = GetPredictType(is_rawscore, is_leafidx, is_predcontrib);
825
  const int* p_indptr = INTEGER(indptr);
826
  const int32_t* p_indices = reinterpret_cast<const int32_t*>(INTEGER(indices));
827
  const double* p_data = REAL(data);
828
829
830
  int64_t nindptr = static_cast<int64_t>(Rf_asInteger(num_indptr));
  int64_t ndata = static_cast<int64_t>(Rf_asInteger(nelem));
  int64_t nrow = static_cast<int64_t>(Rf_asInteger(num_row));
831
  double* ptr_ret = REAL(out_result);
Guolin Ke's avatar
Guolin Ke committed
832
  int64_t out_len;
833
  const char* parameter_ptr = CHAR(PROTECT(Rf_asChar(parameter)));
834
  CHECK_CALL(LGBM_BoosterPredictForCSC(R_ExternalPtrAddr(handle),
Guolin Ke's avatar
Guolin Ke committed
835
836
    p_indptr, C_API_DTYPE_INT32, p_indices,
    p_data, C_API_DTYPE_FLOAT64, nindptr, ndata,
837
838
839
    nrow, pred_type, Rf_asInteger(start_iteration), Rf_asInteger(num_iteration), parameter_ptr, &out_len, ptr_ret));
  UNPROTECT(1);
  return R_NilValue;
840
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
841
842
}

843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
SEXP LGBM_BoosterPredictForCSR_R(SEXP handle,
  SEXP indptr,
  SEXP indices,
  SEXP data,
  SEXP ncols,
  SEXP is_rawscore,
  SEXP is_leafidx,
  SEXP is_predcontrib,
  SEXP start_iteration,
  SEXP num_iteration,
  SEXP parameter,
  SEXP out_result) {
  R_API_BEGIN();
  _AssertBoosterHandleNotNull(handle);
  int pred_type = GetPredictType(is_rawscore, is_leafidx, is_predcontrib);
  const char* parameter_ptr = CHAR(PROTECT(Rf_asChar(parameter)));
  int64_t out_len;
  CHECK_CALL(LGBM_BoosterPredictForCSR(R_ExternalPtrAddr(handle),
    INTEGER(indptr), C_API_DTYPE_INT32, INTEGER(indices),
    REAL(data), C_API_DTYPE_FLOAT64,
    Rf_xlength(indptr), Rf_xlength(data), Rf_asInteger(ncols),
    pred_type, Rf_asInteger(start_iteration), Rf_asInteger(num_iteration),
    parameter_ptr, &out_len, REAL(out_result)));
  UNPROTECT(1);
  return R_NilValue;
  R_API_END();
}

SEXP LGBM_BoosterPredictForCSRSingleRow_R(SEXP handle,
  SEXP indices,
  SEXP data,
  SEXP ncols,
  SEXP is_rawscore,
  SEXP is_leafidx,
  SEXP is_predcontrib,
  SEXP start_iteration,
  SEXP num_iteration,
  SEXP parameter,
  SEXP out_result) {
  R_API_BEGIN();
  _AssertBoosterHandleNotNull(handle);
  int pred_type = GetPredictType(is_rawscore, is_leafidx, is_predcontrib);
  const char* parameter_ptr = CHAR(PROTECT(Rf_asChar(parameter)));
  int nnz = static_cast<int>(Rf_xlength(data));
  const int indptr[] = {0, nnz};
  int64_t out_len;
  CHECK_CALL(LGBM_BoosterPredictForCSRSingleRow(R_ExternalPtrAddr(handle),
    indptr, C_API_DTYPE_INT32, INTEGER(indices),
    REAL(data), C_API_DTYPE_FLOAT64,
    2, nnz, Rf_asInteger(ncols),
    pred_type, Rf_asInteger(start_iteration), Rf_asInteger(num_iteration),
    parameter_ptr, &out_len, REAL(out_result)));
  UNPROTECT(1);
  return R_NilValue;
  R_API_END();
}

void LGBM_FastConfigFree_wrapped(SEXP handle) {
  LGBM_FastConfigFree(static_cast<FastConfigHandle*>(R_ExternalPtrAddr(handle)));
}

SEXP LGBM_BoosterPredictForCSRSingleRowFastInit_R(SEXP handle,
  SEXP ncols,
  SEXP is_rawscore,
  SEXP is_leafidx,
  SEXP is_predcontrib,
  SEXP start_iteration,
  SEXP num_iteration,
  SEXP parameter) {
  R_API_BEGIN();
  _AssertBoosterHandleNotNull(handle);
  int pred_type = GetPredictType(is_rawscore, is_leafidx, is_predcontrib);
  SEXP ret = PROTECT(R_MakeExternalPtr(nullptr, R_NilValue, R_NilValue));
  const char* parameter_ptr = CHAR(PROTECT(Rf_asChar(parameter)));
  FastConfigHandle out_fastConfig;
  CHECK_CALL(LGBM_BoosterPredictForCSRSingleRowFastInit(R_ExternalPtrAddr(handle),
    pred_type, Rf_asInteger(start_iteration), Rf_asInteger(num_iteration),
    C_API_DTYPE_FLOAT64, Rf_asInteger(ncols),
    parameter_ptr, &out_fastConfig));
  R_SetExternalPtrAddr(ret, out_fastConfig);
  R_RegisterCFinalizerEx(ret, LGBM_FastConfigFree_wrapped, TRUE);
  UNPROTECT(2);
  return ret;
  R_API_END();
}

SEXP LGBM_BoosterPredictForCSRSingleRowFast_R(SEXP handle_fastConfig,
  SEXP indices,
  SEXP data,
  SEXP out_result) {
  R_API_BEGIN();
  int nnz = static_cast<int>(Rf_xlength(data));
  const int indptr[] = {0, nnz};
  int64_t out_len;
  CHECK_CALL(LGBM_BoosterPredictForCSRSingleRowFast(R_ExternalPtrAddr(handle_fastConfig),
    indptr, C_API_DTYPE_INT32, INTEGER(indices),
    REAL(data),
    2, nnz,
    &out_len, REAL(out_result)));
  return R_NilValue;
  R_API_END();
}

946
SEXP LGBM_BoosterPredictForMat_R(SEXP handle,
947
  SEXP data,
948
949
950
951
952
953
954
  SEXP num_row,
  SEXP num_col,
  SEXP is_rawscore,
  SEXP is_leafidx,
  SEXP is_predcontrib,
  SEXP start_iteration,
  SEXP num_iteration,
955
  SEXP parameter,
956
  SEXP out_result) {
957
  R_API_BEGIN();
958
  _AssertBoosterHandleNotNull(handle);
959
  int pred_type = GetPredictType(is_rawscore, is_leafidx, is_predcontrib);
960
961
  int32_t nrow = static_cast<int32_t>(Rf_asInteger(num_row));
  int32_t ncol = static_cast<int32_t>(Rf_asInteger(num_col));
962
963
  const double* p_mat = REAL(data);
  double* ptr_ret = REAL(out_result);
964
  const char* parameter_ptr = CHAR(PROTECT(Rf_asChar(parameter)));
Guolin Ke's avatar
Guolin Ke committed
965
  int64_t out_len;
966
  CHECK_CALL(LGBM_BoosterPredictForMat(R_ExternalPtrAddr(handle),
Guolin Ke's avatar
Guolin Ke committed
967
    p_mat, C_API_DTYPE_FLOAT64, nrow, ncol, COL_MAJOR,
968
969
970
    pred_type, Rf_asInteger(start_iteration), Rf_asInteger(num_iteration), parameter_ptr, &out_len, ptr_ret));
  UNPROTECT(1);
  return R_NilValue;
971
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
972
973
}

974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
struct SparseOutputPointers {
  void* indptr;
  int32_t* indices;
  void* data;
  int indptr_type;
  int data_type;
  SparseOutputPointers(void* indptr, int32_t* indices, void* data)
  : indptr(indptr), indices(indices), data(data) {}
};

void delete_SparseOutputPointers(SparseOutputPointers *ptr) {
  LGBM_BoosterFreePredictSparse(ptr->indptr, ptr->indices, ptr->data, C_API_DTYPE_INT32, C_API_DTYPE_FLOAT64);
  delete ptr;
}

SEXP LGBM_BoosterPredictSparseOutput_R(SEXP handle,
  SEXP indptr,
  SEXP indices,
  SEXP data,
  SEXP is_csr,
  SEXP nrows,
  SEXP ncols,
  SEXP start_iteration,
  SEXP num_iteration,
  SEXP parameter) {
  SEXP cont_token = PROTECT(R_MakeUnwindCont());
  R_API_BEGIN();
  _AssertBoosterHandleNotNull(handle);
  const char* out_names[] = {"indptr", "indices", "data", ""};
  SEXP out = PROTECT(Rf_mkNamed(VECSXP, out_names));
  const char* parameter_ptr = CHAR(PROTECT(Rf_asChar(parameter)));

  int64_t out_len[2];
  void *out_indptr;
  int32_t *out_indices;
  void *out_data;

  CHECK_CALL(LGBM_BoosterPredictSparseOutput(R_ExternalPtrAddr(handle),
    INTEGER(indptr), C_API_DTYPE_INT32, INTEGER(indices),
    REAL(data), C_API_DTYPE_FLOAT64,
    Rf_xlength(indptr), Rf_xlength(data),
    Rf_asLogical(is_csr)? Rf_asInteger(ncols) : Rf_asInteger(nrows),
    C_API_PREDICT_CONTRIB, Rf_asInteger(start_iteration), Rf_asInteger(num_iteration),
    parameter_ptr,
    Rf_asLogical(is_csr)? C_API_MATRIX_TYPE_CSR : C_API_MATRIX_TYPE_CSC,
    out_len, &out_indptr, &out_indices, &out_data));

  std::unique_ptr<SparseOutputPointers, decltype(&delete_SparseOutputPointers)> pointers_struct = {
    new SparseOutputPointers(
      out_indptr,
      out_indices,
      out_data),
    &delete_SparseOutputPointers
  };

  SEXP out_indptr_R = safe_R_int(out_len[1], &cont_token);
  SET_VECTOR_ELT(out, 0, out_indptr_R);
  SEXP out_indices_R = safe_R_int(out_len[0], &cont_token);
  SET_VECTOR_ELT(out, 1, out_indices_R);
  SEXP out_data_R = safe_R_real(out_len[0], &cont_token);
  SET_VECTOR_ELT(out, 2, out_data_R);
  std::memcpy(INTEGER(out_indptr_R), out_indptr, out_len[1]*sizeof(int));
  std::memcpy(INTEGER(out_indices_R), out_indices, out_len[0]*sizeof(int));
  std::memcpy(REAL(out_data_R), out_data, out_len[0]*sizeof(double));

  UNPROTECT(3);
  return out;
  R_API_END();
}

1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
SEXP LGBM_BoosterPredictForMatSingleRow_R(SEXP handle,
  SEXP data,
  SEXP is_rawscore,
  SEXP is_leafidx,
  SEXP is_predcontrib,
  SEXP start_iteration,
  SEXP num_iteration,
  SEXP parameter,
  SEXP out_result) {
  R_API_BEGIN();
  _AssertBoosterHandleNotNull(handle);
  int pred_type = GetPredictType(is_rawscore, is_leafidx, is_predcontrib);
  const char* parameter_ptr = CHAR(PROTECT(Rf_asChar(parameter)));
  double* ptr_ret = REAL(out_result);
  int64_t out_len;
  CHECK_CALL(LGBM_BoosterPredictForMatSingleRow(R_ExternalPtrAddr(handle),
    REAL(data), C_API_DTYPE_FLOAT64, Rf_xlength(data), 1,
    pred_type, Rf_asInteger(start_iteration), Rf_asInteger(num_iteration),
    parameter_ptr, &out_len, ptr_ret));
  UNPROTECT(1);
  return R_NilValue;
  R_API_END();
}

SEXP LGBM_BoosterPredictForMatSingleRowFastInit_R(SEXP handle,
  SEXP ncols,
  SEXP is_rawscore,
  SEXP is_leafidx,
  SEXP is_predcontrib,
  SEXP start_iteration,
  SEXP num_iteration,
  SEXP parameter) {
  R_API_BEGIN();
  _AssertBoosterHandleNotNull(handle);
  int pred_type = GetPredictType(is_rawscore, is_leafidx, is_predcontrib);
  SEXP ret = PROTECT(R_MakeExternalPtr(nullptr, R_NilValue, R_NilValue));
  const char* parameter_ptr = CHAR(PROTECT(Rf_asChar(parameter)));
  FastConfigHandle out_fastConfig;
  CHECK_CALL(LGBM_BoosterPredictForMatSingleRowFastInit(R_ExternalPtrAddr(handle),
    pred_type, Rf_asInteger(start_iteration), Rf_asInteger(num_iteration),
    C_API_DTYPE_FLOAT64, Rf_asInteger(ncols),
    parameter_ptr, &out_fastConfig));
  R_SetExternalPtrAddr(ret, out_fastConfig);
  R_RegisterCFinalizerEx(ret, LGBM_FastConfigFree_wrapped, TRUE);
  UNPROTECT(2);
  return ret;
  R_API_END();
}

SEXP LGBM_BoosterPredictForMatSingleRowFast_R(SEXP handle_fastConfig,
  SEXP data,
  SEXP out_result) {
  R_API_BEGIN();
  int64_t out_len;
  CHECK_CALL(LGBM_BoosterPredictForMatSingleRowFast(R_ExternalPtrAddr(handle_fastConfig),
    REAL(data), &out_len, REAL(out_result)));
  return R_NilValue;
  R_API_END();
}

1104
SEXP LGBM_BoosterSaveModel_R(SEXP handle,
1105
1106
  SEXP num_iteration,
  SEXP feature_importance_type,
1107
  SEXP filename) {
Guolin Ke's avatar
Guolin Ke committed
1108
  R_API_BEGIN();
1109
  _AssertBoosterHandleNotNull(handle);
1110
  const char* filename_ptr = CHAR(PROTECT(Rf_asChar(filename)));
1111
1112
1113
  CHECK_CALL(LGBM_BoosterSaveModel(R_ExternalPtrAddr(handle), 0, Rf_asInteger(num_iteration), Rf_asInteger(feature_importance_type), filename_ptr));
  UNPROTECT(1);
  return R_NilValue;
1114
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
1115
1116
}

1117
SEXP LGBM_BoosterSaveModelToString_R(SEXP handle,
1118
  SEXP num_iteration,
1119
  SEXP feature_importance_type) {
1120
1121
  SEXP cont_token = PROTECT(R_MakeUnwindCont());
  R_API_BEGIN();
1122
  _AssertBoosterHandleNotNull(handle);
1123
  int64_t out_len = 0;
1124
  int64_t buf_len = 1024 * 1024;
1125
1126
  int num_iter = Rf_asInteger(num_iteration);
  int importance_type = Rf_asInteger(feature_importance_type);
1127
  std::vector<char> inner_char_buf(buf_len);
1128
  CHECK_CALL(LGBM_BoosterSaveModelToString(R_ExternalPtrAddr(handle), 0, num_iter, importance_type, buf_len, &out_len, inner_char_buf.data()));
1129
1130
  SEXP model_str = PROTECT(safe_R_raw(out_len, &cont_token));
  // if the model string was larger than the initial buffer, call the function again, writing directly to the R object
1131
  if (out_len > buf_len) {
1132
1133
1134
    CHECK_CALL(LGBM_BoosterSaveModelToString(R_ExternalPtrAddr(handle), 0, num_iter, importance_type, out_len, &out_len, reinterpret_cast<char*>(RAW(model_str))));
  } else {
    std::copy(inner_char_buf.begin(), inner_char_buf.begin() + out_len, reinterpret_cast<char*>(RAW(model_str)));
1135
  }
1136
  UNPROTECT(2);
1137
  return model_str;
1138
  R_API_END();
1139
1140
}

1141
SEXP LGBM_BoosterDumpModel_R(SEXP handle,
1142
  SEXP num_iteration,
1143
  SEXP feature_importance_type) {
1144
1145
  SEXP cont_token = PROTECT(R_MakeUnwindCont());
  R_API_BEGIN();
1146
  _AssertBoosterHandleNotNull(handle);
1147
  SEXP model_str;
1148
  int64_t out_len = 0;
1149
  int64_t buf_len = 1024 * 1024;
1150
1151
  int num_iter = Rf_asInteger(num_iteration);
  int importance_type = Rf_asInteger(feature_importance_type);
1152
  std::vector<char> inner_char_buf(buf_len);
1153
  CHECK_CALL(LGBM_BoosterDumpModel(R_ExternalPtrAddr(handle), 0, num_iter, importance_type, buf_len, &out_len, inner_char_buf.data()));
1154
1155
1156
  // if the model string was larger than the initial buffer, allocate a bigger buffer and try again
  if (out_len > buf_len) {
    inner_char_buf.resize(out_len);
1157
    CHECK_CALL(LGBM_BoosterDumpModel(R_ExternalPtrAddr(handle), 0, num_iter, importance_type, out_len, &out_len, inner_char_buf.data()));
1158
  }
1159
1160
1161
  model_str = PROTECT(safe_R_string(static_cast<R_xlen_t>(1), &cont_token));
  SET_STRING_ELT(model_str, 0, safe_R_mkChar(inner_char_buf.data(), &cont_token));
  UNPROTECT(2);
1162
  return model_str;
1163
  R_API_END();
Guolin Ke's avatar
Guolin Ke committed
1164
}
1165

1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
SEXP LGBM_DumpParamAliases_R() {
  SEXP cont_token = PROTECT(R_MakeUnwindCont());
  R_API_BEGIN();
  SEXP aliases_str;
  int64_t out_len = 0;
  int64_t buf_len = 1024 * 1024;
  std::vector<char> inner_char_buf(buf_len);
  CHECK_CALL(LGBM_DumpParamAliases(buf_len, &out_len, inner_char_buf.data()));
  // if aliases string was larger than the initial buffer, allocate a bigger buffer and try again
  if (out_len > buf_len) {
    inner_char_buf.resize(out_len);
    CHECK_CALL(LGBM_DumpParamAliases(out_len, &out_len, inner_char_buf.data()));
  }
  aliases_str = PROTECT(safe_R_string(static_cast<R_xlen_t>(1), &cont_token));
  SET_STRING_ELT(aliases_str, 0, safe_R_mkChar(inner_char_buf.data(), &cont_token));
  UNPROTECT(2);
  return aliases_str;
  R_API_END();
}

1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
SEXP LGBM_BoosterGetLoadedParam_R(SEXP handle) {
  SEXP cont_token = PROTECT(R_MakeUnwindCont());
  R_API_BEGIN();
  _AssertBoosterHandleNotNull(handle);
  SEXP params_str;
  int64_t out_len = 0;
  int64_t buf_len = 1024 * 1024;
  std::vector<char> inner_char_buf(buf_len);
  CHECK_CALL(LGBM_BoosterGetLoadedParam(R_ExternalPtrAddr(handle), buf_len, &out_len, inner_char_buf.data()));
  // if aliases string was larger than the initial buffer, allocate a bigger buffer and try again
  if (out_len > buf_len) {
    inner_char_buf.resize(out_len);
    CHECK_CALL(LGBM_BoosterGetLoadedParam(R_ExternalPtrAddr(handle), out_len, &out_len, inner_char_buf.data()));
  }
  params_str = PROTECT(safe_R_string(static_cast<R_xlen_t>(1), &cont_token));
  SET_STRING_ELT(params_str, 0, safe_R_mkChar(inner_char_buf.data(), &cont_token));
  UNPROTECT(2);
  return params_str;
  R_API_END();
}

1207
1208
// .Call() calls
static const R_CallMethodDef CallEntries[] = {
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
  {"LGBM_HandleIsNull_R"                         , (DL_FUNC) &LGBM_HandleIsNull_R                         , 1},
  {"LGBM_DatasetCreateFromFile_R"                , (DL_FUNC) &LGBM_DatasetCreateFromFile_R                , 3},
  {"LGBM_DatasetCreateFromCSC_R"                 , (DL_FUNC) &LGBM_DatasetCreateFromCSC_R                 , 8},
  {"LGBM_DatasetCreateFromMat_R"                 , (DL_FUNC) &LGBM_DatasetCreateFromMat_R                 , 5},
  {"LGBM_DatasetGetSubset_R"                     , (DL_FUNC) &LGBM_DatasetGetSubset_R                     , 4},
  {"LGBM_DatasetSetFeatureNames_R"               , (DL_FUNC) &LGBM_DatasetSetFeatureNames_R               , 2},
  {"LGBM_DatasetGetFeatureNames_R"               , (DL_FUNC) &LGBM_DatasetGetFeatureNames_R               , 1},
  {"LGBM_DatasetSaveBinary_R"                    , (DL_FUNC) &LGBM_DatasetSaveBinary_R                    , 2},
  {"LGBM_DatasetFree_R"                          , (DL_FUNC) &LGBM_DatasetFree_R                          , 1},
  {"LGBM_DatasetSetField_R"                      , (DL_FUNC) &LGBM_DatasetSetField_R                      , 4},
  {"LGBM_DatasetGetFieldSize_R"                  , (DL_FUNC) &LGBM_DatasetGetFieldSize_R                  , 3},
  {"LGBM_DatasetGetField_R"                      , (DL_FUNC) &LGBM_DatasetGetField_R                      , 3},
  {"LGBM_DatasetUpdateParamChecking_R"           , (DL_FUNC) &LGBM_DatasetUpdateParamChecking_R           , 2},
  {"LGBM_DatasetGetNumData_R"                    , (DL_FUNC) &LGBM_DatasetGetNumData_R                    , 2},
  {"LGBM_DatasetGetNumFeature_R"                 , (DL_FUNC) &LGBM_DatasetGetNumFeature_R                 , 2},
  {"LGBM_DatasetGetFeatureNumBin_R"              , (DL_FUNC) &LGBM_DatasetGetFeatureNumBin_R              , 3},
  {"LGBM_BoosterCreate_R"                        , (DL_FUNC) &LGBM_BoosterCreate_R                        , 2},
  {"LGBM_BoosterFree_R"                          , (DL_FUNC) &LGBM_BoosterFree_R                          , 1},
  {"LGBM_BoosterCreateFromModelfile_R"           , (DL_FUNC) &LGBM_BoosterCreateFromModelfile_R           , 1},
  {"LGBM_BoosterLoadModelFromString_R"           , (DL_FUNC) &LGBM_BoosterLoadModelFromString_R           , 1},
  {"LGBM_BoosterMerge_R"                         , (DL_FUNC) &LGBM_BoosterMerge_R                         , 2},
  {"LGBM_BoosterAddValidData_R"                  , (DL_FUNC) &LGBM_BoosterAddValidData_R                  , 2},
  {"LGBM_BoosterResetTrainingData_R"             , (DL_FUNC) &LGBM_BoosterResetTrainingData_R             , 2},
  {"LGBM_BoosterResetParameter_R"                , (DL_FUNC) &LGBM_BoosterResetParameter_R                , 2},
  {"LGBM_BoosterGetNumClasses_R"                 , (DL_FUNC) &LGBM_BoosterGetNumClasses_R                 , 2},
  {"LGBM_BoosterGetNumFeature_R"                 , (DL_FUNC) &LGBM_BoosterGetNumFeature_R                 , 1},
1235
  {"LGBM_BoosterGetLoadedParam_R"                , (DL_FUNC) &LGBM_BoosterGetLoadedParam_R                , 1},
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
  {"LGBM_BoosterUpdateOneIter_R"                 , (DL_FUNC) &LGBM_BoosterUpdateOneIter_R                 , 1},
  {"LGBM_BoosterUpdateOneIterCustom_R"           , (DL_FUNC) &LGBM_BoosterUpdateOneIterCustom_R           , 4},
  {"LGBM_BoosterRollbackOneIter_R"               , (DL_FUNC) &LGBM_BoosterRollbackOneIter_R               , 1},
  {"LGBM_BoosterGetCurrentIteration_R"           , (DL_FUNC) &LGBM_BoosterGetCurrentIteration_R           , 2},
  {"LGBM_BoosterGetUpperBoundValue_R"            , (DL_FUNC) &LGBM_BoosterGetUpperBoundValue_R            , 2},
  {"LGBM_BoosterGetLowerBoundValue_R"            , (DL_FUNC) &LGBM_BoosterGetLowerBoundValue_R            , 2},
  {"LGBM_BoosterGetEvalNames_R"                  , (DL_FUNC) &LGBM_BoosterGetEvalNames_R                  , 1},
  {"LGBM_BoosterGetEval_R"                       , (DL_FUNC) &LGBM_BoosterGetEval_R                       , 3},
  {"LGBM_BoosterGetNumPredict_R"                 , (DL_FUNC) &LGBM_BoosterGetNumPredict_R                 , 3},
  {"LGBM_BoosterGetPredict_R"                    , (DL_FUNC) &LGBM_BoosterGetPredict_R                    , 3},
  {"LGBM_BoosterPredictForFile_R"                , (DL_FUNC) &LGBM_BoosterPredictForFile_R                , 10},
  {"LGBM_BoosterCalcNumPredict_R"                , (DL_FUNC) &LGBM_BoosterCalcNumPredict_R                , 8},
  {"LGBM_BoosterPredictForCSC_R"                 , (DL_FUNC) &LGBM_BoosterPredictForCSC_R                 , 14},
  {"LGBM_BoosterPredictForCSR_R"                 , (DL_FUNC) &LGBM_BoosterPredictForCSR_R                 , 12},
  {"LGBM_BoosterPredictForCSRSingleRow_R"        , (DL_FUNC) &LGBM_BoosterPredictForCSRSingleRow_R        , 11},
  {"LGBM_BoosterPredictForCSRSingleRowFastInit_R", (DL_FUNC) &LGBM_BoosterPredictForCSRSingleRowFastInit_R, 8},
  {"LGBM_BoosterPredictForCSRSingleRowFast_R"    , (DL_FUNC) &LGBM_BoosterPredictForCSRSingleRowFast_R    , 4},
  {"LGBM_BoosterPredictSparseOutput_R"           , (DL_FUNC) &LGBM_BoosterPredictSparseOutput_R           , 10},
  {"LGBM_BoosterPredictForMat_R"                 , (DL_FUNC) &LGBM_BoosterPredictForMat_R                 , 11},
  {"LGBM_BoosterPredictForMatSingleRow_R"        , (DL_FUNC) &LGBM_BoosterPredictForMatSingleRow_R        , 9},
  {"LGBM_BoosterPredictForMatSingleRowFastInit_R", (DL_FUNC) &LGBM_BoosterPredictForMatSingleRowFastInit_R, 8},
  {"LGBM_BoosterPredictForMatSingleRowFast_R"    , (DL_FUNC) &LGBM_BoosterPredictForMatSingleRowFast_R    , 3},
  {"LGBM_BoosterSaveModel_R"                     , (DL_FUNC) &LGBM_BoosterSaveModel_R                     , 4},
  {"LGBM_BoosterSaveModelToString_R"             , (DL_FUNC) &LGBM_BoosterSaveModelToString_R             , 3},
  {"LGBM_BoosterDumpModel_R"                     , (DL_FUNC) &LGBM_BoosterDumpModel_R                     , 3},
  {"LGBM_NullBoosterHandleError_R"               , (DL_FUNC) &LGBM_NullBoosterHandleError_R               , 0},
  {"LGBM_DumpParamAliases_R"                     , (DL_FUNC) &LGBM_DumpParamAliases_R                     , 0},
1263
1264
1265
  {NULL, NULL, 0}
};

1266
1267
LIGHTGBM_C_EXPORT void R_init_lightgbm(DllInfo *dll);

1268
1269
1270
1271
void R_init_lightgbm(DllInfo *dll) {
  R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
  R_useDynamicSymbols(dll, FALSE);
}