Wektoryzacja pętli z wielu warunków

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

mam matrycę z manekinów

> 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 

że moje smoczki są powiązane tak, że linia 1 zgrupowanych z 2, 3 z 4 i 5 z 6 . Chcę podzielić każdy kod manekina (1) pomiędzy tymi w tej samej grupie na tej samej linii, jak wyżej:

> 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 

aby to osiągnąć, mam następujące:

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

Moje pytanie brzmi, czy mogę to osiągnąć za pomocą wektoryzacji kodu. Nie mogę się dowiedzieć, jak używać ifelse w tym przypadku, ponieważ nie mogę połączyć go z indeksowaniem linii, aby znaleźć 0.5 w każdej linii.

Answer 1

Oto jeden próba bazy 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 

Takie rozwiązanie wykorzystuje fakt, że macierz jest po prostu wektorem o atrybut wymiarowej. which znajduje położenie 1 w bazowym wektorze.

Drugi człon w drugim wierszu, c(1, -1)[(ones %% 2 == 0L) + 1L] pozwala wybrać element "pary" wektora, który będzie używany do dzielenia wartości, w zależności od tego, czy oryginalna pozycja jest parzysta czy nieparzysta. Działa to tutaj, ponieważ istnieje parzysta liczba wierszy, która jest niezbędna w tym problemie sparowanych elementów.

Następne wiersze wypełniają macierz na podstawie tego, czy element pierwotnie jest jednym (0,5), czy jest to sąsiedni element pary (-0,5). Zauważ, że drugie polecenie wykorzystuje bazową koncepcję pozycji wektora.

---

Druga metoda, która pożycza od koncepcji stanowisk i komentarzy hubertl, thelatemail i Martin-Morgan, który należy odjąć 0,5 z oryginalnej matrycy w odpowiednich miejscach najpierw uzyskać indeksy same jak powyżej

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

a następnie połączyć [<- z odejmowaniem

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

Oto inne podejście:

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

Innym podejściem:

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

utworzyć wektor wskazujący grup rzędu, grp i odejmowanie grupa oznacza rowsum(dummies, grp)/2 z każdego członka grupy, jak

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

nieco bardziej ogólnie, umożliwiając grupom o różnej wielkości i niezarejestrowanym

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