样本对满足条件

Question

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

我将选择一个值，一个来自A，另一个值，b来自B.我想要'a总是小于b'。我想获得500对没有重复。

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

如何获得500对（a，b）哪一个<b，没有重复？

---

编辑：

对不起，我需要说清楚我的问题。设置A组和B组后，将不会更改。应从固定的A和B中选择500对。在每对中，a <b。

我希望看到蒙特卡洛的'随机'效果。所以，我认为只是排序无法帮助解决这个问题。

Answer 1

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

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

现在我们需要检查对C[i]，D[i]是否满足所有C[i] < D[i]条件i：

> !!sum(C > D)
#[1] FALSE

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

现在我们分别对C[i]，D[i]和A和B中的条目进行选择，这样C[i] < D[i]就可以获得i的所有500个值。

浮点数实际上不可能复制。

Answer 2

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

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

为了总结问题陈述，你想要将A与B的排列配对，以满足A<B的条件。此外，您希望生成的对集合均匀分布在结果集上，如下所示：

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

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

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

---

我认为这只是一个软件问题。

首先，“重复”是什么意思？ runif极不可能在数值相同的意义上产生重复。

假设我们可以忽略这个条件，这就是拒绝抽样的问题;也就是说，你想从一个带有修剪角的矩形中采样。具体而言，这是5×5平方（区域25）减去1×1三角形（区域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)
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 4

不是最漂亮的解决方案，但它确实有效。小心选择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 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)

连锁蓝莓和拉普利

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