Dplyr: Harus dapat mengambil sampel kelompok

species <- iris %.% 
  group_by(Species) %.% 
  summarise(wt = sum(Sepal.Length)) %.%
  sample_n(5, replace = T, weight = wt) %.%
  select(-wt)

inner_join(species, iris)

Saya bertanya-tanya mengapa ini ditutup? Sepertinya fitur yang berpotensi berguna

iris %>%
    group_by(Species) %>%
    sample_n(1)

untuk mengambil semua data dari spesies acak, mis

Saya tidak berpikir bahwa perilaku sample_n 's harus berubah untuk grup karena pengambilan sampel dalam grup adalah perilaku intuitifnya. Namun seringkali berguna untuk dapat mengambil sampel kelompok secara keseluruhan. Ini harus menjadi fungsi kedua. Inilah implementasi saya:

sample_n_groups = function(tbl, size, replace = FALSE, weight=NULL) {
   # regroup when done
   grps = tbl %>% groups %>% unlist %>% as.character
   # check length of groups non-zero
   keep = tbl %>% summarise() %>% sample_n(size, replace, weight)
   # keep only selected groups, regroup because joins change count.
   # regrouping may be unnecessary but joins do something funky to grouping variable
   tbl %>% semi_join(keep) %>% group_by_(grps) 
}

Contoh oleh @rcorty berfungsi seperti yang diharapkan

iris %>% group_by(Species) %>% sample_n_groups(1)

+1

Sunting: Perubahan ke dplyr memecahkan solusi ini;

Bagi Anda yang tiba di sini melalui mesin pencari mencari fungsi ini, implementasi oleh @MarcusWalz tidak sampel dengan penggantian ketika replace = TRUE . Implementasi perlu menggunakan right_join (atau left_join atau inner_join ) untuk menyimpan duplikat:

sample_n_groups = function(tbl, size, replace = FALSE, weight=NULL) {
  # regroup when done
  grps = tbl %>% groups %>% unlist %>% as.character
  # check length of groups non-zero
  keep = tbl %>% summarise() %>% sample_n(size, replace, weight)
  # keep only selected groups, regroup because joins change count.
  # regrouping may be unnecessary but joins do something funky to grouping variable
  tbl %>% right_join(keep, by=grps) %>% group_by_(grps) 
}

Cluster bootstrap adalah kasus penggunaan yang luas untuk fitur ini.

@drhagen , dalam implementasi Anda, apakah Anda punya saran tentang cara membuat id grup unik baru?

Sebenarnya, ini cukup mudah:

sample_n_groups = function(tbl, size, replace = FALSE, weight=NULL) {
  # regroup when done
  grps = tbl %>% groups %>% unlist %>% as.character
  # check length of groups non-zero
  keep = tbl %>% summarise() %>% sample_n(size, replace, weight) %>% 
    mutate(unique_id = 1:NROW(.))
  # keep only selected groups, regroup because joins change count.
  # regrouping may be unnecessary but joins do something funky to grouping variable
  tbl %>% right_join(keep, by=grps) %>% group_by_(grps) 
}

Jawaban di atas oleh @drhagen sepertinya sudah ketinggalan zaman. Ini tampaknya berfungsi sekarang:

sample_n_groups = function(tbl, size, replace = FALSE, weight = NULL) {
  # regroup when done
  grps = tbl %>% groups %>% lapply(as.character) %>% unlist
  # check length of groups non-zero
  keep = tbl %>% summarise() %>% ungroup() %>% sample_n(size, replace, weight)
  # keep only selected groups, regroup because joins change count.
  # regrouping may be unnecessary but joins do something funky to grouping variable
  tbl %>% right_join(keep, by=grps) %>% group_by_(.dots = grps)
}