用xtable合并几个混淆矩阵
Merge several confusion matrix with xtable
我训练了几个模型,想用三个混淆矩阵来总结它们的性能。 我想做的是使用xtable
将三个不同的混淆矩阵合并为一个table。我想结合 table 1、2 和 3。请参阅下面使用 XGBoost 的示例。
require(xgboost)
require(xtable)
require(caTools)
require(tidyverse)
set.seed(1234)
# Loading data
x1 = c(rnorm(10000, 0,1), rnorm(10000,3,1))
x2 = rnorm(1000)
x3 = rnorm(1000)
class= factor(rep(0:1, each=10000))
df <- as.data.frame(cbind(x1, x2, x3, class))
# Preparing target variable
df$class <- as.numeric(df$class)
df$class <- df$class -1
# Creating a hold-out data
train <- sample.split(df$class, SplitRatio = 0.70)
train.df <- subset(df, train == TRUE)
test.df <- subset(df, train == FALSE)
#Labels.
labels.train <- train.df[c('class')]
labels.test <- test.df[c('class')]
# Dropping target variable.
train.df <- train.df %>%
dplyr::select(-class)
test.df <- test.df %>%
dplyr::select(-class)
# Converting to appropiate format.
train <- xgb.DMatrix(as.matrix(train.df), label = as.matrix(labels.train))
test <- xgb.DMatrix(as.matrix(test.df), label = as.matrix(labels.test))
watchlist <- list(eval = test, train = train)
# Running the model
model <- xgb.train(data=train,
watchlist = watchlist,
nround = 1000,
early_stopping_rounds = 25,
objective = "binary:logistic")
# Predictions
pred <- predict(model, test)
# Evaluating the p-distribution.
hist(pred)
# Confusion matrix
table1 <- table(pred > 0.5, labels.test$class)
table2 <- table(pred > 0.25, labels.test$class)
table3 <- table(pred > 0.75, labels.test$class)
print(xtable(table1, caption = 'Threshhold = 50%'))
print(xtable(table2, caption = 'Threshhold = 25%'))
print(xtable(table3, caption = 'Threshhold = 75%'))
现在的结果是这样的
但我希望它看起来像这样
下一个可能的解决方案是使用 knitr
中的 kable()
、add_header_above()
和 kableExtra
中的 kable_styling()
。在创建混淆矩阵后添加此代码:
#Format table
t1 <- as.data.frame.matrix(table1)
t2 <- as.data.frame.matrix(table2)
t3 <- as.data.frame.matrix(table3)
#Bind
tm <- cbind(t1,t2,t3)
然后下一段代码产生你想要的输出:
kable(tm,"latex",longtable =T,booktabs =T,caption ="Longtable")%>%
add_header_above(c(" ","p=50%"=2,"p=25%"=2,"p=75%"=2))%>%
kable_styling(latex_options =c("repeat_header"))
我在 rmarkdown
文档中有 运行 之前的代码,结果是下一个:
您还必须将库 knitr
和 kableExtra
添加到您的代码中。
我训练了几个模型,想用三个混淆矩阵来总结它们的性能。 我想做的是使用xtable
将三个不同的混淆矩阵合并为一个table。我想结合 table 1、2 和 3。请参阅下面使用 XGBoost 的示例。
require(xgboost)
require(xtable)
require(caTools)
require(tidyverse)
set.seed(1234)
# Loading data
x1 = c(rnorm(10000, 0,1), rnorm(10000,3,1))
x2 = rnorm(1000)
x3 = rnorm(1000)
class= factor(rep(0:1, each=10000))
df <- as.data.frame(cbind(x1, x2, x3, class))
# Preparing target variable
df$class <- as.numeric(df$class)
df$class <- df$class -1
# Creating a hold-out data
train <- sample.split(df$class, SplitRatio = 0.70)
train.df <- subset(df, train == TRUE)
test.df <- subset(df, train == FALSE)
#Labels.
labels.train <- train.df[c('class')]
labels.test <- test.df[c('class')]
# Dropping target variable.
train.df <- train.df %>%
dplyr::select(-class)
test.df <- test.df %>%
dplyr::select(-class)
# Converting to appropiate format.
train <- xgb.DMatrix(as.matrix(train.df), label = as.matrix(labels.train))
test <- xgb.DMatrix(as.matrix(test.df), label = as.matrix(labels.test))
watchlist <- list(eval = test, train = train)
# Running the model
model <- xgb.train(data=train,
watchlist = watchlist,
nround = 1000,
early_stopping_rounds = 25,
objective = "binary:logistic")
# Predictions
pred <- predict(model, test)
# Evaluating the p-distribution.
hist(pred)
# Confusion matrix
table1 <- table(pred > 0.5, labels.test$class)
table2 <- table(pred > 0.25, labels.test$class)
table3 <- table(pred > 0.75, labels.test$class)
print(xtable(table1, caption = 'Threshhold = 50%'))
print(xtable(table2, caption = 'Threshhold = 25%'))
print(xtable(table3, caption = 'Threshhold = 75%'))
现在的结果是这样的
但我希望它看起来像这样
下一个可能的解决方案是使用 knitr
中的 kable()
、add_header_above()
和 kableExtra
中的 kable_styling()
。在创建混淆矩阵后添加此代码:
#Format table
t1 <- as.data.frame.matrix(table1)
t2 <- as.data.frame.matrix(table2)
t3 <- as.data.frame.matrix(table3)
#Bind
tm <- cbind(t1,t2,t3)
然后下一段代码产生你想要的输出:
kable(tm,"latex",longtable =T,booktabs =T,caption ="Longtable")%>%
add_header_above(c(" ","p=50%"=2,"p=25%"=2,"p=75%"=2))%>%
kable_styling(latex_options =c("repeat_header"))
我在 rmarkdown
文档中有 运行 之前的代码,结果是下一个:
您还必须将库 knitr
和 kableExtra
添加到您的代码中。