如何生成满足某些条件的向量？答案

【问题标题】：how to generate a vector which satisfy some conditions?如何生成满足某些条件的向量？
【发布时间】：2015-06-08 12:35:10
【问题描述】：

大家！ 如何生成满足某些条件的向量？
问题：生成一个向量a，使得length(a)=400000 由8 个元素组成：0, 5, 10, 50, 500, 5000, 50000, 300000。每个元素出现一定次数，分别为290205, 100000, 8000, 1600, 160, 32, 2, 1。此外，a 被分成 100 个连续元素的 4,000 个“组”；打电话给他们a_k, k=1,...,4000。这些组必须满足以下条件：

每组之和超过150，即sum_i a_k_i>150代表所有k。
元素 5、10 和 50 在每组中出现 25 到 29 次，即对于所有 k，集合 {i|a_i_k in (5,10,50)} 的大小在 25 到 29 之间。
0 在任何组中都不会连续出现超过 8 次。

我已经尝试了很多次，但它似乎不起作用：我目前的代码如下：

     T <- 4*10^(5)   # data size  
            x <- c(0, 5, 10, 50, 500, 5000, 50000, 300000)      #seed vector  
            t <- c(290205, 100000, 8000, 1600, 160, 32, 2, 1)   #frequency  
            A <- matrix(0, 4000, 100)    #4000 groups  
            k <- rep(0, times = 8)        #record the number of seeds   
            for(m in 1:4000) {        
            p <- (t - k)/(T - 100*(m - 1))      #seed probability  
            A[, m] <- sample(x, 100, replace = TRUE, prob = p)  #group m   
            sm <- 0         
            i <- 0    
              for(j in 1:92) {  
                  if(sum(A[m,j:j + 8])==0){  
                     if(A[m,j] > 0 & A[m,j] < 500) {i <- i+1}  
                        sm <- sm+A[100*m+j]       
                    }  
                   else j <- 0   
                }                
                       if (sm >= 150 & i > 24 & i < 30 & j != 0) {    
                           m <- m + 1  
                           for (n in seq_len(x)) {  
                               k[n] <- sum(A[, m+1] == x[n]) + k[n]  
                            }  
                        }  
            }

【问题讨论】：

你能详细说明一下吗？谢谢你的 cmets
别在意之前的评论。我之前没有看你的代码。
这是一项艰巨的任务。我会创建一些小例子，比如样本 4 的值总和为 50，并且必须重复两次或其他条件。然后从那里构建技术。
关于第三个条件的一个歧义：0 可以永远连续出现超过 8 次，还是这个条件只在组内绑定？例如，a[95:105]==0 可以吗？
另一个问题：您是想提出 just one 这样的向量，还是要编写一个可以生成 many 这样的函数载体？如果你想要一个函数，该函数是否应该能够（理论上）产生所有这样的向量？

标签： r vector sample

【解决方案1】：

仅仅通过建筑来做怎么样？例如：

amat<-matrix(rep(c(rep(rep(c(0,5),c(8,3)),8),
               rep(c(0,NA),c(8,4))),4000),nrow=100)
amat[97:100,1:2205]<-c(rep(10,3),0)
amat[97:98,2206:4000]<-c(5,5)
amat[99:100,2206:2897]<-c(10,10)
amat[99:100,2898]<-c(5,50)
amat[99:100,2899:3307]<-c(5,50)
amat[99:100,3308:3902]<-c(50,50)
amat[which(is.na(amat))]<-rep(c(10,500,5000,5e4,3e5),c(1,160,32,2,1))

a<-c(amat)

这满足你的所有条件：

元素计数：

>sapply(c(0,5,10,50,500,5000,50000,300000),function(x)length(which(a==x)))
[1] 290205 100000   8000   1600    160     32      2      1

小组总和：

> table(colSums(amat)>=150)

TRUE 
4000

5,10,50频率：

> table(sapply(1:4000,function(x)abs(sum(amat[,x] %in% c(5,10,50))-27)<=2))

TRUE 
4000

0 的运行：

> table(sapply(1:4000,function(x)max(rle(amat[,x])$lengths[rle(amat[,x])$values==0])<=8))
#If this is slow, we can just use max(rle(amax[,x]))<=8
#  because there aren't many valid groups with strings of 9+
#  non-0 elements

TRUE 
4000

如果事实上我们永远不允许有 9 个0s 的字符串，我们需要对组 2:2206 进行轻微调整，因为，例如a[100:108]==0

【讨论】：

构造是个好方法，但不是我想要的。如果添加第四个条件，我们该怎么办？事实上，这个问题被我原来的问题简化了。尺寸更大（至 10^8）。我认为的核心问题是，我们可以通过什么方式快速搜索 sastified 向量。规模越大概率越大（指数增长）

【解决方案2】：

我可以开始它，也许有人可以帮助进入下一步。我的方法是从约束开始，让sample 计算出数字。

set.seed(77)
choose <- c(0,5,10,50,500,5000,50000,300000)
freqs <- c(290205,100000,8000,1600,160,32,2,1)
probs <- freqs/sum(freqs)
check.sum <- function(vec) sum(vec) >= 150
check.interval <- function(vec) abs(sum(vec %in% c(5,10,50))-27)<=2
check.runs <- function(vec, runmax=8) max(rle(vec)$lengths[rle(vec)$values==0]) <= runmax

check.all <- function(vector) {
  logicals <- c(check.sum(vector), 
                check.runs(vector),
                check.runs(vector)
                )
  return(all(logicals))

}

nums <- NULL
res <- list()
for(i in 1:4000) {
  nums <- numeric(100)
  while(!check.all(nums)) {nums <- sample(choose, 100, replace=T,prob=probs)}

  res[i] <- list(nums)
}

str(res)
List of 4000
 $ : num [1:100] 1e+01

因此，这将为您提供 4,000 个符合约束条件的 100 个数字组的列表。只用了大约两秒的系统时间。

下一步是让某人找到一种方法来构建类似的东西，除了使用一次消除 300000，使用两次后消除 50000，依此类推。

【讨论】：

这样的好处是，一旦我们建立了总计数条件，这种方法就可以生成all有效的a。但我不确定如何概括——按顺序进行（在每组之后重新填充计数）肯定会失败。
如果 OP 只需要一个这样的向量，我的方法会更好；如果他只需要许多个这样的向量，我们可以在向量化之前置换矩阵的列。但是我的方法也很难推广到所有这样的向量......
我同意，+1 您的解决方案。如果有办法将两者结合起来，那么最终的解决方案将足够强大，可以在通用上下文中自动生成基于规则的字符串。 @MichaelChirico
通过加权抽样，它做得很好。将其推向精确的频率匹配可能是从这里的一个重大飞跃......后验频率是有偏差的——我认为条件有利于吸引很少0s 和许多大值。

【解决方案3】：

受@plafort 方法的启发，我提出了以下方法，它似乎工作得非常快，并且应该能够生成满足您条件的 all 向量：

elts<-c(0,5,10,50,500,5000,50000,300000)
freq<-c(290205,100000,8000,1600,160,32,2,1)
ngrp<-4000L

grp.cond1<-function(x)sum(x)>=150
grp.cond2<-function(x)abs(sum(x %in% c(5,10,50))-27)<=2
grp.cond3<-function(x)max(rle(x)$lengths[rle(x)$values==0])<=8

check.all<-function(mat){
  all(sapply(1:ncol(mat),function(y)grp.cond1(mat[,y])),
      sapply(1:ncol(mat),function(y)grp.cond2(mat[,y])),
      sapply(1:ncol(mat),function(y)grp.cond3(mat[,y])))}

while(!check.all(amat)){amat<-matrix(sample(rep(elts,freq)),ncol=ngrp)}
a<-c(amat)

我还以一种易于推广到其他元素集/计数、组数和分组条件的方式编写了代码。

不幸的是，这些条件似乎非常严格，并且可能需要很长时间才能生成可接受的a。我让while 循环运行了~1300 次，但没有成功...

【讨论】：

成功的概率似乎低于 1300 分之一，这表明对这个问题采取建设性的方法可能是您最好的选择。请注意，我的其他方法似乎能够生成大约 10^2577 个独特的组重新排列；另一方面，鉴于这种方法，随机发生在其中一个上的概率大约为 10^(-116180)。
再次感谢。我遇到了同样的问题。我认为加快搜索速度，寻找新的搜索方式是有效可行的。
我猜是时候并行化了！

【解决方案4】：

谢谢大家！我发现了我的问题。

rm(list = ls())  
media <- matrix(rep(rep(c(0,5,NA),c(72,25,3)),4000),nrow=100)  
media[98:100,1:2400] <-c(10,10,10)  
media[98:99,2401:3200] <-c(50,10)  
media[98:99,3201:4000] <-c(50,0)  
media[100,2401:4000] <-rep(c(0,500,5000,50000,300000),c(1405,160,32,2,1))  
obj1 <- matrix(0,100L,4000)  
obj2 <-obj1  
grp.cond<-function(x) max(rle(x)$lengths[rle(x)$values==0])<=8  
elts<-c(0,5,10,50,500,5000,50000,300000)  
for(i in 1:4000){  
freq<-c(sapply(elts, function(x) length(which(media[,i]==x))))  
while(!grp.cond(obj1[,i])){obj1[,i]<-c(sample(rep(elts,freq)))}  
i<-i+1  
}  
elts1<-c(1:4000)  
freq1<-rep(1,times=4000)  
a1<-sample(rep(elts1,freq1))  
for(i in 1:4000){obj2[,i]<-obj1[,a1[i]]} 
a <- c(obj2)

【讨论】：