Изменения знака строк матрицы

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 столбцов.@DS_UNI выигрывает при наличии 10 столбцов.

Мы можем улучшить решение @ DS_UNI с помощью data.table:

# @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

Я подозреваю, что это быстро (без цикла):

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 3

Как насчет этого:

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))

EDIT: Хорошо, я отказался от элегантности и предпочитаю однострочное решение @ 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 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