R - 使用分布从矩阵中随机抽样以表示每列中零的数量 - 分层抽样答案

【问题标题】：R - Randomly sample from a matrix using a distribution to denote the number of zeros in each column - stratified samplingR - 使用分布从矩阵中随机抽样以表示每列中零的数量 - 分层抽样
【发布时间】：2020-08-10 04:30:31
【问题描述】：

我正在尝试从矩阵中随机抽样（b 下面），但我希望得到的样本矩阵在每列中的零比例等于另一个矩阵的比例（ a 下面）。我正在尝试使用 sample() 函数来执行此操作，但我并没有很高兴。下面是一些可重现的代码，希望能解释我的问题：

编辑：顺便提一下，我不希望增加或编辑任何行，而是从b 进行随机抽样，以便生成矩阵； b_sample 与 a 的零分布大致相等

set.seed(1234)
# matrix a is the matrix that holds the distribution of zeros I want to match
a <- matrix(as.integer(rexp(200, rate=.1)), ncol=20)
# matrix b is the matrix to be sampled from 
b <- matrix(as.integer(rexp(2000, rate=.1)), ncol=20)

a 看起来像：

     [,1] [,2] [,3] [,4] [,5]
[1,]    6    0    6    1   22
[2,]   19    6    0   23   19
[3,]    8   22    8    5    0
[4,]   24   17   28    3    0

b 看起来像：

      [,1] [,2] [,3] [,4] [,5]
 [1,]    1    1   10    5    9
 [2,]   26    1    3    2    2
 [3,]    4    8    3    0    0
 [4,]    2   10   35    3   11
 [5,]    1    3   16    0    6
 [6,]    2    4    2   16    2
 [7,]    3   18   13    6   17
 [8,]    0    2    9    0   13
 [9,]    2   15    6   27   30
[10,]    1    2    7    9   15
[11,]   13    0    5    1    2
[12,]   18   12    9   27   33
[13,]    0   20    3   18    1
[14,]    5    7    7   16    4
[15,]    5    6    4    5    2
[16,]    0    7    5   10    7
[17,]    3   20    5   14   34
[18,]   28    0   10    5    8
[19,]   33    0    2    6   13
[20,]    7   28    0   11    8

我提取a 的每一列中的零分布以用于采样

dist<-apply(a,2, function(x) sum(x!=0)/length(x)) 
dist
[1] 1.00 0.75 0.75 1.00 0.50

然后我继续尝试从 b 中采样以保持与 a 相同的行数

b_sample<-b[sample(x=nrow(b),
                   size=4,
                   replace=F
                   )
            ,]

这可行，但我希望b_sample 在每列中的零比例与a 相同。我已经尝试过这样做

b_sample<-b[sample(x=nrow(b),
                   size=4,
                   replace=F,
                   prob=dist
                   )
            ,]

但我得到一个错误：

Error in sample.int(x, size, replace, prob) : 
  incorrect number of probabilities

我不确定我这样做的格式是否错误，或者sample() 函数根本不是要使用的更正函数。任何帮助将不胜感激！

编辑 2：更新如下

我找到了一种从b 中采样的方法，并使生成的b_sample 中的零比例与原始b 相同。这不是我想要得到的，我希望比例等于a 中的比例，但它可能会更好地了解我想要做什么。有关上述示例的开发，请参见下文

首先我将b 放入一个数据框并索引行以使用dplyr 和groupby()

b_df<-as.data.frame(b)
b_df <- b_df %>%
  mutate(n = row_number()) %>% #create row number
  select(n, everything()) # put row number at the front of the dataset
b_df
    n V1 V2 V3 V4 V5
1   1 19  1 29  2  9
2   2  7 20  1  3  9
3   3  3 25  8  9 22
4   4  9  0 20  9  0
5   5  2 12 14  4  2
6   6 10 22  9  1  9
7   7  0  9 16  1  4
8   8  3  3 14 23  2
9   9  7  0  7  1  0
10 10  9  0 26  2  6
11 11  4 19  0  2  6
12 12  0  2  1  7  4
13 13 16 16 25  2  3
14 14  0  1  1  7  9
15 15  8 14  0  9  5
16 16  0 14  9  5  0
17 17 43 27 14  1  4
18 18  9  0 13  4  9
19 19  0  8  3  9 13
20 20 34 36  1  7 20

然后我创建一个二进制数据框来指示每个单元格是否具有 0 或值

b_df_0[,-1]<-as.data.frame(lapply(b_df[,-1],function(x) x==0))
b_df_0
    n    V1    V2    V3    V4    V5
1   1 FALSE FALSE FALSE FALSE FALSE
2   2 FALSE FALSE FALSE FALSE FALSE
3   3 FALSE FALSE FALSE FALSE FALSE
4   4 FALSE  TRUE FALSE FALSE  TRUE
5   5 FALSE FALSE FALSE FALSE FALSE
6   6 FALSE FALSE FALSE FALSE FALSE
7   7  TRUE FALSE FALSE FALSE FALSE
8   8 FALSE FALSE FALSE FALSE FALSE
9   9 FALSE  TRUE FALSE FALSE  TRUE
10 10 FALSE  TRUE FALSE FALSE FALSE
11 11 FALSE FALSE  TRUE FALSE FALSE
12 12  TRUE FALSE FALSE FALSE FALSE
13 13 FALSE FALSE FALSE FALSE FALSE
14 14  TRUE FALSE FALSE FALSE FALSE
15 15 FALSE FALSE  TRUE FALSE FALSE
16 16  TRUE FALSE FALSE FALSE  TRUE
17 17 FALSE FALSE FALSE FALSE FALSE
18 18 FALSE  TRUE FALSE FALSE FALSE
19 19  TRUE FALSE FALSE FALSE FALSE
20 20 FALSE FALSE FALSE FALSE FALSE

然后，我使用来自dplyr 的group_by 和sample_frac 从b 中采样，以等于a 中的采样数。

proportion <- nrow(a)/nrow(b)
sample <- b_df_0 %>%
  group_by(V1,V2,V3,V4,V5) %>% #any number of variables you wish to partition by proportionally
  sample_frac(proportion) # proportion of the original df you wish to sample

b_df[b_df$n %in% sample$n,]
#The above approach would work if you can get a proportions = b proportions
    n V1 V2 V3 V4 V5
2   2  7 20  1  3  9
19 19  0  8  3  9 13
20 20 34 36  1  7 20

这种方法不是我想要的，但是当我希望它们基于a 时，比例基于b。任何关于如何做到这一点的帮助都会很棒！谢谢！

【问题讨论】：

标签： r dataframe matrix random dplyr

【解决方案1】：

如果p是A列中0的比例，b_rows是B中的行数。

B 的 j 列示例：

B[样本(1:b_rows,b_rows*p),j]=0

【讨论】：

嘿哈维尔，对不起，我应该提到我不想以任何方式增加行，所以我只想以这样一种方式进行采样，以便每个中的零分布列近似于另一个矩阵的分布。我会更新我的问题。
感谢您的快速回复！问题是我不想操纵任何行中的值，我想从 b 中抽取能够给出分布的行。
列的大小相同，但随机定位的行现在为 0。如果 B 列没有零，它就可以工作。如果它已经有零，您可以使用 B[sample(which(B[,j]!=0),b_rows*p-sum(B[,j]==0)),j]=0
抱歉，如果这不是您需要的。如果您显示从 B 采样时想要获得的矩阵示例，我可以帮上忙！。
没问题！但是，我不想手动操作b_sample 来获得与a 相同的零比例。我希望它本质上是在采样中完成的，因为我想多次使用这种方法，所以我不认为显示来自b、b_sample 的行组合会是有益的。我更想寻找另一个函数或使用 sample() 来做到这一点。

【解决方案2】：

问题是尝试将大矩阵下采样到较小矩阵的大小，同时确保下采样矩阵中每个变量的零比例等于较小矩阵的比例。

所以经过几天的研究，我找到了一种方法来解决我遇到的问题，而无需使用任何预定义的函数来完成繁重的工作。事实证明，这是一个排列问题，正如我痛苦地发现的那样，作为我需要从b 采样的矩阵中的行数以及我需要下采样到的矩阵中的行数a 的大小增加，问题变得无法计算。例如，如果我尝试从包含 200 行的矩阵中采样，并且我尝试下采样到的矩阵大小为 20，这将给出 n!/(n-r)!排列或在r

> factorial(200)/factorial(200-20)
[1] NaN

这个排列数大小的问题会吃掉计算能力和内存，stack overflow 已经很好地覆盖了。所以，为了时间和记忆，我显然无法检查每一个排列。我决定做两件事来解决这个问题；首先，我只会检查让我有 95% 的机会在前 5% 的解决方案中获得一个排列的排列比例（我在这里将 top 定义为具有与a 的零分布的最佳近似值）其次，我如果我找到一个解决方案，其中每个变量的零分布都在a 的 0.05 范围内，我会提前停止。下面的代码介绍了解决方案：

首先让我们创建矩阵以从b 采样，并创建矩阵以获取大小和零分布以将采样到a

set.seed(1234)
# matrix a is the matrix that holds the distribution of zeros I want to match
a <- matrix(as.integer(rexp(200, rate=.1)), ncol=20)
# matrix b is the matrix to be sampled from 
b <- matrix(as.integer(rexp(2000, rate=.1)), ncol=20)

接下来我计算出我试图复制的零的分布

zero_dist_to_replicate<-apply(a,2, function(x) 
> zero_dist_to_replicate
 [1] 0.8 0.8 0.9 0.6 0.7 0.9 1.0 0.8 1.0 1.0 0.8 0.9 1.0 1.0 0.9 0.9 0.9 0.9 1.0 0.9

接下来我将创建变量来检查排列计数及其错误

  perms_used <- list()
  error <- vector()
  answer <- matrix()

要计算出我需要从b 抽取多少随机样本才能在我使用的 95% 的时间中获得前 5% 的排列

ceiling(log(1-0.95)/log(1-0.05))
[1] 59

现在我运行一个 while 循环，从 b 中随机采样，并检查是否满足上面的第二个条件，如果不是，我存储排列和相关的错误并继续，直到找到满足第二个条件的条件或尝试 59 个条件。如果我尝试 59，那么我会将具有最接近零分布的那个返回到 a

counter<-1
while(counter < 59){
  perm <- NULL
  #Keep picking random permutations until you find one that hasn't been checked before
  while(is.null(perm) || perm %in% perms_used){
    #sample used to generate random numbers to pick rows from b, 
    #-1 and +1 used so random number picked doesn't include 0
    perm <- sample((n-1),num_vars,replace=T)+1
   }
   subsample_set <- b[perm,]
   #check distribution of zeros of this permutation
   subsample_set_dist <- apply(subsample_set,2, function(x) sum(x!=0)/length(x))
   #if the permuted subsample's distribution of zeros is within .05 
   #for each variable of other matrix end early
   diff <- abs(subsample_set_dist-zero_dist_to_replicate)
   if(all(diff <= 0.05)==T){
      answer <- subsample_set
      break
   }
    #getting the sum of the error across all variables
    error[counter]<-sum(diff)
    perms_used[[counter]]<-perm
    counter = counter+1
  }
  if(all(is.na(answer))){
   #return first row with the minimum error
   best_subsample<-perms_used[which(error == min(error))]
   answer <- matrix_to_sample[best_subsample[[1]],])
  }

【讨论】：