按組分類的「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精度」的自定義省略度量標準

回答

相關問題