r - 用于 summaryFunction 插入符号分类的自定义指标 (hmeasure)

我正在尝试使用 hmeasure 指标 Hand,2009 作为我的自定义指标，用于在插入符号中训练 SVM。由于我对使用 R 比较陌生，因此我尝试调整 twoClassSummary 函数。我所需要的只是将模型(支持向量机)中的真实类标签和预测类概率传递给 hmeasure 包中的 HMeasure 函数，而不是使用 ROC 或插入符号中的其他分类性能度量。

例如，调用 R 中的 HMeasure 函数 - HMeasure(true.class,predictedProbs[,2])- 导致计算 Hmeasure。使用以下 twoClassSummary 代码的改编会导致返回错误:“x”必须是数字。

也许该训练函数无法“看到”评估 HMeasure 函数的预测概率。我怎样才能解决这个问题？

我已经阅读了文档，并链接了在 SO dealing with regression 上提出的问题。这让我有点办法。对于解决方案的任何帮助或指示，我将不胜感激。

library(caret)
library(doMC)
library(hmeasure)
library(mlbench)

set.seed(825)

data(Sonar)
table(Sonar$Class)
inTraining <- createDataPartition(Sonar$Class, p = 0.75, list = FALSE)
training <- Sonar[inTraining, ]
testing <- Sonar[-inTraining, ]


# using caret
fitControl <- trainControl(method = "repeatedcv",number = 2,repeats=2,summaryFunction=twoClassSummary,classProbs=TRUE)

svmFit1 <- train(Class ~ ., data = training,method = "svmRadial",trControl =    fitControl,preProc = c("center", "scale"),tuneLength = 8,metric = "ROC")

predictedProbs <- predict(svmFit1, newdata = testing , type = "prob")
true.class<-testing$Class
hmeas<- HMeasure(true.class,predictedProbs[,2]) # suppose its Rocks we're interested in predicting
hmeasure.probs<-hmeas$metrics[c('H')] # returns the H measure metric

hmeasureCaret<-function (data, lev = NULL, model = NULL,...)
{
# adaptation of twoClassSummary
require(hmeasure)
if (!all(levels(data[, "pred"]) == levels(data[, "obs"])))
 stop("levels of observed and predicted data do not match")
#lev is a character string that has the outcome factor levels taken from the training   data
hObject <- try(hmeasure::HMeasure(data$obs, data[, lev[1]]),silent=TRUE)
hmeasH <- if (class(hObject)[1] == "try-error") {
NA
} else {hObject$metrics[[1]]  #hObject$metrics[c('H')] returns a dataframe, need to    return a vector
}
out<-hmeasH
names(out) <- c("Hmeas")
#class(out)
}
environment(hmeasureCaret) <- asNamespace('caret')

下面的非工作代码。

ctrl <- trainControl(method = "cv", summaryFunction = hmeasureCaret,classProbs=TRUE,allowParallel = TRUE,
                  verboseIter=TRUE,returnData=FALSE,savePredictions=FALSE)
set.seed(1)

svmTune <- train(Class.f ~ ., data = training,method = "svmRadial",trControl =    ctrl,preProc = c("center", "scale"),tuneLength = 8,metric="Hmeas",
              verbose = FALSE)

最佳答案

此代码有效。我发布了一个解决方案，以防其他人想要使用/改进。
问题是由不正确引用 Hmeasure 对象和函数返回值的拼写错误/注释引起的。

library(caret)
library(doMC)
library(hmeasure)
library(mlbench)

set.seed(825)
registerDoMC(cores = 4)

data(Sonar)
table(Sonar$Class)

inTraining <- createDataPartition(Sonar$Class, p = 0.5, list = FALSE)
training <- Sonar[inTraining, ]
testing <- Sonar[-inTraining, ]

hmeasureCaret<-function (data, lev = NULL, model = NULL,...)
{
  # adaptation of twoClassSummary
  require(hmeasure)
  if (!all(levels(data[, "pred"]) == levels(data[, "obs"])))
    stop("levels of observed and predicted data do not match")
  hObject <- try(hmeasure::HMeasure(data$obs, data[, lev[1]]),silent=TRUE)
  hmeasH <- if (class(hObject)[1] == "try-error") {
    NA
  } else {hObject$metrics[[1]]  #hObject$metrics[c('H')] returns a dataframe, need to return a vector
  }
  out<-hmeasH
  names(out) <- c("Hmeas")
  out
}
#environment(hmeasureCaret) <- asNamespace('caret')


ctrl <- trainControl(method = "repeatedcv",number = 10, repeats = 5, summaryFunction = hmeasureCaret,classProbs=TRUE,allowParallel = TRUE,
                     verboseIter=FALSE,returnData=FALSE,savePredictions=FALSE)
set.seed(123)

svmTune <- train(Class ~ ., data = training,method = "svmRadial",trControl = ctrl,preProc = c("center", "scale"),tuneLength = 15,metric="Hmeas",
                 verbose = FALSE)
svmTune

predictedProbs <- predict(svmTune, newdata = testing , type = "prob")

true.class<-testing$Class

hmeas.check<- HMeasure(true.class,predictedProbs[,2])

summary(hmeas.check)

关于r - 用于 summaryFunction 插入符号分类的自定义指标 (hmeasure)，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/24509309/