Создать цикл для подвыборки n-1 строк

Question

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

sub.df<- function(x){
  library(data.table)
  library(tidyverse)
  setDT(x)
  while(nrow(x) > 24) { 
    x.1 <- x %>% # this is the beginning of the sample part
      group_by(x$spiral) %>% 
      tally() %>% select(-n) %>%
      sample_n(x, nrow(x)-1, replace = FALSE) #this is where I have trouble
    ks <- ks.test(dist(x[,c(1,2)]), unif.null) #this part is for evaluating the exclusions
    ks.1 <- ks.test(dist(x.1[,c(1,2)]), unif.null)
    if(ks.1$statistic > ks$statistic) {x <- x.1} else {x <- x}
  }

}

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

x.cord  y.cord  subgroup
1       1       1
1       4       1
3       5       1
2       1       1
2       -3      2
3       -1      2
3       -2      2
1       -3      2
-2      -2      3
-4      -1      3
-5      -5      3
-2      -1      3
-3      4       4
-1      1       4
-2      5       4
-4      3       4

Теперь, если цикл работает правильно, первый экземпляр будет сэмплировать 3 (4-1)из каждой подгруппы, затем 2 (3-1), затем 1 (2-1).Таким образом, мои окончательные данные будут выглядеть примерно так:

x.cord   y.cord   subgroup
3        5        1
1        -3       2
-5       -5       3
-4       3        4

Исходя из моего предоставленного кода, мой фактический набор данных будет иметь 24 точки по 6 из каждой подгруппы, но, надеюсь, это должно проиллюстрировать то, что я пытаюсь сделать.

Answer 1

На высоком уровне я знаю, что хочу использовать group_by() и filter()

group_by(x, subgroup) %>% filter(predicate_n_minus_1(subgroup))

Так что задача состоит в том, чтобы написать и протестировать predicate_n_minus_1().Я придумал

predicate_n_minus_1 <- function(x)
    seq_along(x) %in% sample(length(x) - 1)

Это легко проверить, включая важный крайний случай подгруппы нулевой и одной длины

library(testthat)
expect_equal(predicate_n_minus_1(integer()), logical())        # length 0
expect_equal(predicate_n_minus_1(integer(1)), FALSE)           # length 1
expect_equal(length(predicate_n_minus_1(integer(5))), 5)       # length isomorphism
expect_equal(sum(predicate_n_minus_1(integer(5))), 4)          # n - 1
expect_equal(sum(predicate_n_minus_1(letters)), length(letters) - 1) # other types!

Я знаю, что это неЧистое решение Tidyverse, но оно кажется гораздо чище, легче тестируется и легче модифицируется, чем вызовы вложенных функций в ответе MKR.Может быть, существует решение для Tidyverse, которое аналогичным образом отделяет общую обработку данных от спецификации фильтра?

Answer 2

На мой взгляд, вы не используете sample_n правильно.Функция group_size может помочь вам определить размер группы.Предполагая, что все группы имеют одинаковый размер, вы можете заменить свой оператор выбора в функции, как показано ниже.

Позволяет.Сначала продемонстрируйте, как будет работать этот подвыбор.OP может использовать его как часть функции после проверки.

Использование min(group_size(group_by(.,subgroup)))-1 обеспечит выборку 1 меньше группы с наименьшим количеством строк.

library(tidyverse)
x %>% # this is the beginning of the sample part
  group_by(subgroup) %>%  # This will ensure that equal selection from each group
  sample_n(.,min(group_size(group_by(.,subgroup)))-1, replace = FALSE)

#Result - 3 from each subgroup has been selected. 

# # A tibble: 12 x 3
# # Groups: subgroup [4]
# x.cord y.cord subgroup
# <int>  <int>    <int>
# 1      1      1        1
# 2      3      5        1
# 3      2      1        1
# 4      2     -3        2
# 5      3     -1        2
# 6      1     -3        2
# 7     -4     -1        3
# 8     -2     -1        3
# 9     -5     -5        3
# 10     -4      3        4
# 11     -2      5        4
# 12     -3      4        4

Теперь, так как проверка была выполнена выше, давайте изменим функцию.

Примечание: Функция не проверена.Запросите OP для тестирования с реальными данными.

# modified function should be as
sub.df<- function(x){
  library(tidyverse)
  while(nrow(x) > 24) { 
    x.1 <- x %>% # this is the beginning of the sample part
      group_by(spiral) %>% 
      sample_n(.,min(group_size(group_by(.,spiral)))-1, replace = FALSE)
    ks <- ks.test(dist(x[,c(1,2)]), unif.null) #this part is for evaluating the exclusions
    ks.1 <- ks.test(dist(x.1[,c(1,2)]), unif.null)
    if(ks.1$statistic > ks$statistic) {x <- x.1} else {x <- x}
  }
  x
}

Данные:

x <- read.table(text =
"x.cord  y.cord  subgroup
1       1       1
1       4       1
3       5       1
2       1       1
2       -3      2
3       -1      2
3       -2      2
1       -3      2
-2      -2      3
-4      -1      3
-5      -5      3
-2      -1      3
-3      4       4
-1      1       4
-2      5       4
-4      3       4",
header = TRUE)