“传播” na.locf 数据用于不规则时间数据答案

【问题标题】："Spread" na.locf data for irregular time data“传播” na.locf 数据用于不规则时间数据
【发布时间】：2020-03-29 19:49:26
【问题描述】：

我有如下数据：

data <- tibble(time = c(ymd_hms("2019-11-01 09:33:00"),
                        ymd_hms("2019-11-01 09:35:00"),
                        ymd_hms("2019-11-01 09:40:00"),
                        ymd_hms("2019-11-01 09:52:00")),
               data = c(1250, 900, 4000, 9000))
data
##  A tibble: 4 x 2
#   time                 data
#   <dttm>              <dbl>
# 1 2019-11-01 09:33:00  1250
# 2 2019-11-01 09:35:00   900
# 3 2019-11-01 09:40:00  4000
# 4 2019-11-01 09:52:00  9000

我希望在第一次和最后一次观察之间的每一分钟对 data 列进行重新采样，并且我希望 data 的值成为下一个非 NAN 值除以 1 + 来自之前的非 nan 值到下一个非 nan 值（即，data 的值从其给定的样本点每分钟“传播”回之前的给定样本点）。

例如，在这种情况下，我期望以下

> result
# A tibble: 20 x 2
   time                 data
   <dttm>              <dbl>
 1 2019-11-01 09:33:00  1250
 2 2019-11-01 09:34:00   450
 3 2019-11-01 09:35:00   450
 4 2019-11-01 09:36:00   800
 5 2019-11-01 09:37:00   800
 6 2019-11-01 09:38:00   800
 7 2019-11-01 09:39:00   800
 8 2019-11-01 09:40:00   800
 9 2019-11-01 09:41:00   750
10 2019-11-01 09:42:00   750
11 2019-11-01 09:43:00   750
12 2019-11-01 09:44:00   750
13 2019-11-01 09:45:00   750
14 2019-11-01 09:46:00   750
15 2019-11-01 09:47:00   750
16 2019-11-01 09:48:00   750
17 2019-11-01 09:49:00   750
18 2019-11-01 09:50:00   750
19 2019-11-01 09:51:00   750
20 2019-11-01 09:52:00   750

我该怎么做？

我在 Zoo 中看到了如何使用 na.locf 来几乎完成我想要的，但我没有看到如何合并数据的这种“传播”而不是仅仅填充最后一个值或进行线性插值。

我也尝试过使用 xts 并将两个系列（其中一个是不规则日期）与一些自定义逻辑合并，但这对我来说很有挑战性。

【问题讨论】：

那么为什么"09:35:00" 的data 条目从900 变为450？我以为您只想替换 NA 条目。为什么"09:34:00"（最初是NA）的条目变成450？
@MauritsEvers 缺少一个时间步。所以 900 将除以 2。同样的逻辑发生在 4000 除以 5（4 个时间步为 NA）。看我的回答。
@M——我明白了。感谢您的澄清。这似乎是“插入”值的常用方法。我已经发布了一个线性插值方法的答案。
@EricHansen 我明白了。在更仔细地重新阅读您的帖子后，我意识到您确实说过您想按照与线性插值不同的方法替换条目。应该更仔细阅读;-)
不抱歉，这是我的错 :) 当我写它时似乎很明显，但现在重读它有点奇怪。特定领域的用例。

标签： r dataframe dplyr time-series zoo

【解决方案1】：

我们可以将dplyr 和join 与具有所有时间步长的数据框一起使用。

然后我们可以向上使用tidyr到fill，最后除以每组中的记录数（即丢失的时间步数+1）

library(dplyr)
library(lubridate)
library(tidyr)

data <- tibble(time = c(ymd_hms("2019-11-01 09:33:00"),
                        ymd_hms("2019-11-01 09:35:00"),
                        ymd_hms("2019-11-01 09:40:00"),
                        ymd_hms("2019-11-01 09:52:00")),
               data = c(1250, 900, 4000, 9000))

tibble(time = seq.POSIXt(from = min(data$time),
                         to = max(data$time), by="min")) %>%
  left_join(., data, by="time") %>% 
  group_by(id = cumsum(is.na(data) & !is.na(lag(data)))) %>% 
  fill(data, .direction = "up") %>% 
  mutate(data = data/ n())

#> # A tibble: 20 x 3
#> # Groups:   id [4]
#>    time                 data    id
#>    <dttm>              <dbl> <int>
#>  1 2019-11-01 09:33:00  1250     0
#>  2 2019-11-01 09:34:00   450     1
#>  3 2019-11-01 09:35:00   450     1
#>  4 2019-11-01 09:36:00   800     2
#>  5 2019-11-01 09:37:00   800     2
#>  6 2019-11-01 09:38:00   800     2
#>  7 2019-11-01 09:39:00   800     2
#>  8 2019-11-01 09:40:00   800     2
#>  9 2019-11-01 09:41:00   750     3
#> 10 2019-11-01 09:42:00   750     3
#> 11 2019-11-01 09:43:00   750     3
#> 12 2019-11-01 09:44:00   750     3
#> 13 2019-11-01 09:45:00   750     3
#> 14 2019-11-01 09:46:00   750     3
#> 15 2019-11-01 09:47:00   750     3
#> 16 2019-11-01 09:48:00   750     3
#> 17 2019-11-01 09:49:00   750     3
#> 18 2019-11-01 09:50:00   750     3
#> 19 2019-11-01 09:51:00   750     3
#> 20 2019-11-01 09:52:00   750     3

【讨论】：

【解决方案2】：

1) zoo 转换为zoo对象z，使用merge插入NA，然后将组g定义为连续的位置，除了组中的最后一个位置是NA。然后计算所需的比率并使用fortify.zoo 转换为数据框。如果动物园系列结果正常，则可以省略最后一行。

library(zoo)

z <- read.zoo(data)
m <- merge(z, zoo(, seq(start(z), end(z), 60)))
g <- head(c(0, cumsum(!is.na(m))), -1)
data2 <- na.locf0(m, fromLast = TRUE) /  ave(m, g, FUN = length)
fortify.zoo(data2)

给予：

                 Index data2
1  2019-11-01 09:33:00  1250
2  2019-11-01 09:34:00   450
3  2019-11-01 09:35:00   450
4  2019-11-01 09:36:00   800
5  2019-11-01 09:37:00   800
6  2019-11-01 09:38:00   800
7  2019-11-01 09:39:00   800
8  2019-11-01 09:40:00   800
9  2019-11-01 09:41:00   750
10 2019-11-01 09:42:00   750
11 2019-11-01 09:43:00   750
12 2019-11-01 09:44:00   750
13 2019-11-01 09:45:00   750
14 2019-11-01 09:46:00   750
15 2019-11-01 09:47:00   750
16 2019-11-01 09:48:00   750
17 2019-11-01 09:49:00   750
18 2019-11-01 09:50:00   750
19 2019-11-01 09:51:00   750
20 2019-11-01 09:52:00   750

2) 基础 这是一个更短的基础解决方案。我们定义了一个函数ratiofun，它为一组给定长度（以分钟为单位）和其右端点的值生成数据。然后扩展时间并应用函数。

ratiofun <- function(minutes, data) rep(data/minutes, minutes)
with(data, data.frame(time = seq(min(time), max(time), 60),
  data = unlist(mapply(ratiofun, c(1, diff(time)), data))))

给予：

                  time data
1  2019-11-01 09:33:00 1250
2  2019-11-01 09:34:00  450
3  2019-11-01 09:35:00  450
4  2019-11-01 09:36:00  800
5  2019-11-01 09:37:00  800
6  2019-11-01 09:38:00  800
7  2019-11-01 09:39:00  800
8  2019-11-01 09:40:00  800
9  2019-11-01 09:41:00  750
10 2019-11-01 09:42:00  750
11 2019-11-01 09:43:00  750
12 2019-11-01 09:44:00  750
13 2019-11-01 09:45:00  750
14 2019-11-01 09:46:00  750
15 2019-11-01 09:47:00  750
16 2019-11-01 09:48:00  750
17 2019-11-01 09:49:00  750
18 2019-11-01 09:50:00  750
19 2019-11-01 09:51:00  750
20 2019-11-01 09:52:00  750

【讨论】：

这真的很棒，谢谢！我正在尝试理解您的第二个答案（无论如何都不是 R 专家），但我不太明白。例如，假设我想要执行相同的填充逻辑向前（例如带有fromLast 的 locf）而不是向后。有什么变化？
啊，它只是改变了 1 在差异中的位置......这个答案非常酷:)