查找需要解析 data.frame 的组合频率

Question

我确信有一个简单的解决方案，但我想不通！假设我有一个包含以下信息的数据框：

aaa<-c("A,B","B,C","B,D,E")
vvv<-c("101","101,102","102,103,104")
data_h<-data.frame(aaa,vvv)
data_h
    aaa         vvv
1   A,B         101
2   B,C     101,102
3 B,D,E 102,103,104

所需的输出是单个点击的频率图，用于在热图中进行后续分析。所以：

  101   102   103   104
A  1     0     0     0
B  2     2     1     1
C  1     1     0     0
D  0     1     1     1
E  0     1     1     1

如何进行这种转换？我见过很多类似的例子，但没有一个需要解析数据框的内容。

目标是最终在输出表上使用热图或类似的东西来可视化“aaa”和“vvv”之间的相关性。

Answer 1

这是一个包含 4 行代码的基本 R 解决方案。首先，我们定义一个函数spl，它将逗号分隔的字符串的组成部分拆分为所有字段的向量。 eg 接受两个字符串参数并将spl 应用于每个参数，然后创建拆分结果的网格。最后我们将eg 应用到data_h、rbind 的每一行结果一起，并与xtabs 一起制表：

spl <- function(x) strsplit(as.character(x), ",")[[1]]
eg <- function(aaa, vvv) expand.grid(aaa = spl(aaa), vvv = spl(vvv))
dd <- do.call("rbind", Map(eg, data_h$aaa, data_h$vvv))
xtabs(data = dd)

结果是：

   vvv
aaa 101 102 103 104
  A   1   0   0   0
  B   2   2   1   1
  C   1   1   0   0
  D   0   1   1   1
  E   0   1   1   1

dcast 或者将上面的最后一行代码（带有xtabs 的那一行）替换为：

library(reshape2)
dcast(dd, aaa ~ vvv, fun = length, value.var = "vvv")

在这种情况下，结果是：

  aaa 101 102 103 104
1   A   1   0   0   0
2   B   2   2   1   1
3   C   1   1   0   0
4   D   0   1   1   1
5   E   0   1   1   1

点按。另一种选择是tapply（但是，它将用 NA 而不是 0 填充空单元格）：

tapply(1:nrow(dd), dd, length)

添加替代品。一些改进。

Answer 2

我的concat.split.multiple 函数非常需要重写以提高其效率。我在 cSplit function 中对此做了一些工作，如果你有一个特别大的数据集，这可能会很有用。

以下是我将如何使用cSplit 解决您给定的问题：

table(
  cSplit(
    cSplit(data_h, splitCols = 2, sep = ",", 
           direction = "long", makeEqual = FALSE), 
    splitCols = 1, sep = ",", direction = "long", 
    makeEqual = FALSE))
#    vvv
# aaa 101 102 103 104
#   A   1   0   0   0
#   B   2   2   1   1
#   C   1   1   0   0
#   D   0   1   1   1
#   E   0   1   1   1

好像也挺有效率的……

首先要测试的功能：

fun1 <- function() table(cSplit(cSplit(df, 2, ",", "long", FALSE), 1, ",", "long", FALSE))

fun2 <- function() {
  spl <- function(x) strsplit(as.character(x), ",")[[1]]
  eg <- function(aaa, vvv) expand.grid(aaa = spl(aaa), vvv = spl(vvv))
  dd <- do.call("rbind", Map(eg, df$A, df$V))
  xtabs(data = dd)
}

第二，一些样本数据。更改Nrows并重新生成以查看不同大小的data.frames的效果。

set.seed(1)
Nrow <- 100
aaa <- 100:200
vvv <- LETTERS
maxA <- 10
maxV <- 10
Aaa <- sample(maxA, Nrow, TRUE)
Vvv <- sample(maxV, Nrow, TRUE)
A <- vapply(seq_along(Aaa), function(x) 
  paste(sample(aaa, Aaa[x], TRUE), collapse = ","), character(1L))
V <- vapply(seq_along(Vvv), function(x) 
  paste(sample(vvv, Vvv[x], TRUE), collapse = ","), character(1L))
df <- data.frame(A, V)
head(df)
#                                         A                   V
# 1                             127,122,152       E,E,O,S,W,S,M
# 2                         127,118,152,156             V,A,Z,Q
# 3                 113,125,172,197,110,177               L,A,T
# 4 195,182,131,165,196,196,134,126,116,132 F,Z,X,S,T,M,W,E,Q,H
# 5                             151,193,151       L,B,E,B,Y,I,N
# 6     126,104,142,186,135,113,137,163,139               Q,G,N

比较两种方法以确保结果相同：

X <- fun1()
Y <- fun2()
all(X == Y[dimnames(X)[[1]], dimnames(X)[[2]]])
# [1] TRUE

基准测试（100 行）。

library(microbenchmark)
## Nrow = 100
microbenchmark(fun1(), fun2(), times = 10)
# Unit: milliseconds
#    expr       min        lq    median        uq      max neval
#  fun1()  7.263802  7.326237  7.440843  7.868905 10.26451    10
#  fun2() 62.869130 64.046836 68.525880 73.595061 80.02027    10

基准测试（1000 行）。

## Nrow = 1000
microbenchmark(fun1(), fun2(), times = 10)
# Unit: milliseconds
#    expr      min        lq    median        uq       max neval
#  fun1()  19.2303  20.21857  23.14337  26.97776  35.56338    10
#  fun2() 775.6586 815.01639 835.98951 852.47804 888.15345    10

Answer 3

data.frame 的形状建议使用splitstackshape 包。但是我不太了解这个包，所以我只是用它来重塑数据，然后使用table手动计算频率：

library(splitstackshape)
data_h_split <- concat.split.multiple(data_h,1:2)

# aaa_1 aaa_2 aaa_3 vvv_1 vvv_2 vvv_3
# 1     A     B  <NA>   101    NA    NA
# 2     B     C  <NA>   101   102    NA
# 3     B     D     E   102   103   104

一旦你有了这种格式的数据（没有逗号，常规列），很容易使用table计算频率（你可以使用tapply,reshape）：

table(cbind.data.frame(ff= unlist(data_h_split[1:3]),
                       xx= unlist(data_h_split[4:6])))
   xx
ff  101 102 103 104
  A   1   0   0   0
  B   1   1   0   0
  C   0   1   0   0
  D   0   0   1   0
      0   0   0   0
  E   0   0   0   1

---

阿南达的编辑

这是一种使用“splitstackshape”来获得结果的多步骤方法。

library(splitstackshape)

## Split the "vvv" column first, and reshape at the same time
x <- concat.split.multiple(data_h, split.cols="vvv", ",", "long")

## Add an ID column
x$id <- 1:nrow(x)

## Split the "aaa" column next, again reshaping as we do so
x <- concat.split.multiple(x[complete.cases(x), ], split.cols="aaa", ",", "long")

## Use `table` with `droplevels`
with(droplevels(x), table(aaa, vvv))
#    vvv
# aaa 101 102 103 104
#   A   1   0   0   0
#   B   2   2   1   1
#   C   1   1   0   0
#   D   0   1   1   1
#   E   0   1   1   1