如何在不等频率的时间序列之间进行相关

时间：2017-02-16 12:23:54

标签： r time-series

我每分钟测量室温36分钟，皮肤温度每秒32次测量同一时间段。我有35个重复实验标记（ID）。我需要能够查看相关性，但样本的大小不等。

数据：

我有一个data.frame df1，每分钟测量室温，另一个data.frame df2，皮肤温度每秒测量32次。我有36分钟的数据。此外，还有另一个名为ID的列显示实验编号（1-35），但我不知道如何在以下示例数据中表示这一点。所以从技术上讲，我正在寻找基于ID的每个SkinTemp与RoomTemp的相关性。

    df1 <- data.frame(
        roomTemp = rnorm(1*36),
    )

   df2 <- data.frame(
        skinTemp = rnorm(32*60*36),
        )

我尝试过：

Data <- data.frame(
  Y=c(df1,df2),
  Variable =factor(rep(c("RoomTemp", "SkinTemp"), times=c(length(df1), length(df2))))
)

cor(Data$Y~Data$Variable)

但这似乎不起作用。

2 个答案:

答案 0 :(得分：10)

滚动连接或插值可能有助于在roomTemp测量时计算skinTemp。以下是两者的示例。第一部分是处理多个ID的更新，后面是单个ID案例的原始答案。

更新：处理多个ID的新版本

此更新解决了具有多个ID的数据的情况，我们希望为每个ID单独插值或滚动连接。 

library(data.table)
library(reshape2)
library(dplyr)
library(purrr)
library(ggplot2)
theme_set(theme_classic(base_size=16))

首先，我们将为两个单独的ID创建虚假的自相关数据：

set.seed(395)
df1 <- data.frame(roomTemp = c(cumsum(rnorm(1*36)), cumsum(rnorm(1*36))),
                  ID = rep(c("A","B"), each=36))
df2 <- data.frame(skinTemp = c(cumsum(rnorm(32*60*36,0,0.01)),
                               cumsum(rnorm(32*60*36,0,0.01))),
                  ID = rep(c("A","B"), each=32*60*36))

现在我们添加一个时间列，但在这种情况下，我还在df1中添加了一个班次，这样就不会在df1测量的同时发生df2次测量，只是为了使答案更加通用。

# Add time column
df1$time = rep(0:(0.5*nrow(df1)-1)*60 + 0.0438,2)
df2$time = rep(0:(0.5*nrow(df2)-1)/32, 2)

将数据帧转换为数据表。这次，除了ID之外，我们还为time提供了一个关键列，以便滚动连接将针对每个ID单独进行。

# Convert data frames to data tables
setDT(df1)
setDT(df2)

# Make time a key column in both data frames (for joining)
setkey(df1, ID, time)
setkey(df2, ID, time)

# Rolling join roomTemp to nearest time value of skinTemp
df2 = df1[df2, roll="nearest"]

# Rename rolling joined room temperature column
names(df2)[grep("roomTemp", names(df2))] = "roomTempRoll"

要按roomTemp添加插值的ID，我使用了map_df包中的purrr。 map_df在每个ID上单独运作。 approx负责插值。在原始答案中，我首先使用approxfun创建了一个近似函数，但在这里我只是直接在一个步骤中完成了插值。 map_df会返回一个数据框，但我们只需要y列，其内插值为roomTemp，因此我在dplyr末尾提取了这些内容。功能链并将其分配到roomTempInterp中的df2。 

# Add interpolated room temperature by ID
df2$roomTempInterp = unique(df2$ID) %>% 
  map_df(~ approx(df1$time[df1$ID==.x], df1$roomTemp[df1$ID==.x], 
                  xout=df2$time[df2$ID==.x]), .id="ID") %>% .$y

在下图中，我们将ID分面，以便我们可以分别查看每个ID的估算温度值。

# Plot so we can see what the rolling joined room temperature and 
#  interpolated room temperature look like
ggplot(melt(df2, id.var=c("ID", "time")), aes(time, value, colour=variable)) +
  geom_line(size=0.7) +
  geom_point(data=df1, aes(time, roomTemp), colour="black") +
  facet_grid(ID ~ .)

enter image description here

以下是通过ID获取相关性的一种方法：

df2 %>% group_by(ID) %>%
  summarise(r_interp = cor(skinTemp, roomTempInterp, use="pairwise.complete.obs"),
            r_roll = cor(skinTemp, roomTempRoll, use="pairwise.complete.obs"))

      ID    r_interp      r_roll
1      A -0.04853998 -0.02993207
2      B -0.53993960 -0.53092150

原始答案

首先，我修改了示例数据框以添加一些自相关，因为这似乎更接近您的真实实验并使可视化更容易。

library(data.table)
library(reshape2)
library(dplyr)
library(ggplot2)
theme_set(theme_classic(base_size=16))

# Fake data with autocorrelation
set.seed(395)
df1 <- data.frame(roomTemp = cumsum(rnorm(1*36)))
df2 <- data.frame(skinTemp = cumsum(rnorm(32*60*36,0,0.01)))

现在添加一个时间列。您可以使用实际的日期时间列，但在这里我刚刚使用以秒为单位的数字列。

# Add time column
df1$time = 0:(nrow(df1)-1)*60
df2$time = 0:(nrow(df2)-1)/32

对于插值，我们需要一个函数，在室温测量之间测量皮肤温度时插入室温。 approxfun在点之间执行线性插值。您也可以使用splinefun以类似的方式使用样条线进行插值。

# Function to interpolate room temperature between measurements
roomTempInterp = approxfun(df1$time, df1$roomTemp)

将数据帧转换为数据表，以便使用data.table的滚动连接功能。

# Convert data frames to data tables
setDT(df1)
setDT(df2)

# Make time a key column in both data frames (for joining)
setkey(df1, time)
setkey(df2, time)

现在执行滚动连接到最近的时间值。

# Rolling join roomTemp to nearest time value of skinTemp
df2 = df1[df2, roll="nearest"]

# Rename rolling joined room temperature column
names(df2)[grep("roomTemp", names(df2))] = "roomTempRoll"

将roomTemp的原始df1测量值合并到df2。

df2 = df1[df2, ]  # Equivalent to dplyr: df2 = left_join(df2, df1)

使用我们在上面创建的函数添加插值室温。

# Add interpolated room temperature
df2$roomTempInterp = roomTempInterp(df2$time)

插值方法对我来说似乎更为现实，特别是如果我们可以假设roomTemp在测量之间相对平滑且单调地变化。以下是df2的前10行，其中包括原始df2数据以及新roomTempRoll和roomTempInterp列以及来自{{roomTemp的原始df1测量值1}}。您现在可以使用此数据框来评估roomTemp和skinTemp之间的相关性和其他关系。 

    roomTemp    time roomTempRoll     skinTemp roomTempInterp
 1: -1.21529 0.00000     -1.21529 -0.006511475      -1.215290
 2:       NA 0.03125     -1.21529 -0.014058076      -1.215531
 3:       NA 0.06250     -1.21529 -0.017741690      -1.215773
 4:       NA 0.09375     -1.21529 -0.030211177      -1.216014
 5:       NA 0.12500     -1.21529 -0.027105225      -1.216255
 6:       NA 0.15625     -1.21529 -0.035784295      -1.216497
 7:       NA 0.18750     -1.21529 -0.031319748      -1.216738
 8:       NA 0.21875     -1.21529 -0.033758959      -1.216979
 9:       NA 0.25000     -1.21529 -0.040667384      -1.217220
10:       NA 0.28125     -1.21529 -0.026291442      -1.217462

下面是一个图表，您可以看到滚动连接和插值的外观。黑点标记原始roomTemp测量值。

ggplot(melt(df2 %>% select(-roomTemp), id.var="time"), aes(time, value, colour=variable)) +
  geom_line(size=1) +
  geom_point(data=df2, aes(time, roomTemp), colour="black")

enter image description here

答案 1 :(得分：2)

下面，我提供了一个如何实现此相关性的最小示例。

您可以在下面查看我的评论，但实际上我所做的是为每个室温观察时间创建垃圾箱（或＃34;桶和＃34;）。然后，我通过那些相应的箱子卷起皮肤温度观察值（大大超过室温观察值）。因此，由于您对每个36 * 60 * 32 皮肤温度观察得到一个房间温度观察值，因此将第一个36 * 60 * 32皮肤温度观察结果汇入bin＆＃ 39; 1＆＃39 ;.这个过程从那里继续进行，从[36 * 60 * 32,36 * 60 * 32 * 2]的皮肤温度观察被卷入bin＆＃34; 2＆＃34;，依此类推。

library(lubridate)
library(dplyr)

# create the times of our observations
time.room.temp <- seq.POSIXt(from = as.POSIXct('02/20/2017', format = '%m/%d/%Y'), to = as.POSIXct('02/21/2017', format = '%m/%d/%Y'), by = 36*60)
time.skin.temp <- seq.POSIXt(from = as.POSIXct('02/20/2017', format = '%m/%d/%Y'), to = as.POSIXct('02/21/2017', format = '%m/%d/%Y'), by = 1/32)

n.obs.room.temp <- length(room.temp)
n.obs.skin.temp <- length(skin.temp)

# create some "actual" temperature data
obs.room.temp <- rnorm(n.obs.room.temp, mean = 60, sd = 10)
obs.skin.temp <- rnorm(n.obs.skin.temp, mean = 95, sd = 5)

room.temp.df <- data.frame('room temp' = obs.room.temp, 'time' = time.room.temp)
skin.temp.df <- data.frame('skin temp' = obs.skin.temp, 'time' = time.skin.temp)

# Every 32 indices, seconds is incremented by one.. So our modulus calculuation should be every
# time the index evenly divides 36*60*32... there are 69120 skin-temp observations for every room-temp observation
# So we can effectively "bin" the different seconds for which we observed skin temperatures in order to create a mean temperature by bin,
# i.e. a mean skin temperature for every time at which room temp was recorded
bins <- cut(1:n.obs.skin.temp, seq(0, n.obs.skin.temp, 36*60*32), labels = 1:40)
skin.temp.df$bins <- bins

# Now, we can effectively group skin temperature observations by room temperature observations, and get the average (or median, if you like)
# temperature for each bin
shorter.skin.temp.df <- skin.temp.df %>%
  group_by(bins) %>%
  summarise(average.skin.temp = mean(skin.temp))

# Now we can get the correlation between the two types of temperatures!
cor(room.temp.df$room.temp, shorter.skin.temp.df$average.skin.temp)

编辑：对独特房间温度的数量进行一点验证，并且＆＃34;卷起＆＃34;皮肤温度观察：

> print(length(unique(skin.temp.df$bins)))
[1] 41
> print(length(unique(room.temp.df$time)))
[1] 41

因此，您可以轻松地知道每个独特的室温观察时间都有相应的独特皮肤温度观察时间段。

相关问题
最新问题