如何确定R中6D矩阵的帕累托最优解？-解网

问：

我在 R 中有一个矩阵，其中包含 128 行（场景）和 6 列（每个场景的结果）。我想确定 128 种可能性中的帕累托最优方案。第 1、5 和 6 列的结果应该较低。第 2、3 和 4 列的结果应该很高。我对普通量表的结果进行了归一化。result_matrix 是模拟 reuslt 的矩阵。我尝试了这段代码：

# Example matrix with values between 0 and 1 (not the simulated results I am analysing)
num_rows <- 128
num_cols <- 6

results_matrix <- matrix(runif(num_rows * num_cols), nrow = num_rows, ncol = num_cols)

# Initialize pareto as all points
pareto <- 1:nrow(results_matrix)

# Loop through the points and check for dominance
for (i in 1:nrow(results_matrix)) {
  for (n in 1:nrow(results_matrix)) {
    if (i != n) {
      # Check for dominance
      if (all(results_matrix[i, c(2,3,4)] >= results_matrix[n, c(2,3,4)]) &&
          all(results_matrix[i, c(1,5,6)] <= results_matrix[n, c(1,5,6)])) {
            pareto[i] <- NA
            break  # Break the inner loop when dominance is found
          }
    }
  }
}

# Print the indices of points on the Pareto front
print(pareto)

输出将是一个带有帕累托 otimum 指数的向量。然而，结果并不合理。例如，一个帕累托选项在第一列中具有最高值，尽管该值应该很低。

如果我应用该包，我会得到每列具有最大值或最小值的帕累托解，但我也想要帕累托前面的解：rPref

p <- low(column1, results_df)*high(results_df$column2)* high(results_df$column3)*high(results_df$column4)*    low(results_df$column5)*low(results_df$column6)

peval(p)

R 帕累托最优

pareto1 <- function(m) {
  pareto <- 1:nrow(results_matrix)
  
  # Loop through the points and check for dominance
  for (i in 1:nrow(m)) {
    for (n in 1:nrow(m)) {
      if (i != n) {
        # Check for dominance
        if (all(m[i, c(2,3,4)] <= m[n, c(2,3,4)]) &&
            all(m[i, c(1,5,6)] >= m[n, c(1,5,6)])) {
          pareto[i] <- NA
          break  # Break the inner loop when dominance is found
        }
      }
    }
  }
  
  pareto[!is.na(pareto)]
}

我们还可以通过翻转第 1、5 和 6 列的符号来简化事情。这将使我们能够一次比较整行。

pareto2 <- function(m) {
  m[,c(1, 5:6)] <- -m[,c(1, 5:6)]
  pareto <- 1:nrow(m)
  
  for (i in 1:nrow(m)) {
    for (j in (1:nrow(m))[-i]) {
      if (all(m[j,] >= m[i,])) {
        pareto[i] <- NA
        break
      }
    }
  }
  
  pareto[!is.na(pareto)]
}

或者完全矢量化的版本：

pareto3 <- function(m) {
  m[,c(1, 5:6)] <- -m[,c(1, 5:6)]
  n <- nrow(m)
  (1:n)[-which(rowSums(m[sequence(rep(n, n - 1L), 1:n)%%n + 1L,] >= m[rep(1:n, each = n - 1L),]) == ncol(m))%/%(n - 1L)]
}

计时（并检查结果是否等同于）：microbenchmarkcheck = "equal"

num_rows <- 128
num_cols <- 6
results_matrix <- matrix(runif(num_rows*num_cols), num_rows, num_cols)

microbenchmark::microbenchmark(
  pareto1 = pareto1(results_matrix),
  pareto2 = pareto2(results_matrix),
  pareto3 = pareto3(results_matrix),
  check = "equal"
)
#> Unit: microseconds
#>     expr     min       lq      mean   median       uq     max neval
#>  pareto1 13488.8 14570.55 16589.462 15147.45 16160.35 32005.4   100
#>  pareto2  9216.1  9965.85 11997.814 10694.85 12443.45 24896.5   100
#>  pareto3   779.3   854.30  1129.401  1071.30  1286.90  2413.1   100

上一个：R PROMETHEE 包：“列处的数据集不是数字：1”

下一个：如何在 pandas 数据帧中找到帕累托最优解

如何确定R中6D矩阵的帕累托最优解？

how to determine the pareto optimum solutions of a 6D matrix in R?

评论