[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
|
#' @export
|
||||||
print.xgb.DMatrix <- function(x, verbose = FALSE, ...) {
|
print.xgb.DMatrix <- function(x, verbose = FALSE, ...) {
|
||||||
cat('xgb.DMatrix dim:', nrow(x), 'x', ncol(x), ' info: ')
|
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, 'label')) > 0) infos <- 'label'
|
||||||
if (length(getinfo(x, 'weight')) > 0) infos <- c(infos, 'weight')
|
if (length(getinfo(x, 'weight')) > 0) infos <- c(infos, 'weight')
|
||||||
if (length(getinfo(x, 'base_margin')) > 0) infos <- c(infos, 'base_margin')
|
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)
|
par(mar = mar)
|
||||||
|
|
||||||
# reverse the order of rows to have the highest ranked at the top
|
# 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,
|
barplot(Importance, horiz = TRUE, border = NA, cex.names = cex,
|
||||||
names.arg = Feature, las = 1, ...)]
|
names.arg = Feature, las = 1, ...)]
|
||||||
grid(NULL, NA)
|
grid(NULL, NA)
|
||||||
# redraw over the grid
|
# 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)]
|
barplot(Importance, horiz = TRUE, border = NA, add = TRUE)]
|
||||||
par(op)
|
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")
|
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))
|
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, ]
|
data <- data[idx, ]
|
||||||
|
|
||||||
if (is.null(shap_contrib)) {
|
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]
|
data <- data[, features, drop = FALSE]
|
||||||
cols <- colnames(data)
|
cols <- colnames(data)
|
||||||
if (is.null(cols)) cols <- colnames(shap_contrib)
|
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(data) <- cols
|
||||||
colnames(shap_contrib) <- 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),
|
interaction_trees <- trees[!is.na(Split) & !is.na(parent_1),
|
||||||
c('Feature', paste0('parent_feat_', 1:(input_max_depth - 1))),
|
c('Feature', paste0('parent_feat_', 1:(input_max_depth - 1))),
|
||||||
with = FALSE]
|
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)
|
interaction_list <- lapply(interaction_trees_split, as.character)
|
||||||
|
|
||||||
# Remove NAs (no parent interaction)
|
# 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
|
# Show monotonic constraints still apply by checking scores after incrementing V1
|
||||||
x1 <- sort(unique(x[['V1']]))
|
x1 <- sort(unique(x[['V1']]))
|
||||||
for (i in 1:length(x1)){
|
for (i in seq_along(x1)){
|
||||||
testdata <- copy(x[, -c('V1')])
|
testdata <- copy(x[, - ('V1')])
|
||||||
testdata[['V1']] <- x1[i]
|
testdata[['V1']] <- x1[i]
|
||||||
testdata <- testdata[, paste0('V', 1:10), with = FALSE]
|
testdata <- testdata[, paste0('V', 1:10), with = FALSE]
|
||||||
pred <- predict(bst3, as.matrix(testdata))
|
pred <- predict(bst3, as.matrix(testdata))
|
||||||
|
|||||||
@ -6,21 +6,21 @@ my_linters <- list(
|
|||||||
assignment_linter = lintr::assignment_linter,
|
assignment_linter = lintr::assignment_linter,
|
||||||
closed_curly_linter = lintr::closed_curly_linter,
|
closed_curly_linter = lintr::closed_curly_linter,
|
||||||
commas_linter = lintr::commas_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,
|
infix_spaces_linter = lintr::infix_spaces_linter,
|
||||||
line_length_linter = lintr::line_length_linter,
|
line_length_linter = lintr::line_length_linter,
|
||||||
no_tab_linter = lintr::no_tab_linter,
|
no_tab_linter = lintr::no_tab_linter,
|
||||||
object_usage_linter = lintr::object_usage_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,
|
object_length_linter = lintr::object_length_linter,
|
||||||
open_curly_linter = lintr::open_curly_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_inside_linter = lintr::spaces_inside_linter,
|
||||||
spaces_left_parentheses_linter = lintr::spaces_left_parentheses_linter,
|
spaces_left_parentheses_linter = lintr::spaces_left_parentheses_linter,
|
||||||
trailing_blank_lines_linter = lintr::trailing_blank_lines_linter,
|
trailing_blank_lines_linter = lintr::trailing_blank_lines_linter,
|
||||||
trailing_whitespace_linter = lintr::trailing_whitespace_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(
|
results <- lapply(
|
||||||
|
|||||||
@ -99,7 +99,7 @@ test_that("xgb.DMatrix: colnames", {
|
|||||||
dtest <- xgb.DMatrix(test_data, label = test_label)
|
dtest <- xgb.DMatrix(test_data, label = test_label)
|
||||||
expect_equal(colnames(dtest), colnames(test_data))
|
expect_equal(colnames(dtest), colnames(test_data))
|
||||||
expect_error(colnames(dtest) <- 'asdf')
|
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_silent(colnames(dtest) <- new_names)
|
||||||
expect_equal(colnames(dtest), new_names)
|
expect_equal(colnames(dtest), new_names)
|
||||||
expect_silent(colnames(dtest) <- NULL)
|
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(rowSums(shap), pred, tol = tol)
|
||||||
expect_equal(apply(shapi, 1, sum), 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))
|
for (f in list(rowSums, colSums))
|
||||||
expect_equal(f(shapi[i, , ]), shap[i, ], tol = tol)
|
expect_equal(f(shapi[i, , ]), shap[i, ], tol = tol)
|
||||||
}
|
}
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user