满足条件的样本对

Sample pairs to satisfy a condition

我有这个问题我想不通。我有 500 个来自均匀分布的 A 组样本。并且有 500 个来自另一个均匀分布的 B 组样本。

我要select一个值,a来自A,另一个值b来自B。 我想制作'a is always smaller than b'。我想要500双不重复。

A <- runif(500, min = 19, max= 23)
B <- runif(500, min = 22, max= 26)

如何得到 500 对 a < b 的 (a,b) 而没有重复?


已编辑:

对不起,我需要澄清我的问题。 A组和B组一旦设置,将不会更改。应该从固定的 A 和 B 中 select 编辑 500 对。在每一对中,a < b。

我想看到 'random' 效果 Monte Carlo。所以,我认为仅仅排序不能解决这个问题。

由于A和B的范围不同,我们可以对集合进行排序,并检查排序后的向量是否产生满足所需条件的对。

C <- sort(A)
D <- sort(B)

现在我们需要检查 C[i]D[i] 对是否满足所有 i:

的条件 C[i] < D[i]
> !!sum(C > D)
#[1] FALSE

在这种情况下我们很幸运:所有对都满足必要条件。如果此测试返回 TRUE,我们可以尝试生成新的随机数集。

现在我们有 C[i]D[i] 对,分别从 AB 中选择条目,这样 C[i] < D[i] 的所有 500 个值i

在浮点数中几乎不可能出现重复。

根据我对问题的原始解释保留我之前的答案。

我认为提出的问题并不代表您要解决的真正问题。我建议发布有关潜在问题的更多信息以提供更多动力。

为了按原样总结问题陈述,您想要将 A 与满足 A<B 条件的 B 的排列配对。此外,您希望结果对的集合均匀分布在结果集中,如下所示:

问题是这里的 x 值在 [19,23] 上均匀分布,这意味着 x 值的所有波段将具有相同数量的点,并且由于右侧波段的体积较小(因为被排除的三角形)那一侧的密度会更高。所以不可能通过 B.

的任何排列来实现均匀采样

如果您计划使用此分布 Monte Carlo 评估此对象内部的某些内容,您的结果将不正确,因为您将对集合的某些部分进行过采样,从而对其他部分进行欠采样。

解决这个问题的唯一方法是重新采样,如下所示,或者只是丢弃落入该角的所有对,并使用少于 500 个点进行计算。


我认为这只是部分软件问题。

首先,"duplication" 是什么意思? runif 极不可能产生数值相同的重复值。

假设我们可以忽略那个条件,这是一个拒绝抽样的问题;也就是说,你想从一个矩形中采样,一个角被剪掉了。具体来说,这是一个 5x5 正方形(面积 25)减去一个 1x1 三角形(面积 1/2)。最简单的方法是抽取更多的样本,然后取满足条件的前 500 个。

如果我们从大小为 1000 的数据框开始

df <- data.frame(A=runif(1000, min=19, max=23), B=runif(1000, min=22, max=26))

我们可以过滤并获得前 500 个:

df2 <- head(df[df$A < df$B, ], 500)
rownames(df2) <- NULL

这不是最漂亮的解决方案,但它确实有效。不过,请谨慎选择 A 和 B 的可行最小值和最大值。

A <- runif(500, min = 19, max= 23)
B <- runif(500, min = 22, max= 26)

while(any(A>B)) {
  i <- which(A>B)
  A[i] <- runif(length(i), min = 19, max= 23)
}

给你。

> any(A>B)
[1] FALSE

重复不是问题,因为您是从连续分布中提取的。

The expected number of iteration of the loop is left as an exercise for the reader.

编辑:好吧,我很好奇,所以这里是平均迭代次数的样子,根据数据的行数绘制。

如你所见,它在O(log(size))

代码:

library(foreach)
x <- 10^seq(2,5,.5)

res <- foreach(size=x, .combine=data.frame) %:%
  times(1000) %do% {
    A <- runif(size, min = 19, max= 23)
    B <- runif(size, min = 22, max= 26)
    counter <- 1
    while(any(A>B)) {
      i <- which(A>B)
      A[i] <- runif(length(i), min = 19, max= 23)
      counter <- counter +1
    }  
    counter
  }

plot(x, colMeans(res), log = "x", 
     xlab ="Size of the data (log scale)", ylab="Expected #iteration")

如果一定要从原来的A和B中抽取,我建议:

A <- runif(500, min = 19, max= 23)
B <- runif(500, min = 22, max= 26)
used <- rep(F, 500)

library("foreach")

newB <- foreach(a=A, .combine=c) %do% {
  ind <- which(B>a & !used) # pool of available B values
  if (length(ind)==0) # ie no remaining element of B is over a!
    stop("This is quite unlikely but let's catch it just in case")

  b <- B[ind] # pool of available B values

  i <- sample(length(b), 1) # draw an index at random from b
  ### code was faulty here
  used[ind[i]] <- T # flag it as used, it won't be drawn again
  ### 
  return(b[i]) # return the value
}


foreach(b=B, a=A, .export="B", .final=function(x) {print("Everything is ok")}) %do% {
  if(sum(newB %in% b)>1) 
    stop("There are duplicates")
}

foreach(b=newB, a=A, .export="B", .final=function(x) {print("Everything is ok")}) %do% {
  if(a>b)
    stop("There are invalid pairs")
}

产生:

[1] "Everything is ok"

没有重复或无效的对。

编辑:我修复了它。明明一切正常的测试也坏了,也修好了

这也不是最好的解决方案。反正我解决了! 我使用了带有条件的示例函数,并将选定的值替换为 NA 以防止重复。

A <- runif(500, min = 19, max= 23)
B <- runif(500, min = 22, max= 26)

B.largerthan.A <- function(A,B) {
  result = c()
  i <- 1
  while (i < 500) {
    Select.B <- sample(B[!is.na(B)], size=1)
    if ( (Select.B < max(A,na.rm=TRUE)) & (!is.na(Select.B)) ) {
      Select.A <- sample((A)[(A<Select.B) & (!is.na(A))], size=1)
    }  else {
      Select.A <- sample((A[!is.na(A)]),size=1)
    }

    result = rbind(result, c(Select.A, Select.B))
    A[which(A == Select.A)] = NA
    B[which(B == Select.B)] = NA
    i=1+i
    if (length(B[!is.na(B)]) == 1) {
      Select.B <- B[!is.na(B)]
      Select.A <- A[!is.na(A)]
      result = rbind(result, c(Select.A, Select.B))
      A[which(A == Select.A)] = NA
      B[which(B == Select.B)] = NA
      break
    }}
  return(result)
}

A_B <- B.largerthan.A(A,B)

它产生:

> any(A_B[,1] < A_B[,2])
[1] TRUE

如果你有任何更整洁的想法。请告诉我。 谢谢!

看看这是否有效。

数据

A <- runif(500, min = 19, max= 23)
B <- runif(500, min = 22, max= 26)

链应用和Lapply

result<-sapply(B,function(b){b>lapply(A,function(a){a})})

提取索引

indices<-which(result,arr.ind = TRUE)

使用索引对 A 和 B 向量进行子集化并将所有对放入数据框中

df<-as.data.frame(x=cbind(A=A[indices[,1]],B=B[indices[,2]]))

从中抽取 500 个样本

library(dplyr)    
df_sampled<-sample_n(df,500)

一些测试

all(df$A %in% A)
[1] TRUE
all(df$B %in% B)
[1] TRUE
all(df$A < df$B)
[1] TRUE

这给出了比 500 对大得多的数据框。我们可以轻松地从中获取 500 个样本:)

结果数据帧中的一些样本

sample_n(df,10)

              A        B
79298  19.95930 25.24061
8990   22.47500 25.00853
151784 19.50021 25.81786
189713 20.82555 25.68779
27653  21.47545 23.62572
180116 22.36681 22.50472
52052  21.00113 24.63401
171574 20.11955 22.89538
88720  19.22706 23.98680
25766  21.88181 24.56297