R:找到最佳子矩阵

时间:2016-11-13 10:03:04

标签: r matrix optimization sequential

我有一个大的对称矩阵,想要将它减少到更小的矩阵matrix_small with rows(matrix_small)= n。 matrix_small的平均值应该最大化。 有没有办法在R中使用比我已有的算法更好的算法来实现这个目标?更好的是使用相同的均值更快或更高的平均值和相同的速度。

我觉得应该有一种更聪明的方式,而不是经常搜索min。但我不知道如何为R中的Matrix设置类似SQL的索引来提高性能。

library(microbenchmark)
set.seed(2016)
sym_matrix <- matrix(runif(1e+06), ncol = 1000)
sym_matrix[lower.tri(sym_matrix)] <- t(sym_matrix)[lower.tri(sym_matrix)]
diag(sym_matrix) <- NA

rownames(sym_matrix) <- 1:1000
colnames(sym_matrix) <- 1:1000

findNrows <- function(sym_matrix, nrows){
# Return a matrix with rows(matrix) = nrows.
# mean(matrix) should be maximized 
  set.seed(2017)
  k <- nrow(sym_matrix)
  for (i in nrows:(k-1)) { #eliminate rows with minimum values
    min_rows <- arrayInd(which.min(sym_matrix), dim(sym_matrix))
    choose_row <- sample(min_rows, 1)
    sym_matrix <- sym_matrix[-choose_row, -choose_row]
  }
  sym_matrix
}

microbenchmark(findNrows(sym_matrix = sym_matrix, nrows = 10), times = 25L) 
mean(findNrows(sym_matrix = sym_matrix, nrows = 10), na.rm = TRUE)

1 个答案:

答案 0 :(得分:0)

问题在于从对称矩阵中找到最佳nrows行(以及同样的列),该矩阵最大化所选子矩阵中元素的总和。与2D中的所谓maximum subarray problem不同,其中有一个使用Kadane算法的解决方案,这里的关键问题是所选行不需要是连续的。结果,这个问题似乎是一个更加困难的组合优化。从nrows行(此处为1000)中搜索N行(此处为10)的所有组合的强力方法显然是不切实际的。然而,一种与OP算法不同的非常简单的方法是在所有组合的空间中简单地进行随机搜索,其中我们在每次试验中从对称矩阵中随机选择nrows行(以及同样的列)并在连续试验中保留最佳nrows行:

findNrows.random <- function(sym_matrix, nrows, ntrials){
  set.seed(2017)
  s.rows <- sample.int(nrow(sym_matrix),nrows)
  s <- sym_matrix[s.rows,s.rows]
  for (i in 1:ntrials) {
    t.rows <- sample.int(nrow(sym_matrix),nrows)
    t <- sym_matrix[t.rows,t.rows]
    if (sum(s,na.rm=TRUE) < sum(t,na.rm=TRUE)) {
      s.rows <- t.rows
      s <- t
    }
  }
  return(s)
}

这个算法在R中实现,对于大量的试验来说速度很快,而且对于1000次试验,它产生的结果(对于这个特定的数据集和种子)令人惊讶地与OP相当。结果但大约快500倍。这更倾向于OP算法的次优性而不是随机搜索的最优性,因为1000样本是整个搜索空间的一小部分。另外,通过构造,随着试验次数的增加,所选子矩阵的平均值的性能保证会增加。因此,对于相同的计算时间,简单的随机搜索将优于OP的算法。

## OP results
microbenchmark(findNrows(sym_matrix = sym_matrix, nrows = 10), times = 2L)
##Unit: seconds
##                                           expr      min       lq     mean  median       uq      max neval
## findNrows(sym_matrix = sym_matrix, nrows = 10) 11.67548 11.69193 11.70937 11.6997 11.71076 11.87105    25
mean(findNrows(sym_matrix = sym_matrix, nrows = 10), na.rm = TRUE)
##[1] 0.6256406

## Random search
microbenchmark(findNrows.random(sym_matrix = sym_matrix, nrows = 10, ntrials=1000), times = 25L)
##Unit: milliseconds
##                                                                  expr      min       lq     mean   median       uq      max neval
## findNrows.random(sym_matrix = sym_matrix, nrows = 10, ntrials = 1000) 21.81462 23.20069 27.06079 23.89368 26.25163 46.77016    25
mean(findNrows.random(sym_matrix = sym_matrix, nrows = 10, ntrials=1000), na.rm = TRUE)
##[1] 0.6374652

现在,如果下一组有更大的总和,我们可以通过尝试改进之前的一组选定行来寻求提高此随机搜索的性能,而不是丢弃前一组选定的nrows行使用新的选定行集。我们使用的heurestic是生成的子矩阵的rowSum。也就是说,在每次试验中,我们寻求用新选择的子矩阵中具有较大rowSum s(或等效较大rowMean s)的行替换当前子矩阵中的行。这似乎是合理的,因为值在全矩阵中均匀分布,因为具有较高rowMean的所选子矩阵中的行平均在整行上具有较高值的​​元素。当然,在用新选择的子矩阵中的行替换当前子矩阵中的行(如果有的话)以形成新的子矩阵之后,我们仍然检查这个新的子矩阵是否更好(即,在替换当前最佳子矩阵用于下一次试验之前,比当前子矩阵更大的总和。代码如下:

findNrows.faster <- function(sym_matrix, nrows, ntrials){
  set.seed(2017)
  s.rows <- sample.int(nrow(sym_matrix),nrows)
  s.means <- rowSums(sym_matrix[s.rows,s.rows],na.rm=TRUE)
  for (i in 1:ntrials) {
    t.rows <- sample.int(nrow(sym_matrix),nrows)
    t.means <- rowSums(sym_matrix[t.rows,t.rows],na.rm=TRUE)
    st.rows <- c(s.rows,t.rows)
    st.means <- c(s.means,t.means)
    ## need to make sure we do not have duplicates before we choose the best nrows
    dups <- duplicated(st.rows)
    st.rows <- st.rows[!dups]
    st.means <- st.means[!dups]
    new.rows <- st.rows[order(st.means,decreasing=TRUE)[1:nrows]]
    new.means <- rowSums(sym_matrix[new.rows,new.rows],na.rm=TRUE)
    if (sum(s.means) < sum(new.means)) {
      s.rows <- new.rows
      s.means <- new.means
    }
  }
  sym_matrix[s.rows,s.rows]
}

此算法较慢,但结果明显优于普通随机搜索。请注意,性能与findNrows.random的比较是苹果到苹果,因为使用相同数量的试验相同的种子用于随机选择相同的行对于每个试验。但请注意,我们希望最优算法选择一个平均值远远超过0.9的子矩阵,因此该算法远非最优。

## Improved random search
microbenchmark(findNrows.faster(sym_matrix = sym_matrix, nrows = 10, ntrials=1000), times = 25L)
##Unit: milliseconds
##                                                                  expr      min       lq     mean   median       uq      max neval
## findNrows.faster(sym_matrix = sym_matrix, nrows = 10, ntrials = 1000) 135.0531 136.3961 137.1123 136.7667 137.0439 143.0155    25
mean(findNrows.faster(sym_matrix = sym_matrix, nrows = 10, ntrials=1000), na.rm = TRUE)
##[1] 0.7797313