如何提取与另一列r中指定的数据最接近的10天间隔

pjngdqdw  于 12个月前  发布在  其他
关注(0)|答案(2)|浏览(93)

我有一个每天重复测量的数据(如血糖监测仪)。每个人都可以在一段时间内佩戴该设备,因此一个人可以重复测量1周,其他人可以重复测量6个月。然后每个人都会有一个带有访视日期的列。有些人可以有一次以上的访视(最多3次访视)。
我的数据看起来像这样(抱歉,但我不知道如何生成模拟数据)

datos

id  visit_Date   time                 value
1   2020-03-06   2022-03-23 17:09:00  10    
1   2020-03-06   2022-03-23 17:14:00  11   
1   2020-03-06   2022-03-23 17:19:00  11   
1   2020-03-06   2022-03-23 17:24:00  12   
1   2020-03-06   2022-03-23 17:29:00  11   
2   2018-03-30   2022-03-24 17:22:00  13   
2   2018-03-30   2022-03-24 17:27:00  10
2   2018-03-30   2022-03-24 17:32:00  11
2   2018-03-30   2022-03-24 17:37:00  12

字符串
有些人可以在visit_Date之前佩戴监测设备,有些人只能在visit_Date之后佩戴监测设备。我需要的是提取id, visit_Datetime,和value,间隔10天,但最接近visit_Date。理想情况下应在访视日期之后但有些人在就诊后佩戴的时间不够长,那么visit_Date重叠的间隔就可以了。
到目前为止,我所做的是通过按idvisit_Date分组,按time降序排列,然后按time + 10 days过滤来获得最接近的日期。下面是我使用的代码:

library(lubridate)

datos %>% 
   dplyr::filter(time >= visit_Date) %>%
   group_by(id, visit_Date) %>%
   arrange(desc(time)) %>%
   dplyr::filter(time < time + 10) %>%
   summarise(min = min(time), max = max(time))


我正在使用summarise查看过滤后总共有多少天,但是这种过滤仅适用于访问日期后的time,并且有些人在访问后10天内没有佩戴设备。我想我可以对那些少于10天的人重复相同的过滤过程**time <= visit_Date**,然后合并两个数据集,但我想知道是否有另一种方法来完成它

编辑

我想要的输出将是每个人的所有行,其中10个间隔天最接近visit_Date,理想情况下在visit_Date之后,但如果不重叠visit_Date。这里是一个示例输出(请记住,我的真实的日期在time列中每5分钟有一个数据点。
期望输出(以2个人为例)

> datos

id  visit_Date   time                 value
1   2020-03-06   2022-02-22 17:09:00  10    
1   2020-03-06   2022-02-26 17:09:00  10    
1   2020-03-06   2022-02-26 17:14:00  11   
1   2020-03-06   2022-02-28 17:19:00  11   
1   2020-03-06   2022-03-07 17:24:00  12   
1   2020-03-06   2022-03-07 17:29:00  11   
2   2018-03-30   2022-03-24 17:22:00  13   
2   2018-03-30   2022-03-30 17:27:00  10
2   2018-03-30   2022-04-10 17:32:00  11
2   2018-03-30   2022-04-24 17:37:00  12
2   2018-03-30   2022-04-26 17:37:00  12

# Desired output

id  visit_Date   time                 value
1   2020-03-06   2022-02-26 17:09:00  10    
1   2020-03-06   2022-02-26 17:14:00  11   
1   2020-03-06   2022-02-28 17:19:00  11   
1   2020-03-06   2022-03-07 17:24:00  12   
1   2020-03-06   2022-03-07 17:29:00  11   
2   2018-03-30   2022-03-30 17:27:00  10
2   2018-03-30   2022-04-10 17:32:00  11


在这个例子中,个人 * id 1 * 在访问日期之后没有佩戴设备超过10天,因此,输出应包括访视前的日期,但仅包括最接近visit_Date的10天间隔。在 id2 的情况下,个人在visit_Date之后佩戴设备超过10天,我们选择最接近visit_Date但在visit_Date之后或等于visit_Date的10天
谢谢

mzsu5hc0

mzsu5hc01#

对于一个 id,我们可以检查difftimevisit_date之间的距离是否超过10天。如果是这样,我们可以很容易地用那些TRUE的值进行子集划分。否则,相反地,我们可以对大于负10天的差异进行子集划分。

> by(dat, dat$id, \(x) {
+   if (any(d10 <- difftime(x$visit_Date, as.Date(x$time), unit='days') > 10)) {
+     x[d10, ]
+   } else {
+     x[difftime(x$visit_Date, as.Date(x$time), unit='days') > -10, ]
+   }
+ }) |> do.call(what='rbind')
      id          visit_Date                time value   u
1.1    1 2022-01-01 02:27:41 2022-01-01 02:27:41    12   0
1.2    1 2022-01-01 02:27:41 2022-01-01 14:27:41    12   0
1.3    1 2022-01-01 02:27:41 2022-01-02 02:27:41    12   0
1.4    1 2022-01-01 02:27:41 2022-01-02 14:27:41    10   0
1.5    1 2022-01-01 02:27:41 2022-01-03 02:27:41    13   0
1.6    1 2022-01-01 02:27:41 2022-01-03 14:27:41    10   0
1.7    1 2022-01-01 02:27:41 2022-01-04 02:27:41    10   0
1.8    1 2022-01-01 02:27:41 2022-01-04 14:27:41    12   0
1.9    1 2022-01-01 02:27:41 2022-01-05 02:27:41    10   0
1.10   1 2022-01-01 02:27:41 2022-01-05 14:27:41    12   0
1.11   1 2022-01-01 02:27:41 2022-01-06 02:27:41    11   0
1.12   1 2022-01-01 02:27:41 2022-01-06 14:27:41    12   0
1.13   1 2022-01-01 02:27:41 2022-01-07 02:27:41    12   0
1.14   1 2022-01-01 02:27:41 2022-01-07 14:27:41    10   0
1.15   1 2022-01-01 02:27:41 2022-01-08 02:27:41     9   0
1.16   1 2022-01-01 02:27:41 2022-01-08 14:27:41    10   0
1.17   1 2022-01-01 02:27:41 2022-01-09 02:27:41    12   0
1.18   1 2022-01-01 02:27:41 2022-01-09 14:27:41    13   0
1.19   1 2022-01-01 02:27:41 2022-01-10 02:27:41    11   0
1.20   1 2022-01-01 02:27:41 2022-01-10 14:27:41    11   0
1.21   1 2022-01-01 02:27:41 2022-01-11 02:27:41    10   0
1.22   1 2022-01-01 02:27:41 2022-01-11 14:27:41    11   0
2.26   2 2022-12-04 17:21:57 2022-12-01 17:21:57    11  -3
2.27   2 2022-12-04 17:21:57 2022-12-02 05:21:57    11  -3
2.28   2 2022-12-04 17:21:57 2022-12-02 17:21:57    11  -3
2.29   2 2022-12-04 17:21:57 2022-12-03 05:21:57    11  -3
2.30   2 2022-12-04 17:21:57 2022-12-03 17:21:57    10  -3
2.31   2 2022-12-04 17:21:57 2022-12-04 05:21:57    12  -3
2.32   2 2022-12-04 17:21:57 2022-12-04 17:21:57    11  -3
2.33   2 2022-12-04 17:21:57 2022-12-05 05:21:57    12  -3
2.34   2 2022-12-04 17:21:57 2022-12-05 17:21:57    12  -3
2.35   2 2022-12-04 17:21:57 2022-12-06 05:21:57    13  -3
2.36   2 2022-12-04 17:21:57 2022-12-06 17:21:57    12  -3
2.37   2 2022-12-04 17:21:57 2022-12-07 05:21:57    10  -3
2.38   2 2022-12-04 17:21:57 2022-12-07 17:21:57    10  -3
2.39   2 2022-12-04 17:21:57 2022-12-08 05:21:57    12  -3
2.40   2 2022-12-04 17:21:57 2022-12-08 17:21:57    12  -3
2.41   2 2022-12-04 17:21:57 2022-12-09 05:21:57    13  -3
2.42   2 2022-12-04 17:21:57 2022-12-09 17:21:57    12  -3
2.43   2 2022-12-04 17:21:57 2022-12-10 05:21:57    10  -3
2.44   2 2022-12-04 17:21:57 2022-12-10 17:21:57    10  -3
2.45   2 2022-12-04 17:21:57 2022-12-11 05:21:57    10  -3
2.46   2 2022-12-04 17:21:57 2022-12-11 17:21:57    12  -3
2.47   2 2022-12-04 17:21:57 2022-12-12 05:21:57    10  -3
2.48   2 2022-12-04 17:21:57 2022-12-12 17:21:57    10  -3
2.49   2 2022-12-04 17:21:57 2022-12-13 05:21:57     9  -3
2.50   2 2022-12-04 17:21:57 2022-12-13 17:21:57     9  -3
3.51   3 2022-01-31 11:13:21 2022-01-28 11:13:21    12  -3
3.52   3 2022-01-31 11:13:21 2022-01-28 23:13:21    13  -3
3.53   3 2022-01-31 11:13:21 2022-01-29 11:13:21    11  -3
3.54   3 2022-01-31 11:13:21 2022-01-29 23:13:21    12  -3
3.55   3 2022-01-31 11:13:21 2022-01-30 11:13:21    11  -3
3.56   3 2022-01-31 11:13:21 2022-01-30 23:13:21    10  -3
3.57   3 2022-01-31 11:13:21 2022-01-31 11:13:21    11  -3
3.58   3 2022-01-31 11:13:21 2022-01-31 23:13:21    13  -3
3.59   3 2022-01-31 11:13:21 2022-02-01 11:13:21    11  -3
3.60   3 2022-01-31 11:13:21 2022-02-01 23:13:21    10  -3
3.61   3 2022-01-31 11:13:21 2022-02-02 11:13:21    10  -3
3.62   3 2022-01-31 11:13:21 2022-02-02 23:13:21    11  -3
3.63   3 2022-01-31 11:13:21 2022-02-03 11:13:21    12  -3
3.64   3 2022-01-31 11:13:21 2022-02-03 23:13:21    10  -3
3.65   3 2022-01-31 11:13:21 2022-02-04 11:13:21     9  -3
3.66   3 2022-01-31 11:13:21 2022-02-04 23:13:21    11  -3
3.67   3 2022-01-31 11:13:21 2022-02-05 11:13:21    12  -3
3.68   3 2022-01-31 11:13:21 2022-02-05 23:13:21    11  -3
3.69   3 2022-01-31 11:13:21 2022-02-06 11:13:21    10  -3
3.70   3 2022-01-31 11:13:21 2022-02-06 23:13:21    11  -3
3.71   3 2022-01-31 11:13:21 2022-02-07 11:13:21    13  -3
3.72   3 2022-01-31 11:13:21 2022-02-07 23:13:21    11  -3
3.73   3 2022-01-31 11:13:21 2022-02-08 11:13:21    10  -3
3.74   3 2022-01-31 11:13:21 2022-02-08 23:13:21    11  -3
3.75   3 2022-01-31 11:13:21 2022-02-09 11:13:21    13  -3
4.76   4 2022-03-01 01:40:46 2022-02-17 01:40:46    10 -12
4.77   4 2022-03-01 01:40:46 2022-02-17 13:40:46     9 -12
4.78   4 2022-03-01 01:40:46 2022-02-18 01:40:46    10 -12
4.79   4 2022-03-01 01:40:46 2022-02-18 13:40:46    10 -12
4.80   4 2022-03-01 01:40:46 2022-02-19 01:40:46    10 -12
4.81   4 2022-03-01 01:40:46 2022-02-19 13:40:46    10 -12
5.101  5 2022-07-23 18:27:11 2022-07-11 18:27:11    12 -12
5.102  5 2022-07-23 18:27:11 2022-07-12 06:27:11     9 -12
5.103  5 2022-07-23 18:27:11 2022-07-12 18:27:11    11 -12
5.104  5 2022-07-23 18:27:11 2022-07-13 06:27:11    11 -12
5.105  5 2022-07-23 18:27:11 2022-07-13 18:27:11    11 -12

字符串

更新

如果你想把byidvisit_Date 都分组,你要找的是interaction

> by(dat, with(dat, interaction(id, visit_Date)), \(x) {
+   if (any(d10 <- difftime(x$visit_Date, as.Date(x$time), unit='days') > 10)) {
+     x[d10, ]
+   } else {
+     x[difftime(x$visit_Date, as.Date(x$time), unit='days') > -10, ]
+   }
+ }) |> do.call(what='rbind')

  • 数据类型:*

2022年随机日期的模拟数据,加上12天并随机减去3,0或12天。在示例数据中保留u列用于定向。为了简洁起见,我使用12小时而不是5分钟间隔。

set.seed(42)
dat <- lapply(seq_len(5), \(x) {
  visit_Date <- as.POSIXct(sample.int(31535700, 1), origin='2022-01-01')
  rnd <- runif(1L)
  if (rnd > .66) {
    u <- -3
  } else if (rnd > .33) {
    u <- 0
  } else {
    u <- -12
  }
  time <- seq.POSIXt(visit_Date, visit_Date + 12*60*60*24, by='12 hour') +
    u*60*60*24
  list(id=x,
       visit_Date=visit_Date, 
       time=time,
       value=round(runif(length(time), 9, 13)),
       u=u)
}) |> lapply(data.frame) |> do.call(what='rbind')


> by(dat, ~id, tail, 3)
id: 1
   id          visit_Date                time value   u
23  1 2022-02-07 03:52:21 2022-02-06 03:52:21    11 -12
24  1 2022-02-07 03:52:21 2022-02-06 15:52:21    11 -12
25  1 2022-02-07 03:52:21 2022-02-07 03:52:21    13 -12
--------------------------------------------------------------------------------------------------- 
id: 2
   id          visit_Date                time value  u
48  2 2022-03-24 14:17:57 2022-04-01 15:17:57    12 -3
49  2 2022-03-24 14:17:57 2022-04-02 03:17:57     9 -3
50  2 2022-03-24 14:17:57 2022-04-02 15:17:57    12 -3
--------------------------------------------------------------------------------------------------- 
id: 3
   id          visit_Date                time value   u
73  3 2022-09-26 17:29:28 2022-09-25 17:29:28    10 -12
74  3 2022-09-26 17:29:28 2022-09-26 05:29:28    10 -12
75  3 2022-09-26 17:29:28 2022-09-26 17:29:28    12 -12
--------------------------------------------------------------------------------------------------- 
id: 4
    id          visit_Date                time value   u
98   4 2022-04-29 20:09:16 2022-04-28 20:09:16     9 -12
99   4 2022-04-29 20:09:16 2022-04-29 08:09:16    11 -12
100  4 2022-04-29 20:09:16 2022-04-29 20:09:16    12 -12
--------------------------------------------------------------------------------------------------- 
id: 5
    id          visit_Date                time value u
123  5 2022-03-17 11:28:55 2022-03-28 12:28:55     9 0
124  5 2022-03-17 11:28:55 2022-03-29 00:28:55    12 0
125  5 2022-03-17 11:28:55 2022-03-29 12:28:55    11 0

cwxwcias

cwxwcias2#

这里有一个data.table的解决方案,我没有得到相同的答案,因为你的问题中有一些不一致的地方,但是如果你能稍微澄清一下如何思考时间,这是很容易改变的。

library(data.table)
dt <- data.table(
  id = c(rep(1, 6),
                 rep(2, 5)),
  visit_Date = lubridate::as_datetime(c(
    rep("2020-03-06", 6),
    rep("2018-03-30", 5)
  )),
  time = lubridate::as_datetime(
    c(
      "2020-02-22 17:09:00",
      "2020-02-26 17:09:00",
      "2020-02-26 17:14:00",
      "2020-02-28 17:19:00",
      "2020-03-07 17:24:00",
      "2020-03-07 17:29:00",
      "2018-03-24 17:22:00",
      "2018-03-30 17:27:00",
      "2018-04-10 17:32:00",
      "2018-04-24 17:37:00",
      "2018-04-26 17:37:00"
    )
  ),
  value = c(10, 10, 11, 11, 12, 11, 13, 10, 11, 12, 12)
)

字符串
首先计算时间和访问日期之间的时间差(以天为单位)。

dt[, days_past_visit := lubridate::time_length(time - visit_Date, "days"), id]


然后计算每人最后一次访问日期后的最长时间。

dt[, max_time_followed := max(days_past_visit), id]


这允许您确定在访问后10天内没有跟踪他们的情况下需要多少缓冲时间。pmin()在这里将没有负缓冲时间的天数替换为零。

dt[, backwards_buffer := pmin(max_time_followed - 10, 0)]


然后你选择那些符合你要求的测量值,它们必须不超过未来10天,并且不能超过剩余的向后缓冲区。

dt[days_past_visit <= 10 & days_past_visit > backwards_buffer]

# or

dt[between(days_past_visit, lower = backwards_buffer, upper = 10)]

相关问题