OP 的描述有点模糊,所以建议两种解决方案:
假设只有相关列中存在的1s可以设置为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 的每一列,我们会计算出该列的哪些行包含1s 并从中取样。
编辑:我们必须处理列中只有一个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
如果您想为多个ivecs 执行此操作,每次都增长mat1,那么您可能不想在循环中执行此操作,因为增长的对象很慢(它涉及副本等)。但是您可以只修改ind 的定义以包含您为n ivecs 绑定的额外n 行。