快速计算R中的Pareto前沿

时间:2014-01-22 21:56:17

标签: r performance if-statement

所以我试图计算R中的帕累托前线(http://en.wikipedia.org/wiki/Pareto_efficiency)并且能够做到,但是,我无法有效地做到这一点。特别是随着点对的数量增加,计算速度显着降低。

所以一般来说,我想做的是检查所有非支配(或支配)对。现在,我这样做的方法是找到所有这样的点,使 x i > X  和 y i > Y 其中(x i ,y i 是一对, X Y 表示所有点 x y 。现在,这部分工作非常快并且易于实现,但是,多个 x 值可能相同,但它们将具有不同的 y 值,因此在这种情况下,我希望能够识别具有最低 y 值的 x 值(对于具有相同 y 的点,反之亦然值但不同的 x 值。)

这里要说明的是维基百科的图片:

enter image description here

所以基本上我希望能够识别出红线上的所有点。

这是我的代码,它可以正常工作,但对于大型数据集效率非常低:

#Example Data that actually runs quickly
x = runif(10000)
y = runif(10000)

pareto = 1:length(x)

for(i in 1:length(x)){
    cond1 = y[i]!=min(y[which(x==x[i])])
    cond2 = x[i]!=min(x[which(y==y[i])])
    for(n in 1:length(x)){
        if((x[i]>x[n]  &  y[i]>y[n]) | (x[i]==x[n] & cond1) | (y[i]==y[n] & cond2)){
            pareto[i] = NA
            break
        }
    }
}
#All points not on the red line should be marks as NA in the pareto variable

减速肯定来自于计算(x[i]==x[n] & cond1) | (y[i]==y[n] & cond2)的点,但是我找不到绕过它的方法或更好的布尔表达式来捕捉我想要的所有东西。任何建议都非常感谢!

2 个答案:

答案 0 :(得分:6)

关注@BrodieG

system.time( {
    d = data.frame(x,y)
    D = d[order(d$x,d$y,decreasing=FALSE),]
    front = D[which(!duplicated(cummin(D$y))),]
} )

   user  system elapsed 
   0.02    0.00    0.02 

这是0.86 / 0.02 =快43倍!

答案 1 :(得分:3)

编辑:新版本:

system.time( {
  pareto.2 <- logical(length(x))
  x.sort <- sort(x)
  y.sort <- y[order(x)]
  y.min <- max(y)
  for(i in 1:length(x.sort)) {
    if(pareto.2[i] <- y.sort[i] <= y.min) y.min <- y.sort[i]
  }    
} )
# user  system elapsed 
# 0.036   0.000   0.035 

OLD VERSION:

这比我的系统快6倍。使用更好的算法以及Rcpp可能会做得更好,但这很简单。这里的诀窍是按x排序,然后允许您限制检查以确保x的所有先前值必须具有更大的y值以确保该点已开启边疆。

system.time( {
  pareto.2 <- logical(length(x))
  x.sort <- sort(x)
  y.sort <- y[order(x)]
  for(i in 1:length(x.sort)) {
    pareto.2[i] <- all(y.sort[1:i] >= y.sort[i])
  }    
} )
# user  system elapsed 
# 0.86    0.00    0.88          

原文:

pareto = 1:length(x)
system.time(
  for(i in 1:length(x)){
    cond1 = y[i]!= min(y[which(x==x[i])])
    cond2 = x[i]!= min(x[which(y==y[i])])
    for(n in 1:length(x)){
      if((x[i]>x[n]  &  y[i]>y[n]) | (x[i]==x[n] & cond1) | (y[i]==y[n] & cond2)){
        pareto[i] = NA
        break
      }
    }
  }  
)
# user  system elapsed 
# 5.32    0.00    5.33          

显示这两个方法会产生相同的结果(有点棘手,因为我需要将pareto.2重新排序为x的原始顺序):

all.equal(pareto.2[match(1:length(x), order(x))], !is.na(pareto))
# [1] TRUE