OPからの説明には少しあいまいさがあります。そのため、次の2つの解決策を提案します。
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基本的に、これが行うことは、aをaにスワップする必要がある列ごとに0、列のどの行にsが含まれているかを調べ、その1うちの1つをサンプリングすることです。
編集：列に1つしかない場合を処理する必要があり1ます。長さ1のベクトルからサンプリングするだけの場合、Rは、長さ1sample()のセットからではなくセットからサンプリングする場合と同じように扱います。これをステートメントで処理します。seq_len(n)nif, else
正しい行を取得できるように、列ごとに個別にこれを行う必要があります。とへの繰り返しの呼び出しを回避するためにいくつかの素晴らしい操作を行うことができると思いますwhich()が、列にsample()1つしかない場合を処理する必要があるため、現時点ではどのように逃げますか。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スワップを実行する列が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
これを1回または2回以上実行している場合は、これを関数でラップします。
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追加の行を含めることができます。nn ivec