编辑：解决方案基准

Question

我有一个包含三列的矩阵（例如），例如：

M0 <- rbind(
  c(1, 2, 3),
  c(4, 5, 6)
)

我想生成矩阵每一行符号的所有变化。所需的输出是：

      [,1] [,2] [,3]
 [1,]   -1   -2   -3
 [2,]    1   -2   -3
 [3,]   -1    2   -3
 [4,]    1    2   -3
 [5,]   -1   -2    3
 [6,]    1   -2    3
 [7,]   -1    2    3
 [8,]    1    2    3
 [9,]   -4   -5   -6
[10,]    4   -5   -6
[11,]   -4    5   -6
[12,]    4    5   -6
[13,]   -4   -5    6
[14,]    4   -5    6
[15,]   -4    5    6
[16,]    4    5    6

这是我的解决方法：

signs <- as.matrix(expand.grid(c(-1,1),c(-1,1),c(-1,1)))

M1 <- vapply(1:nrow(M0), 
             function(i) t(signs %*% diag(M0[i,])),
             array(0, dim = c(3,8)))

t(array(M1, dim = c(3, 8*dim(M1)[3])))
#       [,1] [,2] [,3]
#  [1,]   -1   -2   -3
#  [2,]    1   -2   -3
#  [3,]   -1    2   -3
#  [4,]    1    2   -3
#  [5,]   -1   -2    3
#  [6,]    1   -2    3
#  [7,]   -1    2    3
#  [8,]    1    2    3
#  [9,]   -4   -5   -6
# [10,]    4   -5   -6
# [11,]   -4    5   -6
# [12,]    4    5   -6
# [13,]   -4   -5    6
# [14,]    4   -5    6
# [15,]   -4    5    6
# [16,]    4    5    6

您有更优雅的解决方案吗？

此外，此解决方案有一个警告：如果源矩阵的一行中有一些零，则此解决方案会生成一些重复项（因为-0 = 0）。我用mgcv::uniqueCombs删除了它们。您是否有一种解决方案，在不使用“ unique”函数的情况下，如果存在零，则不会生成某些重复项？

编辑：解决方案基准

让我们比较三种给定解决方案的性能。

# @Aurèle
changesOfSign1 <- function(M){
  signs <- as.matrix(expand.grid(rep(list(c(1, -1)), ncol(M))))
  out <- matrix(c(apply(M, 1, `*`, c(t(signs)))), ncol = ncol(M), byrow = TRUE)
  out[!duplicated(out),]
}

# @989
changesOfSign2 <- function(M){
  signs <- as.matrix(expand.grid(rep(list(c(1, -1)), ncol(M))))
  # signs for each row in the resultant matrix
  m1 <- signs[rep(1:nrow(signs), times = nrow(M)), ] 
  # values for each row in the resultant matrix
  m2 <- M[rep(1:nrow(M), each = nrow(signs)), ] 
  #
  res <- m1*m2
  res[!duplicated(res), ]
}

# @DS_UNI
changesOfSign3 <- function(M){
  as.matrix(do.call(rbind, apply(M, 1, function(row){
    expand.grid(lapply(row, function(x) if(x==0) 0 else c(-x,x)))
  })))
}

# benchmark ####
library(microbenchmark)

benchmark <- function(nrows, ncols){
  M0 <- matrix(rpois(nrows*ncols, 3), nrow = nrows, ncol = ncols)
  microbenchmark(
    changesOfSign1 = changesOfSign1(M0),
    changesOfSign2 = changesOfSign2(M0),
    changesOfSign3 = changesOfSign3(M0), 
    times = 1000
  )
}

benchmark(nrows = 20, ncols = 3)
# Unit: microseconds
#           expr      min        lq      mean   median       uq       max neval cld
# changesOfSign1  493.990  542.4075  639.2895  577.884  642.589  7912.316  1000  a 
# changesOfSign2  475.248  522.7730  618.2550  554.232  608.005  7346.927  1000  a 
# changesOfSign3 3506.123 3757.8030 4380.9164 3928.491 4464.204 22603.045  1000   b

benchmark(nrows = 20, ncols = 10)
# Unit: milliseconds
#           expr      min       lq     mean   median       uq      max neval cld
# changesOfSign1 30.09545 35.95840 46.39465 41.37086 49.56855 344.2176  1000  b 
# changesOfSign2 41.20642 47.99532 58.59760 52.83705 60.85200 349.4958  1000   c
# changesOfSign3 13.56397 15.21439 21.34205 18.21113 22.34445 319.3990  1000 a

@Aurèle和@ 989当有3列时获胜。如果有10列，则@DS_UNI获胜。

我们可以使用data.table来改进@DS_UNI的解决方案：

# @DS_UNI with data.table
library(data.table)
changesOfSign4 <- function(M){
  as.matrix(rbindlist(apply(M, 1, function(row){
    do.call(function(...) CJ(..., sorted = FALSE), 
            lapply(row, function(x) if(x==0) 0 else c(-x,x)))
  })))
}

Answer 1

matrix(c(apply(M0, 1, `*`, c(t(signs)))), ncol = ncol(M0), byrow = TRUE)

没有关于优雅的要求：）

Answer 2

如何？

M0 <- rbind(
  c(1, 2, 3),
  c(4, 5, 6)
)

signs <- expand.grid(rep(list(c(1, -1)), ncol(M0)))

do.call(rbind, apply(M0, FUN = `*`, signs, MARGIN = 1))

编辑： 好的，我放弃了优雅，我更喜欢@Aurèle的单线解决方案，但是我正在编辑答案以至少获得所需的输出，并且从正面看，它与零：P

一起使用

my_fun <- function(row){
  expand.grid(
    lapply(row, 
           function(x) {
             if(x != -x)
               return(c(x, -x))
             else
               return(x)}))}

do.call(rbind, apply(M0, FUN = my_fun, MARGIN = 1))

Answer 3

我怀疑这是快速的（无循环）：

signs <- as.matrix(expand.grid(c(-1,1),c(-1,1),c(-1,1)))

# signs for each row in the resultant matrix
m1 <- signs[ rep( 1:nrow(signs), times = nrow(M0) ), ] 

# values for each row in the resultant matrix
m2 <- M0[ rep( 1:nrow(M0), each = nrow(signs) ), ] 

res <- m1*m2

      # Var1 Var2 Var3
 # [1,]   -1   -2   -3
 # [2,]    1   -2   -3
 # [3,]   -1    2   -3
 # [4,]    1    2   -3
 # [5,]   -1   -2    3
 # [6,]    1   -2    3
 # [7,]   -1    2    3
 # [8,]    1    2    3
 # [9,]   -4   -5   -6
# [10,]    4   -5   -6
# [11,]   -4    5   -6
# [12,]    4    5   -6
# [13,]   -4   -5    6
# [14,]    4   -5    6
# [15,]   -4    5    6
# [16,]    4    5    6

要处理由零引起的重复行：

res[ !duplicated(res), ]

Answer 4

高，足够优雅了：）

x <- 1:3

signs <- as.matrix(expand.grid(x = c(-1,1), y = c(-1, 1), z = c(-1, 1)))

    t(x * t(signs))
      x  y  z
[1,] -1 -2 -3
[2,]  1 -2 -3
[3,] -1  2 -3
[4,]  1  2 -3
[5,] -1 -2  3
[6,]  1 -2  3
[7,] -1  2  3
[8,]  1  2  3

矩阵行符号的变化

编辑：解决方案基准

4 个答案: