Select n 行具有 R 中矩阵的最高组合值
Select n row have highest combined value from a matrix in R
这是一个大矩阵的一部分（尺寸约为：1'000-1'000'000 行 x 100 - 1'000 列）：
scen_1 scen_2 scen_3 scen_4 ...
...
9 3.262275 0.000000 0.00000 0.0000000 ...
10 2.843631 0.000000 1.22636 1.0559217 ...
11 0.000000 0.000000 0.00000 0.9836209 ...
12 2.572686 0.000000 0.00000 1.1000293 ...
13 0.000000 0.000000 0.00000 0.0000000 ...
14 0.611070 1.478159 0.00000 0.0000000 ...
15 0.000000 0.000000 0.00000 0.0000000 ...
16 0.000000 0.000000 0.00000 1.0146529 ...
...
现在，我想要 select n 行，其中 - 在为每列获取最大值之后 - 具有最高的总和，因此行可以很好地互补。例如。我 select 第 9 行和第 10 行得到组合（最大值）向量 3.262275 0.00000 1.22636 1.0559217，其总和为 5.5445567。而如果我 select 14 和 16 我得到 0.611070 1.478159 0.00000 1.0146529 总和 3.1038819，因此第一个选项更好。
上述示例中 n 为 3 的解决方案是第 10、14 和 9 行。我希望我能很好地解释问题。
我的方法是首先 select 具有最高行总和的行，然后是将添加最高附加值的行。但我有一种强烈的感觉，这并不总是能给出最好的解决方案。
由于矩阵的大小，计算所有可能的组合是不可行的。遗传算法是解决方案吗？或者有更简单的方法吗？
谢谢。
编辑：
为了更容易理解，这里有一个MWE：
# Create example matrix
mat <- matrix(c(1.562275, 0.000000, 0.00000, 0.0000000,2.843631, 0.000000, 1.22636, 1.0559217,0.000000, 0.000000, 0.00000, 0.9836209,1.572686, 0.000000, 0.00000, 1.8000293,0.000000, 0.000000, 0.00000, 0.0000000,1.611070, 1.478159, 0.00000, 0.0000000,0.000000, 0.000000, 0.00000, 0.0000000,0.000000, 0.000000, 0.00000, 1.0146529), byrow = TRUE, ncol = 4, dimnames = list(c(9:16), c("scen_1", "scen_2", "scen_3", "scen_4")))
# Function to evaluate each combination of rows (this value should be maximized)
get_combined_max_value_sum <- function(choosen_rows){
# Select rows
sel_mat <- mat[choosen_rows,]
# calculate columwise max
max_mat <- apply(sel_mat, 2, max)
# Sum the values
return(sum(max_mat))
}
# I am looking for the function best_rows() which returns the rows, which gives the
# maximum value (or at least a close guess) for the get_combined_max_value_sum()
# function
best_rows <- function(n_rows){
result <- vector()
# do some magic
return(result) # vector with length n_row for the "best" rows.
}
# ------------------------------------------------
# @ slamballais
# The rows with the highest rowise sum (10 & 12)
get_combined_max_value_sum(c("10","12"))
# get a lower score then row 9 and 13
get_combined_max_value_sum(c("10","14"))
更新（递归方法，次优解）
你可以定义一个递归函数f（见函数thomas2内），它可以是任意行数k（1 <= k <= nrow(mat)）
thomas2 <- function(mat, k) {
f <- function(mat, k) {
if (k == 1) {
return(which.max(rowSums(mat)))
}
p <- f(mat, k - 1)
q <- seq(nrow(mat))[-p]
rmax <- apply(mat[p, , drop = FALSE], 2, max)
c(p, q[which.max(sapply(q, function(k) sum(pmax(rmax, mat[k, ]))))])
}
row.names(mat)[sort(f(mat, k))]
}
例如
> thomas2(mat, 2)
[1] "10" "14"
> thomas2(mat, 3)
[1] "10" "12" "14"
> thomas2(mat, 4)
[1] "9" "10" "12" "14"
> thomas2(mat, 5)
[1] "9" "10" "11" "12" "14"
> thomas2(mat, 6)
[1] "9" "10" "11" "12" "13" "14"
上一个答案（蛮力方法，效率低下）
你的算法是一个贪心算法，不能始终保证全局最大值。因此，蛮力方法可能是实现目标的直接解决方法。
或许你可以试试下面的暴力破解方法
rs <- combn(nrow(mat), 3)
row.names(mat)[rs[, which.max(apply(rs, 2, function(k) sum(do.call(pmax, data.frame(t(mat[k, ]))))))]]
这给出了
[1] "10" "12" "14"
这不是最佳答案，但可能会启发其他人...
假设
- 答案有
k 行，其中 k 是由用户预先指定的。
k <= ncol(mat)
回答
某些行永远不会成为答案的一部分。我建议在应用蛮力方法之前过滤掉这些行。目前过滤条件：
- 删除总和低于最小最大列值的行
- 删除所有值都低于包含最大列值的任何行的行
代码
slam <- function(mat, k) {
cm <- apply(mat, 2, max)
rs <- apply(mat, 1, function(x) sum(x[x > 0], na.rm = TRUE))
# remove rows whose sum is lower than the lowest column max
matb <- subset(mat, rs > min(cm))
# remove rows that have only values lower than all values of the rows containing a column max
mrows <- matb[apply(matb, 2, which.max), ]
any_bigger <- apply(mrows, 1, function(x) rowSums(sweep(matb, 2, x, `-`) >= 0) > 0)
matc <- matb[apply(any_bigger, 1, all), ]
# code copied + modified from @ThomasIsCoding's answer
rs <- combn(nrow(matc), k)
row.names(matc)[rs[, which.max(apply(rs, 2, function(z) sum(do.call(pmax, data.frame(t(matc[z, ]))))))]]
}
示例 + 基准
# bigger dataset with 100 rows and negative values too
n <- 100
n2 <- 500
set.seed(2021)
mat2 <- matrix(rnorm(n * 4), ncol = 4, dimnames = list(c(1:n), c("scen_1", "scen_2", "scen_3", "scen_4")))
mat3 <- matrix(rnorm(n2 * 4), ncol = 4, dimnames = list(c(1:n2), c("scen_1", "scen_2", "scen_3", "scen_4")))
# verification
slam(mat, 3) # [1] "10" "12" "14"
thomas(mat) # [1] "10" "12" "14"
slam(mat2, 3) # [1] "25" "44" "99"
thomas(mat2) # [1] "25" "44" "99"
# benchmark (without `thomas(mat3)`, it takes too long)
microbenchmark::microbenchmark(slam(mat2, 3), thomas(mat2),
slam(mat3, 3), times = 1L)
# Unit: milliseconds
# expr min lq mean median uq max neval
# slam(mat2, 3) 249.4705 249.4705 249.4705 249.4705 249.4705 249.4705 1
# thomas(mat2) 19557.8194 19557.8194 19557.8194 19557.8194 19557.8194 19557.8194 1
# slam(mat3, 3) 16159.9113 16159.9113 16159.9113 16159.9113 16159.9113 16159.9113 1
最后的想法
还有另一种方法可以做到这一点。从包含 k 最大列值的 k 行的初始组合开始。对于这些行中的每一行，计算是否有其他行在剩余列中提供进一步的增益。如果有更好的行，请尝试将其换成初始组合。不断重复这个过程，直到选择了最好的行。我现在没有时间写，但如果明天还没有完成，我会试一试。
这是一个大矩阵的一部分（尺寸约为：1'000-1'000'000 行 x 100 - 1'000 列）：
scen_1 scen_2 scen_3 scen_4 ...
...
9 3.262275 0.000000 0.00000 0.0000000 ...
10 2.843631 0.000000 1.22636 1.0559217 ...
11 0.000000 0.000000 0.00000 0.9836209 ...
12 2.572686 0.000000 0.00000 1.1000293 ...
13 0.000000 0.000000 0.00000 0.0000000 ...
14 0.611070 1.478159 0.00000 0.0000000 ...
15 0.000000 0.000000 0.00000 0.0000000 ...
16 0.000000 0.000000 0.00000 1.0146529 ...
...
现在，我想要 select n 行，其中 - 在为每列获取最大值之后 - 具有最高的总和，因此行可以很好地互补。例如。我 select 第 9 行和第 10 行得到组合（最大值）向量 3.262275 0.00000 1.22636 1.0559217，其总和为 5.5445567。而如果我 select 14 和 16 我得到 0.611070 1.478159 0.00000 1.0146529 总和 3.1038819，因此第一个选项更好。
上述示例中 n 为 3 的解决方案是第 10、14 和 9 行。我希望我能很好地解释问题。
我的方法是首先 select 具有最高行总和的行，然后是将添加最高附加值的行。但我有一种强烈的感觉，这并不总是能给出最好的解决方案。 由于矩阵的大小，计算所有可能的组合是不可行的。遗传算法是解决方案吗？或者有更简单的方法吗？ 谢谢。
编辑：
为了更容易理解，这里有一个MWE：
# Create example matrix
mat <- matrix(c(1.562275, 0.000000, 0.00000, 0.0000000,2.843631, 0.000000, 1.22636, 1.0559217,0.000000, 0.000000, 0.00000, 0.9836209,1.572686, 0.000000, 0.00000, 1.8000293,0.000000, 0.000000, 0.00000, 0.0000000,1.611070, 1.478159, 0.00000, 0.0000000,0.000000, 0.000000, 0.00000, 0.0000000,0.000000, 0.000000, 0.00000, 1.0146529), byrow = TRUE, ncol = 4, dimnames = list(c(9:16), c("scen_1", "scen_2", "scen_3", "scen_4")))
# Function to evaluate each combination of rows (this value should be maximized)
get_combined_max_value_sum <- function(choosen_rows){
# Select rows
sel_mat <- mat[choosen_rows,]
# calculate columwise max
max_mat <- apply(sel_mat, 2, max)
# Sum the values
return(sum(max_mat))
}
# I am looking for the function best_rows() which returns the rows, which gives the
# maximum value (or at least a close guess) for the get_combined_max_value_sum()
# function
best_rows <- function(n_rows){
result <- vector()
# do some magic
return(result) # vector with length n_row for the "best" rows.
}
# ------------------------------------------------
# @ slamballais
# The rows with the highest rowise sum (10 & 12)
get_combined_max_value_sum(c("10","12"))
# get a lower score then row 9 and 13
get_combined_max_value_sum(c("10","14"))
更新（递归方法，次优解）
你可以定义一个递归函数f（见函数thomas2内），它可以是任意行数k（1 <= k <= nrow(mat)）
thomas2 <- function(mat, k) {
f <- function(mat, k) {
if (k == 1) {
return(which.max(rowSums(mat)))
}
p <- f(mat, k - 1)
q <- seq(nrow(mat))[-p]
rmax <- apply(mat[p, , drop = FALSE], 2, max)
c(p, q[which.max(sapply(q, function(k) sum(pmax(rmax, mat[k, ]))))])
}
row.names(mat)[sort(f(mat, k))]
}
例如
> thomas2(mat, 2)
[1] "10" "14"
> thomas2(mat, 3)
[1] "10" "12" "14"
> thomas2(mat, 4)
[1] "9" "10" "12" "14"
> thomas2(mat, 5)
[1] "9" "10" "11" "12" "14"
> thomas2(mat, 6)
[1] "9" "10" "11" "12" "13" "14"
上一个答案（蛮力方法，效率低下）
你的算法是一个贪心算法，不能始终保证全局最大值。因此，蛮力方法可能是实现目标的直接解决方法。
或许你可以试试下面的暴力破解方法
rs <- combn(nrow(mat), 3)
row.names(mat)[rs[, which.max(apply(rs, 2, function(k) sum(do.call(pmax, data.frame(t(mat[k, ]))))))]]
这给出了
[1] "10" "12" "14"
这不是最佳答案，但可能会启发其他人...
假设
- 答案有
k行，其中k是由用户预先指定的。 k<=ncol(mat)
回答
某些行永远不会成为答案的一部分。我建议在应用蛮力方法之前过滤掉这些行。目前过滤条件：
- 删除总和低于最小最大列值的行
- 删除所有值都低于包含最大列值的任何行的行
代码
slam <- function(mat, k) {
cm <- apply(mat, 2, max)
rs <- apply(mat, 1, function(x) sum(x[x > 0], na.rm = TRUE))
# remove rows whose sum is lower than the lowest column max
matb <- subset(mat, rs > min(cm))
# remove rows that have only values lower than all values of the rows containing a column max
mrows <- matb[apply(matb, 2, which.max), ]
any_bigger <- apply(mrows, 1, function(x) rowSums(sweep(matb, 2, x, `-`) >= 0) > 0)
matc <- matb[apply(any_bigger, 1, all), ]
# code copied + modified from @ThomasIsCoding's answer
rs <- combn(nrow(matc), k)
row.names(matc)[rs[, which.max(apply(rs, 2, function(z) sum(do.call(pmax, data.frame(t(matc[z, ]))))))]]
}
示例 + 基准
# bigger dataset with 100 rows and negative values too
n <- 100
n2 <- 500
set.seed(2021)
mat2 <- matrix(rnorm(n * 4), ncol = 4, dimnames = list(c(1:n), c("scen_1", "scen_2", "scen_3", "scen_4")))
mat3 <- matrix(rnorm(n2 * 4), ncol = 4, dimnames = list(c(1:n2), c("scen_1", "scen_2", "scen_3", "scen_4")))
# verification
slam(mat, 3) # [1] "10" "12" "14"
thomas(mat) # [1] "10" "12" "14"
slam(mat2, 3) # [1] "25" "44" "99"
thomas(mat2) # [1] "25" "44" "99"
# benchmark (without `thomas(mat3)`, it takes too long)
microbenchmark::microbenchmark(slam(mat2, 3), thomas(mat2),
slam(mat3, 3), times = 1L)
# Unit: milliseconds
# expr min lq mean median uq max neval
# slam(mat2, 3) 249.4705 249.4705 249.4705 249.4705 249.4705 249.4705 1
# thomas(mat2) 19557.8194 19557.8194 19557.8194 19557.8194 19557.8194 19557.8194 1
# slam(mat3, 3) 16159.9113 16159.9113 16159.9113 16159.9113 16159.9113 16159.9113 1
最后的想法
还有另一种方法可以做到这一点。从包含 k 最大列值的 k 行的初始组合开始。对于这些行中的每一行，计算是否有其他行在剩余列中提供进一步的增益。如果有更好的行，请尝试将其换成初始组合。不断重复这个过程，直到选择了最好的行。我现在没有时间写，但如果明天还没有完成，我会试一试。