Pareto optimization - non-dominated points

Question

I wrote an algorithm that returns a list similar to that which nsga2 returns. (nsga2 of package \"mco\" (pdf))

The algorithm can not itself recognize if a point is

Answer 1

This is a late answer but it may be useful for future visitors.

After testing your answer code more carefully with different input data, I realized that it may not work well in some situations.

Take a look at this example. The input data is here.

Results using your code (adapted):

urlfile<-'https://raw.githubusercontent.com/allanvc/pareto_non_dominated_points-test/master/data_example.txt'
dt<-read.table(urlfile, header=TRUE)

from = 1:nrow(dt)
d <- as.data.frame(cbind(dt, from))
D = d[order(d$x, d$y), ]
nondom = D[which(!duplicated(cummin(d$y))), ]

plot(d[,c(1,2)])
points(nondom, col='red')

We can see clearly that your algorithm was not able to find correctly the non-dominated points. The purple point at the bottom left (near the origin) was one of them for instance.

After seeking for an alternative and fast solution, I've found two packages that do the job: "ecr" and "emoa". Actually emoa loads ecr inside.

with ecr:

# ecr alternative:
library(ecr)
nondom_ecr <- dt[which.nondominated(t(dt)),]

plot(dt)
points(nondom_ecr, col='red')

with emoa:

library(emoa)
nondom_emoa <- nondominated_points(t(as.matrix(dt)))

plot(dt)
points(t(nondom_emoa), col='green')

Note:

In both cases we have to pass our data matrix as a "long format" to functions. So we simple transpose it with t().

More information about these packages you'll find at:

1. https://www.rdocumentation.org/packages/ecr/versions/2.1.0/

2. http://r.adu.org.za/web/packages/emoa/emoa.pdf

Session Info:

R version 3.4.4 (2018-03-15)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Linux Mint 18.3

Matrix products: default
BLAS: /usr/lib/libblas/libblas.so.3.6.0
LAPACK: /usr/lib/lapack/liblapack.so.3.6.0

locale:
 [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C               LC_TIME=en_US.UTF-8        LC_COLLATE=en_US.UTF-8    
 [5] LC_MONETARY=pt_BR.UTF-8    LC_MESSAGES=en_US.UTF-8    LC_PAPER=pt_BR.UTF-8       LC_NAME=C                 
 [9] LC_ADDRESS=C               LC_TELEPHONE=C             LC_MEASUREMENT=pt_BR.UTF-8 LC_IDENTIFICATION=C       

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] emoa_0.5-0          ecr_2.1.0           smoof_1.5.1         checkmate_1.8.5     ParamHelpers_1.10   BBmisc_1.11        
 [7] magrittr_1.5        ggplot2_2.2.1       RcppMLPACK_1.0.10-6 Rcpp_0.12.16       

loaded via a namespace (and not attached):
 [1] parallelMap_1.3     pillar_1.1.0        compiler_3.4.4      RColorBrewer_1.1-2  plyr_1.8.4          bindr_0.1          
 [7] tools_3.4.4         digest_0.6.14       viridisLite_0.2.0   jsonlite_1.5        tibble_1.4.2        gtable_0.2.0       
[13] pkgconfig_2.0.1     rlang_0.1.6         parallel_3.4.4      yaml_2.1.16         bindrcpp_0.2        stringr_1.2.0      
[19] dplyr_0.7.4         httr_1.3.1          htmlwidgets_1.0     plot3D_1.1.1        grid_3.4.4          glue_1.2.0         
[25] data.table_1.10.4-3 R6_2.2.2            plotly_4.7.1        mco_1.0-15.1        RJSONIO_1.3-0       reshape2_1.4.3     
[31] tidyr_0.7.2         purrr_0.2.4         backports_1.1.2     scales_0.5.0        htmltools_0.3.6     assertthat_0.2.0   
[37] misc3d_0.8-4        colorspace_1.3-2    labeling_0.3        stringi_1.1.6       lazyeval_0.2.1      munsell_0.4.3

Answer 2

Found the answer myself. (No one answering for more than 2 days seems somewhat of a motivation)

For visualization this example shows how you would retain the color of points when you implement non-dominated-calculation, obviously you can also store their search-space coordinates in multiple columns instead. (note: this example is specialized on 2 objectives but that can be generalized)

x = runif(20)
y = runif(20)
from = 1:20
d = data.frame(x, y, from)
d
D = d[order(d$x, d$y), ]
nondom = D[which(!duplicated(cummin(D$y))), ]
nondom
plot(d[,1:2], col=d$from, xlim=c(0,1), ylim=c(0,1))
plot(nondom[,1:2], col=nondom$from, xlim=c(0,1), ylim=c(0,1))