按组分类的“k精度”的自定义省略度量标准

创建包含参数并可汇总训练数据子集的caret::train中使用的自定义度量标准函数的正确方法是什么？按组分类的“k精度”的自定义省略度量标准

想象一下，我们有信用评分和贷款数据，并希望通过培训模型来预测不同类别的贷款（住房抵押贷款，汽车贷款，学生贷款等）内的最高贷款前景。我们有限的金额并希望分散我们的投资组合，因此我们希望在每个类别中找出少数低风险贷款。

作为示例，我们可以使用caret包中的GermanLoans数据。在这些培训数据中，每笔贷款都归类为“好”或“差”。在重新安排一些栏目后，我们有Purpose这一列标识了所请求贷款的类型。

## Load packages 
library(data.table); library(caret); library(xgboost); library(Metrics) 

## Load data and convert dependent variable (Class) to factor 
data(GermanCredit) 
setDT(GermanCredit, keep.rownames=TRUE) 
GermanCredit[, `:=`(rn=as.numeric(rn), Class=factor(Class, levels=c("Good", "Bad")))] 

## Now we need to collapse a few columns... 
## - Columns containing purpose for getting loan 
colsPurpose <- names(GermanCredit)[names(GermanCredit) %like% "Purpose."] 

## - Replace purpose columns with a single factor column 
GermanCredit[, Purpose:=melt(GermanCredit, id.var="rn", measure.vars=colsPurpose)[ 
    value==1][order(rn), factor(sub("Purpose.", "", variable))]] 

## - Drop purpose columns 
GermanCredit[, colsPurpose:=NULL, with=FALSE]

现在我们需要创建自定义度量函数。像precision at k（其中k是我们希望在每个类别中进行的贷款数量）在群组上平均看起来是合适的，但我愿意接受建议。在任何情况下，函数应该看起来像这样：

twoClassGroup <- function (data, lev=NULL, model=NULL, k, ...) { 
    if(length(levels(data$obs)) > 2) 
    stop(paste("Your outcome has", length(levels(data$obs)), 
       "levels. The twoClassGroup() function isn't appropriate.")) 
    if (!all(levels(data$pred) == levels(data$obs))) 
    stop("levels of observed and predicted data do not match") 

    [subset the data, probably using data$rowIndex] 

    [calculate the metrics, based on data$pred and data$obs] 

    [return a named vector of metrics] 
}

最后，我们可以训练模型。

## Train a model (just an example; may or may not be appropriate for this problem) 
creditModel <- train(
    Class ~ . - Purpose, data=GermanCredit, method="xgbTree", 
    trControl=trainControl(
    method="cv", number=6, returnResamp="none", summaryFunction=twoClassGroup, 
    classProbs=TRUE, allowParallel=TRUE, verboseIter=TRUE), 
    tuneGrid = expand.grid(
    nrounds=500, max_depth=6, eta=0.02, gamma=0, colsample_bytree=1, min_child_weight=6), 
    metric="someCustomMetric", preProc=c("center", "scale")) 

## Add predictions 
GermanCredit[, `:=`(pred=predict(creditModel, GermanCredit, type="raw"), 
        prob=predict(creditModel, GermanCredit, type="prob")[[levels(creditModel)[1]]])]

问题

我如何通过k的以twoClassGroup从train呼叫的价值？在主函数参数中添加它不起作用，也不在trControl或tuneGrid中添加它。
如何在twoClassGroup范围内对数据进行子集分析，以计算每个值Purpose内前k个值的模型精度？ twoClassGroup函数中的data对象与传递给原始train函数的对象不同。

来源

2016-08-03 dnlbrky

这种尝试主要适用，但我希望有人可以分享更好的方法。 train的参数dt和k不是通过的参数，而是在twoClassGroup中“硬编码”。此外，从Metrics::mapk的价值似乎非常低，虽然由此产生的模型似乎挑选最好的贷款前景。

library(Metrics) 

twoClassGroup <- function (data, lev=NULL, model=NULL, dt=GermanCredit, k=10) { 
    if(length(levels(data$obs)) > 2) 
    stop(paste("Your outcome has", length(levels(data$obs)), 
       "levels. The twoClassGroup() function isn't appropriate.")) 
    if (!all(levels(data$pred) == levels(data$obs))) 
    stop("levels of observed and predicted data do not match") 

    data <- data.table(data, group=dt[data$rowIndex, Purpose]) 

    ## You can ignore these extra metrics... 
    ## <----- 
    sens <- sensitivity(data$pred, data$obs, positive=lev[1]) 
    spec <- specificity(data$pred, data$obs, positive=lev[1]) 
    precision <- posPredValue(data$pred, data$obs) 
    recall <- sens 

    Fbeta <- function(precision, recall, beta=1) { 
    val <- (1+beta^2)*(precision*recall)/(precision*beta^2 + recall) 
    if(is.nan(val)) val <- 0 
    return(val) 
    } 
    F0.5 <- Fbeta(precision, recall, beta=0.5) 
    F1 <- Fbeta(precision, recall, beta=1) 
    F2 <- Fbeta(precision, recall, beta=2) 

    ## -----> 
    ## This is the important one... 
    mapk <- data[, .(obs=list(obs), pred=list(pred)), by=group][, mapk(k, obs, pred)] 

    return(c(sensitivity=sens, specificity=spec, F0.5=F0.5, F1=F1, F2=F2, mapk=mapk)) 
}

在从原岗位的train通话中，metric值将是“MAPK”，而不是“someCustomMetric”。

来源

2016-08-03 22:50:56 dnlbrky

按组分类的“k精度”的自定义省略度量标准

回答

相关问题