Как изменить умножение матриц, чтобы суммировать только положительные или отрицательные значения в R

Я хочу сделать матричное умножение с изюминкой.

У меня есть эта матрица:

A <- matrix(c(1,-1,-1,0,-1,0,1,0,0,1,0,0,0,1,-1,1,-1,0,0,-1,1,0,1,0,1,-1,-1,1,-1,1), nrow = 6, ncol = 5)

A
     [,1] [,2] [,3] [,4] [,5]
[1,]    1    1    0    0    1
[2,]   -1    0    1   -1   -1
[3,]   -1    0   -1    1   -1
[4,]    0    1    1    0    1
[5,]   -1    0   -1    1   -1
[6,]    0    0    0    0    1

И я хочу получить две разные матрицы. Первая матрица такова:

C
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    0    0    0    2    0    1
[2,]    0    0    2    1    2    0
[3,]    0    2    0    0    4    0
[4,]    2    1    0    0    0    1
[5,]    0    2    4    0    0    0
[6,]    1    0    0    1    0    0

Эта «матрица сходимости» чем-то похожа на умножение A для ее транспонирования (в R это что-то вроде этого A%*%t(A)), но с небольшим поворотом, во время суммирования для получения каждой ячейки мне нужна только сумма положительных значений. Например, для ячейки C23 обычная сумма будет такой:

(-1)(-1) + (0)(0) + (1)(-1) + (-1)(1) + (-1)(-1) = 0

, но мне нужна только сумма положительных произведений, в этом примере первое [(-1)(-1)] и последнее [(-1)(-1)] для получения 2.

Вторая матрица такова:

D
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    0    2    2    0    2    0
[2,]    2    0    2    1    2    1
[3,]    2    2    0    2    0    1
[4,]    0    1    2    0    2    0
[5,]    2    2    0    2    0    1
[6,]    0    1    1    0    1    0

Эта «матрица расхождений» похожа на предыдущую, с той разницей, что я хочу суммировать только абсолютные значения отрицательных значений. Например, для ячейки D23 обычная сумма будет такой:

(-1)(-1) + (0)(0) + (1)(-1) + (-1)(1) + (-1)(-1) = 0

, но мне нужна только сумма абсолютных значений отрицательных произведений, в этом примере третий абс [(1)(-1)] и четвертый абс[(-1)(-1)] для получения 2.

Я пытался с применением, разверткой и циклами, но я не могу этого добиться. Спасибо за ваши ответы.


r matrix cross-product
person Ivan    schedule 14.04.2017    source источник
comment
Я думаю, что C неверно. Разве C[1,1] не должно быть 3?   -  person alistaire    schedule 14.04.2017
comment
Алистер, да, ты прав, но мне нужна диагональ матрицы с 0, поэтому я меняю ее только на diag(C) <- 0   -  person Ivan    schedule 15.04.2017

Ответы (3)


arrow_upward
1
arrow_downward

Еще один прием:

D <- A
D[D<0] = -1i*D[D<0]
D <- Im(tcrossprod(D))

C <- tcrossprod(A) + D

A определяется в вопросе. Выход:

> D
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    0    2    2    0    2    0
[2,]    2    0    2    1    2    1
[3,]    2    2    0    2    0    1
[4,]    0    1    2    0    2    0
[5,]    2    2    0    2    0    1
[6,]    0    1    1    0    1    0
> C
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    3    0    0    2    0    1
[2,]    0    4    2    1    2    0
[3,]    0    2    4    0    4    0
[4,]    2    1    0    3    0    1
[5,]    0    2    4    0    4    0
[6,]    1    0    0    1    0    1
person Marat Talipov    schedule 14.04.2017
comment
еще проще, D <- (tcrossprod(abs(A))-tcrossprod(A))/2; C <- tcrossprod(A) + D - person Marat Talipov; 15.04.2017

arrow_upward
1
arrow_downward

Это попытка в базе R. Таким образом, в основном вы следуете матричному подходу перекрестного произведения, но пытаетесь управлять шагом sum вручную:

f <- function(A, convergence=TRUE){
    sapply(seq_len(nrow(A)), function(i) {
        r <- t(matrix(A[i,],ncol(A),nrow(A)))*A
        if(convergence)
            r[r<0] <- 0
        else
            r[r>0] <- 0
        rowSums(abs(r))
    })
}

> f(A, convergence = TRUE)

     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    3    0    0    2    0    1
[2,]    0    4    2    1    2    0
[3,]    0    2    4    0    4    0
[4,]    2    1    0    3    0    1
[5,]    0    2    4    0    4    0
[6,]    1    0    0    1    0    1

> f(A, convergence = FALSE)

     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    0    2    2    0    2    0
[2,]    2    0    2    1    2    1
[3,]    2    2    0    2    0    1
[4,]    0    1    2    0    2    0
[5,]    2    2    0    2    0    1
[6,]    0    1    1    0    1    0
person 989    schedule 14.04.2017

arrow_upward
1
arrow_downward

Это будет значительно менее эффективно, но вы можете разбить матрицу на список векторов-строк, с которыми проще выполнять вычисления. Используя purrr, который удобен для списков,

library(purrr)

A <- matrix(c(1,-1,-1,0,-1,0,1,0,0,1,0,0,0,1,-1,1,-1,0,0,-1,1,0,1,0,1,-1,-1,1,-1,1), 
            nrow = 6, ncol = 5)

C <- seq(nrow(A)) %>%    # generate a sequence of row indices
    map(~A[.x, ]) %>%   # subset matrix into a list of rows
    cross2(., .) %>%    # do a Cartesian join to get pairs of rows
    # calculate products, then subset before summing. Simplify to vector
    map_dbl(~{ij <- .x[[1]] * .x[[2]]; sum(ij[ij >= 0])}) %>% 
    matrix(nrow(A))    # reassemble to matrix

C
#>      [,1] [,2] [,3] [,4] [,5] [,6]
#> [1,]    3    0    0    2    0    1
#> [2,]    0    4    2    1    2    0
#> [3,]    0    2    4    0    4    0
#> [4,]    2    1    0    3    0    1
#> [5,]    0    2    4    0    4    0
#> [6,]    1    0    0    1    0    1

# same except subsetting and `-` to make negatives positive
D <- seq(nrow(A)) %>% 
    map(~A[.x, ]) %>%
    cross2(., .) %>% 
    map_dbl(~{ij <- .x[[1]] * .x[[2]]; sum(-ij[ij <= 0])}) %>% 
    matrix(nrow(A))

D
#>      [,1] [,2] [,3] [,4] [,5] [,6]
#> [1,]    0    2    2    0    2    0
#> [2,]    2    0    2    1    2    1
#> [3,]    2    2    0    2    0    1
#> [4,]    0    1    2    0    2    0
#> [5,]    2    2    0    2    0    1
#> [6,]    0    1    1    0    1    0
person alistaire    schedule 14.04.2017