Векторизация из цикла с несколькими условиями

Question

dummies = matrix(c(0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0), nrow=6, ncol=6) 
colnames(dummies) <- c("a","b", "c", "d", "e", "f") 

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

> dummies 
    a b c d e f 
[1,] 0 0 0 0 1 0 
[2,] 0 0 1 0 0 0 
[3,] 1 0 0 0 0 0 
[4,] 0 0 0 0 0 1 
[5,] 0 1 0 0 0 0 
[6,] 0 0 0 1 0 0 

Я знаю, что мои соски связаны в этой строке 1, сгруппированная с 2, 3 с 4, и 5 с 6 . Я хочу, чтобы разделить каждый фиктивный код (1) между теми, в одной и той же группы на той же линии, что и выше:

> dummies 
     a b c d e f 
[1,] 0.0 0.0 -0.5 0.0 0.5 0.0 
[2,] 0.0 0.0 0.5 0.0 -0.5 0.0 
[3,] 0.5 0.0 0.0 0.0 0.0 -0.5 
[4,] -0.5 0.0 0.0 0.0 0.0 0.5 
[5,] 0.0 0.5 0.0 -0.5 0.0 0.0 
[6,] 0.0 -0.5 0.0 0.5 0.0 0.0 

для достижения этой цели, я следующее:

dummies <- ifelse(dummies==1, 0.5, 0) 
for (i in 1:nrow(dummies)){ 
    column = which(dummies[i,] %in% 0.5) 
    if (i %% 2 != 0) {  
     dummies[i+1, column] <- -0.5 
    } else {    
     dummies[i-1, column] <- -0.5 
    } 
} 

Мой вопрос: смогу ли я достичь этого с помощью векторизованного кода. Я не могу понять, как использовать ifelse в этом случае, потому что я не могу объединить его с индексированием строк, чтобы найти 0.5 на каждой строке.

Answer 1

Вот одна попытка в базе R

# get locations of ones 
ones <- which(dummies == 1) 
# get adjacent locations 
news <- ones + c(1L, -1L)[(ones %% 2 == 0L) + 1L] 

# fill out matrix 
dummiesDone <- dummies * 0.5 
dummiesDone[news] <- -0.5 

dummiesDone 
     a b c d e f 
[1,] 0.0 0.0 -0.5 0.0 0.5 0.0 
[2,] 0.0 0.0 0.5 0.0 -0.5 0.0 
[3,] 0.5 0.0 0.0 0.0 0.0 -0.5 
[4,] -0.5 0.0 0.0 0.0 0.0 0.5 
[5,] 0.0 0.5 0.0 -0.5 0.0 0.0 
[6,] 0.0 -0.5 0.0 0.5 0.0 0.0 

Это решение использует тот факт, что матрица представляет собой просто вектор с атрибутом размера. which находит местоположение 1s в базовом векторе.

второй член во второй строке, c(1, -1)[(ones %% 2 == 0L) + 1L] позволяет выбирать элемент пары, который будет использоваться для разделения значения, исходя из того, является ли исходное положение четным или нечетным. Это работает здесь, потому что существует четное количество строк, что необходимо в этой проблеме парных элементов.

Следующие строки заполняют матрицу на основе того, является ли элемент изначально одним (0,5), или если это смежный элемент пары (-0,5). Обратите внимание, что вторая команда использует базовую концепцию положения вектора.

---

Второй метод, который заимствует от концепции постов и комментариев от hubertl, thelatemail и мартеновского-Моргана, что вычитает 0,5 из исходной матрицы в правильных местах первым, чтобы получить показатели таких же, как и выше

# get locations of ones 
ones <- which(dummies == 1) 
# get adjacent locations 
news <- ones + c(1L, -1L)[(ones %% 2 == 0L) + 1L] 

, а затем объединить [<- с вычитанием

dummies[c(ones, news)] <- dummies[c(ones, news)] - .5 
dummies 
     a b c d e f 
[1,] 0.0 0.0 -0.5 0.0 0.5 0.0 
[2,] 0.0 0.0 0.5 0.0 -0.5 0.0 
[3,] 0.5 0.0 0.0 0.0 0.0 -0.5 
[4,] -0.5 0.0 0.0 0.0 0.0 0.5 
[5,] 0.0 0.5 0.0 -0.5 0.0 0.0 
[6,] 0.0 -0.5 0.0 0.5 0.0 0.0 

Answer 2

Вот другой подход:

dummies[] <- sapply(split(dummies, gl(length(dummies)/2,2)), function(v) if(any(!!v))v-.5 else v) 
     a b c d e f 
[1,] 0.0 0.0 -0.5 0.0 0.5 0.0 
[2,] 0.0 0.0 0.5 0.0 -0.5 0.0 
[3,] 0.5 0.0 0.0 0.0 0.0 -0.5 
[4,] -0.5 0.0 0.0 0.0 0.0 0.5 
[5,] 0.0 0.5 0.0 -0.5 0.0 0.0 
[6,] 0.0 -0.5 0.0 0.5 0.0 0.0 

Answer 3

Другой подход:

dummies - ((dummies[c(1,3,5),]+dummies[c(2,4,6),])/2)[c(1,1,2,2,3,3),] 

     a b c d e f 
[1,] 0.0 0.0 -0.5 0.0 0.5 0.0 
[2,] 0.0 0.0 0.5 0.0 -0.5 0.0 
[3,] 0.5 0.0 0.0 0.0 0.0 -0.5 
[4,] -0.5 0.0 0.0 0.0 0.0 0.5 
[5,] 0.0 0.5 0.0 -0.5 0.0 0.0 
[6,] 0.0 -0.5 0.0 0.5 0.0 0.0 

Answer 4

Создание вектора с указанием группы строк, grp, и вычитать группа означает rowsum(dummies, grp)/2 от каждого члена группы, так как

grp = rep(seq_len(nrow(dummies)/2), each=2) 
dummies - rowsum(dummies, grp)[grp,]/2 

немного больше как правило, для групп разного размера и неупорядоченных групп

dummies - (rowsum(dummies, grp)/tabulate(grp))[grp,]