Цикл по матрице - векторное умножение, причем элементы обоих меняются с каждым раундом

Question

У меня большой набор данных, состоящий из двух матриц и вектора.Одна из двух матриц и вектор имеют изменяющиеся элементы.Я хотел бы перебрать все возможные комбинации векторов и матриц, добавить каждый столбец и строку для каждой итерации и, наконец, сохранить эти результаты в векторе.

Вектор имеет один элемент с "1", остальные0 '.Матрица имеет 1 везде, кроме одного меньшего блока из 0 по диагонали.

Вектор и матрица не являются независимыми друг от друга, расположение нулей матрицы зависит от местоположения 1 в векторе.

Например, элементы матрицы сгруппированы с размером 2 * 2, затем, когда вектор имеет 1 в первом или втором элементе, матрица имеет 0 в первом 2 * 2 блоке по диагонали.Если 1 находится в третьем элементе вектора, блок 0 в матрице перемещается в [3: 4, 3: 4] и т. Д.

Я приведу небольшой пример с матрицами a и b и вектор c:

a <- matrix(1:36, nrow = 6, byrow = TRUE)

В этом примере я группирую элементы по блокам размера 3 * 3.Поскольку я не знаю, как сделать цикл очень хорошо, я уже подготовил все комбинации для b и c:

b <- matrix(rep(1, times = 36), nrow = 6, byrow = TRUE)

b1 <- b
b1[1:3,1:3] <- 0
b2 <- b
b2[4:6,4:6] <- 0

c1 <- rep(0, times = 6)
c1[1] <- 1
c2 <- rep(0, times = 6)
c2[2] <- 1
c3 <- rep(0, times = 6)
c3[3] <- 1
c4 <- rep(0, times = 6)
c4[4] <- 1
c5 <- rep(0, times = 6)
c5[5] <- 1
c6 <- rep(0, times = 6)
c6[6] <- 1

d1 <- sum(colSums(b1 * diag(as.vector(a %*% c1), nrow = 6)))
d2 <- sum(colSums(b1 * diag(as.vector(a %*% c2), nrow = 6)))
d3 <- sum(colSums(b1 * diag(as.vector(a %*% c3), nrow = 6)))
d4 <- sum(colSums(b2 * diag(as.vector(a %*% c4), nrow = 6)))
d5 <- sum(colSums(b2 * diag(as.vector(a %*% c5), nrow = 6)))
d6 <- sum(colSums(b2 * diag(as.vector(a %*% c6), nrow = 6)))

Умножение между обеими матрицами является поэлементным.

Я сохраняю результаты в results

results <- cbind(d1, d2, d3, d4, d5, d6)

, что дает:

     d1 d2 d3 d4 d5 d6
[1,] 75 78 81 30 33 36

Есть ли способ сделать это эффективно, используя циклы?Я также был бы очень признателен, если бы я мог определить внутри кода, насколько велики блоки.По моим данным, блоки около 50 * 50.Кроме того, у меня есть несколько блоков в моем наборе данных ..

Answer 1

a <- matrix(1:36, nrow = 6, byrow = TRUE)
b <- matrix(rep(1, times =  36), nrow = 6, byrow = TRUE)
b1 <- b
b1[1:3,1:3] <- 0
b2 <- b
b2[4:6,4:6] <- 0

коды моей петли ...

for (i in seq(6)){
temp = rep(0, 6)
temp[i] = 1
assign(paste('c', i, sep = ''), temp)
}

for (i in seq(6)){ 
cx = get(paste('c', i, sep = ''))
if(i<4){
  px = sum(colSums(b1 * diag(as.vector(a %*% cx), nrow = 6)))
  assign(paste('d', i, sep = ''), px)
} else{
  px = sum(colSums(b2 * diag(as.vector(a %*% cx), nrow = 6)))
  assign(paste('d', i, sep = ''), px)
}
}

тогда результаты

results <- cbind(d1, d2, d3, d4, d5, d6)