如何標記R中特定行的任何值的範圍？

Question

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

問題

我想在一個給定的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 s，我更喜歡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 S中的組。我想過使用for loop與do.call()，但由於大量換道和file.ID s，它可能會非常緩慢。

感謝您的時間和精力幫助我。

Answer 1

經過進一步思考和測試，我認爲這個解決方案可以爲OP工作。這是來自mine和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是最終的輸出。

Answer 2

這隻需要仔細索引數組。

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 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  .