满足条件的样本对

Question

我有这个问题，我无法弄清楚。我有 500 个来自均匀分布的 A 组样本。并且有 500 个来自另一个均匀分布的 B 组样本。

我将从 A 中选择一个值 a，从 B 中选择另一个值 b。 我想让'a总是小于b'。我想得到 500 双不重复。

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

我怎样才能得到 500 对 (a,b) 是 a

---

编辑：

抱歉，我需要澄清一下我的问题。 A 组和 B 组一旦设置，将不会更改。应从固定的 A 和 B 中选择 500 对。在每对中，a

我想看到像蒙特卡洛那样的“随机”效应。所以，我认为只是排序不能解决这个问题。

Answer 1

由于 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] 与分别从 A 和 B 中选择的条目，这样 C[i] < D[i] 对应于 i 的所有 500 个值。

在浮点数中重复几乎是不可能的。

Answer 2

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

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

按原样总结问题陈述，您希望将A 与满足A<B 条件的B 排列配对。此外，您希望结果对集均匀分布在结果集上，如下所示：

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

如果您打算使用此分布对该对象内部的某些内容进行蒙特卡罗评估，那么您的结果将不正确，因为您将在集合的某些部分进行过采样，从而在其他部分进行欠采样。

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

---

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

首先，“重复”是什么意思？在数值相同的意义上，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

Answer 3

不是最漂亮的解决方案，但它有效。不过要小心为 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

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

循环的预期迭代次数留作练习 给读者。

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

如您所见，它位于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")

Answer 4

如果一定要从原来的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]“一切正常”

没有重复或无效对。

编辑：我修好了。显然，一切正常的测试也被打破了，它也被修复了。

Answer 5

这也不是最漂亮的解决方案。反正我解决了！ 我使用带有条件的示例函数，并将选定的值替换为 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

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

Answer 6

看看这是否有效。

数据

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

Chain Sapply 和 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