使用dplyr的线性插值

时间:2015-01-13 11:06:59

标签: r xts dplyr

我正在尝试使用na.approx()库中的zoo函数(与xts结合使用)来为多个测量的多个人重复测量数据中的缺失值。< / p>

示例数据......

event.date <- c("2010-05-25", "2010-09-10", "2011-05-13", "2012-03-28", "2013-03-07",    
                "2014-02-13", "2010-06-11", "2010-09-10", "2011-05-13", "2012-03-28",
                "2013-03-07", "2014-02-13")
variable   <- c("neck.bmd", "neck.bmd", "neck.bmd", "neck.bmd", "neck.bmd", "neck.bmd",
                "wbody.bmd", "wbody.bmd", "wbody.bmd", "wbody.bmd", "wbody.bmd", "wbody.bmd")
value      <- c(0.7490, 0.7615, 0.7900, 0.7730, NA, 0.7420, 1.0520, 1.0665, 1.0760,
                1.0870, NA, 1.0550)
## Bind into a data frame
df <- data.frame(event.date, variable, value)
rm(event.date, variable, value)
## Convert date
df$event.date <- as.Date(df$event.date)
## Load libraries
library(magrittr)
library(xts)
library(zoo)

我可以使用xts()na.approx() ....为某个人的单个结果插入一个缺失数据点....

## Subset one variable
wbody <- subset(df, variable == "wbody.bmd")
## order/index and then interpolate
xts(wbody$value, wbody$event.date) %>%
  na.approx()
2010-06-11 1.052000
2010-09-10 1.066500
2011-05-13 1.076000
2012-03-28 1.087000
2013-03-07 1.070977
2014-02-13 1.055000

返回矩阵并不理想,但我可以解决这个问题。我遇到的主要问题是我有多个人的多个结果。我,或许天真地认为,因为这是一个分裂 - 应用 - 组合问题,我可以利用dplyr以下列方式实现这一目标......

## Load library
library(dplyr)
## group and then arrange the data (to ensure dates are correct)
df %>%
  group_by(variable) %>%
    arrange(variable, event.date) %>%
      xts(.$value, .$event.date) %>%
        na.approx()
Error in xts(., .$value, .$event.date) : 
  order.by requires an appropriate time-based object

似乎dplyrxts / zoo的效果不佳,我花了几个小时在寻找有关如何插补缺失的教程/示例R中的数据点,但我发现的只是单个案例,到目前为止,我一直无法找到任何关于如何为多个人的多个站点执行此操作(我发现我可以通过将我的数据重新调整为宽,但仍然无法解决我遇到的问题。)

非常感谢任何关于如何进行的想法/建议/见解。

由于

编辑:澄清某些功能来自zoo包。

2 个答案:

答案 0 :(得分:6)

我选择的解决方案基于@docendodiscimus

的第一条评论

我没有尝试创建新的数据框,而是采用这种方法,只是通过利用dplyr的{​​{1}}函数将列添加到现有数据框中。

我的代码现在......

mutate()

df %>% group_by(variable) %>% arrange(variable, event.date) %>% mutate(ip.value = na.approx(value, maxgap = 4, rule = 2)) 允许最多连续四个maxgap,而NA选项允许外推到侧翼时间点。

答案 1 :(得分:5)

使用approx()函数进行线性插值:

df %>%
  group_by(variable) %>%
    arrange(variable, event.date) %>%
    mutate(time=seq(1,n())) %>%
      mutate(ip.value=approx(time,value,time)$y) %>%
      select(-time)

或用于非线性插值的spline函数:

df %>%
  group_by(variable) %>%
    arrange(variable, event.date) %>%
    mutate(time=seq(1,n())) %>%
      mutate(ip.value=spline(time,value ,n=n())$y) %>%
      select(-time)