[R] fix uses of 1:length(x) and other small things (#5992)

Author: jameslamb

R-package/R/xgb.DMatrix.R

@@ -357,7 +357,7 @@ slice.xgb.DMatrix <- function(object, idxset, ...) {
 #' @export
 print.xgb.DMatrix <- function(x, verbose = FALSE, ...) {
   cat('xgb.DMatrix  dim:', nrow(x), 'x', ncol(x), ' info: ')
-  infos <- c()
+  infos <- character(0)
   if (length(getinfo(x, 'label')) > 0) infos <- 'label'
   if (length(getinfo(x, 'weight')) > 0) infos <- c(infos, 'weight')
   if (length(getinfo(x, 'base_margin')) > 0) infos <- c(infos, 'base_margin')

R-package/R/xgb.plot.importance.R

@@ -106,12 +106,12 @@ xgb.plot.importance <- function(importance_matrix = NULL, top_n = NULL, measure
     par(mar = mar)
 
     # reverse the order of rows to have the highest ranked at the top
-    importance_matrix[nrow(importance_matrix):1,
+    importance_matrix[rev(seq_len(nrow(importance_matrix))),
                       barplot(Importance, horiz = TRUE, border = NA, cex.names = cex,
                               names.arg = Feature, las = 1, ...)]
     grid(NULL, NA)
     # redraw over the grid
-    importance_matrix[nrow(importance_matrix):1,
+    importance_matrix[rev(seq_len(nrow(importance_matrix))),
                       barplot(Importance, horiz = TRUE, border = NA, add = TRUE)]
     par(op)
   }

R-package/R/xgb.plot.shap.R

@@ -124,7 +124,7 @@ xgb.plot.shap <- function(data, shap_contrib = NULL, features = NULL, top_n = 1,
     stop("shap_contrib is not compatible with the provided data")
 
   nsample <- if (is.null(subsample)) min(100000, nrow(data)) else as.integer(subsample * nrow(data))
-  idx <- sample(1:nrow(data), nsample)
+  idx <- sample(seq_len(nrow(data)), nsample)
   data <- data[idx, ]
 
   if (is.null(shap_contrib)) {
@@ -162,7 +162,7 @@ xgb.plot.shap <- function(data, shap_contrib = NULL, features = NULL, top_n = 1,
   data <- data[, features, drop = FALSE]
   cols <- colnames(data)
   if (is.null(cols)) cols <- colnames(shap_contrib)
-  if (is.null(cols)) cols <- paste0('X', 1:ncol(data))
+  if (is.null(cols)) cols <- paste0('X', seq_len(ncol(data)))
   colnames(data) <- cols
   colnames(shap_contrib) <- cols
 

R-package/demo/interaction_constraints.R

@@ -36,7 +36,7 @@ treeInteractions <- function(input_tree, input_max_depth) {
   interaction_trees <- trees[!is.na(Split) & !is.na(parent_1),
                              c('Feature', paste0('parent_feat_', 1:(input_max_depth - 1))),
                              with = FALSE]
-  interaction_trees_split <- split(interaction_trees, 1:nrow(interaction_trees))
+  interaction_trees_split <- split(interaction_trees, seq_len(nrow(interaction_trees)))
   interaction_list <- lapply(interaction_trees_split, as.character)
 
   # Remove NAs (no parent interaction)
@@ -101,8 +101,8 @@ bst3_interactions <- treeInteractions(bst3_tree, 4)
 
 # Show monotonic constraints still apply by checking scores after incrementing V1
 x1 <- sort(unique(x[['V1']]))
-for (i in 1:length(x1)){
-  testdata <- copy(x[, -c('V1')])
+for (i in seq_along(x1)){
+  testdata <- copy(x[, - ('V1')])
   testdata[['V1']] <- x1[i]
   testdata <- testdata[, paste0('V', 1:10), with = FALSE]
   pred <- predict(bst3, as.matrix(testdata))

R-package/tests/run_lint.R

@@ -6,21 +6,21 @@ my_linters <- list(
   assignment_linter = lintr::assignment_linter,
   closed_curly_linter = lintr::closed_curly_linter,
   commas_linter = lintr::commas_linter,
-  # commented_code_linter = lintr::commented_code_linter,
+  equals_na = lintr::equals_na_linter,
   infix_spaces_linter = lintr::infix_spaces_linter,
   line_length_linter = lintr::line_length_linter,
   no_tab_linter = lintr::no_tab_linter,
   object_usage_linter = lintr::object_usage_linter,
-  # snake_case_linter = lintr::snake_case_linter,
-  # multiple_dots_linter = lintr::multiple_dots_linter,
   object_length_linter = lintr::object_length_linter,
   open_curly_linter = lintr::open_curly_linter,
-  # single_quotes_linter = lintr::single_quotes_linter,
+  semicolon = lintr::semicolon_terminator_linter,
+  seq = lintr::seq_linter,
   spaces_inside_linter = lintr::spaces_inside_linter,
   spaces_left_parentheses_linter = lintr::spaces_left_parentheses_linter,
   trailing_blank_lines_linter = lintr::trailing_blank_lines_linter,
   trailing_whitespace_linter = lintr::trailing_whitespace_linter,
-  true_false = lintr::T_and_F_symbol_linter
+  true_false = lintr::T_and_F_symbol_linter,
+  unneeded_concatenation = lintr::unneeded_concatenation_linter
 )
 
 results <- lapply(

R-package/tests/testthat/test_dmatrix.R

@@ -99,7 +99,7 @@ test_that("xgb.DMatrix: colnames", {
   dtest <- xgb.DMatrix(test_data, label = test_label)
   expect_equal(colnames(dtest), colnames(test_data))
   expect_error(colnames(dtest) <- 'asdf')
-  new_names <- make.names(1:ncol(test_data))
+  new_names <- make.names(seq_len(ncol(test_data)))
   expect_silent(colnames(dtest) <- new_names)
   expect_equal(colnames(dtest), new_names)
   expect_silent(colnames(dtest) <- NULL)

R-package/tests/testthat/test_helpers.R

@@ -174,7 +174,7 @@ test_that("SHAPs sum to predictions, with or without DART", {
 
     expect_equal(rowSums(shap), pred, tol = tol)
     expect_equal(apply(shapi, 1, sum), pred, tol = tol)
-    for (i in 1 : nrow(d))
+    for (i in seq_len(nrow(d)))
       for (f in list(rowSums, colSums))
         expect_equal(f(shapi[i, , ]), shap[i, ], tol = tol)
   }