multiple objective pareto front

# multiple objective pareto front
MPF <- function(P){
  i = 1; n = dim(P)[1]; N = dim(P)[2]
  if(length(rownames(P))==0) rownames(P) = 1:dim(P)[1]
  P = as.matrix(na.omit(unique(P)))
  P = P[eval(parse(text = paste0("order(", paste0("P[,", 1:ncol(P), "]", collapse=","), ",decreasing=T)"))),]
  while(n > i){
    x = matrix(NA, nrow=n, ncol=N); y = logical(n); m = rownames(P)
    for(j in 1:N){x[,j] = P[i,j] > P[,j]} # do not delete itself
    for(s in 1:n) y[s] = all(x[s,])
    P[y,] <- NA; P = na.omit(P); na = na.action(P); r = rownames(P)
    # cat(dim(P)[1], i,"\n");
    if(m[i] %in% r) {
      i = match(m[i], r)+1
    } else {
      if(dim(P)[1] == n)
        i = n
      else {
        i = match(m[min((c(1:n)[-na])[i < c(1:n)[-na]], na.rm=T)], r)
      }
    }
    n = dim(P)[1]
  }
  return(as.integer(rownames(as.matrix(P))))
}

MPF2 <- function(P){
  order_i <- 1:nrow(P)
  order_rows <- eval(parse(text = paste0("order(", paste0("P[,", 1:ncol(P), "]", collapse=","), ",decreasing=T)")))
  P <- P[order_rows, ]
  order_i <- order_i[order_rows]
  idx <- !duplicated(P)
  P <- P[idx, ]
  order_i <- order_i[idx]
  i <- 1
  while (TRUE) {
    tmp <- order_i[i]
    idx <- rowSums(sweep(P, 2, P[i, ], ">=")) > 0
    order_i <- order_i[idx]
    P <- P[idx, ]
    # cat(i, length(order_i), "\n")
    i <- match(tmp, order_i) + 1
    if (i > length(order_i))
      break
  }
  return(order_i)
}

library(compiler)
MPF_cmp <- cmpfun(MPF)
MPF2_cmp <- cmpfun(MPF2)
numRows <- 1e4
numCols <- 6
P <- matrix(rnorm(numRows * numCols), numRows)
all.equal(MPF(P), MPF2(P)) # TRUE
all.equal(MPF_cmp(P), MPF2_cmp(P)) # TRUE

library(Rcpp)
library(RcppArmadillo)
sourceCpp("MPF.cpp") # find it at http://pastebin.com/WtHY0NE1
all.equal(sort(MPF2(P)), sort(MPF3(P))) # TRUE
all.equal(sort(MPF2(P)), sort(MPF3(P, FALSE))) # TRUE

library(microbenchmark)
microbenchmark(MPF(P), MPF2(P), MPF_cmp(P), MPF2_cmp(P), MPF3_para = MPF3(P),
               MPF3_nonpara = MPF3(P, FALSE), times = 20L)
# Unit: milliseconds
#         expr       min        lq      mean    median        uq       max neval
#       MPF(P) 2898.5075 2932.7963 2945.0281 2941.5603 2956.3465 2994.9500    20
#      MPF2(P)  425.7175  439.0134  448.3850  447.7643  452.4919  479.0854    20
#   MPF_cmp(P) 1606.3404 1624.9569 1644.8267 1641.9885 1666.8717 1680.6014    20
#  MPF2_cmp(P)  418.9768  439.9396  447.5985  447.3701  452.4641  493.2948    20
#    MPF3_para  571.9870  582.4695  605.7268  604.7585  627.4120  658.2572    20
# MPF3_nonpara  465.8012  466.3910  468.7969  467.8026  470.2701  474.8473    20

numRows <- 1e5
numCols <- 6
P <- matrix(rnorm(numRows * numCols), numRows)
microbenchmark(MPF2(P), MPF3_para = MPF3(P), MPF3_nonpara = MPF3(P, FALSE), times = 20L)
# Unit: seconds
#         expr      min        lq      mean    median        uq       max neval
#      MPF2(P)  4.55766  4.652819  4.683523  4.675676  4.722864  4.793978    20
#    MPF3_para 75.54325 77.565791 79.864403 79.633073 82.175211 83.923895    20
# MPF3_nonpara 78.98010 80.252929 81.062153 80.761794 82.034476 84.191405    20