r语言 - 采样每组的比例,但具有最小约束(使用dplyr)



我有6个类别(阶层)的人口,我希望在每个阶层中取10%作为样本。为此,我采取:

var = c(rep("A",10),rep("B",10),rep("C",3),rep("D",5),"E","F");var
value = rnorm(30)
dat = tibble(var,value);
pop=dat%>%group_by(var)
pop
singleallocperce = slice_sample(pop, prop=0.1);
singleallocperce

与结果:

# A tibble: 2 x 2
# Groups:   var [2]
var   value
<chr> <dbl>
1 A     -1.54
2 B     -1.12

但我希望即使在某些阶层中,其中的人口不能达到所取样本的10%至少进行一次观察。我怎么能做到这一点在R使用dplyr包?

另外

此外,如果我想进行比例分配抽样(即权重与每个阶层的子群体成正比,例如A的权重将为:10/30,B为:10/30,C:3/30,D:5/30等),如果子群体不符合要求,保持1个观察值的约束?

可能的方法(注意存在20 x A以检查返回两个)。

library(tidyverse)
# Data (note 20 As)
var = c(rep("A",20),rep("B",10),rep("C",3),rep("D",5),"E","F")
value = rnorm(40)
dat = tibble(var, value)
# Possible approach
dat %>%
group_by(var) %>%
mutate(min = if_else(n() * 0.1 >= 1, n() * 0.1, 1),
random = sample(n())) %>%
filter(random <= min) |> 
select(var, value)
#> # A tibble: 7 × 2
#> # Groups:   var [6]
#>   var     value
#>   <chr>   <dbl>
#> 1 A      0.0105
#> 2 A      0.171 
#> 3 B     -1.89  
#> 4 C      1.89  
#> 5 D      0.612 
#> 6 E      0.516 
#> 7 F      0.185

由reprex包(v2.0.1)创建于2022-06-02

加权版本:

library(tidyverse)
# Data (note 20 As)
var = c(rep("A",20),rep("B",10),rep("C",3),rep("D",5),"E","F")
value = rnorm(40)
dat = tibble(var, value)
# Possible approach
dat %>%
add_count(name = "n_all") %>%
group_by(var) %>%
mutate(
weight = n() / n_all,
min = if_else(n() * weight >= 1, n() * weight, 1),
random = sample(n())
) %>%
filter(random <= min) |>
select(var, value)
#> # A tibble: 16 × 2
#> # Groups:   var [6]
#>    var     value
#>    <chr>   <dbl>
#>  1 A      0.339 
#>  2 A      1.77  
#>  3 A     -0.145 
#>  4 A     -0.915 
#>  5 A      0.146 
#>  6 A      0.896 
#>  7 A     -0.407 
#>  8 A     -1.30  
#>  9 A      1.22  
#> 10 A      0.0527
#> 11 B     -0.602 
#> 12 B     -0.432 
#> 13 C     -0.0540
#> 14 D     -1.45  
#> 15 E      1.54  
#> 16 F      0.879

由reprex包(v2.0.1)创建于2022-06-09

这是一个可能的解决方案:

sample_func <- function(data) {
standard <- data %>% 
group_by(var) %>% 
slice_sample(prop = 0.1) %>% 
ungroup()

if(!all(unique(data$var) %in% unique(standard$var))) {
mins <- data %>% 
filter(!var %in% standard$var) %>% 
group_by(var) %>% 
slice(1) %>% 
ungroup()
}

bind_rows(standard, mins) 

}
sample_func(dat)

给了:

var     value
<chr>   <dbl>
1 A      1.36  
2 B     -1.03  
3 C     -0.0450
4 D     -0.380 
5 E     -0.0556
6 F      0.519 

假设是,如果您按比例采样并且没有var的任何样本,则最小阈值将是从var中采样一条记录(通过使用slice(1))。

data.table

library(data.table)
setDT(dat) # make the tibble a data.table
dat[, .SD[sample((1:.N), fifelse(.N >= 10, .N %/% 10, 1))], var]

结果

var     value
1:   A -0.040487
2:   A  0.543354
3:   B -1.100892
4:   C  0.998006
5:   D  0.496898
6:   E  0.819967
7:   F  0.629236

# Data (note 20 As)
var = c(rep("A",20),rep("B",10),rep("C",3),rep("D",5),"E","F")
value = rnorm(40)
dat = tibble(var, value)

最新更新