Question

所以我有一个看起来像这样的数据集：

a   b   c
23  34  Falcons
14  9   Hawks
2   18  Eagles
3   21  Eagles
22  8   Falcons
11  4   Hawks

而且我知道我可以做一个行with a nested conditional的随机子集，但我想要做的是创建一个随机子集，它使列'c'中每个可用值中的至少一个

所以可能正确的子集是

23  34  Falcons
14  9   Hawks
3   21  Eagles

或

11  4   Hawks
2   18  Eagles
22  8   Falcons

[没有特别的顺序]，但是像：

14  9   Hawks
2   18  Eagles
3   21  Eagles

不起作用，因为'Falcons'没有代表。在R中有一种简单的方法吗？

Answer 1

在group_by包中使用sample_n和dplyr个功能。

text1 <- "a   b   c
23  34  Falcons
14  9   Hawks
2   18  Eagles
3   21  Eagles
22  8   Falcons
11  4   Hawks"

dat <- read.table(text=text1, head=T, as.is=T)

library(dplyr)
dat %>% group_by(c) %>% sample_n(1)

# Source: local data frame [3 x 3]
# Groups: c [3]

#       a     b       c
#   (int) (int)   (chr)
# 1     3    21  Eagles
# 2    22     8 Falcons
# 3    11     4   Hawks

更新：您可以编写一个功能来进行采样。

sample_df <- function(df) {
  df.r <- sample(1:nrow(df), 1)
  return(sample_n(df, df.r))
}
dat %>% group_by(c) %>% do(sample_df(.))

Answer 2

你可以在这里为每个组指定n（如果你只想要一个带有nrows ==组数的数据框，则使用1s

dd <- read.table(header = TRUE, text = 'a   b   c
23  34  Falcons
14  9   Hawks
2   18  Eagles
3   21  Eagles
22  8   Falcons
11  4   Hawks', stringsAsFactors = FALSE)

(n <- setNames(c(1,2,1), unique(dd$c)))
# Falcons   Hawks  Eagles 
#       1       2       1 

set.seed(1)
dd[as.logical(ave(dd$c, dd$c, FUN = function(x)
  sample(rep(c(FALSE, TRUE), c(length(x) - n[x[1]], n[x[1]]))))), ]

#    a  b       c
# 1 23 34 Falcons
# 2 14  9   Hawks
# 4  3 21  Eagles
# 6 11  4   Hawks

将其置于一个功能中，为您自动化其他一些事情

sample_each <- function(data, var, n = 1L) {
  lvl <- table(data[, var])
  n1 <- setNames(rep_len(n, length(lvl)), names(lvl))
  n0 <- lvl - n1
  idx <- ave(as.character(data[, var]), data[, var], FUN = function(x)
    sample(rep(0:1, c(n0[x[1]], n1[x[1]]))))
  data[!!(as.numeric(idx)), ]
}

sample_each(dd, 'c', n = c(1,2,1))
#    a  b       c
# 1 23 34 Falcons
# 3  2 18  Eagles
# 5 22  8 Falcons
# 6 11  4   Hawks

sample_each(mtcars, 'gear', 1)
#                mpg cyl  disp  hp drat   wt  qsec vs am gear carb
# Valiant       18.1   6 225.0 105 2.76 3.46 20.22  1  0    3    1
# Merc 280      19.2   6 167.6 123 3.92 3.44 18.30  1  0    4    4
# Maserati Bora 15.0   8 301.0 335 3.54 3.57 14.60  0  1    5    8


sample_each(mtcars, 'gear', c(2,2,5))
#                     mpg cyl  disp  hp drat    wt  qsec vs am gear carb
# Hornet Sportabout  18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2
# Porsche 914-2      26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2
# Lotus Europa       30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2
# Ford Pantera L     15.8   8 351.0 264 4.22 3.170 14.50  0  1    5    4
# Ferrari Dino       19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6
# Maserati Bora      15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8
# Mazda RX4 Wag1     21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4
# Hornet Sportabout1 18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2
# Merc 2801          19.2   6 167.6 123 3.92 3.440 18.30  1  0    4    4

随机抽样的行，“每个条件至少有一个”

2 个答案: