如何标记 R 中特定行周围的任何值范围？

Question

这是的后续问题。

数据

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"))

问题

我想在给定 file.ID 组的每个变道中标记几行行上方和后几行 lane.change=="yes" 行。上一个问题的答案适用于连续的行，但不适用于任意数量的行。我尝试在 lead 和 lag 函数中提供参数 n，但它没有给出预期的结果。

期望的输出

理想情况下，我希望能够在 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.IDs，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.IDs，它可能会非常慢。

感谢您花时间和精力帮助我。

Answer 1

这只需要仔细索引数组。

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        .

Answer 2

我发布这个答案只是为了让您知道对于这个问题也完全没问题。你只需要稍微调整一下：

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        .

Answer 3

经过进一步的思考和测试，我认为这个解决方案可以适用于OP。这是此线程中和 Masoud 的改进解决方案。它需要 tidyr 包中的 fill 函数来填充土地变化上下边界之间的 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是最终输出。

如何标记 R 中特定行周围的任何值范围？

How to label any range of values around a specific row in R?

r

dataframe

dplyr

tidyr

tidyverse

数据

问题

期望的输出

编辑