在我的图形包中（如在图论中，由边连接的节点）我有一个向量，指示每个边缘的原始节点from，一个向量指示每个边缘的目标节点{{1和一个指示每条边{1}的曲线的向量。
默认情况下，如果两个节点之间只有一条边，则希望边的曲线为0;如果两个节点之间有两条边，则曲线为0.2。我现在使用的代码是for循环，它有点慢：
to所以基本上我会查找每个边缘（curve中的一个索引和curve <- rep(0,5)
from<-c(1,2,3,3,2)
to<-c(2,3,4,2,1)
for (i in 1:length(from))
{
if (any(from==to[i] & to==from[i]))
{
curve[i]=0.2
}
}
中的一个索引），如果from和to中有任何其他对使用相同的边节点（数字）。
我正在寻找的是两件事：
编辑：
为了使这个升技更清楚，另一个例子：
from在这两个向量中，对3与对10相同（1和7都以不同的顺序排列），对4和12是相同的（2和8）。所以我希望to成为：
from <- c(4L, 6L, 7L, 8L, 1L, 9L, 5L, 1L, 2L, 1L, 10L, 2L, 6L, 7L, 10L, 4L, 9L)
to <- c(1L, 1L, 1L, 2L, 3L, 3L, 4L, 5L, 6L, 7L, 7L, 8L, 8L, 8L, 8L, 10L, 10L)
cbind(from,to)
from to
[1,] 4 1
[2,] 6 1
[3,] 7 1
[4,] 8 2
[5,] 1 3
[6,] 9 3
[7,] 5 4
[8,] 1 5
[9,] 2 6
[10,] 1 7
[11,] 10 7
[12,] 2 8
[13,] 6 8
[14,] 7 8
[15,] 10 8
[16,] 4 10
[17,] 9 10
（作为矢量，我换了两次以获得行号）。
curve以下是不同解决方案的一些基准测试
[1,] 0.0
[2,] 0.0
[3,] 0.2
[4,] 0.2
[5,] 0.0
[6,] 0.0
[7,] 0.0
[8,] 0.0
[9,] 0.0
[10,] 0.2
[11,] 0.0
[12,] 0.2
[13,] 0.0
[14,] 0.0
[15,] 0.0
[16,] 0.0
[17,] 0.0
提供最快的解决方案：
from <- c(4L, 6L, 7L, 8L, 1L, 9L, 5L, 1L, 2L, 1L, 10L, 2L, 6L, 7L, 10L, 4L, 9L)
to <- c(1L, 1L, 1L, 2L, 3L, 3L, 4L, 5L, 6L, 7L, 7L, 8L, 8L, 8L, 8L, 10L, 10L)
srt <- apply(cbind(from,to),1,sort)
dub <- duplicated(t(srt))|duplicated(t(srt),fromLast=T)
curve <- ifelse(dub,0.2,0)
答案 0 :(得分：2)
如何使用outer？
from <- c(1,2,3,3,2)
to <- c(2,3,4,2,1)
out <- outer(from, to, `==`)
ifelse(rowSums(out) > 0 & colSums(out) > 0, 0.2, 0)
答案 1 :(得分：2)
更改
any(from==to[i] & to==from[i])
到
any(from==to[i]) && any(to==from[i])
可以节省相当多的时间。在您的示例中，如果from和to被复制5000次，则计算时间减少1/3。
使用&&时，如果第一个条件为FALSE，则R无需评估第二个表达式。
答案 2 :(得分：2)
如果我理解正确，您可以使用%in%：
curve[ to %in% from & from %in% to ] <- 0.2
基于您的更新的另一种解决方案：
srt <- t(apply(cbind(from,to),1,sort))
curve <- ifelse(ave(srt[,1], srt[,1], srt[,2], FUN=length) > 1, 0.2, 0)
答案 3 :(得分：2)
以下是使用plyr
我首先将from和to合并到data.frame
library(plyr)
data=data.frame(cbind(id=1:length(from),from,to))
数据
id from to
1 1 4 1
2 2 6 1
3 3 7 1
4 4 8 2
5 5 1 3
6 6 9 3
7 7 5 4
8 8 1 5
9 9 2 6
10 10 1 7
11 11 10 7
12 12 2 8
13 13 6 8
14 14 7 8
15 15 10 8
16 16 4 10
17 17 9 10
然后以下内容应该产生你想要的结果：
data=ddply(data, .(id), transform, f1=min(from,to),f2=max(from,to))
curved=data.frame(data[which(duplicated(data[,4:5])==TRUE),],value=0.2)
result=join(data[,4:5],curved[,4:6],by=intersect(names(data)[4:5],names(curved)[4:6]))
result$value[which(is.na(result$value))]=0
result=data.frame(from,to,curve=result$value)
应该产生：
from to curve
1 4 1 0.0
2 6 1 0.0
3 7 1 0.2
4 8 2 0.2
5 1 3 0.0
6 9 3 0.0
7 5 4 0.0
8 1 5 0.0
9 2 6 0.0
10 1 7 0.2
11 10 7 0.0
12 2 8 0.2
13 6 8 0.0
14 7 8 0.0
15 10 8 0.0
16 4 10 0.0
17 9 10 0.0
您可以将上述代码转换为函数
calculate_curve <- function (from,to)
{
data=data.frame(cbind(id=1:length(from),from,to))
data=ddply(data, .(id), transform, f1=min(from,to),f2=max(from,to))
curved=data.frame(data[which(duplicated(data[,4:5])==TRUE),],value=0.2)
result=join(data[,4:5],curved[,4:6],by=intersect(names(data)[4:5],names(curved)[4:6]))
result$value[which(is.na(result$value))]=0
return (result$value)
}
只是做
curve=calculate_curve(from,to)