Benutzerdefiniert summaryFunction in Caret, Logloss

Question

Mit dem Caret-Paket habe ich Probleme, die folgende benutzerdefinierte Zusammenfassungsfunktion zu erhalten. Es soll den Logloss berechnen, aber ich bekomme immer wieder, dass Logloss nicht gefunden wird. Unten ein reproduzierbares Beispiel:

data <- data.frame('target' = sample(c('Y','N'),100,replace = T), 'X1' = runif(100), 'X2' = runif(100)) 

log.loss2 <- function(data, lev = NULL, model = NULL) { 
    logloss = -sum(data$obs*log(data$Y) + (1-data$obs)*log(1-data$Y))/length(data$obs) 
    names(logloss) <- c('LL') 
    logloss 
} 

fitControl <- trainControl(method="cv",number=1, classProbs = T, summaryFunction = log.loss2) 

my.grid <- expand.grid(.decay = c(0.05), .size = c(2)) 

fit.nnet2 <- train(target ~., data = data, 
        method = "nnet", maxit = 500, metric = 'LL', 
        tuneGrid = my.grid, verbose = T) 

Answer 1

Der Fehler war aufgrund der Tatsache, Sie nicht zu trainieren, haben trControl = fitControl im Aufruf zu enthalten. Jedoch, dass Sie auf einen anderen Fehler mit sich bringen würde, die auf die Tatsache zurückzuführen ist data$obs und data$pred Faktoren sind - muss man numerisch konvertieren, die 1 oder 2 gibt, 1 Subtrahieren 0 und 1

log.loss2 <- function(data, lev = NULL, model = NULL) { 
    data$pred <- as.numeric(data$pred)-1 
    data$obs <- as.numeric(data$obs)-1 
    logloss = -sum(data$obs*log(data$Y) + (1-data$obs)*log(1-data$Y))/length(data$obs) 
    names(logloss) <- c('LL') 
    logloss 
} 

fitControl <- trainControl(method="cv",number=1, classProbs = T, summaryFunction = log.loss2) 

fit.nnet2 <- train(target ~., data = data, 
        method = "nnet", maxit = 500, metric = "LL" , 
        tuneGrid = my.grid, verbose = T, trControl = fitControl) 
#output 
Neural Network 

100 samples 
    2 predictor 
    2 classes: 'N', 'Y' 

No pre-processing 
Resampling: Cross-Validated (1 fold) 
Summary of sample sizes: 0 
Resampling results: 

    LL  
    0.6931472 

Tuning parameter 'size' was held constant at a value of 2 
Tuning parameter 'decay' was held constant at a value of 0.05 

Mehrere Dinge ergibt Wünsche zu beachten :

diese Verlustfunktion N/Y als Klassen, weil Wahrscheinlichkeit als data$Y definiert ist, ein besserer Ansatz, die nur mit Daten arbeiten, die Namen der Klasse zu finden und zu verwenden. Zusätzlich ist es eine gute Übung, um die Wahrscheinlichkeitswerte abzuschneiden, da log(0) keine gute Idee ist:

LogLoss <- function (data, lev = NULL, model = NULL) 
    { 
    obs <- data[, "obs"] 
    cls <- levels(obs) #find class names 
    probs <- data[, cls[2]] #use second class name 
    probs <- pmax(pmin(as.numeric(probs), 1 - 1e-15), 1e-15) #bound probability 
    logPreds <- log(probs)   
    log1Preds <- log(1 - probs) 
    real <- (as.numeric(data$obs) - 1) 
    out <- c(mean(real * logPreds + (1 - real) * log1Preds)) * -1 
    names(out) <- c("LogLoss") 
    out 
    }