ランダムなサンプルをグループ別に選択し、追加の条件を付けてください。

Question

this post,に基づいて、行のサンプルを作成しようとしています。同じRアイリスデータの例を使用する。私は正確にそれぞれの種のための15行

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

のサンプルを作成しました。しかし、今どのように新しい選択された行は、少なくとも最後に選択した1から20行の後でなければならないという条件に基づいてサンプルを作成するために？

Answer 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 

} 

間の行のintialサンプルサイズと数を調整するために、必要に応じてここ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()) 

改善の可能性の余地があるに適用される機能ですが、これは私が