这是this one的后续问题。
x <- data.frame(file.ID = "Car1",
frames = 1:15,
lane.change = c("no", "no", "no", "yes",
"no", "no", "no", "no",
"no", "yes", "no", "no", "no", "no", "no"))
我想在给定lane.change=="yes"组的每个通道的file.ID行之后标记少数行以及几行。上一个问题的答案适用于连续行但不适用于任意数量的行。我尝试在n和lead函数中提供参数lag，但它没有给出预期的结果。
理想情况下，我希望能够在lane.change=="yes"之前和之后标记任意数量的行。在我的原始数据框中，我想要标记前后800行。但是在示例数据框x中我试图标记2.所以期望的输出应该是：
file.ID frames lane.change range_LC
1 Car1 1 no .
2 Car1 2 no LC1
3 Car1 3 no LC1
4 Car1 4 yes LC1
5 Car1 5 no LC1
6 Car1 6 no LC1
7 Car1 7 no .
8 Car1 8 no LC2
9 Car1 9 no LC2
10 Car1 10 yes LC2
11 Car1 11 no LC2
12 Car1 12 no LC2
13 Car1 13 no .
14 Car1 14 no .
15 Car1 15 no .
请帮助我获得所需的输出。由于原始数据有多个file.ID，我更喜欢dplyr解决方案，因为我以后可以使用group_by。感谢。
我想概括多个file.ID的代码。您可以下载包含2 file.ID s，here的原始数据框的子集。我试过跟随（感谢@ G5W的解决方案）：
library(tidyr)
by_file.ID <- c %>%
group_by(file.ID) %>%
nest()
library(purrr)
by_file.ID <- by_file.ID %>%
mutate(range_LC = map(data, ~ ".")) %>%
mutate(Changes = map(data, ~ tail(which(.$lane.change=="yes"),-1)))
请注意，每种情况下的第一个车道变化都是一个非常小的索引号。所以，我通过tail(which(...), -1)跳过它。另外，请注意，在这些数据中，我想在换道行之前和之后使用800行。因此，单个file.ID的代码应该是这样的：
range_LC[t(outer(Changes, -800:800, '+'))] = rep(1:length(Changes), each=1601)
上面的代码是我不确定如何应用于file.ID组的主要代码。我考虑过将for loop与do.call()一起使用，但由于大量的车道更改和file.ID s，它可能会非常慢。
感谢您花时间和精力帮助我。
答案 0 :(得分：3)
这只需要仔细索引数组。
x$range_LC = "."
Changes = which(x$lane.change == "yes")
x$range_LC[t(outer(Changes, -2:2, '+'))] = rep(1:length(Changes), each=5)
x
file.ID frames lane.change range_LC
1 Car1 1 no .
2 Car1 2 no 1
3 Car1 3 no 1
4 Car1 4 yes 1
5 Car1 5 no 1
6 Car1 6 no 1
7 Car1 7 no .
8 Car1 8 no 2
9 Car1 9 no 2
10 Car1 10 yes 2
11 Car1 11 no 2
12 Car1 12 no 2
13 Car1 13 no .
14 Car1 14 no .
15 Car1 15 no .
答案 1 :(得分：3)
我刚发布这个答案让你知道@ycw's answer对于这个问题也完全没问题。你只需稍微调整一下：
x22 <- x %>%
mutate(LC_ID = rleid(lane.change)/2) %>%
mutate(LC_ID2 = ifelse(LC_ID %% 1 == 0, paste0("LC", LC_ID), NA)) %>%
mutate(LC_ID3 = lag(LC_ID2), LC_ID4 = lead(LC_ID2)) %>%
mutate(LC_ID5 = lag(LC_ID3), LC_ID6 = lead(LC_ID4))
x33 <- mutate(x22, range_LC = coalesce(x22$LC_ID2, x22$LC_ID3, x22$LC_ID4,
x22$LC_ID5, x22$LC_ID6, "."))
x44 <- x33 %>% select(file.ID, frames, lane.change, range_LC)
#output:
x44
# file.ID frames lane.change range_LC
# 1 Car1 1 no .
# 2 Car1 2 no LC1
# 3 Car1 3 no LC1
# 4 Car1 4 yes LC1
# 5 Car1 5 no LC1
# 6 Car1 6 no LC1
# 7 Car1 7 no .
# 8 Car1 8 no LC2
# 9 Car1 9 no LC2
# 10 Car1 10 yes LC2
# 11 Car1 11 no LC2
# 12 Car1 12 no LC2
# 13 Car1 13 no .
# 14 Car1 14 no .
# 15 Car1 15 no .
答案 2 :(得分：2)
经过进一步的思考和测试，我认为这个解决方案可以适用于OP。这是来自mine和Masoud's的改进解决方案。它需要fill包中的tidyr函数在土地变化的上限和下限之间填充NA。
# Load packages
library(dplyr)
library(tidyr)
library(data.table)
我创建了比OP更大的测试用例。现在有两个file.ID。我这样做是为了测试分组是否适用于多辆汽车。
# Create example data frames
x <- data.frame(file.ID = c(rep("Car1", 20), rep("Car2", 20)),
frames = 1:40,
lane.change = c(rep(c("no", "no", "no", "no", "no", "yes",
"no", "no", "no", "no", "no", "no",
"no", "yes", "no", "no", "no", "no", "no", "no"), 2)))
OP可以设置铅和圈的数量。这里我以3为例。请注意，OP有责任确保这些不重叠。
# Set the lead and lag distance
Step <- 3
# Create LC_ID, uppber bound and lower bound of the lead lag difference
x2 <- x %>%
group_by(file.ID) %>%
mutate(LC_ID = rleid(lane.change)/2) %>%
mutate(LC_ID2 = ifelse(LC_ID %% 1 == 0, paste0("LC", LC_ID), NA)) %>%
mutate(LC_ID3 = lag(LC_ID2, Step), LC_ID4 = lead(LC_ID2, Step))
LC_groupID1和LC_groupID2用于分组，以便能够使用fill。
# Create groups based on LC_ID, Group the data and apply fill for two directions
x3 <- x2 %>%
mutate(LC_groupID1 = ifelse(LC_ID %% 1 == 0, LC_ID + 0.5, LC_ID),
LC_groupID2 = ifelse(LC_ID %% 1 == 0, LC_ID - 0.5, LC_ID)) %>%
group_by(file.ID, LC_groupID1) %>%
# Fill one direction based on LC_ID4
fill(LC_ID4, .direction = "down") %>%
ungroup() %>%
# Fill the other direction based on LC_ID3
group_by(file.ID, LC_groupID2) %>%
fill(LC_ID3, .direction = "up") %>%
ungroup()
# Coalesce all the columns
x4 <- mutate(x3, range_LC = coalesce(x3$LC_ID2, x3$LC_ID3, x3$LC_ID4,"."))
# Select the columns
x5 <- x4 %>% select(file.ID, frames, lane.change, range_LC)
x5是最终输出。