R中的条件值映射答案

【问题标题】：Value mapping by condition in RR中的条件值映射
【发布时间】：2019-11-02 18:34:38
【问题描述】：

我有一个如下所示的原始数据框：

test
   id class                time
1   1 start 2019-06-20 00:00:00
2   1   end 2019-06-20 00:05:00
3   1 start 2019-06-20 00:10:00
4   1   end 2019-06-20 00:15:00
5   2   end 2019-06-20 00:20:00
6   2 start 2019-06-20 00:25:00
7   2   end 2019-06-20 00:30:00
8   2 start 2019-06-20 00:35:00
9   3   end 2019-06-20 00:40:00
10  3 start 2019-06-20 00:45:00
11  3   end 2019-06-20 00:50:00
12  3 start 2019-06-20 00:55:00

我的目标是将值映射到每个 ID 的输出表仅，其中有一个 start 和一个 end 在连续顺序（时间）。因此，输出如下所示：

output
  id               start                 end
1  1 2019-06-20 00:00:00 2019-06-20 00:05:00
2  1 2019-06-20 00:10:00 2019-06-20 00:15:00
3  2 2019-06-20 00:25:00 2019-06-20 00:30:00
4  3 2019-06-20 00:45:00 2019-06-20 00:50:00

我尝试过使用dplyr 包，但是

test %>% group_by(id) %>% arrange(time) %>% starts_with("start")
Error in starts_with(., "start") : is_string(match) is not TRUE

starts_with 总是抛出错误。我想避免编写 for 循环，因为我确信这可以通过一些链操作来处理。 dplyr 或 data.table 中的解决方法有什么想法吗？

【问题讨论】：

试试test %>% group_by(id) %>% arrange(time) %>% filter(class %>% starts_with("start"))

标签： r dplyr data.table mapping

【解决方案1】：

一种可能的方法：

test[, {
        si <- which(class=="start" & shift(class, -1L)=="end")
        .(id, start=time[si], end=time[si + 1L])
    }, by=.(id)]

输出：

   id                 start                 end
1:  1 1 2019-06-20 00:00:00 2019-06-20 00:05:00
2:  1 1 2019-06-20 00:10:00 2019-06-20 00:15:00
3:  2 2 2019-06-20 00:25:00 2019-06-20 00:30:00
4:  3 3 2019-06-20 00:45:00 2019-06-20 00:50:00

数据：

library(data.table)
test <- fread("id,class,time
1,start,2019-06-20 00:00:00
1,end,2019-06-20 00:05:00
1,start,2019-06-20 00:10:00
1,end,2019-06-20 00:15:00
2,end,2019-06-20 00:20:00
2,start,2019-06-20 00:25:00
2,end,2019-06-20 00:30:00
2,start,2019-06-20 00:35:00
3,end,2019-06-20 00:40:00
3,start,2019-06-20 00:45:00
3,end,2019-06-20 00:50:00
3,start,2019-06-20 00:55:00")

【讨论】：

当我在你或我的数据集上尝试这个时，我得到Error in (function (classes, fdef, mtable) : unable to find an inherited method for function ‘shift’ for signature ‘"character"’
我正在使用data.table_1.12.2
哦，那么包之间的函数命名有冲突

【解决方案2】：

我通常使用 cumsum() 是这些情况

test %>% 
  group_by(id) %>%
  arrange(time, .by_group = TRUE) %>%   # should use .by_group arg
  mutate(flag = cumsum(class == "start")) %>%
  group_by(id, flag) %>%
  filter(n() == 2L) %>%
  ungroup() %>%
  spread(class, time) %>%
  select(-flag)

【讨论】：

不错的答案。结果的结束/开始列的顺序错误。也许使用因子（如我的回答）有效？我不熟悉 spread() 所以我不确定。

【解决方案3】：

使用dplyr和tidyr，我们可以先filter遵循"start"和"end"模式的行，创建2行组和spread长格式。

library(dplyr)
library(tidyr)

test %>%
  group_by(id) %>%
  filter(class == "start" & lead(class) == "end" | 
         class == "end" & lag(class) == "start") %>%
  group_by(group = gl(n()/2, 2)) %>%
  spread(class, time) %>%
  ungroup() %>%
  select(-group) %>%
  select(id, start, end)

#     id  start              end               
#   <int> <dttm>              <dttm>             
#1     1 2019-06-20 00:00:00 2019-06-20 00:05:00
#2     1 2019-06-20 00:10:00 2019-06-20 00:15:00
#3     2 2019-06-20 00:25:00 2019-06-20 00:30:00
#4     3 2019-06-20 00:45:00 2019-06-20 00:50:00

【讨论】：

感谢您的帮助！这会引发以下错误：Error in (function (classes, fdef, mtable) : unable to find an inherited method for function ‘select’ for signature ‘"tbl_df"’
@the_darkside 是的，我认为还有另一个命名冲突。尝试使用dplyr::select ?

【解决方案4】：

您可以保留每个start 行加上紧随其后的end（如果有），然后使用dcast 从长格式切换到宽格式：

test[, 
  if (.N >= 2) head(.SD, 2)
, by=.(g = rleid(id, cumsum(class=="start"))), .SDcols=names(test)][, 
  dcast(.SD, id + g ~ factor(class, levels=c("start", "end")), value.var="time")
]

   id g               start                 end
1:  1 1 2019-06-20 00:00:00 2019-06-20 00:05:00
2:  1 2 2019-06-20 00:10:00 2019-06-20 00:15:00
3:  2 4 2019-06-20 00:25:00 2019-06-20 00:30:00
4:  3 7 2019-06-20 00:45:00 2019-06-20 00:50:00

rleid 和cumsum 用于查找序列；并且需要factor 告诉dcast 列顺序。

旁注：这与@cheetahfly 的回答基本相同（我发帖时没有意识到）：由于 cumsum 正在增加，因此按 id + cumsum 分组就足够了无需使用 rleid （用于跟踪值的运行）。唯一的区别是我的方法会像开始、结束、结束一样保持运行；而另一个答案将使用 n() == 2 检查将其过滤掉。

【讨论】：