获取变量组合矩阵

Question

数据
我们有许多看起来像这样的文本字符串（在我们的真实数据集中更长）：

df <- data.frame(
  id = c('text1','text2','text3'),text = c('ABA','ABA','AAA')
)


>df
     id text
1 text1  ABA
2 text2  ABA
3 text3  AAA

我们想要创建一个矩阵来告诉我们在位置 x 的一个字母与其他位置的其他字母一起被找到的频率，所以在这种情况下：

3A  3   1   2   3
2B  2   0   2   2
2A  1   1   0   1
1A  3   1   2   3
    1A  2A  2B  3A

---

我尝试了什么

我之前将矩阵转换为二进制矩阵，如下所示：

structure(list(pos1_A = c(1, 1, 1), pos2_A = c(0, 0, 1), pos2_B = c(1, 
1, 0), pos3_A = c(1, 1, 1)), class = "data.frame", row.names = c("text1", 
"text2", "text3"))

      pos1_A pos2_A pos2_B pos3_A
text1      1      0      1      1
text2      1      0      1      1
text3      1      1      0      1

然后我可以运行像cor 这样的命令来获取相关性，但是，我想要频率而不是相关性。

---

注意这不同于关于共现的问题，其中变量名本身（此处的位置）被忽略，例如“How to use R to create a word co-occurrence matrix”

Answer 1

感谢@Ronak Shah 的回答here

---

如果我们将分类数据转换为数字（二进制​​矩阵）会简单得多，例如使用homals 包的这种简单但简单的方法，然后应用上面链接的@Ronak Shah 的方法：

# The dataset
df <- data.frame(
  id = c('text1','text2','text3'),text = c('ABA','ABA','AAA')
)

# Split the strings in characters and add column names
df2 <- df %>% splitstackshape::cSplit('text', sep = '', stripWhite = FALSE, type.convert = FALSE, direction = 'wide') %>%
  column_to_rownames('id')
colnames(df2) <- paste0('pos', 1:ncol(df2))

# Convert to binary matrix (hacky way)
bin.mat <- homals:::expandFrame(df2, clean = F)

# Method by @Ronak Shah to get the frequency matrix
fun <- function(x, y) sum(bin.mat[, x] & bin.mat[, y])
n <- seq_along(bin.mat)
mat <- outer(n, n, Vectorize(fun))
dimnames(mat) <- list(names(bin.mat)[n], names(bin.mat[n]))

这会产生矩阵：

>mat
       pos1_A pos2_A pos2_B pos3_A
pos1_A      3      1      2      3
pos2_A      1      1      0      1
pos2_B      2      0      2      2
pos3_A      3      1      2      3

Answer 2

这是一种替代方法，可以按照最初的要求生成矩阵：

# Make all strings the same length:
df$text <-  stringr::str_pad(df$text, side = "right", max(nchar(df$text)))

# Create a matrix with all letters labelled by their position:
all_vals <- apply(do.call(rbind, strsplit(df$text, "")), 1, 
                  function(x) paste0(seq_along(x), x))

# Create a vector of all possible letter / position combos
all_labs <- do.call(paste0, expand.grid(seq(max(nchar(df$text))),
                                        unique(unlist(strsplit(df$text, "")))))

# Create a function that will count all co-occurences per data frame row
f <- function(y, x) as.vector(outer(x, x, function(a, b) 1 * (a %in% y & b %in% y)))

# Create the results matrix and label it
m <- matrix(rowSums(apply(as.data.frame(all_vals), 2, f, all_labs)), nrow = length(all_labs))
rownames(m) <- all_labs
colnames(m) <- all_labs
m
#>    1A 2A 3A 1B 2B 3B
#> 1A  3  1  3  0  2  0
#> 2A  1  1  1  0  0  0
#> 3A  3  1  3  0  2  0
#> 1B  0  0  0  0  0  0
#> 2B  2  0  2  0  2  0
#> 3B  0  0  0  0  0  0

^{由reprex package (v0.3.0) 于 2020 年 5 月 24 日创建}