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

各位!！ 如何生成满足某些条件的向量？
问题：生成一个向量

a

，使

长度（a）=400000

，它由8个元素组成：

0、5、10、50、500、5000、50000、300000

。每个元素出现的次数都是固定的，即分别为

290205、100000、8000、1600、160、32、2、1

。此外，

a

被分为100个连续元素的4000个“组”；叫他们

a_k，k=1，…，4000

。这些组必须满足以下要求：

每组的总和超过150，即所有

k

的

sum\u i a\u k\u i>150

元素

5

、

10

和

50

在每组中出现25到29次，即对于所有

k

，集合

{i|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]  
                            }  
                        }  
            }  

---

T我可以开始，也许有人可以帮助我进入下一步。我的方法是从约束开始，让
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

set.seed（77）
选择通过构造来做怎么样？例如：

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)

集团总额：

> 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 

如果事实上我们不允许有9个
0
s的字符串，我们需要对组2:2206进行轻微调整，因为，例如，
a[100:108]==0
受@plafort方法的启发，我提出了以下方法，它似乎工作得很快，应该能够生成满足您条件的所有向量：

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)

elts谢谢大家！我已经解决了我的问题

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)

rm（list=ls（））
媒体你能详细介绍一下吗？谢谢你的评论。谢谢你对之前的评论发表评论。我之前没有看过你的代码。这是一项艰巨的任务。我将创建一些小示例，比如样本4值，它们的总和为50，并且必须重复两次或其他条件。然后从那里构建技术。关于第三个条件的一个模糊性：
0
在一行中出现的次数不能超过8次，或者该条件仅在组内绑定？e、 例如，如果
a[95:105]==0可以吗？另一个问题：你是想得到一个这样的向量，还是想写一个可以生成许多这样的向量的函数？如果你想要一个函数，该函数（理论上）应该能够生成所有这样的向量吗？这样做的好处是，一旦我们在总计数条件下构建，这种方法可以生成所有有效的
a
。但我不确定如何推广——按顺序进行（每组后重新填充计数）肯定会失败；如果他只需要很多这样的向量，我们可以在向量化之前排列矩阵的列。但我的方法也很难推广到所有这样的向量……我同意，你的解是+1。如果有一种方法将两者结合起来，那么最终的解决方案将足够强大，能够在通用上下文中自动生成基于规则的字符串@Michaelchirico通过加权抽样，它做了一项值得尊敬的工作。把它推到精确的频率匹配可能是一个重大的飞跃。。。后验频率是有偏差的——我认为这种情况有利于使用较少的
0
s和许多较大的值绘制。成功的概率似乎低于1300分之一，这表明对这个问题采取建设性的方法可能是你的最佳选择。注意，我的另一种方法似乎能够产生大约10^2577个组的独特重排；另一方面，在这种方法下，随机发生在其中一个上的概率约为10^（-116180）。再次感谢。我也遇到了同样的问题。我认为加快搜索速度，找到一种新的搜索方法是有效可行的。我想是时候并行化了！建筑是一种很好的方法，但它不是我想要的。如果加上第四个条件，我们怎么办？事实上，这个问题被我原来的问题简化了。尺寸更大（至10^8）。我认为核心问题是，通过什么方法我们可以快速搜索简化的向量。规模越大，可能性越大（指数增长）
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)

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)