В описании от OP есть некоторая двусмысленность, поэтому предлагаются два решения:
При условии, что только существующие 1 s в соответствующих столбцах могут быть установлены на 0
Я просто изменю исходную функцию (см. Ниже).Изменение относится к строке, определяющей rows.Теперь у меня есть (была ошибка в оригинале - версия ниже пересмотрена, чтобы справиться с ошибкой):
rows <- sapply(seq_along(cols),
function(x, mat, cols) {
ones <- which(mat[,cols[x]] == 1L)
out <- if(length(ones) == 1L) {
ones
} else {
sample(ones, 1)
}
out
}, mat = mat, cols = cols)
По сути, это то, что для каждого столбца нам нужно поменять местами 1 до 0, мы выясняем, какие строки столбца содержат 1 с, и выбираем один из них.
Редактировать : Мы должны обработать случай, когда естьтолько один 1 в столбце.Если мы просто сэмплируем из вектора длины 1, R sample() будет обрабатывать его так, как если бы мы хотели сэмплировать из набора seq_len(n), а не из набора длины 1 n.Теперь мы обрабатываем это с помощью оператора if, else.
Мы должны сделать это индивидуально для каждого столбца, чтобы получить правильные строки.Я полагаю, что мы могли бы сделать некоторые приятные манипуляции, чтобы избежать повторных вызовов which() и sample(), но как это ускользает от меня на данный момент, потому что мы должны обработать случай, когда в столбце есть только один 1.Вот готовая функция (обновленная для обработки ошибки образца длины 1 в оригинале):
foo <- function(mat, vec) {
nr <- nrow(mat)
nc <- ncol(mat)
cols <- which(vec == 1L)
rows <- sapply(seq_along(cols),
function(x, mat, cols) {
ones <- which(mat[,cols[x]] == 1L)
out <- if(length(ones) == 1L) {
ones
} else {
sample(ones, 1)
}
out
}, mat = mat, cols = cols)
ind <- (nr*(cols-1)) + rows
mat[ind] <- 0
mat <- rbind(mat, vec)
rownames(mat) <- NULL
mat
}
, и вот она в действии:
> set.seed(2)
> foo(mat1, ivec)
[,1] [,2] [,3] [,4]
[1,] 1 0 0 0
[2,] 0 1 0 0
[3,] 1 0 1 0
[4,] 0 0 0 1
[5,] 0 1 1 0
, и она работает, когда есть толькоодин 1 в столбце, в который мы хотим выполнить обмен:
> foo(mat1, c(0,0,1,1))
[,1] [,2] [,3] [,4]
[1,] 1 1 0 0
[2,] 0 1 0 0
[3,] 1 0 1 0
[4,] 0 0 0 1
[5,] 0 0 1 1
Оригинальный ответ: Предполагая, что любое значение в соответствующем столбце может быть установлено равным нулю
Вот векторизованный ответ, где мы рассматриваем матрицу как вектор при выполнении замены.Используя данные примера:
mat1 <- matrix(c(1,1,0,0,0,1,0,0,1,0,1,0,0,0,1,1), byrow = TRUE, nrow = 4)
ivec <- c(0,1,1,0)
## Set a seed to make reproducible
set.seed(2)
## number of rows and columns of our matrix
nr <- nrow(mat1)
nc <- ncol(mat1)
## which of ivec are 1L
cols <- which(ivec == 1L)
## sample length(cols) row indices, with replacement
## so same row can be drawn more than once
rows <- sample(seq_len(nr), length(cols), replace = TRUE)
## Compute the index of each rows cols combination
## if we treated mat1 as a vector
ind <- (nr*(cols-1)) + rows
## ind should be of length length(cols)
## copy for illustration
mat2 <- mat1
## replace the indices we want with 0, note sub-setting as a vector
mat2[ind] <- 0
## bind on ivec
mat2 <- rbind(mat2, ivec)
Это дает нам:
> mat2
[,1] [,2] [,3] [,4]
1 0 0 0
0 1 0 0
1 0 0 0
0 0 1 1
ivec 0 1 1 0
Если бы я делал это более одного или двух раз, я бы обернул это в функцию:
foo <- function(mat, vec) {
nr <- nrow(mat)
nc <- ncol(mat)
cols <- which(vec == 1L)
rows <- sample(seq_len(nr), length(cols), replace = TRUE)
ind <- (nr*(cols-1)) + rows
mat[ind] <- 0
mat <- rbind(mat, vec)
rownames(mat) <- NULL
mat
}
Что дает:
> foo(mat1, ivec)
[,1] [,2] [,3] [,4]
[1,] 1 1 0 0
[2,] 0 1 0 0
[3,] 1 0 1 0
[4,] 0 0 0 1
[5,] 0 1 1 0
Если вы хотите сделать это в течение нескольких ivec с, увеличиваясь mat1 каждый раз, то вы, вероятно, не хотите делать это вЦикл растущих объектов идет медленно (он включает в себя копии и т. д.).Но вы можете просто изменить определение ind, добавив в него дополнительные строки n, которые вы привязываете для n ivec s.