r - 使用混淆矩阵和roc曲线测试逻辑回归模型的质量

Question

我尝试使用逻辑回归模型进行分类。

这就是我所做的:

library(ROCR)
data<-read.csv("c:/InsideNetwork.csv");
s1 <- sample(which(data$Active==1),3000)
s2 <- sample(which(data$Active==0),6000)
train <- data[c(s1,s2),]
test  <- data[c(-s1,-s2),]
m<-glm(Active~Var1+Var2+Var3,data=train,family=binomial())
test$score<-predict(m,type="response", test)
pred<-prediction(test$score, test$Active)
perf<-performance(pred,"tpr","fpr")
plot(perf, lty=1)

我有很好的 ROC 图，但如何创建混淆矩阵？

Answer 1

使用下面的辅助函数:

pred_df <- data.frame(dep_var = test$Active, score = test$score)
confusion_matrix(pred_df, cutoff = 0.2)

例如，

confusion_matrix(data.frame(score = rank(iris$Sepal.Length)/nrow(iris),
                 dep_var = as.integer(iris$Species != 'setosa')), cutoff = 0.5)

#             score = 0 score = 1
# dep_var = 0        49         1
# dep_var = 1        24        76

辅助函数

#' Plot a confusion matrix for a given prediction set, and return the table.
#'
#' @param dataframe data.frame. Must contain \code{score} and \code{dep_var}
#'    columns. The confusion matrix will be calculated for these values.
#'    The mentioned columns must both be numeric.
#' @param cutoff numeric. The cutoff at which to assign numbers greater a 1
#'    for prediction purposes, and 0 otherwise. The default is 0.5.
#' @param plot.it logical. Whether or not to plot the confusion matrix as a
#'    four fold diagram. The default is \code{TRUE}.
#' @param xlab character. The labels for the rows (\code{dep_var}). The default
#'    is \code{c("dep_var = 0", "dep_var = 1")}.
#' @param ylab character. The labels for the rows (\code{score}). The default
#'    is \code{c("score = 0", "score = 1")}.
#' @param title character. The title for the fourfoldplot, if it is graphed.
#' @return a table. The confusion matrix table.
confusion_matrix <- function(dataframe, cutoff = 0.2, plot.it = TRUE,
                             xlab = c("dep_var = 0", "dep_var = 1"),
                             ylab = c("score = 0", "score = 1"), title = NULL) {
  stopifnot(is.data.frame(dataframe) &&
              all(c('score', 'dep_var') %in% colnames(dataframe)))
  stopifnot(is.numeric(dataframe$score) && is.numeric(dataframe$dep_var))


  dataframe$score <- ifelse(dataframe$score <= cutoff, 0, 1)
  categories <- dataframe$score * 2 + dataframe$dep_var
  confusion <- matrix(tabulate(1 + categories, 4), nrow = 2)
  colnames(confusion) <- ylab
  rownames(confusion) <- xlab
  if (plot.it) fourfoldplot(confusion, color = c("#CC6666", "#99CC99"),
                            conf.level = 0, margin = 1, main = title)
  confusion

}