R嵌套循环以填充空白变量,直到达到特定的时间戳

R嵌套循环以填充空白变量,直到达到特定的时间戳,r,for-loop,if-statement,nested-loops,posixct,R,For Loop,If Statement,Nested Loops,Posixct,我使用的数据集每半小时有一个时间戳(POSIXct格式)(但有些时间块有重复项,而每个时间块的重复项数量不同)。有三列A、B1、B2记录船舶在港口的位置。还有两列带有每艘船到达和离开的时间戳。我想将A、B1和B2的时间向前推进,直到到达出发时间戳,以实际指示船舶在港的时间,而不仅仅是到达时间 下面是表的外观(有更多的行…200万…) [时间戳][A][B1][B2][到达][离开] [1,]“2018-04-19 08:00:00”A“NA-NA”2018-04-19 08:00:00“2018

我使用的数据集每半小时有一个时间戳(POSIXct格式)(但有些时间块有重复项,而每个时间块的重复项数量不同)。有三列A、B1、B2记录船舶在港口的位置。还有两列带有每艘船到达和离开的时间戳。我想将A、B1和B2的时间向前推进,直到到达出发时间戳,以实际指示船舶在港的时间,而不仅仅是到达时间

下面是表的外观(有更多的行…200万…)

[时间戳][A][B1][B2][到达][离开]
[1,]“2018-04-19 08:00:00”A“NA-NA”2018-04-19 08:00:00“2018-04-20 06:00:00”
[2,]“2018-04-29 07:00:00”A“NA-NA”2018-04-29 07:00:00“2018-04-29 15:00:00”
[3]“2018-04-30 08:00:00”A“NA-NA”2018-04-30 08:00:00“2018-04-30 18:00:00”
[4]“2018-05-11 08:00:00”A“NA-NA”2018-05-11 08:00:00“2018-05-11 17:00:00”
[5]“2018-05-14 08:00:00”A“NA-NA”2018-05-14 08:00:00“2018-05-14 18:00:00”
[6,]“2018-05-18 08:00:00”A“NA-NA”2018-05-18 08:00:00“2018-05-18 17:00:00”
[7,]“2018-05-20 07:00:00”NA“B1”NA“2018-05-20 07:00:00”“2018-05-20 17:00:00”
[8,]“2018-05-20 08:00:00”A“NA-NA”2018-05-20 08:00:00“2018-05-20 17:00:00”
[9]“2018-05-22 07:00:00”A“NA-NA”2018-05-22 07:00:00“2018-05-22 22:00:00”
[10]“2018-05-27 07:00:00”A“NA-NA”2018-05-27 07:00:00“2018-05-27 15:00:00”
[11,]“2018-06-01 00:00:00”不适用
[12,]“2018-06-01 00:30:00”不适用
[13,]“2018-06-01 01:00:00”不适用
[14,]“2018-06-01 01:30:00”不适用
[15,]“2018-06-01 02:00:00”不适用
[16,]“2018-06-01 02:30:00”不适用
[17,]“2018-06-01 03:00:00”不适用
[18,]“2018-06-01 03:30:00”不适用
[19,]“2018-06-01 04:00:00”不适用
[20,]“2018-06-01 04:30:00”不适用
[21,]“2018-06-01 05:00:00”不适用
[22,]“2018-06-01 05:30:00”不适用
[23,]“2018-06-01 06:00:00”不适用
[24]“2018-06-01 06:30:00”不适用
[25,]“2018-06-01 07:00:00”NA“B1”NA“2018-06-01 07:00:00”“2018-06-01 22:00:00”
[26,]“2018-06-01 07:30:00”不适用
[27]“2018-06-01 08:00:00”A“NA-NA”2018-06-01 08:00:00“2018-06-01 17:00:00”
[28,]“2018-06-01 08:30:00”不适用
[29,]“2018-06-01 09:00:00”不适用
[30,]“2018-06-01 09:30:00”不知道
[31,]“2018-06-01 10:00:00”不适用
[32,]“2018-06-01 10:30:00”不适用
[33,]“2018-06-01 11:00:00”不适用
[34,]“2018-06-01 11:30:00”不适用
[35,]“2018-06-01 12:00:00”不适用
[36,]“2018-06-01 12:30:00”不适用
[37,]“2018-06-01 13:00:00”不适用
[38,]“2018-06-01 13:30:00”不适用
[39,]“2018-06-01 14:00:00”不适用
[40,]“2018-06-01 14:30:00”不适用
[41,]“2018-06-01 15:00:00”不适用
[42,]“2018-06-01 15:30:00”不适用
[43,]“2018-06-01 16:00:00”不适用
[44,]“2018-06-01 16:30:00”不适用
[45,]“2018-06-01 17:00:00”不适用
[46,]“2018-06-01 17:30:00”不适用
[47,]“2018-06-01 18:00:00”不适用
lastdate = 1
for(i in 1:length(loopdata$Timestamp))  
{
  if(i%%1000==0) print(i)
  if(!is.na(loopdata$Arrival[i]))
  {lastdate=i}
  if(loopdata$Timestamp[i] >= loopdata$Arrival[lastdate] & 
     loopdata$Timestamp[i] <= loopdata$Departure[lastdate])
  {loopdata[i,2:4]=loopdata[lastdate,2:4]}
}
library(data.table)
time_cols <- c("Arrival", "Departure")
ships_in_harbour <- melt(
  setDT(loopdata), id.var = time_cols, 
  measure.vars = patterns("Anchorage"), na.rm = TRUE,
  value.name = "Anchorage")[
    , variable := NULL][
      # set time zone to EST for all time columns
      , (time_cols) := lapply(.SD, lubridate::force_tz, "EST"), .SDcols = time_cols]

ships_in_harbour[]
                Arrival           Departure Anchorage id
 1: 2018-04-19 14:00:00 2018-04-20 12:00:00         A  1
 2: 2018-04-29 13:00:00 2018-04-29 21:00:00         A  2
 3: 2018-04-30 14:00:00 2018-05-01 00:00:00         A  3
 4: 2018-05-11 14:00:00 2018-05-11 23:00:00         A  4
 5: 2018-05-14 14:00:00 2018-05-15 00:00:00         A  5
 6: 2018-05-18 14:00:00 2018-05-18 23:00:00         A  6
 7: 2018-05-20 14:00:00 2018-05-20 23:00:00         A  7
 8: 2018-05-22 13:00:00 2018-05-23 04:00:00         A  8
 9: 2018-05-27 13:00:00 2018-05-27 21:00:00         A  9
10: 2018-06-01 14:00:00 2018-06-01 23:00:00         A 10
11: 2018-05-20 13:00:00 2018-05-20 23:00:00        B1 11
12: 2018-06-01 13:00:00 2018-06-02 04:00:00        B1 12
library(ggplot2)
ggplot(ships_in_harbour) + 
  aes(x = Arrival, xend = Departure, y = Anchorage, yend = Anchorage) +
  geom_segment()
library(magrittr)   # piping used to improve readability
result <- ships_in_harbour[
  , c(.(time = seq(lubridate::ceiling_date(Arrival, "30 min"),
                   lubridate::floor_date(Departure, "30 min"),
                   by = "30 min")), .SD), 
  by = .(id = seq_len(nrow(ships_in_harbour)))] %>% 
  # reshape to wide format
  dcast(time ~ Anchorage, toString, value.var = "id")

result    
                    time A B1
  1: 2018-04-19 14:00:00 1   
  2: 2018-04-19 14:30:00 1   
  3: 2018-04-19 15:00:00 1   
  4: 2018-04-19 15:30:00 1   
  5: 2018-04-19 16:00:00 1   
 ---                         
238: 2018-06-02 02:00:00   12
239: 2018-06-02 02:30:00   12
240: 2018-06-02 03:00:00   12
241: 2018-06-02 03:30:00   12
242: 2018-06-02 04:00:00   12
tail(result, 22L)
                   time  A B1
 1: 2018-06-01 17:30:00 10 12
 2: 2018-06-01 18:00:00 10 12
 3: 2018-06-01 18:30:00 10 12
 4: 2018-06-01 19:00:00 10 12
 5: 2018-06-01 19:30:00 10 12
 6: 2018-06-01 20:00:00 10 12
 7: 2018-06-01 20:30:00 10 12
 8: 2018-06-01 21:00:00 10 12
 9: 2018-06-01 21:30:00 10 12
10: 2018-06-01 22:00:00 10 12
11: 2018-06-01 22:30:00 10 12
12: 2018-06-01 23:00:00 10 12
13: 2018-06-01 23:30:00    12
14: 2018-06-02 00:00:00    12
15: 2018-06-02 00:30:00    12
16: 2018-06-02 01:00:00    12
17: 2018-06-02 01:30:00    12
18: 2018-06-02 02:00:00    12
19: 2018-06-02 02:30:00    12
20: 2018-06-02 03:00:00    12
21: 2018-06-02 03:30:00    12
22: 2018-06-02 04:00:00    12
                   time  A B1
ships_in_harbour[, id := .I]
time_of_event <-  ships_in_harbour[, c(Arrival, Departure) %>% sort() %>% unique]
foverlaps(
  ships_in_harbour, 
  data.table(start = head(time_of_event, -1L), 
             end = tail(time_of_event, -1L) - lubridate::seconds(0), 
             key = "start,end"), by.x = time_cols) %>% 
  .[, .(start = pmax(start, Arrival), end = pmin(end, Departure), id, Anchorage)] %>% 
  .[start < end] %>% 
  dcast(., start + end ~ Anchorage, toString, value.var = "id")
                  start                 end  A B1
 1: 2018-04-19 14:00:00 2018-04-20 12:00:00  1   
 2: 2018-04-29 13:00:00 2018-04-29 21:00:00  2   
 3: 2018-04-30 14:00:00 2018-05-01 00:00:00  3   
 4: 2018-05-11 14:00:00 2018-05-11 23:00:00  4   
 5: 2018-05-14 14:00:00 2018-05-15 00:00:00  5   
 6: 2018-05-18 14:00:00 2018-05-18 23:00:00  6   
 7: 2018-05-20 13:00:00 2018-05-20 14:00:00    11
 8: 2018-05-20 14:00:00 2018-05-20 23:00:00  7 11
 9: 2018-05-22 13:00:00 2018-05-23 04:00:00  8   
10: 2018-05-27 13:00:00 2018-05-27 21:00:00  9   
11: 2018-06-01 13:00:00 2018-06-01 14:00:00    12
12: 2018-06-01 14:00:00 2018-06-01 23:00:00 10 12
13: 2018-06-01 23:00:00 2018-06-02 04:00:00    12