如何将表格嵌套在数据框的列中?

How to nest tables in a column of a dataframe?

我了解到可以使用 nest 将数据帧存储在数据帧的列中: https://tidyr.tidyverse.org/reference/nest.html

是否也可以将 tables 存储在数据框的列中?

原因是我想用 Caret 计算数据框的每个子组的 Kappa。虽然 caret::confusionMatrix(t) 期望 table 作为输入。

在下面的示例代码中,如果我一次计算完整数据帧的 Kappa,它就可以正常工作:

library(tidyverse)
library(caret)

  # generate some sample data:
  n <- 100L
  x1 <- rnorm(n, 1.0, 2.0)
  x2 <- rnorm(n, -1.0, 0.5)
  y  <- rbinom(n, 1L, plogis(1 * x1 + 1 * x2))
  my_factor <- rep( c('A','B','C','D'), 25 )   
  
  df <- cbind(x1, x2, y, my_factor)
  
  # fit a model and make predictions:
  mod <- glm(y ~ x1 + x2, "binomial")
  probs <- predict(mod, type = "response")
  
  # confusion matrix
  probs_round <- round(probs)
  
  t <- table(factor(probs_round, c(1,0)), factor(y, c(1,0)))
  ccm <- caret::confusionMatrix(t)
  
  # extract Kappa:
  ccm$overall[2]

> Kappa
> 0.5232
  
  
  
  

尽管我尝试group_by 为每个因子生成 Kappa 作为子组(见下面的代码)它不会成功。我想我需要以某种方式将 t 嵌套在 df 中,尽管我不知道如何:

  # extract Kappa for every subgroup with same factor (NOT WORKING CODE):

  df <- cbind(df, probs_round)
  df <- as.data.frame(df)
  
  output <- df %>%
    dplyr::group_by(my_factor) %>% 
    dplyr::mutate(t = table(factor(probs_round, c(1,0)), factor(y, c(1,0)))) %>%
    summarise(caret::confusionMatrix(t))

Expected output:

>my_factor Kappa
>1 A       0.51
>2 B       0.52
>3 C       0.53
>4 D       0.54

这是否正确,这可能吗? (由于样本数据的随机性,Kappa 的确切值会有所不同)

非常感谢!

您可以跳过给您带来麻烦的中间步骤 mutate():

library(dplyr)
library(caret)

df %>%
    group_by(my_factor) %>% 
    summarize(t = confusionMatrix(table(factor(probs_round, c(1,0)),
                                        factor(y, c(1,0))))$overall[2])

Returns:

# A tibble: 4 x 2
  my_factor     t
  <chr>     <dbl>
1 A         0.270
2 B         0.513
3 C         0.839
4 D         0.555

以上方法最容易得到想要的结果。但只是为了展示什么是可能的,我们可以将您的方法与 rowwise::nest_by 一起使用,它将数据集 rowwise.

分组

在下面的方法中,我们为每个子组计算一个单独的 glm。我不确定那是不是你想要做的。

library(tidyverse)
library(caret)


# generate some sample data:
n <- 1000L

df <- tibble(x1 = rnorm(n, 1.0, 2.0),
             x2 = rnorm(n, -1.0, 0.5),
             y = rbinom(n, 1L, plogis(x1 + 1 * x1 + 1 * x2)),
             my_factor = rep( c('A','B','C','D'), 250))

output <- df %>%
  nest_by(my_factor) %>%
  mutate(y = list(data$y), 
         mod = list(glm(y ~ x1 + x2,
                        family = "binomial",
                        data = data)),
         probs = list(predict(mod, type = "response")),
         probs_round = list(round(probs)),
         t = list(table(factor(probs_round, c(1, 0)),
                  factor(y, c(1, 0)))),
         ccm = caret::confusionMatrix(t)$overall[2])

output %>%

  pull(ccm)
#>     Kappa     Kappa     Kappa     Kappa 
#> 0.7743682 0.7078112 0.7157761 0.7549340

reprex package (v0.3.0)

于 2021 年 6 月 23 日创建