Как загрузить функцию после взятия произвольно выбранной выборки без замены

Question

У меня есть некоторый код, который позволяет мне взять две случайно выбранные выборки из набора данных, применить функцию и повторить процедуру определенное количество раз (см. Ниже код из соответствующего вопроса: Как загрузить функцию с заменой и вернуть результат).

Пример данных:

> dput(a)
structure(list(index = 1:30, val = c(14L, 22L, 1L, 25L, 3L, 34L, 
35L, 36L, 24L, 35L, 33L, 31L, 30L, 30L, 29L, 28L, 26L, 12L, 41L, 
36L, 32L, 37L, 56L, 34L, 23L, 24L, 28L, 22L, 10L, 19L), id = c(1L, 
2L, 2L, 3L, 3L, 4L, 5L, 6L, 7L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 
14L, 15L, 16L, 16L, 17L, 18L, 19L, 20L, 21L, 21L, 22L, 23L, 24L, 
25L)), .Names = c("index", "val", "id"), class = "data.frame", row.names = c(NA, 
-30L))

Код:

   library(plyr)
    extractDiff <- function(P){
      subA <- P[sample(nrow(P), 15, replace=TRUE), ] # takes a random sample of 15 rows
      subB <- P[sample(nrow(P), 15, replace=TRUE), ] # takes a second random sample of 15 rows
      meanA <- mean(subA$val)
      meanB <- mean(subB$val)
      diff <- abs(meanA-meanB)
      outdf <- c(mA = meanA, mB= meanB, diffAB = diff)
      return(outdf)
    }

    set.seed(42)
    fin <- do.call(rbind, replicate(10, extractDiff(a), simplify=FALSE))

Вместо того, чтобы брать ДВУХ случайно выбранных выборок размером 15, я хотел бы взять одну случайно выбранную выборку размера 15, а затем извлечь оставшиеся 15 строк в наборе данных после того, как был сделан первый случайный отбор subA будет равна первой случайной выборке из 15 аков, subB будет равно оставшимся 15 акам после того, как субА был взят). Я действительно не уверен, как это сделать. Любая помощь могла бы быть полезна. Спасибо!

Answer 1

Я считаю, что вы можете сделать это, внеся небольшое изменение в свой код.

extractDiff <- function(P){
  sampleset = sample(nrow(P), 15, replace=FALSE) #select the first 15 rows, note replace=FALSE
  subA <- P[sampleset, ] # takes the 15 selected rows
  subB <- P[-sampleset, ] # takes the remaining rows in the set
  meanA <- mean(subA$val)
  meanB <- mean(subB$val)
  diff <- abs(meanA-meanB)
  outdf <- c(mA = meanA, mB= meanB, diffAB = diff)
  return(outdf)
}

Тем не менее, обратите внимание, что это не совместимо с загрузкой, так как она требует замены. Если, с другой стороны, вы хотите произвести выборку с заменой из набора данных, а затем выполнить выборку с заменой из набора данных, не выбранного в первой выборке, вы можете сделать следующее.

extractDiff <- function(P){
  sampleset1 = sample(nrow(P), 15, replace=TRUE) #select the first 15 rows, note replace=TRUE
  sampleset2 = sample((1:nrow(P))[-unique(sampleset1)],15,replace=TRUE) #selects only from rows not used in sampleset1
  subA <- P[sampleset1, ] # takes the 15 selected rows
  subB <- P[sampleset2, ] # takes the 15 selected rows in the remaining set set
  meanA <- mean(subA$val)
  meanB <- mean(subB$val)
  diff <- abs(meanA-meanB)
  outdf <- c(mA = meanA, mB= meanB, diffAB = diff)
  return(outdf)
}

Однако в зависимости от вашего приложения это все еще может быть не идеальным, так как второй набор данных с большей вероятностью будет иметь несколько экземпляров значения, чем первый. Если бы вы выбирали меньшую долю от общего набора, это было бы гораздо меньшей проблемой. Возможно, было бы лучше разделить набор на два, используя 'shuffle' и сэмплирование с заменой из обеих половин, чтобы два набора были более равномерными, но это не позволит первому набору снова стать настоящим набором для загрузки ботинка.

Answer 2

В этом случае я бы просто перемешал номера строк P (Хранится в index ниже), а затем выберите первые 15 для subA а второй 15 для subB:

library(plyr)
extractDiff <- function(P){
  index <- sample(seq_len(nrow(P)),replace = FALSE)
  subA <- P[index[1:15], ] # takes a random sample of 15 rows
  subB <- P[index[16:30], ] # takes a second random sample of 15 rows
  meanA <- mean(subA$val)
  meanB <- mean(subB$val)
  diff <- abs(meanA-meanB)
  outdf <- c(mA = meanA, mB= meanB, diffAB = diff)
  return(outdf)
}

set.seed(42)
fin <- do.call(rbind, replicate(10, extractDiff(a), simplify=FALSE))