R：使用 dplyr 提前 1 小時計算發生次數

Question

試圖想出一種方法來使用 dplyr 來計算每個 id 在每個時間提前 1 小時的出現次數。 嘗試使用 for 循環，但它沒有給我想要的結果。 遍歷堆棧並嘗試尋找各種方法，但無濟於事。 非常感謝任何建議或幫助。 謝謝

數據集： https://drive.google.com/file/d/1U186SeBWYyTnJVgUPmow7yknr6K9vu8i/view?usp=sharing

  id           date_time count
1  1 2019-12-27 00:00:00    NA
2  2 2019-12-27 00:00:00    NA
3  2 2019-12-27 00:55:00    NA
4  2 2019-12-27 01:00:00    NA
5  2 2019-12-28 01:00:00    NA
6  3 2019-12-27 22:00:00    NA
7  3 2019-12-27 22:31:00    NA
8  3 2019-12-28 14:32:00    NA

所需 Output

  id           date_time count
1  1 2019-12-27 00:00:00    1     #Count = 1 since there is no other cases 1 hour ahead but itself, only 1 case of id=1 
2  2 2019-12-27 00:00:00    3     #Count = 3 as there are 3 cases from 00:00 to 01:00 on 27/12
3  2 2019-12-27 00:55:00    2     #Count = 2 as there are 2 cases from 00:55 to 01:55 on 27/12
4  2 2019-12-27 01:00:00    1     #Count = 1 as only itself from 01:00 to 02:00 on 27/12
5  2 2019-12-28 01:00:00    1     #Count = 1 as only itself from 01:00 to 02:00 on 28/12
6  3 2019-12-27 22:00:00    2
7  3 2019-12-27 22:31:00    1
8  3 2019-12-28 14:32:00    1

我的代碼（我被卡住了）：

library(tidyverse)

data <- read.csv('test.csv')
data$date_time <- as.POSIXct(data$date_time)
data$count <- NA

data %>% 
  group_by(id) %>%
  arrange(date_time, .by_group=TRUE)

#Doesn't give the desired output
for (i in 1:nrow(data)){
  data$count[i] <- nrow(data[data$date_time<=data$date_time[i]+1*60*60 & data$date_time>=data$date_time[i],])
}

Answer 1

如果 OP 只是在尋找tidyverse解決方案。 我很高興刪除它。

這是使用data.table非等連接的方法：

DT[, onehrlater := date_time + 60*60] 
DT[, count :=
  DT[DT, on=.(id, date_time>=date_time, date_time<=onehrlater),
    by=.EACHI, .N]$N
]

如何閱讀：

1) DT[, onehrlater:= date_time + 60*60]創建一小時后的 POSIX 日期時間的新列。 :=通過引用更新原始數據集。

2) DT[DT, on=.(id, date_time>=date_time, date_time<=onehrlater)執行自非等連接，使得所有具有 i) 相同 id, ii) date_time 在該行的 date_time 和 iii) 之后的行此行的 date_time 一小時后之前的 date_time 加入到此行。

3) by=.EACHI, .N返回每一行的計數。 並且$N訪問這個自非等連接的 output。 並且DT[, count:=...]通過引用更新原始數據集。

output：

   id           date_time          onehrlater count
1:  1 2019-12-27 00:00:00 2019-12-27 01:00:00     1
2:  2 2019-12-27 00:00:00 2019-12-27 01:00:00     3
3:  2 2019-12-27 00:55:00 2019-12-27 01:55:00     2
4:  2 2019-12-27 01:00:00 2019-12-27 02:00:00     1
5:  2 2019-12-28 01:00:00 2019-12-28 02:00:00     1
6:  3 2019-12-27 22:00:00 2019-12-27 23:00:00     2
7:  3 2019-12-27 22:31:00 2019-12-27 23:31:00     1
8:  3 2019-12-28 14:32:00 2019-12-28 15:32:00     1

數據：

library(data.table)
DT <- fread("id           date_time 
1 2019-12-27T00:00:00
2 2019-12-27T00:00:00
2 2019-12-27T00:55:00
2 2019-12-27T01:00:00
2 2019-12-28T01:00:00
3 2019-12-27T22:00:00
3 2019-12-27T22:31:00
3 2019-12-28T14:32:00")
DT[, date_time := as.POSIXct(date_time, format="%Y-%m-%dT%T")]

Answer 2

這個問題可以使用非 equi 自連接來解決（在data.table中）。 不幸的是，這還不適用於dplyr ，AFAIK。

這是使用 SQL 的實現：

library(sqldf)
sqldf("
select d1.id, d1.date_time, count(d2.date_time) as count 
  from dat as d1, dat as d2
  where d1.id = d2.id and d1.date_time between d2.date_time and (d2.date_time + 60*60)
  group by d2.id, d2.date_time")

 id date_time count 1 1 2019-12-27 00:00:00 1 2 2 2019-12-27 00:00:00 3 3 2 2019-12-27 00:55:00 2 4 2 2019-12-27 01:00:00 1 5 2 2019-12-28 01:00:00 1 6 3 2019-12-27 22:00:00 2 7 3 2019-12-27 22:31:00 1 8 3 2019-12-28 14:32:00 1

數據

# reading directly from google drive, see https://stackoverflow.com/a/33142446/3817004
dat <- data.table::fread(
  "https://drive.google.com/uc?id=1U186SeBWYyTnJVgUPmow7yknr6K9vu8i&export=download")[
    , date_time := anytime::anytime(date_time)]

Answer 3

也許fuzzyjoin在這里可能會有所幫助。 您可以為每行數據創建時間范圍（將end_time設置為 3600 秒或每次后 1 小時）。 然后，您可以對其自身進行模糊連接，其中date_time介於此范圍之間，計為一小時內。

library(tidyverse)
library(fuzzyjoin)

df %>%
  mutate(row_id = row_number(),
         end_time = date_time + 3600) %>%
  fuzzy_inner_join(df, 
                  by = c("id", "date_time" = "date_time", "end_time" = "date_time"), 
                  match_fun = list(`==`, `<=`, `>=`)) %>%
  group_by(row_id) %>%
  summarise(id = first(id.x),
            date_time = first(date_time.x),
            count = n())

Output

# A tibble: 8 x 4
  row_id    id date_time           count
   <int> <int> <dttm>              <int>
1      1     1 2019-12-27 00:00:00     1
2      2     2 2019-12-27 00:00:00     3
3      3     2 2019-12-27 00:55:00     2
4      4     2 2019-12-27 01:00:00     1
5      5     2 2019-12-28 01:00:00     1
6      6     3 2019-12-27 22:00:00     2
7      7     3 2019-12-27 22:31:00     1
8      8     3 2019-12-28 14:32:00     1

Answer 4

我可能只是在這里寫一個小幫手 function 以及 split-lapply-bind 方法而不是group_by ：

f <- function(x)
{
  sapply(1:nrow(x), function(i) {
    y <- as.numeric(difftime(x$date_time, x$date_time[i], units = "min"))
    sum(y >= 0 & y <= 60)
  })
}

df %>% mutate(count = do.call(c, df %>% split(df$id) %>% lapply(f)))
#>   id           date_time count
#> 1  1 2019-12-27 00:00:00     1
#> 2  2 2019-12-27 00:00:00     3
#> 3  2 2019-12-27 00:55:00     2
#> 4  2 2019-12-27 01:00:00     1
#> 5  2 2019-12-28 01:00:00     1
#> 6  3 2019-12-27 22:00:00     2
#> 7  3 2019-12-27 22:31:00     1
#> 8  3 2019-12-28 14:32:00     1

Answer 5

我已按 id 拆分數據，然后對於每一行，我計算了在選定行之后有多少個日期時間在 1 小時的范圍內：

my_data <- tribble(
  ~id,   ~date_time, 
  1, "2019-12-27 00:00:00",
  2, "2019-12-27 00:00:00",    
  2, "2019-12-27 00:55:00",    
  2, "2019-12-27 01:00:00",   
  2, "2019-12-28 01:00:00",    
  3, "2019-12-27 22:00:10",    
  3, "2019-12-27 22:31:00",    
  3, "2019-12-28 14:32:00"    
)

my_data <- my_data %>%
  mutate(
    date_time = lubridate::ymd_hms(date_time)
  ) %>%
  split(.$id) %>%
  map(~.x %>% mutate(diff = c(0, diff(date_time)) / 60))

counts <- my_data %>%
  map(function(id_data) 
    map_dbl(seq_len(nrow(id_data)),
        ~{
          start_diff <- id_data %>% 
            slice(.x) %>%
            pluck("diff")

          id_data[.x:nrow(id_data),] %>%
            filter(diff - start_diff < 1) %>%
            nrow()
        }
    )
  )

my_data <- my_data %>%
  map2(counts, ~.x %>% mutate(counts = .y)) %>%
  bind_rows() %>%
  select(-diff)

Answer 6

您只需要調整循環的邏輯：

res <- data.frame() # empty df for results

for(i in unique(data$id)){
  tmp      <- data[data$id == i,]  # logic is on the Id level

  for(r in 1:nrow(tmp)){
    tmp          <- tmp[ifelse(tmp$date_time <= tmp$date_time[1]+3600,T,F),] # logical test based on 1 hour window
    tmp$count[1] <- nrow(tmp)       # count
    tmp          <- tmp[1,]         # result is on the row level
    res          <- rbind(res, tmp) # populate results
  }
}

這產生：

> res
  id           date_time count
1  1 2019-12-27 00:00:00     1
2  2 2019-12-27 00:00:00     3
3  2 2019-12-27 00:00:00     1
4  2 2019-12-27 00:00:00     1
5  2 2019-12-27 00:00:00     1
6  3 2019-12-27 22:00:00     2
7  3 2019-12-27 22:00:00     1
8  3 2019-12-27 22:00:00     1