维护所有级别因子变量的采样数据框
Sampling data frames maintaining all levels of factor variables
我需要对一个数据框进行采样，以维护结果中所有级别的因素。然后我想得到这个样本的补充——即那些不属于样本的行。我的最终目标是为回归分析创建训练样本和测试样本。要成功做到这一点，我需要确保因子变量的所有级别都在训练样本中得到体现。
我尝试过的方法（下面的示例代码）是使用 dplyr::group_by 结合 dplyr::slice_sample 然后 dplyr::anti_join 来获得测试样本。由于某种原因，它不起作用。要么是我遗漏了一些关于这些函数应该如何工作的信息，要么是它们没有按预期运行。
我也尝试过基于 this question 的方法。它们没有用，因为 (1) 我需要保证多个因素的所有级别都得到代表，并且 (2) 我想 select 观察的一部分，而不是特定的数字。
示例代码
> library(tidyverse)
>
> set.seed(72)
>
> data <- tibble(y = rnorm(100), x1 = rnorm(100),
+ x2 = sample(letters, 100, T), x3 = sample(LETTERS, 100, T))
> data
# A tibble: 100 x 4
y x1 x2 x3
<dbl> <dbl> <chr> <chr>
1 1.37 -0.737 c C
2 1.16 1.66 c T
3 0.0344 -0.319 q P
4 1.03 -0.963 k C
5 0.636 0.961 i H
6 0.319 0.761 g L
7 0.216 0.860 u M
8 1.31 0.887 g M
9 -0.594 2.70 m I
10 -0.542 0.517 u C
# … with 90 more rows
>
> train_data <- data %>%
+ group_by(x2, x3) %>%
+ slice_sample(prop = .7)
> train_data # clearly this is not what I want
# A tibble: 8 x 4
# Groups: x2, x3 [8]
y x1 x2 x3
<dbl> <dbl> <chr> <chr>
1 1.23 -0.297 c A
2 1.11 0.689 e O
3 0.559 0.353 e Z
4 -1.65 -1.71 l M
5 -0.777 1.31 l X
6 0.784 0.309 s E
7 0.755 -0.362 u X
8 -0.768 0.292 v H
>
> test_data <- data %>%
+ anti_join(train_data)
Joining, by = c("y", "x1", "x2", "x3")
> test_data # my goal was that the training data would have 70% and the test data would have around 30% of the full sample.
# A tibble: 92 x 4
y x1 x2 x3
<dbl> <dbl> <chr> <chr>
1 1.37 -0.737 c C
2 1.16 1.66 c T
3 0.0344 -0.319 q P
4 1.03 -0.963 k C
5 0.636 0.961 i H
6 0.319 0.761 g L
7 0.216 0.860 u M
8 1.31 0.887 g M
9 -0.594 2.70 m I
10 -0.542 0.517 u C
# … with 82 more rows
>
> reg <- lm(y ~ x1 + x2 + x3, train_data)
> predict(reg, newdata = test_data) # I obviously still have the same problem
Error in model.frame.default(Terms, newdata, na.action = na.action, xlev = object$xlevels) :
factor x2 has new levels a, b, d, f, g, h, i, j, k, m, n, o, p, q, r, t, w, x, y, z
>
>
我不得不将您的数据扩展到 10,000 行，以获得每个分类变量组合的合理数量的观察值。然后，我使用 dplyr（版本 1.0.1）中的 nest_by() 并对每个子集进行采样。
library(dplyr)
set.seed(72)
data <- tibble(y = rnorm(10000), x1 = rnorm(10000),
x2 = sample(letters, 10000, T), x3 = sample(LETTERS, 10000, T))
train <- data %>%
nest_by(x2, x3, .key = "xy") %>%
mutate(sample = list(xy[sample(1:nrow(xy),
size = round(0.7*nrow(xy))),])) %>%
select(-xy) %>%
summarize(sample)
train
# A tibble: 6,975 x 4
# Groups: x2, x3 [676]
x2 x3 y x1
<chr> <chr> <dbl> <dbl>
1 a A -0.539 -1.22
2 a A -0.664 0.453
3 a A -1.32 -0.831
4 a A 0.765 0.258
5 a A -0.462 0.764
6 a A 1.86 -0.0400
7 a A -1.15 1.02
8 a A 0.244 -0.823
9 a A -0.277 -0.744
10 a A 0.221 -0.292
# ... with 6,965 more rows
test <- data%>%
anti_join(train)
test
# A tibble: 3,025 x 4
y x1 x2 x3
<dbl> <dbl> <chr> <chr>
1 0.636 1.71 b P
2 0.319 -0.851 b K
3 1.31 -1.61 r A
4 -1.03 0.436 a B
5 -0.672 -1.43 g O
6 -1.42 -0.637 l L
7 0.879 -1.78 t G
8 0.935 -1.44 g C
9 -2.21 -0.842 v F
10 -1.00 -2.40 i D
# ... with 3,015 more rows
我可以 运行 你的 lm() 和 predict() 没有错误。
如果您使用的是 dplyr 的旧版本，那么制作 train 的方法略有不同。
library(dplyr)
library(tidyr)
library(purrr)
train <-data %>%
nest(x2, x3) %>%
mutate(sample = map(data, function(df) {df[sample(1:nrow(df), round(0.7*nrow(df))),]}) %>%
select(-data) %>%
unnest(sample)
你的code/approach没有问题。你没有足够的观察。有很多组只有 1 行，当以 0.7 比例采样时将其向下舍入为 0。如果将样本更改为 1000 行，相同的代码可以正常工作而不会出错。
library(dplyr)
data <- tibble(y = rnorm(1000), x1 = rnorm(1000),
x2 = sample(letters, 1000, T), x3 = sample(LETTERS, 1000, T))
train_data <- data %>%
group_by(x2, x3) %>%
slice_sample(prop = 0.7)
test_data <- data %>% anti_join(train_data)
reg <- lm(y ~ x1 + x2 + x3, train_data)
predict(reg, newdata = test_data)
如果在您的真实数据中，您的组只有 1 行，您可以对它们进行采样，以便它选择 max of 1 或（0.7*组中的行数）。
train_data <- data %>% group_by(x2, x3) %>% sample_n(max(0.7*n(), 1))
（这里使用了 sample_n 因为我不能在 slice_sample 中使用 n()）。
我需要对一个数据框进行采样，以维护结果中所有级别的因素。然后我想得到这个样本的补充——即那些不属于样本的行。我的最终目标是为回归分析创建训练样本和测试样本。要成功做到这一点，我需要确保因子变量的所有级别都在训练样本中得到体现。
我尝试过的方法（下面的示例代码）是使用 dplyr::group_by 结合 dplyr::slice_sample 然后 dplyr::anti_join 来获得测试样本。由于某种原因，它不起作用。要么是我遗漏了一些关于这些函数应该如何工作的信息，要么是它们没有按预期运行。
我也尝试过基于 this question 的方法。它们没有用，因为 (1) 我需要保证多个因素的所有级别都得到代表，并且 (2) 我想 select 观察的一部分，而不是特定的数字。
示例代码
> library(tidyverse)
>
> set.seed(72)
>
> data <- tibble(y = rnorm(100), x1 = rnorm(100),
+ x2 = sample(letters, 100, T), x3 = sample(LETTERS, 100, T))
> data
# A tibble: 100 x 4
y x1 x2 x3
<dbl> <dbl> <chr> <chr>
1 1.37 -0.737 c C
2 1.16 1.66 c T
3 0.0344 -0.319 q P
4 1.03 -0.963 k C
5 0.636 0.961 i H
6 0.319 0.761 g L
7 0.216 0.860 u M
8 1.31 0.887 g M
9 -0.594 2.70 m I
10 -0.542 0.517 u C
# … with 90 more rows
>
> train_data <- data %>%
+ group_by(x2, x3) %>%
+ slice_sample(prop = .7)
> train_data # clearly this is not what I want
# A tibble: 8 x 4
# Groups: x2, x3 [8]
y x1 x2 x3
<dbl> <dbl> <chr> <chr>
1 1.23 -0.297 c A
2 1.11 0.689 e O
3 0.559 0.353 e Z
4 -1.65 -1.71 l M
5 -0.777 1.31 l X
6 0.784 0.309 s E
7 0.755 -0.362 u X
8 -0.768 0.292 v H
>
> test_data <- data %>%
+ anti_join(train_data)
Joining, by = c("y", "x1", "x2", "x3")
> test_data # my goal was that the training data would have 70% and the test data would have around 30% of the full sample.
# A tibble: 92 x 4
y x1 x2 x3
<dbl> <dbl> <chr> <chr>
1 1.37 -0.737 c C
2 1.16 1.66 c T
3 0.0344 -0.319 q P
4 1.03 -0.963 k C
5 0.636 0.961 i H
6 0.319 0.761 g L
7 0.216 0.860 u M
8 1.31 0.887 g M
9 -0.594 2.70 m I
10 -0.542 0.517 u C
# … with 82 more rows
>
> reg <- lm(y ~ x1 + x2 + x3, train_data)
> predict(reg, newdata = test_data) # I obviously still have the same problem
Error in model.frame.default(Terms, newdata, na.action = na.action, xlev = object$xlevels) :
factor x2 has new levels a, b, d, f, g, h, i, j, k, m, n, o, p, q, r, t, w, x, y, z
>
>
我不得不将您的数据扩展到 10,000 行，以获得每个分类变量组合的合理数量的观察值。然后，我使用 dplyr（版本 1.0.1）中的 nest_by() 并对每个子集进行采样。
library(dplyr)
set.seed(72)
data <- tibble(y = rnorm(10000), x1 = rnorm(10000),
x2 = sample(letters, 10000, T), x3 = sample(LETTERS, 10000, T))
train <- data %>%
nest_by(x2, x3, .key = "xy") %>%
mutate(sample = list(xy[sample(1:nrow(xy),
size = round(0.7*nrow(xy))),])) %>%
select(-xy) %>%
summarize(sample)
train
# A tibble: 6,975 x 4
# Groups: x2, x3 [676]
x2 x3 y x1
<chr> <chr> <dbl> <dbl>
1 a A -0.539 -1.22
2 a A -0.664 0.453
3 a A -1.32 -0.831
4 a A 0.765 0.258
5 a A -0.462 0.764
6 a A 1.86 -0.0400
7 a A -1.15 1.02
8 a A 0.244 -0.823
9 a A -0.277 -0.744
10 a A 0.221 -0.292
# ... with 6,965 more rows
test <- data%>%
anti_join(train)
test
# A tibble: 3,025 x 4
y x1 x2 x3
<dbl> <dbl> <chr> <chr>
1 0.636 1.71 b P
2 0.319 -0.851 b K
3 1.31 -1.61 r A
4 -1.03 0.436 a B
5 -0.672 -1.43 g O
6 -1.42 -0.637 l L
7 0.879 -1.78 t G
8 0.935 -1.44 g C
9 -2.21 -0.842 v F
10 -1.00 -2.40 i D
# ... with 3,015 more rows
我可以 运行 你的 lm() 和 predict() 没有错误。
如果您使用的是 dplyr 的旧版本，那么制作 train 的方法略有不同。
library(dplyr)
library(tidyr)
library(purrr)
train <-data %>%
nest(x2, x3) %>%
mutate(sample = map(data, function(df) {df[sample(1:nrow(df), round(0.7*nrow(df))),]}) %>%
select(-data) %>%
unnest(sample)
你的code/approach没有问题。你没有足够的观察。有很多组只有 1 行，当以 0.7 比例采样时将其向下舍入为 0。如果将样本更改为 1000 行，相同的代码可以正常工作而不会出错。
library(dplyr)
data <- tibble(y = rnorm(1000), x1 = rnorm(1000),
x2 = sample(letters, 1000, T), x3 = sample(LETTERS, 1000, T))
train_data <- data %>%
group_by(x2, x3) %>%
slice_sample(prop = 0.7)
test_data <- data %>% anti_join(train_data)
reg <- lm(y ~ x1 + x2 + x3, train_data)
predict(reg, newdata = test_data)
如果在您的真实数据中，您的组只有 1 行，您可以对它们进行采样，以便它选择 max of 1 或（0.7*组中的行数）。
train_data <- data %>% group_by(x2, x3) %>% sample_n(max(0.7*n(), 1))
（这里使用了 sample_n 因为我不能在 slice_sample 中使用 n()）。