В описании из ОП есть небольшая двусмысленность, поэтому предлагаются два решения:
Предполагая, что только существующие 1 в соответствующих столбцах могут быть установлены на 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, sample() R будет обрабатывать его так, как если бы мы хотели сделать выборку из набора 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
Если вы хотите сделать это для нескольких ivecs, увеличивая mat1 каждый раз, то вы, вероятно, не хотите делать это в цикле, так как растущие объекты медленны (это включает в себя копии и т. д.). Но вы можете просто изменить определение ind, чтобы включить дополнительные n строк, которые вы привязываете для n ivecs.
person
Gavin Simpson
schedule
28.07.2011
