# Effecient way to decompose multiple time series in a data frame and compare the fit of additive and multiplicative models?

I have a data frame in R that contains time series data of 7 variables that were taken on several hundred different individuals. I want to know if it would be more appropriate to use an additive model or a multiplicative model for each variable.

To give an example, the data is structured something like this:

set.seed(123)
ID = factor(letters[seq(15)])
Time = c(1000,1200,1234,980,1300,1020,1180,1908,1303,
1045,1373,1111,1097,1167,1423)
df <- data.frame(ID = rep(ID, Time), Time = sequence(Time))
df[paste0('Var', c(1:7))] <- rnorm(sum(Time))


What is an effective way to decompose the data for each variable/ID combination, fit each with an additive model and a multiplicative model, and compare the fits?

• What do you mean by an additive or multiplicative model? And what do you mean by decompose here? – Rob Hyndman Apr 21 at 3:30
• @RobHyndman I want to decompose the time series, meaning removing the trend, seasonal, and random cmponents, and fit an additive model (meaning the trend, seasonal, and error components are additive in describing the series) and a multiplicative model (meaning the components are multiplicative in describing the model). I would then use some form of model comparison (i.e. which model has the lowest residual error via least squares) to determine which type of model fit the data better. – Ryan Apr 21 at 12:35

## 1 Answer

One way to do this would be to fit the decompositions with the same numbers of degrees of freedom and see which fits the best. It is convenient to do this using the tsibble and feasts packages as they allow for modelling many time series at once.

I've modified your example data so that it is possible to do a multiplicative decomposition -- having negative values in the data makes multiplicative decompositions problematic.

The multiplicative decomposition uses STL on the log data, and then exponentiates the trend and seasonal terms to put them back on the original scale.

Your example has no obvious seasonality so I have arbitrarily set the seasonal period to 12 for illustration purposes. Change it to whatever it should be.

I have set the trend window to be 99 and the seasonal component to be periodic. Again, change these to suit your actual data but the two fits should have the same values.

set.seed(123)
ID = factor(letters[seq(15)])
Time = c(1000,1200,1234,980,1300,1020,1180,1908,1303,
1045,1373,1111,1097,1167,1423)
df <- data.frame(ID = rep(ID, Time), Time = sequence(Time))
df[paste0('Var', c(1:7))] <- abs(rnorm(sum(Time)))

library(tidyverse)
library(tsibble)
library(feasts)

# Create tsibble in long form
df <- df %>%
pivot_longer(starts_with("Var"), names_to="Series", values_to="value") %>%
as_tsibble(index=Time, key=c(ID,Series))
# Additive decompositions
additive <- df %>%
model(add = STL(value ~ trend(window=99) + season("periodic", period=12))) %>%
components()
# Multiplicative decompositions
multiplicative <- df %>%
model(mult = STL(log(value) ~ trend(window=99) + season("periodic", period=12))) %>%
components() %>%
mutate(remainder = df\$value - exp(trend+season_12))
# Find variance of remainders
rva <- additive %>%
as_tibble() %>%
group_by(ID, Series) %>%
summarise(rv = var(remainder, na.rm=TRUE)) %>%
ungroup()
rvm <- multiplicative %>%
as_tibble() %>%
group_by(ID, Series) %>%
summarise(rv = var(remainder, na.rm=TRUE)) %>%
ungroup()
# Which remainder has lowest variance?
left_join(rva, rvm, by = c("ID","Series")) %>%
mutate(best = if_else(rv.x < rv.y, "additive", "multiplicative"))
#> # A tibble: 105 x 5
#>    ID    Series  rv.x  rv.y best
#>    <fct> <chr>  <dbl> <dbl> <chr>
#>  1 a     Var1   0.357 0.361 additive
#>  2 a     Var2   0.357 0.361 additive
#>  3 a     Var3   0.357 0.361 additive
#>  4 a     Var4   0.357 0.361 additive
#>  5 a     Var5   0.357 0.361 additive
#>  6 a     Var6   0.357 0.361 additive
#>  7 a     Var7   0.357 0.361 additive
#>  8 b     Var1   0.338 0.341 additive
#>  9 b     Var2   0.338 0.341 additive
#> 10 b     Var3   0.338 0.341 additive
#> # … with 95 more rows


Created on 2020-04-22 by the reprex package (v0.3.0)