Exercises

1. Explore the following four time series: Bricks from aus_production, Lynx from pelt, Close from gafa_stock, Demand from vic_elec.

A) Use ? (or help()) to find out about the data in each series.

Answer:

Let’s load the library first

library(fpp3)
## ── Attaching packages ────────────────────────────────────────────── fpp3 0.5 ──
## ✔ tibble      3.2.1     ✔ tsibble     1.1.4
## ✔ dplyr       1.1.4     ✔ tsibbledata 0.4.1
## ✔ tidyr       1.3.0     ✔ feasts      0.3.1
## ✔ lubridate   1.9.3     ✔ fable       0.3.3
## ✔ ggplot2     3.4.4     ✔ fabletools  0.3.4
## ── Conflicts ───────────────────────────────────────────────── fpp3_conflicts ──
## ✖ lubridate::date()    masks base::date()
## ✖ dplyr::filter()      masks stats::filter()
## ✖ tsibble::intersect() masks base::intersect()
## ✖ tsibble::interval()  masks lubridate::interval()
## ✖ dplyr::lag()         masks stats::lag()
## ✖ tsibble::setdiff()   masks base::setdiff()
## ✖ tsibble::union()     masks base::union()

Now let’s check each data set one by one.

?aus_production
?pelt
?gafa_stock
?vic_elec

B) What is the time interval of each series?

Answer:

interval(aus_production)
## <interval[1]>
## [1] 1Q
interval(pelt)
## <interval[1]>
## [1] 1Y
interval(gafa_stock)
## <interval[1]>
## [1] !
interval(vic_elec)
## <interval[1]>
## [1] 30m

C) Use autoplot() to produce a time plot of each series. D) For the last plot, modify the axis labels and title.

Answer:

autoplot(aus_production, Bricks)+ggtitle("Quarterly Bricks Production in Australia")

autoplot(gafa_stock, Close) + ggtitle("Historical stock prices from 2014-2018") + xlab("Year") + ylab("Closing Price")

autoplot(vic_elec, Demand) + ggtitle("Half-hourly electricity demand for Victoria, Australia") + xlab("Year") + ylab("Demand")

autoplot(pelt, Lynx) + ggtitle("Pelt trading records") + xlab("Year") + ylab("Records")

2. Use filter() to find what days corresponded to the peak closing price for each of the four stocks in gafa_stock.

Answer:

library(dplyr)
data(gafa_stock)
gafa_stock %>%
  group_by(Symbol) %>%
  filter(Close == max(Close)) %>% #Keeps rows where Close value = max close value
  select(Symbol, Date, Close)
## # A tsibble: 4 x 3 [!]
## # Key:       Symbol [4]
## # Groups:    Symbol [4]
##   Symbol Date       Close
##   <chr>  <date>     <dbl>
## 1 AAPL   2018-10-03  232.
## 2 AMZN   2018-09-04 2040.
## 3 FB     2018-07-25  218.
## 4 GOOG   2018-07-26 1268.

3. Download the file tute1.csv from the book website, open it in Excel (or some other spreadsheet application), and review its contents. You should find four columns of information. Columns B through D each contain a quarterly series, labelled Sales, AdBudget and GDP. Sales contains the quarterly sales for a small company over the period 1981-2005. AdBudget is the advertising budget and GDP is the gross domestic product. All series have been adjusted for inflation.

A. You can read the data into R with the following script:

Answer:

tute1 <- readr::read_csv("https://otexts.com/fpp3/extrafiles/tute1.csv")
## Rows: 100 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl  (3): Sales, AdBudget, GDP
## date (1): Quarter
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
#View(tute1)

B. Convert the data to time series

Answer:

mytimeseries <- tute1 |>
  mutate(Quarter = yearquarter(Quarter)) |>
  as_tsibble(index = Quarter)

C. Construct time series plots of each of the three series

Answer:

mytimeseries |>
  pivot_longer(-Quarter) |>
  ggplot(aes(x = Quarter, y = value, colour = name)) +
  geom_line() +
  facet_grid(name ~ ., scales = "free_y")

Check what happens when you don’t include facet_grid().

Answer:

mytimeseries |>
  pivot_longer(-Quarter) |>
  ggplot(aes(x = Quarter, y = value, colour = name)) +
  geom_line()

4. The USgas package contains data on the demand for natural gas in the US.

A. Install the USgas package.

Answer:

#install.packages("USgas")
library(USgas)

B. Create a tsibble from us_total with year as the index and state as the key.

Answer:

us_total <- us_total |>
  as_tibble(key =state, index =year)

C. Plot the annual natural gas consumption by state for the New England area (comprising the states of Maine, Vermont, New Hampshire, Massachusetts, Connecticut and Rhode Island).

Answer:

us_total %>%
  filter(state %in% c('Maine', 'Vermont', 'New Hampshire', 'Massachusetts', 'Connecticut', 'Rhode Island')) %>%
  ggplot(aes(x = year, y = y, colour = state)) +
  geom_line() +
  facet_grid(state ~., scales = "free_y") +
  labs(title = "Annual Natural Gas Consumption in New England",
       y = "Consumption")

The annual natural has consumption follows an increasing trend for Connecticut, Massachusetts, and Vermont, and is decreasing in the remaining states.

5. A. Download tourism.xlsx from the book website and read it into R using readxl::read_excel().

tourism <- readxl::read_excel("/Users/umerfarooq/Downloads/tourism.xlsx")

B. Create a tsibble which is identical to the tourism tsibble from the tsibble package.

tourism_ts <- tourism %>%
  mutate(Quarter = yearquarter(Quarter)) %>%
  as_tsibble(key = c(Region, State, Purpose),
             index = Quarter)

C. Find what combination of Region and Purpose had the maximum number of overnight trips on average.

tourism_ts %>%
  group_by(Region, Purpose) %>%
  mutate(Avg_Trips = mean(Trips)) %>%
  ungroup() %>%
  filter(Avg_Trips == max(Avg_Trips)) %>%
  distinct(Region, Purpose)
## # A tibble: 1 × 2
##   Region Purpose 
##   <chr>  <chr>   
## 1 Sydney Visiting

D. Create a new tsibble which combines the Purposes and Regions, and just has total trips by State.

tourism %>%
  group_by(Quarter, State) %>%
  mutate(Quarter = yearquarter(Quarter),
         Total_Trips = sum(Trips)) %>%
  select(Quarter, State, Total_Trips) %>%
  distinct() %>%
  as_tsibble(index = Quarter,
             key = State)
## # A tsibble: 640 x 3 [1Q]
## # Key:       State [8]
## # Groups:    State @ Quarter [640]
##    Quarter State Total_Trips
##      <qtr> <chr>       <dbl>
##  1 1998 Q1 ACT          551.
##  2 1998 Q2 ACT          416.
##  3 1998 Q3 ACT          436.
##  4 1998 Q4 ACT          450.
##  5 1999 Q1 ACT          379.
##  6 1999 Q2 ACT          558.
##  7 1999 Q3 ACT          449.
##  8 1999 Q4 ACT          595.
##  9 2000 Q1 ACT          600.
## 10 2000 Q2 ACT          557.
## # ℹ 630 more rows

8. Use the following graphics functions: autoplot(), gg_season(), gg_subseries(), gg_lag(), ACF() and explore features from the following time series: “Total Private” Employed from us_employment, Bricks from aus_production, Hare from pelt, “H02” Cost from PBS, and Barrels from us_gasoline.

us_employement

us_employment
## # A tsibble: 143,412 x 4 [1M]
## # Key:       Series_ID [148]
##       Month Series_ID     Title         Employed
##       <mth> <chr>         <chr>            <dbl>
##  1 1939 Jan CEU0500000001 Total Private    25338
##  2 1939 Feb CEU0500000001 Total Private    25447
##  3 1939 Mar CEU0500000001 Total Private    25833
##  4 1939 Apr CEU0500000001 Total Private    25801
##  5 1939 May CEU0500000001 Total Private    26113
##  6 1939 Jun CEU0500000001 Total Private    26485
##  7 1939 Jul CEU0500000001 Total Private    26481
##  8 1939 Aug CEU0500000001 Total Private    26848
##  9 1939 Sep CEU0500000001 Total Private    27468
## 10 1939 Oct CEU0500000001 Total Private    27830
## # ℹ 143,402 more rows
us_empl_tsi <- us_employment|>
  filter(Title == 'Total Private')|>
  as_tsibble(key = Title, index = Month)
autoplot(us_empl_tsi, Employed)

gg_season(us_empl_tsi, Employed)

gg_subseries(us_empl_tsi, Employed)

gg_lag(us_empl_tsi, Employed)

ACF(us_empl_tsi, Employed)
## # A tsibble: 29 x 3 [1M]
## # Key:       Title [1]
##    Title              lag   acf
##    <chr>         <cf_lag> <dbl>
##  1 Total Private       1M 0.997
##  2 Total Private       2M 0.993
##  3 Total Private       3M 0.990
##  4 Total Private       4M 0.986
##  5 Total Private       5M 0.983
##  6 Total Private       6M 0.980
##  7 Total Private       7M 0.977
##  8 Total Private       8M 0.974
##  9 Total Private       9M 0.971
## 10 Total Private      10M 0.968
## # ℹ 19 more rows

The overall trend is increasing for the Employed in us_employement. Seasonality is also present with some cyclic behavior almost every 10 years

aus_production:

autoplot(aus_production, Bricks)
## Warning: Removed 20 rows containing missing values (`geom_line()`).

gg_season(aus_production, Bricks)
## Warning: Removed 20 rows containing missing values (`geom_line()`).

gg_subseries(aus_production, Bricks)
## Warning: Removed 5 rows containing missing values (`geom_line()`).

gg_lag(aus_production, Bricks)
## Warning: Removed 20 rows containing missing values (gg_lag).

ACF(aus_production, Bricks)
## # A tsibble: 22 x 2 [1Q]
##         lag   acf
##    <cf_lag> <dbl>
##  1       1Q 0.900
##  2       2Q 0.815
##  3       3Q 0.813
##  4       4Q 0.828
##  5       5Q 0.720
##  6       6Q 0.642
##  7       7Q 0.655
##  8       8Q 0.692
##  9       9Q 0.609
## 10      10Q 0.556
## # ℹ 12 more rows

The first 20 years shows an increase in the trend followed by a slight decrease in trend in. the next 25 years. Seasonality is present and can be witnessed in gg_season(). A cycle can also be seen since the the trend changes mid data.

pelt:

autoplot(pelt, Hare)

#gg_season(pelt, Hare)
gg_subseries(pelt, Hare)

gg_lag(pelt, Hare)

ACF(pelt, Hare)
## # A tsibble: 19 x 2 [1Y]
##         lag     acf
##    <cf_lag>   <dbl>
##  1       1Y  0.658 
##  2       2Y  0.214 
##  3       3Y -0.155 
##  4       4Y -0.401 
##  5       5Y -0.493 
##  6       6Y -0.401 
##  7       7Y -0.168 
##  8       8Y  0.113 
##  9       9Y  0.307 
## 10      10Y  0.340 
## 11      11Y  0.296 
## 12      12Y  0.206 
## 13      13Y  0.0372
## 14      14Y -0.153 
## 15      15Y -0.285 
## 16      16Y -0.295 
## 17      17Y -0.202 
## 18      18Y -0.0676
## 19      19Y  0.0956

Well there is no obvious trend in the series and it is oscillating but I’m struggling to find any seasonality but only cyclic behavior.

PBS:

PBS_tsi <- PBS|>
  filter(ATC2 == "H02")
autoplot(PBS_tsi, Cost)

gg_season(PBS_tsi, Cost)

gg_subseries(PBS_tsi, Cost)

#gg_lag(PBS_tsi, Cost)
ACF(PBS_tsi, Cost)
## # A tsibble: 92 x 6 [1M]
## # Key:       Concession, Type, ATC1, ATC2 [4]
##    Concession   Type        ATC1  ATC2       lag   acf
##    <chr>        <chr>       <chr> <chr> <cf_lag> <dbl>
##  1 Concessional Co-payments H     H02         1M 0.834
##  2 Concessional Co-payments H     H02         2M 0.679
##  3 Concessional Co-payments H     H02         3M 0.514
##  4 Concessional Co-payments H     H02         4M 0.352
##  5 Concessional Co-payments H     H02         5M 0.264
##  6 Concessional Co-payments H     H02         6M 0.219
##  7 Concessional Co-payments H     H02         7M 0.253
##  8 Concessional Co-payments H     H02         8M 0.337
##  9 Concessional Co-payments H     H02         9M 0.464
## 10 Concessional Co-payments H     H02        10M 0.574
## # ℹ 82 more rows

The graphs above have four series-es. An increase in the trend can be seen in concessional/co-payments/H/H02 with seasonality with peculiar behavior for year 2004-5. General/co-payments/H/H02 shows no seasonality with a no real trend.General/Safety net/H/H02 also has no trend but seasonality can be seen. Concessional/Safety net/H/H02 also has seasonailty in the series.

us_gasoline:

autoplot(us_gasoline, Barrels)

gg_season(us_gasoline, Barrels)

gg_subseries(us_gasoline, Barrels)

gg_lag(us_gasoline, Barrels)

ACF(us_gasoline, Barrels)
## # A tsibble: 31 x 2 [1W]
##         lag   acf
##    <cf_lag> <dbl>
##  1       1W 0.893
##  2       2W 0.882
##  3       3W 0.873
##  4       4W 0.866
##  5       5W 0.847
##  6       6W 0.844
##  7       7W 0.832
##  8       8W 0.831
##  9       9W 0.822
## 10      10W 0.808
## # ℹ 21 more rows