我正在尝试创建一个函数，该函数将使R能够读取每个单数（ID）并计算该单元中特定字符的共现次数。 数据集如下：
ID class weight
1 1 A 1.0
2 1 A 1.0
3 1 B 1.0
4 2 A 1.0
5 2 B 1.0
6 2 C 1.0
7 3 B 1.0
8 4 B 1.0
9 4 C 1.0
10 4 C 1.0
11 4 D 1.0
12 4 D 1.0
13 5 A 0.9
14 5 B 0.9
15 5 C 0.9
16 5 D 0.9
17 6 B 0.8
18 6 B 0.8
19 7 C 0.7
20 7 C 0.7
21 7 D 0.7
22 7 D 0.7
23 8 C 0.6
24 8 D 0.6
25 9 D 0.5
26 9 E 0.5
27 9 E 0.5
28 10 C 0.4
29 10 C 0.4
30 10 C 0.4
31 10 E 0.4
32 11 A 0.3
33 11 A 0.3
34 11 A 0.3
35 12 A 0.2
36 12 B 0.2
37 12 C 0.2
38 13 B 0.1
39 13 D 0.1
40 13 D 0.1
41 13 E 0.1
42 14 D 1.0
43 14 E 1.0
44 15 B 1.0
45 15 B 1.0
46 15 C 1.0
47 15 C 1.0
48 15 D 1.0
49 16 C 1.0
50 16 D 1.0
51 16 E 1.0
52 16 E 1.0
53 17 B 1.0
54 17 C 1.0
55 17 C 1.0
56 18 D 1.0
57 18 D 1.0
58 18 E 1.0
59 19 E 1.0
60 19 E 1.0
61 20 B 1.0
62 20 D 1.0
63 20 E 1.0
64 20 E 1.0
我试图创建一个循环函数，但是我不知道如何正确指定表达式。 R应该识别从1到20的ID，并且在每个ID中计算字符共同出现的次数。不仅如此，每次同现还必须通过ID的特定权重进行加权。 关于生成循环函数有什么想法？
一些细节： 在ID 1中，类别A和类别B共同出现两次（第一个类别A与B以及第二个类别A与B），乘以权重（1）得到的初始值为2。 循环完成整个列表后，A和B的共现值应为4.1，并且该值应在矩阵5x5中报告，如下所示：
A B C D E
A 1 4.1 ..
B 4.1 1 ..
C .. .. 1
D .. 1
E .. 1
相同类之间的并发仅为1。
dput（数据） 结构（列表（ID = c（1L，1L，1L，2L，2L，2L，3L，4L，4L，4L， 4L，4L，5L，5L，5L，5L，6L，6L，7L，7L，7L，7L，8L，8L，9L，9L， 9L，10L，10L，10L，10L，11L，11L，11L，12L，12L，12L，13L，13L， 13L，13L，14L，14L，15L，15L，15L，15L，15L，16L，16L，16L，16L， 17L，17L，17L，18L，18L，18L，19L，19L，20L，20L，20L，20L）， class = c（“ A”，“ A”，“ B”，“ A”，“ B”，“ C”，“ B”，“ B”，“ C”，“ C”， “ D”，“ D”，“ A”，“ B”，“ C”，“ D”，“ B”，“ B”，“ C”，“ C”，“ D”，“ D”， “ C”，“ D”，“ D”，“ E”，“ E”，“ C”，“ C”，“ C”，“ E”，“ A”，“ A”，“ A”， “ A”，“ B”，“ C”，“ B”，“ D”，“ D”，“ E”，“ D”，“ E”，“ B”，“ B”，“ C”， “ C”，“ D”，“ C”，“ D”，“ E”，“ E”，“ B”，“ C”，“ C”，“ D”，“ D”，“ E”， “ E”，“ E”，“ B”，“ D”，“ E”，“ E”），重量= c（1，1，1，1，1，1， 1，1，1，1，1，1，1，0.9，0.9，0.9，0.9，0.8，0.8，0.7，0.7， 0.7、0.7、0.6、0.6、0.5、0.5、0.5、0.4、0.4、0.4、0.4、0.3， 0.3、0.3、0.2、0.2、0.2、0.1、0.1、0.1、0.1、1、1、1、1 1，1，1，1，1，1，1，1，1，1，1，1，1，1，1，1，1，1，1）），row.names = c（NA， -64L），class = c（“ data.table”，“ data.frame”），.internal.selfref =） GC（） 已使用（Mb）gc触发（Mb）最大已使用（Mb） Ncell 2672851 142.8 4316924 230.6 4316924 230.6 Vcell 5761794 44.0 12425324 94.8 29629603 226.1 库（data.table） 数据<-fread（“ toy.csv”） dput（数据） 结构（列表（ID = c（1L，1L，1L，2L，2L，2L，3L，4L，4L，4L， 4L，4L，5L，5L，5L，5L，6L，6L，7L，7L，7L，7L，8L，8L，9L，9L， 9L，10L，10L，10L，10L，11L，11L，11L，12L，12L，12L，13L，13L， 13L，13L，14L，14L，15L，15L，15L，15L，15L，16L，16L，16L，16L， 17L，17L，17L，18L，18L，18L，19L，19L，20L，20L，20L，20L）， class = c（“ A”，“ A”，“ B”，“ A”，“ B”，“ C”，“ B”，“ B”，“ C”，“ C”， “ D”，“ D”，“ A”，“ B”，“ C”，“ D”，“ B”，“ B”，“ C”，“ C”，“ D”，“ D”， “ C”，“ D”，“ D”，“ E”，“ E”，“ C”，“ C”，“ C”，“ E”，“ A”，“ A”，“ A”， “ A”，“ B”，“ C”，“ B”，“ D”，“ D”，“ E”，“ D”，“ E”，“ B”，“ B”，“ C”， “ C”，“ D”，“ C”，“ D”，“ E”，“ E”，“ B”，“ C”，“ C”，“ D”，“ D”，“ E”， “ E”，“ E”，“ B”，“ D”，“ E”，“ E”），重量= c（1，1，1，1，1，1， 1，1，1，1，1，1，1，0.9，0.9，0.9，0.9，0.8，0.8，0.7，0.7， 0.7、0.7、0.6、0.6、0.5、0.5、0.5、0.4、0.4、0.4、0.4、0.3， 0.3、0.3、0.2、0.2、0.2、0.1、0.1、0.1、0.1、1、1、1、1 1，1，1，1，1，1，1，1，1，1，1，1，1，1，1，1，1，1，1）），row.names = c（NA， -64L），class = c（“ data.table”，“ data.frame”），.internal.selfref =）
答案 0 :(得分：1)
这是一种方法：
library(tidyverse)
data <- structure(list(ID = c(1L, 1L, 1L, 2L, 2L, 2L, 3L, 4L, 4L, 4L, 4L, 4L, 5L, 5L, 5L, 5L, 6L, 6L, 7L, 7L, 7L, 7L, 8L, 8L, 9L, 9L, 9L, 10L, 10L, 10L, 10L, 11L, 11L, 11L, 12L, 12L, 12L, 13L, 13L, 13L, 13L, 14L, 14L, 15L, 15L, 15L, 15L, 15L, 16L, 16L, 16L, 16L, 17L, 17L, 17L, 18L, 18L, 18L, 19L, 19L, 20L, 20L, 20L, 20L), class = c("A", "A", "B", "A", "B", "C", "B", "B", "C", "C", "D", "D", "A", "B", "C", "D", "B", "B", "C", "C", "D", "D", "C", "D", "D", "E", "E", "C", "C", "C", "E", "A", "A", "A", "A", "B", "C", "B", "D", "D", "E", "D", "E", "B", "B", "C", "C", "D", "C", "D", "E", "E", "B", "C", "C", "D", "D", "E", "E", "E", "B", "D", "E", "E"), weight = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0.9, 0.9, 0.9, 0.9, 0.8, 0.8, 0.7, 0.7, 0.7, 0.7, 0.6, 0.6, 0.5, 0.5, 0.5, 0.4, 0.4, 0.4, 0.4, 0.3, 0.3, 0.3, 0.2, 0.2, 0.2, 0.1, 0.1, 0.1, 0.1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)), row.names = c(NA, -64L), class = c("data.table", "data.frame")) %>% as_tibble()
创建一个“计数”数据框：
(df <- data %>%
count(ID, class, weight) %>%
spread(class, n, fill = 0))
获取所有类组合：
eg <- expand.grid(unique(data$class), unique(data$class), stringsAsFactors = FALSE)
对小数和加权计数：
final <- map2(
eg$Var1,
eg$Var2,
~ df %>% select(.x, .y, weight) %>%
mutate(counts = !!sym(.x) * !!sym(.y)) %>%
mutate(wt_counts = counts * weight) %>%
select(wt_counts) %>%
sum() %>%
tibble(Var1 = .x, Var2 = .y, wt_count = .)
)
转换为矩阵：
finalmatrix <- bind_rows(final) %>%
mutate(wt_count = ifelse(Var1 == Var2, 1, wt_count)) %>%
spread(Var2, wt_count) %>%
select(-Var1) %>%
as.matrix()
最后，设置名称：
row.names(finalmatrix) <- colnames(finalmatrix)
> finalmatrix
A B C D E
A 1.0 4.1 2.1 0.9 0.0
B 4.1 1.0 10.1 6.1 2.1
C 2.1 10.1 1.0 11.3 3.2
D 0.9 6.1 11.3 1.0 8.2
E 0.0 2.1 3.2 8.2 1.0
我个人不喜欢我的解决方案有多长时间，也看不出使用rlang东西（!!sym()）的方法，但是仍然可以。
答案 1 :(得分：1)
编辑：
已修改，以匹配@Marian Minar的答案。还添加了一个tidyverse解决方案，该解决方案是此小型数据集的三种方法中最快的。
Tidyverse ：
mat_ans_2 <- DF%>%
count(ID, class, weight)%>%
inner_join(., ., by = 'ID')%>%
filter(class.x != class.y)%>%
group_by(class.x, class.y)%>%
summarize(co_occur = sum(weight.x * n.x * n.y))%>%
spread(key = 'class.x', value = 'co_occur', fill = 0L)%>%
column_to_rownames('class.y')%>%
as.matrix()
diag(mat_ans_2) <- 1L
data.table -在此数据集上速度较慢
dt <- as.data.table(DF)[, .N, by = .(ID, class, weight)]
dt2 <- dt[dt, on = 'ID', .(class, i.class, weight, N, i.N), by = .EACHI, allow.cartesian = T
][class != i.class, .(co_occur = sum(weight * N * i.N)), by = .(class, i.class)]
dt3 <- dcast(dt2, class ~ i.class, fill = 0, value.var = 'co_occur')
mat_ans <- as.matrix(dt3[,-1])
rownames(mat_ans) = colnames(mat_ans)
diag(mat_ans) <- 1L
这是使用xtabs
dt <- setkey(as.data.table(DF)[, .N, by = .(ID, class, weight)], ID)
dt_mat <- xtabs(co_occur ~ i.class + class,
data = dt[dt, .(class, i.class, co_occur = weight*N*i.N), allow.cartesian = T]
)
diag(dt_mat) <- 1L
性能：
Unit: milliseconds
expr min lq mean median uq max neval
cole_dt 9.7538 10.36345 10.966212 10.84040 11.1854 15.8167 100
cole_tidy 5.5976 5.79765 6.221044 5.96675 6.1522 10.0465 100
cole_xtabs 6.2134 6.65480 7.062921 6.94780 7.2503 13.9981 100
marian_tidy 95.9504 100.08345 103.244376 101.95380 104.7970 125.7495 100
数据：
DF <- structure(list(ID = c(1L, 1L, 1L, 2L, 2L, 2L, 3L, 4L, 4L, 4L, 4L, 4L, 5L, 5L, 5L, 5L, 6L, 6L, 7L, 7L, 7L, 7L, 8L, 8L, 9L, 9L, 9L, 10L, 10L, 10L, 10L, 11L, 11L, 11L, 12L, 12L, 12L, 13L, 13L, 13L, 13L, 14L, 14L, 15L, 15L, 15L, 15L, 15L, 16L, 16L, 16L, 16L, 17L, 17L, 17L, 18L, 18L, 18L, 19L, 19L, 20L, 20L, 20L, 20L)
, class = c("A", "A", "B", "A", "B", "C", "B", "B", "C", "C", "D", "D", "A", "B", "C", "D", "B", "B", "C", "C", "D", "D", "C", "D", "D", "E", "E", "C", "C", "C", "E", "A", "A", "A", "A", "B", "C", "B", "D", "D", "E", "D", "E", "B", "B", "C", "C", "D", "C", "D", "E", "E", "B", "C", "C", "D", "D", "E", "E", "E", "B", "D", "E", "E")
, weight = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0.9, 0.9, 0.9, 0.9, 0.8, 0.8, 0.7, 0.7, 0.7, 0.7, 0.6, 0.6, 0.5, 0.5, 0.5, 0.4, 0.4, 0.4, 0.4, 0.3, 0.3, 0.3, 0.2, 0.2, 0.2, 0.1, 0.1, 0.1, 0.1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1))
, row.names = c(NA, -64L)
, class = c("data.table", "data.frame")
)
答案 2 :(得分：0)
我曾尝试做空玛丽安（Marian）的解决方案，但仅涉及了前两个部分。它使用data.table，似乎您已经在使用它。
dt <- data[, `:=` (Count = .N), by = list(ID, class)] %>%
dcast(., ID + weight ~ class, value.var = "Count")
eg.dt <- merge(unique(data$class), unique(data$class), all = TRUE) %>%
setnames(., c("x", "y"), c("Var1", "Var2"))
代码没有大的减少。如果我提出更多建议，我将进行更新。