首页
学习
活动
专区
圈层
工具
发布
社区首页 >问答首页 >如何识别两个向量中的多对相同对

如何识别两个向量中的多对相同对
EN

Stack Overflow用户
提问于 2011-02-15 21:20:57
回答 4查看 766关注 0票数 1

在我的图论中(如图论中,由边连接的节点),我有一个向量表示每个边的原点from,一个向量表示每个边的目的to节点,还有一个向量表示每个边缘curve的曲线。

默认情况下,如果两个节点之间只有一条边,则希望边的曲线为0,如果两个节点之间有两条边,则曲线为0.2。我现在使用的代码是for-循环,它有点慢:

代码语言:javascript
复制
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中的一个),如果fromto中有使用相同节点(数字)的其他对的话。

我要找的是两件事:

  1. --识别在它们之间是否有两条边的节点的一种方法(因此如果不是,我可以省略循环)
  2. --加速这个循环的方法--

编辑:

为了更清楚地说明这一点,另一个例子:

代码语言:javascript
复制
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

在这两个向量中,对3与对10 (以不同顺序排列的1和7)是相同的,对4和12是相同的(2和8)。所以我希望curve成为:

代码语言:javascript
复制
 [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

(作为向量,我转了两次以得到行号)。

解决方案

代码语言:javascript
复制
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)

基准解决方案

以下是一些不同解决方案的基准测试

代码语言:javascript
复制
> # for-loop
> system.time(
+ {
+ curve <- rep(0,5)
+     for (i in 1:length(from))
+     {
+         if (any(from==to[i] & to==from[i]))
+         {
+             curve[i]=0.2        
+ 
+         }
+     }
+ })
   user  system elapsed 
 171.49    0.05  171.98 

from <- sample(1:1000,100000,T)
> to <- sample(1:1000,100000,T)
> 
> # My solution:
> system.time(
+ {
+ srt <- apply(cbind(from,to),1,sort)
+ dub <- duplicated(t(srt))|duplicated(t(srt),fromLast=T)
+ curve <- ifelse(dub,0.2,0)
+ })
   user  system elapsed 
  16.92    0.00   16.94 
> 
> 
> # Marek 1:
> system.time(
+ {
+ srt <- cbind(pmin(from,to), pmax(from,to) )
+ dub <- duplicated(srt)|duplicated(srt,fromLast=T)
+ curve <- ifelse(dub,0.2,0)
+ })
   user  system elapsed 
   2.43    0.00    2.43 
> 
> # Marek 2:
> system.time(
+ {
+ srt <- cbind(ifelse(from>to,to,from),ifelse(from>to,from,to))
+ dub <- duplicated(srt)|duplicated(srt,fromLast=T)
+ curve <- ifelse(dub,0.2,0)
+ })
   user  system elapsed 
   2.67    0.00    2.70 
> 
> # Maiasaura:
> library(plyr)
> 
> system.time(
+ {
+ 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
+ result=data.frame(from,to,curve=result$value)
+ })
   user  system elapsed 
 103.43    0.11  103.95

> # Marek 1 + Joshua
> > system.time(
> + {
> + srt <- cbind(pmin(from,to), pmax(from,to) )
> + curve <- ifelse(ave(srt[,1], srt[,1], srt[,2], FUN=length) > 1,
> 0.2, 0)
> + })    user  system elapsed 
>    7.26    0.00    7.25

它提供了最快的解决方案是:

代码语言:javascript
复制
srt <- cbind(pmin(from,to), pmax(from,to) )
dub <- duplicated(srt)|duplicated(srt,fromLast=T)
curve <- ifelse(dub,0.2,0)
EN

回答 4

Stack Overflow用户

回答已采纳

发布于 2011-02-16 00:58:04

下面是使用plyr的解决方案

我首先将fromto合并成一个data.frame

代码语言:javascript
复制
library(plyr)
data=data.frame(cbind(id=1:length(from),from,to))

数据

代码语言:javascript
复制
  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

然后,以下内容将产生您所寻求的结果:

代码语言:javascript
复制
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)

应产生:

代码语言:javascript
复制
   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

可以将上述代码转换为函数。

代码语言:javascript
复制
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)
}

就这么做

代码语言:javascript
复制
curve=calculate_curve(from,to)
票数 2
EN

Stack Overflow用户

发布于 2011-02-15 21:26:41

使用outer怎么样?

代码语言:javascript
复制
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)
票数 2
EN

Stack Overflow用户

发布于 2011-02-15 22:35:28

改变

代码语言:javascript
复制
any(from==to[i] & to==from[i])

代码语言:javascript
复制
any(from==to[i]) && any(to==from[i])

可以节省不少时间。在您的示例中,如果fromto被复制了5000次,计算时间将减少1/3。

当使用&&时,如果第一个条件是FALSE R,则不需要计算第二个表达式。

票数 2
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/5009632

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档