R 使用XGB模型为新部署数据评分

背景

• 我已经用R构建了一个极端梯度增强（XGB）模型
• 我已经使用模型对象为我的测试集打分
• 但是，我无法使用模型对象为部署集评分

加载R库

library(xgboost)
library(Matrix)

创建虚拟数据

### Training Set ###

train1 <- c("5032","1","66","139","0","9500","12","0")
train2 <-c("5031","1","61","34","5078","5100","12","2")
train3 <-c("5030","0","72","161","2540","4000","11","2")
train4 <-c("5029","1","68","0","6456","10750","12","4")
train5 <-c("5028","1","59","86","0","10000","12","0")
train6 <-c("5027","0","49","42","1756","4500","12","2")
train7 <-c("5026","0","61","14","0","2500","12","0")
train8 <-c("5025","0","44","153","0","9000","12","0")
train9 <-c("5024","1","79","61","0","5000","12","0")
train10 <-c("5023","1","46","139","2121","5600","6","3")
train <- rbind.data.frame(train1, train2, train3, train4, train5,
     train6, train7, train8, train9, train10)
names(train) <- c("customer_id","target","v1","v2","v3","v4","v5","v6")

for(i in 1:ncol(train)) {
     train[,i] <- as.character(train[,i])
}

for(i in 1:ncol(train)) {
     train[,i] <- as.integer(train[,i])
}


### Testing Set ###

test1 <- c("5021","0","55","64","2891","5000","12","4")
test2 <-c("5020","1","57","49","167","3000","12","2")
test3 <-c("5019","1","54","55","4352","9000","12","4")
test4 <-c("5018","0","70","8","2701","5000","12","3")
test5 <-c("5017","0","64","59","52","3000","12","2")
test6 <-c("5016","1","57","73","0","4000","12","0")
test7 <-c("5015","0","46","28","1187","6000","12","3")
test8 <-c("5014","1","57","38","740","4500","12","2")
test9 <-c("5013","1","54","159","0","3300","11","0")
test10 <-c("5012","0","48","19","690","6500","11","2")
test <- rbind.data.frame(test1, test2, test3, test4, test5,
     test6, test7, test8, test9, test10)
names(test) <- c("customer_id","target","v1","v2","v3","v4","v5","v6")

for(i in 1:ncol(test)) {
     test[,i] <- as.character(test[,i])
}

for(i in 1:ncol(test)) {
     test[,i] <- as.integer(test[,i])
}


### Deployment Set ###


deploy1 <- c("5011","58","5","7897","12000","12","4")
deploy2 <- c("5010","60","161","1601","7500","12","2")
deploy3 <- c("5009","40","59","0","5000","12","0")
deploy4 <- c("5008","57","80","0","3500","12","0")
deploy5 <- c("5007","50","70","1056","3000","12","2")
deploy6 <- c("5006","65","6","1010","9000","12","3")
deploy7 <- c("5005","65","17","1978","4500","12","2")
deploy8 <- c("5004","80","103","0","10000","12","0")
deploy9 <- c("5003","52","11","2569","3500","12","2")
deploy10 <- c("5002","54","81","1905","4000","12","4")
deploy <- rbind.data.frame(deploy1, deploy2, deploy3, deploy4, deploy5,
     deploy6, deploy7, deploy8, deploy9, deploy10)
names(deploy) <- c("customer_id","v1","v2","v3","v4","v5","v6")

for(i in 1:ncol(deploy)) {
     deploy[,i] <- as.character(deploy[,i])
}

for(i in 1:ncol(deploy)) {
     deploy[,i] <- as.integer(deploy[,i])
}

分数部署集

predict(hn_xgb, test_dmatrix)

部署集没有目标变量，因为目标尚未发生，即部署分数将尝试预测的正是目标

### Convert to matrix ###

# Remove customer Id
deploy_A <- deploy %>% select(-customer_id) 

# Covert deployment set into sparse-matrix
deploy_sparse_matrix<- sparse.model.matrix(data = deploy_A) ## Error !!!

###转换为矩阵###
#删除客户Id
部署一个%select（-customer\u id）
#将部署集转换为稀疏矩阵
deploy_sparse_matrix我对您的数据进行了一些清理，使其更具可读性。如果你有什么不明白的，请告诉我

library(xgboost)
library(Matrix)


### Training Set ###

train1 <- c("5032","1","66","139","0","9500","12","0")
train2 <-c("5031","1","61","34","5078","5100","12","2")
train3 <-c("5030","0","72","161","2540","4000","11","2")
train4 <-c("5029","1","68","0","6456","10750","12","4")
train5 <-c("5028","1","59","86","0","10000","12","0")
train6 <-c("5027","0","49","42","1756","4500","12","2")
train7 <-c("5026","0","61","14","0","2500","12","0")
train8 <-c("5025","0","44","153","0","9000","12","0")
train9 <-c("5024","1","79","61","0","5000","12","0")
train10 <-c("5023","1","46","139","2121","5600","6","3")
train <- rbind.data.frame(train1, train2, train3, train4, train5,
                          train6, train7, train8, train9, train10)
names(train) <- c("customer_id","target","v1","v2","v3","v4","v5","v6")


train <- train %>%
  mutate_if(is.factor, as.numeric)

### Testing Set ###

test1 <- c("5021","0","55","64","2891","5000","12","4")
test2 <-c("5020","1","57","49","167","3000","12","2")
test3 <-c("5019","1","54","55","4352","9000","12","4")
test4 <-c("5018","0","70","8","2701","5000","12","3")
test5 <-c("5017","0","64","59","52","3000","12","2")
test6 <-c("5016","1","57","73","0","4000","12","0")
test7 <-c("5015","0","46","28","1187","6000","12","3")
test8 <-c("5014","1","57","38","740","4500","12","2")
test9 <-c("5013","1","54","159","0","3300","11","0")
test10 <-c("5012","0","48","19","690","6500","11","2")
test <- rbind.data.frame(test1, test2, test3, test4, test5,
                         test6, test7, test8, test9, test10)
names(test) <- c("customer_id","target","v1","v2","v3","v4","v5","v6")

test <- test %>%
  mutate_if(is.factor, as.numeric)

############# XGBoost model ########################

x_train <- train %>%
  select(-target)

x_test <- test %>%
  select(-target)

y_train <- train %>%
  mutate(target = target - 1) %>% # we -1 here since XGBoost expects values between 0 and 1 for binary logistic models
  pull(target)

y_test <- test %>%
  mutate(target = target - 1) %>% # do the same to the testing data (-1)
  pull(target)


dtrain <- xgb.DMatrix(data = as.matrix(x_train), label = y_train, missing = "NaN")
dtest <- xgb.DMatrix(data = as.matrix(x_test), missing = "NaN")

params <- list(
  "max_depth"         = 6,
  "eta"               = 0.3, 
  "num_parallel_tree" = 1, 
  "nthread"           = 2, 
  "nround"            = 100,
  "metrics"           = "error",
  "objective"         = "binary:logistic",
  "eval_metric"       = "auc"
)

xgb.model <- xgb.train(params, dtrain, nrounds = 100)

predict(xgb.model, dtest)


######################################################

### Deployment Set ###


deploy1 <- c("5011","58","5","7897","12000","12","4")
deploy2 <- c("5010","60","161","1601","7500","12","2")
deploy3 <- c("5009","40","59","0","5000","12","0")
deploy4 <- c("5008","57","80","0","3500","12","0")
deploy5 <- c("5007","50","70","1056","3000","12","2")
deploy6 <- c("5006","65","6","1010","9000","12","3")
deploy7 <- c("5005","65","17","1978","4500","12","2")
deploy8 <- c("5004","80","103","0","10000","12","0")
deploy9 <- c("5003","52","11","2569","3500","12","2")
deploy10 <- c("5002","54","81","1905","4000","12","4")
deploy <- rbind.data.frame(deploy1, deploy2, deploy3, deploy4, deploy5,
                           deploy6, deploy7, deploy8, deploy9, deploy10)
names(deploy) <- c("customer_id","v1","v2","v3","v4","v5","v6")


deploy <- deploy %>%
  mutate_if(is.factor, as.numeric)

x_deploy <- deploy

ddeploy <- xgb.DMatrix(data = as.matrix(x_deploy), missing = "NaN")

predict(xgb.model, ddeploy)

谢谢你是冠军。它就像一个符咒。非常感谢：）
### Convert to matrix ###

# Remove customer Id
deploy_A <- deploy %>% select(-customer_id) 

# Covert deployment set into sparse-matrix
deploy_sparse_matrix<- sparse.model.matrix(data = deploy_A) ## Error !!!

# Convert training set to dmatrix (preferred for xgboost)
deploy_dmatrix <- xgboost::xgb.DMatrix(data=deploy_sparse_matrix)

library(xgboost)
library(Matrix)


### Training Set ###

train1 <- c("5032","1","66","139","0","9500","12","0")
train2 <-c("5031","1","61","34","5078","5100","12","2")
train3 <-c("5030","0","72","161","2540","4000","11","2")
train4 <-c("5029","1","68","0","6456","10750","12","4")
train5 <-c("5028","1","59","86","0","10000","12","0")
train6 <-c("5027","0","49","42","1756","4500","12","2")
train7 <-c("5026","0","61","14","0","2500","12","0")
train8 <-c("5025","0","44","153","0","9000","12","0")
train9 <-c("5024","1","79","61","0","5000","12","0")
train10 <-c("5023","1","46","139","2121","5600","6","3")
train <- rbind.data.frame(train1, train2, train3, train4, train5,
                          train6, train7, train8, train9, train10)
names(train) <- c("customer_id","target","v1","v2","v3","v4","v5","v6")


train <- train %>%
  mutate_if(is.factor, as.numeric)

### Testing Set ###

test1 <- c("5021","0","55","64","2891","5000","12","4")
test2 <-c("5020","1","57","49","167","3000","12","2")
test3 <-c("5019","1","54","55","4352","9000","12","4")
test4 <-c("5018","0","70","8","2701","5000","12","3")
test5 <-c("5017","0","64","59","52","3000","12","2")
test6 <-c("5016","1","57","73","0","4000","12","0")
test7 <-c("5015","0","46","28","1187","6000","12","3")
test8 <-c("5014","1","57","38","740","4500","12","2")
test9 <-c("5013","1","54","159","0","3300","11","0")
test10 <-c("5012","0","48","19","690","6500","11","2")
test <- rbind.data.frame(test1, test2, test3, test4, test5,
                         test6, test7, test8, test9, test10)
names(test) <- c("customer_id","target","v1","v2","v3","v4","v5","v6")

test <- test %>%
  mutate_if(is.factor, as.numeric)

############# XGBoost model ########################

x_train <- train %>%
  select(-target)

x_test <- test %>%
  select(-target)

y_train <- train %>%
  mutate(target = target - 1) %>% # we -1 here since XGBoost expects values between 0 and 1 for binary logistic models
  pull(target)

y_test <- test %>%
  mutate(target = target - 1) %>% # do the same to the testing data (-1)
  pull(target)


dtrain <- xgb.DMatrix(data = as.matrix(x_train), label = y_train, missing = "NaN")
dtest <- xgb.DMatrix(data = as.matrix(x_test), missing = "NaN")

params <- list(
  "max_depth"         = 6,
  "eta"               = 0.3, 
  "num_parallel_tree" = 1, 
  "nthread"           = 2, 
  "nround"            = 100,
  "metrics"           = "error",
  "objective"         = "binary:logistic",
  "eval_metric"       = "auc"
)

xgb.model <- xgb.train(params, dtrain, nrounds = 100)

predict(xgb.model, dtest)


######################################################

### Deployment Set ###


deploy1 <- c("5011","58","5","7897","12000","12","4")
deploy2 <- c("5010","60","161","1601","7500","12","2")
deploy3 <- c("5009","40","59","0","5000","12","0")
deploy4 <- c("5008","57","80","0","3500","12","0")
deploy5 <- c("5007","50","70","1056","3000","12","2")
deploy6 <- c("5006","65","6","1010","9000","12","3")
deploy7 <- c("5005","65","17","1978","4500","12","2")
deploy8 <- c("5004","80","103","0","10000","12","0")
deploy9 <- c("5003","52","11","2569","3500","12","2")
deploy10 <- c("5002","54","81","1905","4000","12","4")
deploy <- rbind.data.frame(deploy1, deploy2, deploy3, deploy4, deploy5,
                           deploy6, deploy7, deploy8, deploy9, deploy10)
names(deploy) <- c("customer_id","v1","v2","v3","v4","v5","v6")


deploy <- deploy %>%
  mutate_if(is.factor, as.numeric)

x_deploy <- deploy

ddeploy <- xgb.DMatrix(data = as.matrix(x_deploy), missing = "NaN")

predict(xgb.model, ddeploy)

> predict(xgb.model, dtest)
 [1] 0.6102757 0.6102757 0.8451911 0.6102757 0.6102757 0.3162267 0.6172123 0.3162267
 [9] 0.3150521 0.6172123

> predict(xgb.model, ddeploy)
 [1] 0.6102757 0.8444782 0.8444782 0.6089817 0.6102757 0.6184962 0.6172123 0.3150521
 [9] 0.3162267 0.3174037