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

时间:2015-06-08 12:35:11

标签: r vector sample

大家好! 如何生成满足某些条件的向量?
问题:生成一个向量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。这些组必须满足以下条件:

  1. 每个组的总和超过150,即所有sum_i a_k_i>150的{​​{1}}。
  2. 元素k510在每组中显示25到29次,即对于所有50,元素k具有幅度25至29岁之间。
  3. {i|a_i_k in (5,10,50)}在任何群组中连续出现的次数不会超过8次。
  4. 我已经尝试了很多次,但它似乎不起作用: 我目前的代码如下:

    0

4 个答案:

答案 0 :(得分: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等等。

答案 1 :(得分:2)

如何通过施工来做到这一点?例如:

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 0 s字符串,我们需要对第2组:2206进行轻微调整,因为例如a[100:108]==0

答案 2 :(得分:2)

受到@ 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)

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

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

答案 3 :(得分:0)

谢谢大家!我弄明白了我的问题。

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)