R:在数据表上迭代,并替换



过去几天我一直在为此绞尽脑汁。我有一个数据集,显示如下:

V1 <- c("A", "B", "C", "D", "B", "A", "A", "D")
V2 <- c("B", "E", "A", "G", "C", "G", "E", "B")
R1 <- c(120, 195, 135, 30, 195, 120, 120, 30)
G1 <- c(0, 195, 0, 195, 195, 0, 0, 195)
B1 <- c(240, 195, 0, 135, 195, 240, 240, 135)
R2 <- c(195, 60, 120, 75, 135, 75, 60, 195)
G2 <- c(195, 15, 0, 15, 0, 15, 15, 195)
B2 <- c(195, 150, 240, 150, 0, 150, 150, 195)
cross <- data.frame(V1,V2,R1,G1,B1,R2,G2,B2)

这是我实际数据集的一个非常简化的版本,它要大得多,有超过60000个观测值。在前两列中,V1V2表示ID变量。然后,R1B1G1对应于与V1相关联的属性,同样,R2B2G2V2的属性(这是一个网络模型,映射哪些节点链接到哪些节点以及这些节点的相关属性,但这与重点无关(。这给出了一个数据帧,看起来像:

V1 V2  R1  G1  B1  R2  G2  B2
1  A  B 120   0 240 195 195 195
2  B  E 195 195 195  60  15 150
3  C  A 135   0   0 120   0 240
4  D  G  30 195 135  75  15 150
5  B  C 195 195 195 135   0   0
6  A  G 120   0 240  75  15 150
7  A  E 120   0 240  60  15 150
8  D  B  30 195 135 195 195 195

注意,在V1中出现的ID也可以出现在V2中。还要注意,每个ID的关联属性在整个数据集中是唯一和统一的。

现在,我想做的是遍历每一行并计算一系列均值。在这个过程的第一次迭代之后,我的数据应该看起来像:

V1 V2    R1     G1      B1     R2    G2      B2
1  A  B 157.5   97.5   217.5  157.5  97.5   217.5
2  B  E   195    195     195     60    15     150
3  C  A   135      0       0    120     0     240
4  D  G    30    195     135     75    15     150
5  B  C   195    195     195    135     0       0
6  A  G   120      0     240     75    15     150
7  A  E   120      0     240     60    15     150
8  D  B    30    195     135    195   195     195

即,R1R2是其针对第一行的先前两个相应值120195的平均值。等等。

然后,该均值被重新插入为新属性(与ID匹配(,该过程从下一行开始。在这一步之后,我的数据集应该看起来像:

V1 V2    R1     G1      B1     R2    G2      B2
1  A  B 157.5   97.5   217.5  157.5  97.5   217.5
2  B  E 157.5   97.5   217.5     60    15     150
3  C  A   135      0       0  157.5  97.5   217.5
4  D  G    30    195     135     75    15     150
5  B  C 157.5   97.5   217.5    135     0       0
6  A  G 157.5   97.5   217.5     75    15     150
7  A  E 157.5   97.5   217.5     60    15     150
8  D  B    30    195     135  157.5  97.5   217.5

因此,AB的所有属性都发生了变化。然后,该过程将继续到第二行(对于BE(,依此类推。该过程将一直持续到到达最后一行。

这是我迄今为止的代码。我没有使用data.table,因为这正是我想要弄清楚的。但它是这样的。它很有效,但速度非常慢,这让我很难探究系统中发生了什么。

for(i in 1:nrow(cross)){
Rc <- (cross[i,3] + cross[i,6]) / 2 
Gc <- (cross[i,4] + cross[i,7]) / 2 
Bc <- (cross[i,5] + cross[i,8]) / 2 
V1c <- cross[i,"V1"]
V2c <- cross[i,"V2"]

cross$R1 <- with(cross, replace(R1, V1 == V1c, Rc)) 
cross$G1 <- with(cross, replace(G1, V1 == V1c, Gc))  
cross$B1 <- with(cross, replace(B1, V1 == V1c, Bc)) 

cross$R1 <- with(cross, replace(R1, V1 == V2c, Rc)) 
cross$G1 <- with(cross, replace(G1, V1 == V2c, Gc))  
cross$B1 <- with(cross, replace(B1, V1 == V2c, Bc)) 

cross$R2 <- with(cross, replace(R2, V2 == V2c, Rc)) 
cross$G2 <- with(cross, replace(G2, V2 == V2c, Gc))  
cross$B2 <- with(cross, replace(B2, V2 == V2c, Bc)) 

cross$R2 <- with(cross, replace(R2, V2 == V1c, Rc)) 
cross$G2 <- with(cross, replace(G2, V2 == V1c, Gc))  
cross$B2 <- with(cross, replace(B2, V2 == V1c, Bc)) 
}

考虑到我的数据大小,这个过程需要一个多小时。据我所知,data.table应该更快。我几乎什么都试过,从琐碎的东西到转换成矩阵。我甚至对需要替换的数据进行了细分。但我在尝试使用data.table时遇到了很多困难,这显然会跳过使用for循环的需要。

如果有任何帮助的话,循环的慢部分似乎是替换变量的部分,而不是生成变量的部分。

提前感谢!

我是data.table的忠实粉丝,但我认为这里不需要它。不是在每次迭代中更新整个data.frame中的所有匹配条目,而是通过索引更新参考矩阵。

V1 <- c("A", "B", "C", "D", "B", "A", "A", "D")
V2 <- c("B", "E", "A", "G", "C", "G", "E", "B")
R1 <- c(120, 195, 135, 30, 195, 120, 120, 30)
G1 <- c(0, 195, 0, 195, 195, 0, 0, 195)
B1 <- c(240, 195, 0, 135, 195, 240, 240, 135)
R2 <- c(195, 60, 120, 75, 135, 75, 60, 195)
G2 <- c(195, 15, 0, 15, 0, 15, 15, 195)
B2 <- c(195, 150, 240, 150, 0, 150, 150, 195)
V12 <- c(V1, V2)
uids <- unique(V12)
idx1 <- match(V1, uids)
idx2 <- match(V2, uids)
mRef <- matrix(c(R1, R2, G1, G2, B1, B2), ncol = 3)[match(uids, V12),]

mRefV1V2中的唯一ID的RGB值的矩阵。CCD_ 33矢量指向与CCD_ 35和CCD_ 36中的ID相对应的CCD_。

这里有一个快速的小Rcpp函数,用于迭代idx1idx2以更新mRef。

Rcpp::cppFunction('NumericMatrix updatecross(const IntegerVector& id1, const IntegerVector& id2, NumericMatrix attr) {
const int idrows = id1.length();
const int attrcols = attr.ncol();
double newval = 0;
for (int col = 0; col < attrcols; col++) {
for (int row = 0; row < idrows; row++) {
newval = (attr(id1(row), col) + attr(id2(row), col))/2;
attr(id1(row), col) = newval;
attr(id2(row), col) = newval;
}
}
return attr;
}')

更新mRef并使用idx向量构建最终的data.frame

mRef <- updatecross(idx1 - 1L, idx2 - 1L, mRef)
cross <- cbind(data.frame(V1, V2),
setNames(cbind(as.data.frame(mRef[idx1,]),
as.data.frame(mRef[idx2,])),
c("R1", "G1", "B1", "R2", "G2", "B2")))
cross
#>   V1 V2       R1      G1       B1       R2      G2       B2
#> 1  A  B 104.0625 66.5625 154.6875  90.0000 78.7500 144.3750
#> 2  B  E  90.0000 78.7500 144.3750 104.0625 66.5625 154.6875
#> 3  C  A 127.5000 52.5000 146.2500 104.0625 66.5625 154.6875
#> 4  D  G  90.0000 78.7500 144.3750  99.3750 76.8750 125.6250
#> 5  B  C  90.0000 78.7500 144.3750 127.5000 52.5000 146.2500
#> 6  A  G 104.0625 66.5625 154.6875  99.3750 76.8750 125.6250
#> 7  A  E 104.0625 66.5625 154.6875 104.0625 66.5625 154.6875
#> 8  D  B  90.0000 78.7500 144.3750  90.0000 78.7500 144.3750

D和B在任何地方都是一样的,因为它们是最后更新的。类似地,A和E在任何地方都是相同的,因为在第7行之后都没有更新。

使用igraph(不确定是否会更快(:

library(igraph)
library(purrr)
vertices <- tibble(
V = c("A", "B", "C", "D", "G", "E"),
R = c(120, 195, 135, 30, 75, 60),
G = c(0, 195, 0, 195, 15, 15),
B = c(240, 195, 0, 195, 150, 150)
)
edges <- tibble(
from = c("A", "B", "C", "D", "B",  "A", "A", "D"),
to = c("B", "E", "A", "G", "C", "G", "E", "B")
)
g <- graph_from_data_frame(edges, vertices = vertices, directed = FALSE)
for(iRow in seq_len(nrow(edges))){

v <- as.character(edges[iRow,])

values <- igraph::vertex.attributes(g, v) %>%
.[-1] %>%
map_dbl(mean) 

for(iAttr in names(values))
vertex_attr(g, iAttr, v) <- values[[iAttr]]
}
as_tibble(vertex.attributes(g))

结果:

name      R     G     B
<chr> <dbl> <dbl> <dbl>
1 A     104.   66.6  162.
2 B      90    78.8  159.
3 C     128.   52.5  146.
4 D      90    78.8  159.
5 G      99.4  76.9  141.
6 E     104.   66.6  162.

我不确定这个过程代表什么,最终结果取决于您的数据所描述的合并顺序。你能分享一下你最初的问题吗?这个问题就是从这个问题衍生出来的?

最新更新