满足条件的样本对
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]
对,分别从 A
和 B
中选择条目,这样 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
我有这个问题我想不通。我有 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]
对,分别从 A
和 B
中选择条目,这样 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