如何将一组数字随机分配给R中的矩阵,而没有具有所有相同元素的行

时间:2017-12-31 08:38:01

标签: r matrix

我想制作一个包含n行和m列的随机矩阵。我希望从一组数字中随机选择矩阵每行的元素。我希望每行至少有一个不同的数字。我不希望一行中的所有元素都相同。我曾经问过我的问题here,但我不知道为什么我提供的功能仍然给我一些包含所有相同元素的行。如何调整此功能?

f2 <- function(x, n, m) {
if ( length(unique(x)) == 1 ) {
    stop('x has only one unique element.', call. = FALSE)
}
result <- t(replicate(n, sample(x, m, replace = TRUE)))
while ( any(apply(result, 1, function(x) length(unique(result)) == 1)) ) {
    result <- t(replicate(n, sample(x, m, replace = TRUE)))
}
return(result)}

以下是一个例子:

x <- c(1, 1.5, 2, 3,4)
set.seed(123456)
matall=f2(x, 1200, 4)
View(matall)

      [,1] [,2] [,3] [,4]
   [1,]  3.0  3.0  1.5  1.5
   [2,]  1.5  1.0  2.0  1.0
   [3,]  4.0  1.0  3.0  2.0
   [4,]  4.0  4.0  4.0  4.0

2 个答案:

答案 0 :(得分:1)

  

我想制作一个包含n行和m列的随机矩阵。

cols <- 3; rows <- 3
m <- matrix(ncol = cols, nrow = rows)
  

我希望随机选择矩阵每行的元素   来自一组数字。

set.seed(2)
set <- seq(ncol(m)-1L)
m[] <- sample(set, length(m), replace = T)
m
#      [,1] [,2] [,3]
# [1,]    1    1    1
# [2,]    2    2    2
# [3,]    2    2    1
  

我希望每行至少有一个不同的数字。

rowRanges <- matrixStats::rowRanges(m)
(isSingle <- rowRanges[,2]-rowRanges[,1]==0)
# [1]  TRUE  TRUE FALSE

m[isSingle,1] <- vapply(rowRanges[isSingle, 1], function(x) set[set!=x][1], 0L)
m
#      [,1] [,2] [,3]
# [1,]    2    1    1
# [2,]    1    2    2
# [3,]    2    2    1

或者,如果您想根据设置值和选择的列随机化分配:

vsample <- Vectorize(function(x) sample(set[set!=x], size = 1L), "x")
idx <- cbind(row=which(isSingle), col=sample(ncol(m), sum(isSingle), replace = TRUE))
mvals <- vsample(rowRanges[isSingle, 1])
m[idx] <- mvals

答案 1 :(得分:1)

函数定义中存在拼写错误。 while子句应为

while ( any(apply(result, 1, function(x) length(unique(x)) == 1)) ) {

而不是

while ( any(apply(result, 1, function(x) length(unique(result)) == 1)) ) {

但是,该函数不会快速终止,因为每次找到具有相同值的行时,它都会尝试重新创建整个矩阵。

改进版仅替换具有相同值的行

f3 <- function(x, n, m) {
  if ( length(unique(x)) == 1 ) {
    stop('x has only one unique element.', call. = FALSE)
  }
  result <- replicate(m, sample(x, n, replace = TRUE))
  uni_rows <- apply(result, 1, function(x) length(unique(x)) == 1)
  while ( any(uni_rows) ) {
    result[which(uni_rows), ] <- replicate(m, sample(x, sum(uni_rows), replace = TRUE))
    uni_rows <- apply(result, 1, function(x) length(unique(x)) == 1)
  }
  return(result)
}

现在,

x <- c(1, 1.5, 2, 3, 4)
set.seed(123456)
matall <- f3(x, 1200, 4)
any(apply(matall, 1, function(x) length(unique(x)) == 1))
[1] FALSE

返回

head(matall, 11)
      [,1] [,2] [,3] [,4]
 [1,]  3.0    3  1.5  1.5
 [2,]  1.5    1  2.0  1.0
 [3,]  4.0    1  3.0  2.0
 [4,]  2.0    4  3.0  1.0
 [5,]  4.0    1  1.5  3.0
 [6,]  4.0    3  2.0  3.0
 [7,]  2.0    3  4.0  4.0
 [8,]  4.0    1  2.0  4.0
 [9,]  1.5    1  4.0  1.0
[10,]  4.0    4  3.0  3.0
[11,]  1.5    3  4.0  1.5