Random sample of rows with "at least one from each" condition

Question

So I've got a dataset that looks something like this:

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

And I know I can do a random subset of rows with a nested conditional, but what I want to do is create a random subset that takes at least one of each available value in column 'c'.

So possible correct subsets would be

23  34  Falcons
14  9   Hawks
3   21  Eagles

or

11  4   Hawks
2   18  Eagles
22  8   Falcons

[in no particular order], but something like:

14  9   Hawks
2   18  Eagles
3   21  Eagles

would NOT work, because 'Falcons' is not represented. Is there an easy way to do this in R?

Answer 1

Use group_by and sample_n functions in the dplyr package.

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

UPDATE: You can write a function to do the sampling.

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

You can specify the n for each group here (use 1s if you only want a data frame with nrows == number of groups

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

Putting this into a function to automate some other things for you

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