[R] fix uses of 1:length(x) and other small things (#5992)
This commit is contained in:
parent
801e6b6800
commit
589b385ec6
@ -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')
|
||||
|
||||
@ -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)
|
||||
}
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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(
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
}
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user