R 布尔变量及其关系综述

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

对于每一个变量，我想计算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)

---

谢谢

可能少做一点工作：

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]])))

当有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)

---

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

这并不短，但它避免了重新计算内容，因为

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))

库（tidyverse）
cols这是一个有趣的答案，当我第一次研究这个问题时，我也使用了
combn
，不过老实说，没有你那么好。然而，我认为查看基准会很好，所以我在下面编辑了我的答案，将其包括在内。令人惊讶的是，重复计算的操作实际上更快。幸运的是，你没有考虑我在竞争中的基于解决方案，LOL！我非常喜欢你基于expand.grid+map2的方法。然而，我将把这个问题继续讨论几天，以防有人知道一种更紧凑的方法来执行这项任务。谢谢
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 

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 

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))