r - 组合二元分类算法

Question

我有几种算法通过为每个观察分配目标值等于 1 的概率来解决二元分类(响应为 0 或 1)问题。所有算法都试图最小化 log loss function其中 N 是观察次数，y_i 是实际目标值，p_i 是算法预测的 1 的概率。这是一些带有示例数据的 R 代码:

actual.response = c(1,0,0,0,1)
prediction.df = data.frame(
  method1 = c(0.5080349,0.5155535,0.5338271,0.4434838,0.5002529),
  method2 = c(0.5229466,0.5298336,0.5360780,0.4217748,0.4998602),
  method3 = c(0.5175378,0.5157711,0.5133765,0.4372109,0.5215695),
  method4 = c(0.5155535,0.5094510,0.5201827,0.4351625,0.5069823)
)

log.loss = colSums(-1/length(actual.response)*(actual.response*log(prediction.df)+(1-actual.response)*log(1-prediction.df)))

示例代码给出了每个算法的对数损失:

method1   method3   method2   method4 
0.6887705 0.6659796 0.6824404 0.6719181 

现在我想结合这些算法，以便进一步减少对数损失。有没有可以为我做这个的 R 包？我将感谢对解决此类问题的任何算法、文章、书籍或研究论文的引用。请注意，作为最终结果，我希望获得每个类别的预测概率并记录简单的 0,1 响应。

Answer 1

这叫做 ensemble learning (Wikipedia) .

查看这篇文章:"an intro to ensemble learning in r."

这是我使用 Cornell movie review data 做的一个例子可以通过单击链接下载。我曾经使用包含 1000 条正面评论和 1000 条负面评论的数据集。将数据输入 R 后:

library(RTextTools)
library(tm) 
library(glmnet)
library(ipred)
library(randomForest) 
library(data.table)

## create a column of sentiment score. 0 for negative and 1 for        
## positive. 

text_neg$pos_neg<-rep(0,1000)
text_pos$pos_neg<-rep(1,1000)

## Combine into 1 data.table and rename.

text_all<-rbind(text_neg, text_pos)
##dont forget to shuffle
set.seed(26)
text2<-text_all[sample(nrow(text_all)),]
## turn the data.frame into a document term matrix. This uses the handy 
##RTextTools wrappers and functions.

doc_matrix <- create_matrix(text2$V1, language="english", 
removeNumbers=TRUE, stemWords=TRUE, removeSparseTerms=.98)
ncol(data.frame(as.matrix(doc_matrix)))

## 2200 variables at .98 sparsity. runs pretty slow...
## create a container with the very nice RTextTools package

container <- create_container(doc_matrix, text2$pos_neg,  
trainSize=1:1700, testSize=1701:2000, virgin=FALSE)

## train the data
time_glm<-system.time(GLMNET <- train_model(container,"GLMNET"));    
time_glm #1.19
time_slda<-system.time(SLDA <- train_model(container,"SLDA"));   
time_slda #45.03
time_bag<-system.time(BAGGING <- train_model(container,"BAGGING"));   
time_bag #59.24
time_rf<-system.time(RF <- train_model(container,"RF")); time_rf #69.59

## classify with the models
GLMNET_CLASSIFY <- classify_model(container, GLMNET)
SLDA_CLASSIFY <- classify_model(container, SLDA)
BAGGING_CLASSIFY <- classify_model(container, BAGGING)
RF_CLASSIFY <- classify_model(container, RF)

## summarize results
analytics <- create_analytics(container,cbind( SLDA_CLASSIFY,  
BAGGING_CLASSIFY,RF_CLASSIFY, GLMNET_CLASSIFY))

summary(analytics)

这使用 4 种不同的方法(随机森林、GLM、SLD 和套袋)运行了一个集成分类器。最后的整体总结显示

# ENSEMBLE SUMMARY
#
# n-ENSEMBLE COVERAGE   n-ENSEMBLE        RECALL
# n >= 1                1.00              0.86
# n >= 2                1.00              0.86
# n >= 3                0.89              0.89
# n >= 4                0.63              0.96

如果所有 4 种方法都同意评论是正面的还是负面的，那么集成的召回率为 96%。但要小心，因为对于二元结果(2 个选择)和 4 种不同的算法，必然会有很多一致。

有关更多说明，请参阅 RTextTools 文档。他们还用我在上面的例子中或多或少模仿的美国国会数据做了一个几乎相同的例子。

希望这对您有所帮助。