按组选择随机样本，在 R 中有附加条件答案

【问题标题】：Select random sample by group, with additional condition in R按组选择随机样本，在 R 中有附加条件
【发布时间】：2016-12-19 13:03:37
【问题描述】：

基于this post, 我正在尝试制作一个行样本。使用相同的 R iris 数据示例。我已经为每个物种正确地创建了 15 行的样本

Selec_ir<-iris[ with(iris, unlist(tapply(seq_len(nrow(iris)),
                          Species, FUN = sample, 15,replace=FALSE))), ]

但是现在如何根据新选择的行必须至少在最后一个选择的20行之后创建一个样本？

【问题讨论】：

你的问题有点不清楚；请提供您想要的输出示例来说明。
当 iris 只有 150 行的情况下，你将如何绘制 15 个样本，这些样本至少比上一个样本晚 20 行？
@manotheshark，抱歉，我们只能随机选择 2 行而不是 15 行；
内联Selec_ir<-iris[ with(iris, unlist(tapply(seq_len(nrow(iris)), Species, FUN = sample, 3,replace=FALSE))), ]
@manotheshark，想法是，如果选择了一行，则下一个选择的行必须至少位于上一个选择的第 20 位。

标签： r random

【解决方案1】：

以下函数将用于传递数据集中每个组的所有row_numbers，然后在不替换的情况下绘制sample，然后使用split的组合删除所有落在步长范围内的值和findInterval。返回的数组将用于slice 以所需的样本步长输出所需的样本大小。

根据需要修改sample_size和sample_step以调整初始样本大小和保留样本之间的行数

library(plyr)

sample_drop <- function(x, sample_size, sample_step=1) {

  # draw sample and convert to list
  lst_samp <- list(sort(sample(x, size=sample_size, replace=FALSE)))

  # function to split last element of list by step size
  split_last <- function(lst, step) {
    lst_tail <- unlist(tail(lst, n=1L))
    split(lst_tail, findInterval(lst_tail, c(0, step) + min(lst_tail)))
  }

  # split list until all values of last element fall within step size
  while(do.call(function(x) max(x) - min(x), list(unlist(tail(lst_samp, n=1L)))) >= sample_step) {
    lst_samp <- c(head(lst_samp, n=-1L), split_last(lst_samp, sample_step))
  }

  #lst_samp <- llply(lst_samp, unname) # for debug only to remove attr names
  laply(lst_samp, min) # return minimum value from each element

}

这是应用于iris 数据集的函数。

library(dplyr)

data("iris")

sample <- list()
sample$seed <- 1
sample$size <- 15L
sample$step <- 20L

# simulate sample draws with dropping and compare to iris results
set.seed(sample$seed)
sample_drop(50, sample$size, sample$step)
sample_drop(50, sample$size, sample$step)
sample_drop(50, sample$size, sample$step)

set.seed(sample$seed)
iris %>%
  group_by(Species) %>%
  mutate(gid=row_number()) %>%
  slice(sample_drop(n(), sample$size, sample$step))

这是应用于更大的diamonds 数据集的函数

library(dplyr)
library(ggplot2)

data("diamonds")

sample <- list()
sample$seed <- 1
sample$size <- 1000L
sample$step <- 20L

set.seed(sample$seed)
diamonds %>%
  group_by(cut) %>%
  mutate(gid=row_number()) %>%
  slice(sample_drop(n(), sample$size, sample$step))

set.seed(sample$seed)
diamonds %>%
  group_by(cut) %>%
  mutate(gid=row_number()) %>%
  slice(sample_drop(n(), sample$size, sample$step)) %>%
  summarise(samples=n())

可能还有改进的余地，但这对我来说更容易理解

【讨论】：

这正是我正在寻找的，但我是一个 R 初学者，我从未使用过 dplyr 库。如何使其适应两个不同的数据集，其中： - 我必须为每个物种随机选择 15 行（在这种情况下，我有 7 个物种而不是虹膜的三个）。 - 每个物种 10 行（13 种）在您的代码中，当我使用将 samp_size 更改为 samp_step 时，出现此错误：Sample size (7) greater than population size (4). Do you want replace = TRUE?
@freestyle 该错误通常意味着您告诉sample 比原始length 抽取更多样本，而replace = FALSE。如果replace 设置为TRUE，那么它可以从数据中重绘以填充指定的样本长度。您的评论说每个物种有 10 行，但我会先查看那里以确保您有足够的行并且 group_by 命令设置正确。
@freestyle 试试下面的命令来验证每组的行数iris %>% group_by(Species) %>% summarise(n())
我的数据集中有 43249 行。
@freestyle 我改变了使用函数的方法。这应该适用于任何数据集，因为如果没有足够的值可供采样，它将减少样本量。