总结布尔变量及其关系

Question

我想总结一下布尔变量及其关系。特别是：

对于每个变量，我想计算 TRUE 的数量。
对于一对变量，我想计算 TRUE 和 TRUE 的数量。

我模拟了一些数据给大家举个例子：

n <- 100
id <- 1:n

set.seed(1)
d1 <- sample(c(TRUE, FALSE), n, replace = TRUE)
d2 <- sample(c(TRUE, FALSE), n, replace = TRUE)
d3 <- sample(c(TRUE, FALSE), n, replace = TRUE)
d4 <- sample(c(TRUE, FALSE), n, replace = TRUE)
d5 <- sample(c(TRUE, FALSE), n, replace = TRUE)

df <- data.frame(id, d1, d2, d3, d4, d5)

因为在我使用 ggplot2 使用输出获得热图之后，我找到了基于函数 expand.grid 和 for 的使用的解决方案，但是我想知道是否有另一种更紧凑的方法来获得这样的结果。我分享我的解决方案，包括获取热图的代码（没有美学调整 ;-)）。

library(ggplot)    
to_plot <- expand.grid(colnames(df)[-1], colnames(df)[-1], stringsAsFactors = FALSE)
to_plot$n <- NA

aux <- 0
for(i in 1:nrow(to_plot)){
  
  aux <- aux + 1
  to_plot$n[aux] <- sum(df[to_plot$Var1[i]] & df[to_plot$Var2[i]])
  
}

ggplot(to_plot, aes(Var1, Var2)) +
  geom_tile(aes(fill = n))

谢谢！

Answer 1

工作量可能少了点：

library(dplyr)
library(purrr)
to_plot <- expand.grid(colnames(df)[-1], colnames(df)[-1], 
    stringsAsFactors = FALSE)
to_plot <- to_plot %>% 
  mutate(n = map2(Var1, Var2, ~sum(df[[.x]] & df[[.y]])))

编辑

为了回应 Ronak 的回答，避免重复计算，甚至认为这种方式似乎应该总是更快，但事实并非如此。考虑以下一组基准。首先，这是我们正在做的两个操作：

op1 <- function(){
  cols <- names(df)[-1]
  val <- combn(cols, 2, function(x) sum(rowSums(df[x]) == 2))
  mat <- matrix(nrow = length(cols), ncol = length(cols),
                dimnames = list(cols, cols))
  mat[upper.tri(mat)] <- val
  mat[lower.tri(mat)] <- val
  diag(mat) <- colSums(df[-1])
  
  out <- mat %>%
    as.data.frame() %>%
    rownames_to_column('row') %>%
    pivot_longer(cols = -row) 
}

op2 <- function(){
  to_plot <- expand.grid(colnames(df)[-1], colnames(df)[-1], 
                         stringsAsFactors = FALSE)
  to_plot <- to_plot %>% 
    mutate(n = map2(Var1, Var2, ~sum(df[[.x]] & df[[.y]])))
}

在具有 5 个变量和 100 个观测值的原始设置中，设置数据：

n <- 100
nvar <- 5
id <- 1:n

dat <- lapply(1:nvar, function(i)sample(c(TRUE, FALSE), n, replace = TRUE))
names(dat) <- paste0("d", seq_along(dat))
df <- do.call(data.frame, dat)
df <- cbind(id=id, df)

运行基准：

microbenchmark(op1(), op2(), times=100)
Unit: milliseconds
  expr      min       lq     mean   median       uq       max neval cld
 op1() 4.002038 4.551332 6.633587 5.499613 8.341939 12.335900   100   b
 op2() 1.200123 1.323183 2.011996 1.743236 2.305946  4.030759   100  a

当有 100 个变量，每个变量有 1000 个观测值时：

n <- 1000
nvar <- 100
id <- 1:n

dat <- lapply(1:nvar, function(i)sample(c(TRUE, FALSE), n, replace = TRUE))
names(dat) <- paste("d", seq_along(dat))
dat$id <- id
df <- do.call(data.frame, dat)

运行基准：

microbenchmark(op1(), op2(), times=100)
Unit: milliseconds
  expr      min       lq     mean   median       uq      max neval cld
 op1() 332.0568 352.9815 377.0784 369.1204 383.3933 768.0261   100   b
 op2() 158.8863 170.4160 185.8864 184.4045 198.0373 254.2080   100  a

在这两种情况下，执行更多计算的操作实际上要快得多。这显然不会在小数据上产生明显的差异，但有趣的是看看不同的操作如何扩展。

Answer 2

这并不短，但它避免了重新计算，因为 d1、d2 值与 d2、d1 相同。我们可以只计算一次并在两个地方更新它。它还避免使用 colSums.

计算 d1 和 d1

使用combn：

library(tidyverse)

cols <- names(df)[-1]
val <- combn(cols, 2, function(x) sum(rowSums(df[x]) == 2))
mat <- matrix(nrow = length(cols), ncol = length(cols),
              dimnames = list(cols, cols))
mat[upper.tri(mat)] <- val
mat[lower.tri(mat)] <- val
diag(mat) <- colSums(df[-1])

mat %>%
  as.data.frame() %>%
  rownames_to_column('row') %>%
  pivot_longer(cols = -row) %>%
  ggplot(aes(row, name)) +
  geom_tile(aes(fill = value))

总结布尔变量及其关系

Summarizing boolean variables and their relationships

boolean

r

relationship

ggplot2