# Using Autocorrelation (Tutorial)

*Created: 2020-07-20 ; Updated: 2020-07-20*

Most personal science datasets come in a format known technicaly as a “stream”: rather than a single datapoint or two, the data is most interesting because it comes in a steady form over time. The timeframe might be days or weeks (say, if you measure your weight) or it might be minutes or seconds (heart rate), but these streams generally come as long sequences taken at roughly regular intervals.

Let’s start with a simple example using (average) resting heart rate and weight, both measured daily over a period of 100 days. I’ll generate a dataframe made of daily dates starting from the beginning of the year, with a resting heart rate (rhr) and weight both normally distributed around a mean of 70 and 160 respectively. I’ll also generate `somedata`

that is just like `rhr`

only with a hidden sine wave pattern embedded within. We’ll look at that in a bit.

```
my_data <- tibble(date = seq.Date(from = as_date("2020-01-01"), by = 1, length.out = 100),
rhr = (rnorm(n=100, mean = 70)),
weight = rnorm(n=100,mean=165),
somedata = rhr +sin(seq(1,100))*100)
my_data <- tsibble(my_data) # %>% pivot_longer(cols=rhr:somedata, names_to = "feature") %>% mutate(feature=factor(feature))
```

`## Using `date` as index variable.`

`my_data `

```
## # A tsibble: 100 x 4 [1D]
## date rhr weight somedata
## <date> <dbl> <dbl> <dbl>
## 1 2020-01-01 69.7 166. 154.
## 2 2020-01-02 70.5 164. 161.
## 3 2020-01-03 67.1 165. 81.2
## 4 2020-01-04 71.9 164. -3.81
## 5 2020-01-05 72.3 165. -23.6
## 6 2020-01-06 68.7 164. 40.8
## 7 2020-01-07 70.5 165. 136.
## 8 2020-01-08 68.6 165. 168.
## 9 2020-01-09 69.6 164. 111.
## 10 2020-01-10 70.2 165. 15.8
## # … with 90 more rows
```

Let’s plot it to see how it looks

```
my_data %>% ggplot(aes(x=date, y = rhr)) + geom_line() +
geom_line(aes(x=date,y=weight/2.3), color = "red") +
scale_y_continuous("Percentage",sec.axis = sec_axis(~ . * 2.3, name = "Pounds"))
```

Looks pretty random, but is it really?

Let’s run a simple T-Test to see if the two streams are correlated.

`with(my_data, t.test(rhr, weight))`

```
##
## Welch Two Sample t-test
##
## data: rhr and weight
## t = -632.66, df = 194.84, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -95.35085 -94.75821
## sample estimates:
## mean of x mean of y
## 69.97362 165.02815
```

Wow, this is incredible! If a p-value less than 0.05 is considered the cut-off for statistical significance, our result is magnitudes better. Despite generating data from purely random numbers, what are the odds we’d get such an apparently perfect conclusion?

Unfortunately, the numbers only *look* correlated because of the way they were generated. This plot gives it away: the linear model shows an R^2 value close to zero and a near-horizontal line. Nope, these two are not correlated.

```
my_data %>% ggplot(aes(x=rhr,y=weight)) + geom_point() +
geom_smooth(method = "lm", se=FALSE, color="black") +
geom_point()
```

`## `geom_smooth()` using formula 'y ~ x'`

```
# R-Squared value
with(my_data, summary(lm(weight ~ rhr)))$r.squared
```

`## [1] 0.0002095279`

So that’s it, right? Use R^2 instead of a T-test.

Not so fast…

In this dummy, made-up data, each point in the stream was generated completely at random. But real life data isn’t entirely random – in fact, the whole point of trying to track things is to find the non-random elements. If you have a resting heart rate of, say, 70 on a Monday, you might expect that the rate on Tuesday should also be pretty close to 70. I mean, it can go up and down a little, but you wouldn’t expect a major change unless something else was happening to cause it. If however, your rate goes up a little each day for a week, you might start to wonder if there’s a reason.

In other words, the expected rate of your variable (e.g. heart rate) on a given day is driven by two things: (1) external circumstances and (2) its previous value. Since the whole point of the experiment is to find the external circumstance that drives the change, we need to eliminate this second effect somehow.

When variables have some degree of correlation to one another (usually through time) we call this *autocorrelation* and here’s how you take it into account in your analysis.

Two built-in R functions make this easy: time series (`ts()`

) converts my dataframe into a special data structure that understands data that occurs over time. Once I have a valid time series, then the handy R function `acf()`

computes the autocorrelation and displays it as a series of charts like this:

`acf(ts(my_data))`

Those little vertical bars sticking out at each `lag`

on the horizontal (x) axis indicate the amount of variance that is explained simply by the fact of two data points occuring chronologically near each other. Bars that go above the blue dotted line are lags that have meaningful significance.

The trivial case is with the `date`

variable in the upper-left plot. All of the variance (1.0) can be explained when two dates are zero days apart from one another, with its intensity decreasing steadily over time. The other variables in this dataframe (`weight`

and `rhr`

) have very short vertical bars throughout that stay within the dotted blue lines, indicating that almost none of their variance is due to their chronological sequence. (Which is what we expect, considering the data was generated randomly).

The one exception is the made-up variable `somedata`

, which we deliberately infected with a sine wave pattern that is clearly visible in the vertical bars in the lower-right plot.

# Real World Data

Now let’s run the same analysis on some real data. We’ll pull the data about resting heart rate from OpenHumans and combine with my Apple Health data. We’ll also convert the data to a `tsibble`

object, which is a tidyverse-compliant time series data frame.

```
library(httr)
library(tsibble)
# access_token <- "3p6KTiVy3pJH0UiP17Jt3Kt2uBA2Q1" # UPDATE daily from Sys.getenv("OH_ACCESS_TOKEN")
# url <- paste("https://www.openhumans.org/api/direct-sharing/project/exchange-member/?access_token=",access_token,sep="")
# resp <- GET(url)
# user <- content(resp, "parsed")
# user_data <- user$data
# while (!is.null(user$`next`)) {
# resp <- GET(user$`next`)
# user <- content(resp, "parsed")
# user_data <- append(user_data, user$data)
# }
# for (data_source in user_data){
# if (data_source$source == 'direct-sharing-453'){
# hr <- readr::read_csv(url(data_source$download_url),col_names=c("hr","date","type"))
# }
# }
#
# my_weight <- read_csv("weight2020.csv") %>% mutate(date=as_date(Date), weight=value)
#
# hr_data <- hr %>% dplyr::filter(date>today()-months(15),type=="R") %>% mutate(date=as_date(date)) %>%
# left_join(my_weight, by="date") %>% dplyr::filter(date>"2020-01-01" & date<"2020-03-30") %>% select(date,hr,weight) %>%
# fill(weight, .direction = "up") %>% # replace NA weight values with whatever value precedes it.
#
# distinct(date,hr,.keep_all = TRUE) %>% dplyr::filter(!(hr==64 & weight==164.5)) %>% tsibble()
hr_data <- read_csv("hr_data2020.csv") %>% as_tsibble()
```

```
## Parsed with column specification:
## cols(
## date = col_date(format = ""),
## hr = col_double(),
## weight = col_double()
## )
```

`## Using `date` as index variable.`

` hr_data`

```
## # A tsibble: 85 x 3 [1D]
## date hr weight
## <date> <dbl> <dbl>
## 1 2020-01-02 55 165
## 2 2020-01-03 63 165
## 3 2020-01-04 55 165
## 4 2020-01-05 52 165
## 5 2020-01-06 54 163.
## 6 2020-01-07 55 162.
## 7 2020-01-08 54 163.
## 8 2020-01-09 57 162.
## 9 2020-01-10 60 162.
## 10 2020-01-11 59 161.
## # … with 75 more rows
```

and look at the correlations

```
hr_data %>% ggplot(aes(x=date, y = hr)) + geom_line() +
geom_line(aes(x=date,y=weight/2.3), color = "red") +
scale_y_continuous("Percentage",sec.axis = sec_axis(~ . * 2.3, name = "Pounds"))
```

```
hr_data %>% ggplot(aes(x=hr,y=weight)) + geom_point() +
geom_smooth(method = "lm", se=FALSE, color="black") +
geom_point()
```

`## `geom_smooth()` using formula 'y ~ x'`

```
# R-Squared value
with(hr_data, summary(lm(weight ~ hr)))$r.squared
```

`## [1] 0.007682562`

and now I’m getting a slight relationship between resting heart rate and weight, but at under 2% it’s hardly meaningful.

Let’s see if autocorrelation can tell us anything interesting

`my_cors <- acf(ts(hr_data))`

Indeed there is a substantial lag of about 10-12 days, when the actual heart rate and actual weight appear correlated.

Can we do anything with this information?

Let’s see if there’s more to this `hr`

and `weight`

situation

```
plot.new()
frame()
par(mfcol=c(2,2))
# the stationary signal and ACF
plot(1:85,hr_data$hr,
type='l',col='red',
xlab = "time (t)",
ylab = "Y(t)",
main = "Resting Heart Rate")
acf(hr_data$hr,lag.max = length(hr_data$hr),
xlab = "lag #", ylab = 'ACF',main=' ')
plot(t,hr_data$weight,
type='l',col='red',
xlab = "time (t)",
ylab = "Y(t)",
main = "Weight")
acf(hr_data$weight,lag.max = length(hr_data$weight),
xlab = "lag #", ylab = 'ACF', main=' ')
```

Run some statistical tests on the above data.

```
lag.length = 25
Box.test(hr_data$hr, lag=lag.length, type="Ljung-Box") # test stationary signal
```

```
##
## Box-Ljung test
##
## data: hr_data$hr
## X-squared = 19.061, df = 25, p-value = 0.7942
```

`Box.test(hr_data$weight, lag=lag.length, type="Ljung-Box") # test stationary signal`

```
##
## Box-Ljung test
##
## data: hr_data$weight
## X-squared = 187.47, df = 25, p-value < 2.2e-16
```

There is something unusual about the `hr`

data. See how at a lag of 6 and 11 days there’s a spike. Similarly, the weight data also has some odd periodicity

`hr_data %>% tsibble::fill_gaps() %>% ACF(hr) %>% autoplot() + ggtitle("ACF: resting heart rate")`

`hr_data %>% tsibble::fill_gaps() %>% ACF(weight) %>% autoplot() + ggtitle("ACF: weight")`

Let’s try to construct a model

`# hr_data %>% tsibble::fill_gaps() %>% model(STL(hr))`

To be continued…