将 case_when 和 between 与对应阈值表一起使用答案

【问题标题】：Using case_when and between with a correspondance threshold table将 case_when 和 between 与对应阈值表一起使用
【发布时间】：2020-08-08 16:12:26
【问题描述】：

早上好，

我有 2 个数据框：(25000,66) 和一个包含 10 个组和每个组的最后一个 id 的温度表 (10,2)。

在大数据集中，我有一个名为id 的变量。只是id = row_number()

id
1
2
3
4
5
...
25000

编辑：很多答案，感谢您的所有想法。阅读后我意识到我忘记了数据描述中的一个重要步骤，我向您道歉。

我在原始bigdataset 上使用合成采样来生成新点。因此，在对id 列进行采样后，如下所示：

id
1
2
2.1
3
3.8
4.74
5.12
6
...
25000

这就是为什么我使用带 last_id 的 between 子句将 id 重新分配给他们的组。

阈值表：

last_id   group_name
50        grp1
1500      grp2
8900      grp3
...
25000     grp10

我想向大数据集添加新列，以便仅基于 id 在阈值表指定的组范围内的条件获得 id 和组名。

现在我写了这个：

df <- df %>%
    dplyr::mutate(group_name = case_when(id < last_id[1,1] ~ last_id[1,2],
                                                between(id, last_id[1,1], last_id[2,1]) ~ last_id[2,2],
                                                between(id, last_id[2,1], last_id[3,1]) ~ last_id[3,2],
                                                between(id, last_id[3,1], last_id[4,1]) ~ last_id[4,2],
                                                between(id, last_id[4,1], last_id[5,1]) ~ last_id[5,2],
                                                between(id, last_id[5,1], last_id[6,1]) ~ last_id[6,2],
                                                between(id, last_id[6,1], last_id[7,1]) ~ last_id[7,2],
                                                between(id, last_id[7,1], last_id[8,1]) ~ last_id[8,2],
                                                between(id, last_id[8,1], last_id[9,1]) ~ last_id[9,2],
                                                id > last_id[9,1] ~ last_id[10,2]))
    )

但它不起作用，我收到此错误：

FUN 中的错误（左，右）：比较 (5) 仅适用于类型列表和原子

而且这段代码看起来很糟糕，必须有其他方法使用 apply 或其他 dplyr 函数吗？

感谢您的阅读。

【问题讨论】：

标签： r dplyr

【解决方案1】：

data.table-package 的两个选项：

1) 使用滚动连接功能

dt <- dt2[dt1, on = .(last_id = id), roll = -Inf]

给出：

> dt
      last_id group_name
   1:       1       grp1
   2:       2       grp1
   3:       3       grp1
   4:       4       grp1
   5:       5       grp1
  ---                   
8896:    8896       grp3
8897:    8897       grp3
8898:    8898       grp3
8899:    8899       grp3
8900:    8900       grp3

2) 使用非等连接功能

# create a 'first_id'
dt2[, first_id := shift(last_id, fill = 0)]
# perform the non-equi join
dt1[dt2, on = .(id > first_id, id <= last_id), group := group_name]

此方法将更新dt1，而不是创建新的data.table，因此内存效率更高：

> dt1
        id group
   1:    1  grp1
   2:    2  grp1
   3:    3  grp1
   4:    4  grp1
   5:    5  grp1
  ---           
8896: 8896  grp3
8897: 8897  grp3
8898: 8898  grp3
8899: 8899  grp3
8900: 8900  grp3

使用基础 R 的选项：

带有findInterval（与cut-method from @ Otto Kässi相当）的纯基R：

df1$group_name <- df2$group_name[findInterval(df1$id, c(0, df2$last_id), left.open = TRUE)]

或者使用基本 R 的 merge 和 zoo::na.locf：

df <- merge(df1, df2, by.x = "id", by.y = "last_id", all.x = TRUE)
df$group_name <- zoo::na.locf(df$group_name, fromLast = TRUE)

使用的数据：

df1 <- data.frame(id = 1:8900)
df2 <- read.table(text="last_id   group_name
50        grp1
1500      grp2
8900      grp3
", header=TRUE, stringsAsFactors=FALSE)

library(data.table)
dt1 <- as.data.table(df1)
dt2 <- as.data.table(df2)

【讨论】：

【解决方案2】：

cut in base R 可以相对容易地做到这一点：

bigdataset <- data.frame(seq(1, 25000,1))
names(bigdataset) <- 'id'
thresholds <- data.frame(
                       c(50, 1500, 8900, 10000, 12000, 13000, 14000, 15000, 16000, 25000), 
                       c('grp1','grp2','grp3','grp4', 'grp5','grp6', 'grp7','grp8','grp9','grp10'))
names(thresholds) <- c('last_id','group_name')

cut(bigdataset$id, breaks=breaks=c(min(bigdataset$id),thresholds$last_id + 1), labels=thresholds$group_name[1:10], right=FALSE) -> bigdataset$group_name

输出：

> bigdataset
         id group_name
1         1       grp1
2         2       grp1
3         3       grp1
4         4       grp1
5         5       grp1
6         6       grp1
7         7       grp1
8         8       grp1
9         9       grp1
10       10       grp1
11       11       grp1
12       12       grp1
13       13       grp1
14       14       grp1
15       15       grp1
16       16       grp1
17       17       grp1
18       18       grp1
19       19       grp1
20       20       grp1
21       21       grp1
22       22       grp1
23       23       grp1
24       24       grp1
25       25       grp1
26       26       grp1
27       27       grp1
28       28       grp1
29       29       grp1
30       30       grp1
31       31       grp1
32       32       grp1
33       33       grp1
34       34       grp1
35       35       grp1
36       36       grp1
37       37       grp1
38       38       grp1
39       39       grp1
40       40       grp1
41       41       grp1
42       42       grp1
43       43       grp1
44       44       grp1
45       45       grp1
46       46       grp1
47       47       grp1
48       48       grp1
49       49       grp1
50       50       grp2
51       51       grp2
52       52       grp2
53       53       grp2
54       54       grp2
55       55       grp2
56       56       grp2
57       57       grp2
58       58       grp2
59       59       grp2
60       60       grp2

请注意，您需要使用min(bigdataset$id) 填充阈值；这样你就有 10 个类的 11 个切点。

【讨论】：

您好@Otto Kässi，您的解决方案似乎有效。您能否阐明用 min() 填充阈值以获得 11 个切点 的含义？
?cut 实际上将组的起点作为断点参数。这就是为什么你需要像这样参数化类断点：breaks=c(min(bigdataset$id), thresholds$last_id)。这会将 0 到 50 之间的 id 分配给 grp1。所以，我没有写breaks=thresholds$last_id，而是在断点列表中包含（“填充”）一个额外的切点min(bigdataset$id)。
使用此答案发布的输出的第 50 行 id = 50，group = grp2。它不应该在grp1中吗？如果将breaks= 更改为breaks=c(min(bigdataset$id),thresholds$last_id + 1) id = 50 将分配给grp1。

【解决方案3】：

这是一种使用dplyr::mutate() 创建索引变量范围的方法，同时使用sqldf() 和BETWEEN 命令来连接数据。

df <- data.frame(matrix(runif(10000,max=100),1000,10))
df$id <- 1:nrow(df)
library(dplyr)
grptbl <- data.frame(maxIndex = c(250,500,750,1000),groupID = c("one","two","three","four"))
grptbl <- mutate(grptbl,minIndex = if_else(is.na(lag(maxIndex)),1,lag(maxIndex)+1))

library(sqldf)
joinedData <- sqldf("select df.*, grptbl.groupID 
                    from df LEFT JOIN grptbl ON (df.id BETWEEN grptbl.minIndex AND grptbl.maxIndex)")
# print first and last rows of each group
joinedData[c(1,250,251,500,501,750,751,1000),c("group_name","X1","X2")]

...和输出：

> # print first and last rows of each group
> joinedData[c(1,250,251,500,501,750,751,1000),c("group_name","X1","X2")]
     group_name        X1        X2
1           one 53.807611 15.134119
250         one 53.016958 50.554198
251         two 36.921168  3.984325
500         two  5.974273 33.079079
501       three 75.851652 24.039047
750       three 98.233083 26.500973
751        four 14.788170 10.312172
1000       four 11.106466 41.666359

sqldf() 的另一种选择是通过 WHERE 子句而不是 LEFT JOIN 完成合并：

joinedData <- sqldf("select df.*, grptbl.groupID 
                    from df, grptbl
                    WHERE df.id BETWEEN grptbl.minIndex AND grptbl.maxIndex")

【讨论】：

感谢您的回答。我转向另一个方向以避免在 R 中使用 SQL 代码的维护复杂性。

【解决方案4】：

这是tidyverse 解决方案。由于您以每个组的最大值加入，您可以指定.direction = 'up' 来填写所有缺失值。

library(tidyverse)
df <- left_join(df1,df2,by = c('id' = 'last_id')) %>% 
  fill(group_name, .direction = 'up')

df1:

df1 <- data.frame(id = rep(1:25000))

df2:

structure(list(last_id = c(50, 1500, 8900, 10500, 16900, 25000
), group_name = c("grp1", "grp2", "grp3", "grp4", "grp5", "grp6"
)), row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame"
))

【讨论】：

您好，马特，感谢您的回答。我在原始问题中添加了一个 EDIT 以添加我错过的数据采样步骤。我不能使用left_join，因为大多数原始ID不在合成数据集中。

【解决方案5】：

您可以改为进行联接，然后使用“最后一次观察结转”（na.locf 来自 zoo 包）作为解决方法来填充缺失值：

# some sample data
df <- data.frame(id = 1:50, val = LETTERS[1:10])
threshold <- data.frame(last_id = c(5, 15, 34, 45),
                        group_name = paste0("group_", 1:4))

df %>% 
  dplyr::left_join(threshold, by = c("id" = "last_id")) %>% 
  zoo::na.locf(fromLast = TRUE)

#>    id val group_name
#> 1   1   A    group_1
#> 2   2   B    group_1
#> 3   3   C    group_1
#> 4   4   D    group_1
#> 5   5   E    group_1
#> 6   6   F    group_2
#> 7   7   G    group_2
#> 8   8   H    group_2
#> 9   9   I    group_2
#> 10 10   J    group_2

从技术上讲，通过设置fromLast = TRUE，这实际上对应于 NOCB（下一个观察向后进行）。

【讨论】：

您好@lks_swrx，我修改了问题以添加我忘记的采样步骤，这对问题进行了相当大的修改。尽管如此，我尝试了您的解决方案，但返回的数据框只有 4 个组（而不是 10 个）。检查后，只有在采样数据帧中存在阈值的组才会在最终数据帧中返回。