如何在組內將第一個值與每個后續值進行比較，直到滿足條件

所以我在下面的一般結構中有一個資料框：

資料框：

我想做的是，在組內，將第一行與下一行進行比較，直到日期之間的差異達到某個閾值，例如 10 天。然后，一旦該行達到閾值，我想針對下一行測驗下一行。它看起來像這樣：

結果，使用閾值 10：

|rownum|group |date       |date diff|
|------|------|-----------|---|        
|1     | a    |2021-05-01 |NA|
|2     | a    |2021-05-02 |1|
|3     | a    |2021-05-03 |2|
|4     | b    |2021-05-15 |NA|
|5     | b    |2021-05-17 |2|
|6     | b    |2021-05-30 |15 (meets criteria, start from row 7 now)|
|7     | b    |2021-05-31 | NA|
|8     | b    |2021-05-31 | 0|
|9     | c    |2021-05-01 | NA|
|10    | c    |2021-05-05 |  4|

所以重申一下，它將組的第一行與后續行進行比較，直到達到某個閾值。然后從組內的第一個代表開始計數到組內的后續行。差異記錄為 datediff。

我試過這個，但我不知道 sapply 是否可行：

dataframe %>% 
    group_by(group) %>%
    mutate(
        datediff = sapply(date, function(x) {
            all(difftime(dataframe$date,dplyr::lag(dataframe, n = 1, default = NA)))
                }
        )
    )

也試過這個，我認為這更接近我想要的：

for (m in 1:length(dataframe)) {
    dataframe <- dataframe %>% 
        group_by(group) %>% 
        rowwise() %>% 
        mutate(datediff = difftime(dataframe$date,dplyr::lag(date, n = m, default = NA), units="days"))
    }

到目前為止，我還沒有能夠獲得正確的行比較來實作閾值位。

uj5u.com熱心網友回復：

另一種tidyverse解決方案。我們可以用它accumulate來實作這個任務。dat來自 r2evans 的例子。

library(tidyverse)

dat2 <- dat %>%
  group_by(group) %>%
  mutate(diff_lag = as.integer(date - lag(date))) %>%
  mutate(diff = accumulate(diff_lag, function(x, y){
    if (is.na(x)){
      res <- y
    }  else if (x > 10){
      res <- NA
    } else {
      res <- x   y
    }
    return(res)
  })) %>%
  select(-diff_lag) %>%
  ungroup()

dat2
# # A tibble: 10 x 4
#    rownum group date        diff
# <    int> <chr> <date>     <int>
#  1      1 a     2021-05-01    NA
#  2      2 a     2021-05-02     1
#  3      3 a     2021-05-03     2
#  4      4 b     2021-05-15    NA
#  5      5 b     2021-05-17     2
#  6      6 b     2021-05-30    15
#  7      7 b     2021-05-31    NA
#  8      8 b     2021-05-31     0
#  9      9 c     2021-05-01    NA
# 10     10 c     2021-05-05     4

uj5u.com熱心網友回復：

基數R

func <- function(x, threshold = 10) {
  r <- rle(c(0, diff(x)) > threshold)
  if ((len <- length(r$values)) > 1) {
    r$lengths[len] <- r$lengths[len] - 1L
    r$lengths[1] <- r$lengths[1]   1L
  }
  cumsum(inverse.rle(r))
}
dat$group2 <- ave(as.numeric(dat$date), dat$group, FUN = func)
dat$datediff <- ave(as.numeric(dat$date), dat[,c("group", "group2")], FUN = function(x) c(NA, (x - x[1])[-1]))
dat$group2 <- NULL
dat
#    rownum group       date datediff
# 1       1     a 2021-05-01       NA
# 2       2     a 2021-05-02        1
# 3       3     a 2021-05-03        2
# 4       4     b 2021-05-15       NA
# 5       5     b 2021-05-17        2
# 6       6     b 2021-05-30       15
# 7       7     b 2021-05-31       NA
# 8       8     b 2021-05-31        0
# 9       9     c 2021-05-01       NA
# 10     10     c 2021-05-05        4

dplyr

library(dplyr)
dat %>%
  group_by(group) %>%
  mutate(group2 = func(date)) %>%
  group_by(group, group2) %>%
  mutate(datediff = c(NA, (date - date[1])[-1])) %>%
  ungroup() %>%
  select(-group2)
# # A tibble: 10 x 4
#    rownum group date       datediff
#     <int> <chr> <date>        <dbl>
#  1      1 a     2021-05-01       NA
#  2      2 a     2021-05-02        1
#  3      3 a     2021-05-03        2
#  4      4 b     2021-05-15       NA
#  5      5 b     2021-05-17        2
#  6      6 b     2021-05-30       15
#  7      7 b     2021-05-31       NA
#  8      8 b     2021-05-31        0
#  9      9 c     2021-05-01       NA
# 10     10 c     2021-05-05        4

資料

dat <- structure(list(rownum = 1:10, group = c("a", "a", "a", "b", "b", "b", "b", "b", "c", "c"), date = structure(c(18748, 18749, 18750, 18762, 18764, 18777, 18778, 18778, 18748, 18752), class = "Date")), row.names = c(NA, -10L), class = "data.frame")

（我已經轉換dat$date為Date-class。）

uj5u.com熱心網友回復：

這是獲取所需內容的一種迂回方式，其中一些人NA將0使用此解決方案：

library(tidyverse)

df %>% 
  group_by(group) %>% 
  mutate(date = as.Date(date),
         date_diff = date - first(date),
         flag = date_diff > 10) %>% 
  group_by(group, flag) %>% 
  mutate(temp_group = cur_group_id()) %>% 
  group_by(temp_group) %>% 
  mutate(date_diff = case_when(date_diff == first(date_diff) ~ date_diff,
                               date_diff != first(date_diff) & date_diff < 10 ~ date - first(date),
                               date_diff != first(date_diff) & date_diff > 10 ~ date - nth(date, 2))) %>% 
  ungroup() %>% 
  select(group, date, date_diff) 


# A tibble: 10 x 3
   group date       date_diff
   <chr> <date>     <drtn>   
 1 a     2021-05-01  0 days  
 2 a     2021-05-02  1 days  
 3 a     2021-05-03  2 days  
 4 b     2021-05-15  0 days  
 5 b     2021-05-17  2 days  
 6 b     2021-05-30 15 days  
 7 b     2021-05-31  0 days  
 8 b     2021-05-31  0 days  
 9 c     2021-05-01  0 days  
10 c     2021-05-05  4 days 

標籤：r if 语句 dplyr 迭代 逐行

上一篇：檢索頂部和底部值R資料框

下一篇：如何更改ggplot圖例，以便`fill`是一個正方形而`linetype`是一條線？