我正试图为每一个样本绘制一个可变数量的 n 的尝试。 在这个例子中 n = 8 因为 length(n.obs) == 8. 一旦所有的样本都被绘制出来，我想把它们组合成一个新的样本。matrix.
这是我的第一次尝试。
set.seed(1234)
n.obs <- c(2,1,2,2,2,2,2,2)
my.samples <- sapply(1:8, function(x) sample(1:4, size=n.obs[x], prob=c(0.1,0.2,0.3,0.4), replace=TRUE))
my.samples
这个方法产生了一个 list.
class(my.samples)
#[1] "list"
我确定了输出中需要的列数。matrix 使用。
max.len <- max(sapply(my.samples, length))
max.len
#[1] 2
输出 matrix 可以使用创建。
corrected.list <- lapply(my.samples, function(x) {c(x, rep(NA, max.len - length(x)))})
output.matrix <- do.call(rbind, corrected.list)
output.matrix[is.na(output.matrix)] <- 0
output.matrix
# [,1] [,2]
#[1,] 4 3
#[2,] 3 0
#[3,] 3 2
#[4,] 3 4
#[5,] 4 3
#[6,] 3 3
#[7,] 3 4
#[8,] 1 4
上面的方法似乎很好用，因为随着： n.obs 包括多个值和至少一个 element 在 n.obs > 1. 然而，我希望代码能够足够灵活地处理以下每一种情况。n.obs:
以上 sapply 语句返回一个2×8的 matrix 具备以下条件 n.obs.
set.seed(1234)
n.obs <- c(2,2,2,2,2,2,2,2)
以上 sapply 语句返回一个 integer 具备以下条件 n.obs.
set.seed(3333)
n.obs <- c(1,1,1,1,1,1,1,1)
以上 sapply 语句返回一个 list 具备以下条件 n.obs.
n.obs <- c(0,0,0,0,0,0,0,0)
以下是上述三种情况下的预期结果的例子 n.obs:
desired.output <- matrix(c(4, 3,
3, 3,
2, 3,
4, 4,
3, 3,
3, 3,
4, 1,
4, 2), ncol = 2, byrow = TRUE)
desired.output <- matrix(c(2,
3,
4,
2,
3,
4,
4,
1), ncol = 1, byrow = TRUE)
desired.output <- matrix(c(0,
0,
0,
0,
0,
0,
0,
0), ncol = 1, byrow = TRUE)
我怎样才能将代码通用化，使其总是返回一个 matrix 八行，无论 n.obs 用作输入？ 一种方法是用一系列的 if 语句来处理有问题的情况，但我认为可能有一个更简单、更有效的解决方案。
我们可以写一个函数。
get_matrix <- function(n.obs) {
nr <- length(n.obs)
my.samples <- sapply(n.obs, function(x)
sample(1:4, size=x, prob=c(0.1,0.2,0.3,0.4), replace=TRUE))
max.len <- max(lengths(my.samples))
mat <- matrix(c(sapply(my.samples, `[`, 1:max.len)), nrow = nr, byrow = TRUE)
mat[is.na(mat)] <- 0
mat
}
检查输出 :
get_matrix(c(2,1,2,2,2,2,2,2))
# [,1] [,2]
#[1,] 1 4
#[2,] 4 0
#[3,] 4 3
#[4,] 4 4
#[5,] 4 2
#[6,] 4 3
#[7,] 4 4
#[8,] 4 4
get_matrix(c(1,1,1,1,1,1,1,1))
# [,1]
#[1,] 4
#[2,] 4
#[3,] 3
#[4,] 4
#[5,] 2
#[6,] 4
#[7,] 1
#[8,] 4
get_matrix(c(0,0,0,0,0,0,0,0))
# [,1]
#[1,] 0
#[2,] 0
#[3,] 0
#[4,] 0
#[5,] 0
#[6,] 0
#[7,] 0
#[8,] 0
你可以 Vectorize 的 sample 上的功能 size= 争论。
samplev <- Vectorize(sample, "size", SIMPLIFY=F)
缠绕 samplev 到一个函数中，并使用以下方法分配最大的长度 length<- 在...中 lapply.
FUN <- function(n.obs, prob.=c(.1,.2,.3,.4)) {
s <- do.call(rbind, lapply(
samplev(1:4, size=n.obs, prob=prob., replace=TRUE),
`length<-`, max(n.obs)))
if (!all(dim(s))) matrix(0, length(n.obs))
else ({s[is.na(s)] <- 0; s})
}
结果。
set.seed(1234)
FUN(c(2,1,2,2,2,2,2,2))
# [,1] [,2]
# [1,] 4 3
# [2,] 3 0
# [3,] 3 2
# [4,] 3 4
# [5,] 4 3
# [6,] 3 3
# [7,] 3 4
# [8,] 1 4
FUN(c(2,2,2,2,2,2,2,2))
# [,1] [,2]
# [1,] 2 4
# [2,] 4 4
# [3,] 4 4
# [4,] 4 4
# [5,] 4 4
# [6,] 2 3
# [7,] 1 2
# [8,] 4 3
FUN(c(1,1,1,1,1,1,1,1))
# [,1]
# [1,] 4
# [2,] 4
# [3,] 3
# [4,] 4
# [5,] 2
# [6,] 4
# [7,] 4
# [8,] 1
FUN(c(0,0,0,0,0,0,0,0))
# [,1]
# [1,] 0
# [2,] 0
# [3,] 0
# [4,] 0
# [5,] 0
# [6,] 0
# [7,] 0
# [8,] 0
FUN(c(3, 4))
# [,1] [,2] [,3] [,4]
# [1,] 2 3 3 0
# [2,] 4 3 4 3