library(fpp3)
library(janitor)data_624_hw01
Data 624: Homework 1
Exercises
2.10.1
Exploring Bricks from aus_production
The time interval of the Bricks data is quarterly.
# learn some info about the data
help(aus_production)head(aus_production)# A tsibble: 6 x 7 [1Q]
Quarter Beer Tobacco Bricks Cement Electricity Gas
<qtr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 1956 Q1 284 5225 189 465 3923 5
2 1956 Q2 213 5178 204 532 4436 6
3 1956 Q3 227 5297 208 561 4806 7
4 1956 Q4 308 5681 197 570 4418 6
5 1957 Q1 262 5577 187 529 4339 5
6 1957 Q2 228 5651 214 604 4811 7# load the aus_porudction dataframe, clean the names, filter to just the quarter and bricks columns, omit na values
bricks_df <- aus_production |> clean_names() |> select(quarter, bricks) |> na.omit()# autoplot the bricks_df
autoplot(bricks_df, bricks) + labs(x = "Year Quarter", y = "Bricks production (in millions)")
# seasonal plot
bricks_df |> gg_season(bricks, labels = "both") + labs(x = "Year Quarter", y = "Bricks production (in millions)")
#seasonal subseries
bricks_df |> gg_subseries(bricks) + labs(x = "Year Quarter", y = "Bricks production (in millions)")
bricks_df |> gg_lag(bricks, geom = "point")
bricks_df |> ACF(bricks) |> autoplot()
Exploring Lynx from pelt
The time interval of the Lynx data is yearly.
# learn some info about the data
help(pelt)head(pelt)# A tsibble: 6 x 3 [1Y]
Year Hare Lynx
<dbl> <dbl> <dbl>
1 1845 19580 30090
2 1846 19600 45150
3 1847 19610 49150
4 1848 11990 39520
5 1849 28040 21230
6 1850 58000 8420# load the dataframe, clean the names, filter to just the time series and target data column, omit na values
lynx_df <- pelt |> clean_names() |> select(year, lynx) |> na.omit()# autoplot
autoplot(lynx_df, lynx) + labs(x = "Year", y = "Pelts traded")
#seasonal subseries
lynx_df |> gg_subseries(lynx) + labs(x = "Year", y = "Pelts traded")
lynx_df |> gg_lag(lynx, geom = "point")
lynx_df |> ACF(lynx) |> autoplot()
Exploring Close price from gafa_stock
The time interval of the Close price from the gafa_stock dataset is irregular days.
# learn some info about the data
help(gafa_stock)head(gafa_stock)# A tsibble: 6 x 8 [!]
# Key: Symbol [1]
Symbol Date Open High Low Close Adj_Close Volume
<chr> <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 AAPL 2014-01-02 79.4 79.6 78.9 79.0 67.0 58671200
2 AAPL 2014-01-03 79.0 79.1 77.2 77.3 65.5 98116900
3 AAPL 2014-01-06 76.8 78.1 76.2 77.7 65.9 103152700
4 AAPL 2014-01-07 77.8 78.0 76.8 77.1 65.4 79302300
5 AAPL 2014-01-08 77.0 77.9 77.0 77.6 65.8 64632400
6 AAPL 2014-01-09 78.1 78.1 76.5 76.6 65.0 69787200# load the dataframe, clean the names, filter to just the time series and target data column, omit na values
close_df <- gafa_stock |> clean_names() |> select(symbol, date, close) |> na.omit()# autoplot
autoplot(close_df, close) + labs(x = "Year", y = "Close")
# seasonal plot
close_df |> gg_season(close, labels = "both") + labs(x = "Year", y = "Close")
Exploring Demand from vic_elec
The time interval of the Deman from the Victoria Electric dataframe is half-hours.
# learn some info about the data
help(vic_elec)head(vic_elec)# A tsibble: 6 x 5 [30m] <Australia/Melbourne>
Time Demand Temperature Date Holiday
<dttm> <dbl> <dbl> <date> <lgl>
1 2012-01-01 00:00:00 4383. 21.4 2012-01-01 TRUE
2 2012-01-01 00:30:00 4263. 21.0 2012-01-01 TRUE
3 2012-01-01 01:00:00 4049. 20.7 2012-01-01 TRUE
4 2012-01-01 01:30:00 3878. 20.6 2012-01-01 TRUE
5 2012-01-01 02:00:00 4036. 20.4 2012-01-01 TRUE
6 2012-01-01 02:30:00 3866. 20.2 2012-01-01 TRUE # load the dataframe, clean the names, filter to just the time series and target data column, omit na values
demand_df <- vic_elec |> clean_names() |> select(time, demand) |> na.omit()autoplot(demand_df, demand) + labs(x = "Time", y = "Demand (MWh")
# seasonal plot
demand_df |> gg_season(demand, labels = "both") + labs(x = "Year", y = "Demand")
demand_df |> ACF(demand) |> autoplot()
2.10.2
The peak closing price for the stocks in the gafa_stock set all appear to be in mid to late 2018.
# filter gafa_stock to just peak closing prices
gafa_stock |> group_by(Symbol) |> filter(Close == max(Close)) |> ungroup() |> select(Symbol, Date, Close)# A tsibble: 4 x 3 [!]
# Key: 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.2.10.3
a.
Reading the data into R
tute1 <- readr::read_csv("tute1.csv")
View(tute1)b.
Converting the data to time series
mytimeseries <- tute1 |>
mutate(Quarter = yearquarter(Quarter)) |>
as_tsibble(index = Quarter)c.
Constructing some plots
mytimeseries |>
pivot_longer(-Quarter) |>
ggplot(aes(x = Quarter, y = value, colour = name)) +
geom_line() +
facet_grid(name ~., scales = "free_y")
Constructing the plots without using facet_grid. They all appear on the same plot.
mytimeseries |>
pivot_longer(-Quarter) |>
ggplot(aes(x = Quarter, y = value, colour = name)) +
geom_line()
2.10.4
a.
Calling up the USgas packaged and taking a look at the head.
library(USgas)
head(us_total) year state y
1 1997 Alabama 324158
2 1998 Alabama 329134
3 1999 Alabama 337270
4 2000 Alabama 353614
5 2001 Alabama 332693
6 2002 Alabama 379343b.
Creating a tsibble from the USgas package.
gas_df <- us_total |> as_tsibble(key = state, index = year)
head(gas_df)# A tsibble: 6 x 3 [1Y]
# Key: state [1]
year state y
<int> <chr> <int>
1 1997 Alabama 324158
2 1998 Alabama 329134
3 1999 Alabama 337270
4 2000 Alabama 353614
5 2001 Alabama 332693
6 2002 Alabama 379343c.
Filtering the data to just states in New England.
new_england <- c("Maine", "Vermont", "New Hampshire", "Massachusetts", "Connecticut", "Rhode Island")
filtered_df <- gas_df |> filter(state %in% new_england)
head(filtered_df)# A tsibble: 6 x 3 [1Y]
# Key: state [1]
year state y
<int> <chr> <int>
1 1997 Connecticut 144708
2 1998 Connecticut 131497
3 1999 Connecticut 152237
4 2000 Connecticut 159712
5 2001 Connecticut 146278
6 2002 Connecticut 177587Plotting the annual natural gas consumption by state for New England. The result of the data is interesting. Vermont has the lowest usage. As the lowest population state and a very rural state, while Massachusetts, as the highest population state has the most usage.
filtered_df |> autoplot(y) + labs(x = "Year", y = "Total natural gas consumption (millions of cubic feet)")
2.10.5
a.
Loading the tourism excel document into R.
tourism_excel <- readxl::read_excel("tourism.xlsx")
head(tourism_excel)# A tibble: 6 × 5
Quarter Region State Purpose Trips
<chr> <chr> <chr> <chr> <dbl>
1 1998-01-01 Adelaide South Australia Business 135.
2 1998-04-01 Adelaide South Australia Business 110.
3 1998-07-01 Adelaide South Australia Business 166.
4 1998-10-01 Adelaide South Australia Business 127.
5 1999-01-01 Adelaide South Australia Business 137.
6 1999-04-01 Adelaide South Australia Business 200.b.
Creating a tsibble from the tourism dataframe.
tourism_tsibble <- tourism_excel |> mutate(Quarter = yearquarter(Quarter)) |> as_tsibble(index = Quarter, key = c(Region, State, Purpose))
head(tourism_tsibble)# A tsibble: 6 x 5 [1Q]
# Key: Region, State, Purpose [1]
Quarter Region State Purpose Trips
<qtr> <chr> <chr> <chr> <dbl>
1 1998 Q1 Adelaide South Australia Business 135.
2 1998 Q2 Adelaide South Australia Business 110.
3 1998 Q3 Adelaide South Australia Business 166.
4 1998 Q4 Adelaide South Australia Business 127.
5 1999 Q1 Adelaide South Australia Business 137.
6 1999 Q2 Adelaide South Australia Business 200.c.
Sorting and summarising to determine which Region and Purpose had the most overnight trips. Turns out it was Sydney with average trips of 747.27 for purpose of Visiting.
tourism_tsibble |> as_tibble() |> group_by(Region, Purpose) |> summarise(average_overnight_trips = mean(Trips, na.rm = TRUE), .groups = "drop") |> slice_max(average_overnight_trips, n = 5)# A tibble: 5 × 3
Region Purpose average_overnight_trips
<chr> <chr> <dbl>
1 Sydney Visiting 747.
2 Melbourne Visiting 619.
3 Sydney Business 602.
4 North Coast NSW Holiday 588.
5 Sydney Holiday 550.d.
Creating a new tsibble that has the total trips by state and quarter.
new_tsibble <- tourism_excel |> mutate(Quarter = yearquarter(Quarter)) |> group_by(State, Quarter) |> summarise(Total_Trips = sum(Trips), .groups = "drop") |> as_tsibble(index = Quarter, key = State)
head(new_tsibble)# A tsibble: 6 x 3 [1Q]
# Key: State [1]
State Quarter Total_Trips
<chr> <qtr> <dbl>
1 ACT 1998 Q1 551.
2 ACT 1998 Q2 416.
3 ACT 1998 Q3 436.
4 ACT 1998 Q4 450.
5 ACT 1999 Q1 379.
6 ACT 1999 Q2 558.Then a plot of the Total trips by State and Quarter. It appears New South Wales sees the most trips regardless of year or quarter while the Northern Territory generally sees the fewest. Interestingly, Western Australia saw a notable and sustained increase in visits around 2013/2014.
new_tsibble |> autoplot(Total_Trips) + labs(x = "Year Quarter", y = "Total overnight trips (thousands)")
2.10.8
Total Private
The US employment dataframe shows monthly employment data from January 1939 to June 2019. Below the data is filtered for total private employment.
help(us_employment)
total_private_df <- us_employment |> filter(Title == "Total Private")
head(total_private_df)# A tsibble: 6 x 4 [1M]
# Key: Series_ID [1]
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 26485When plotted on with autoplot, there is a clear positive trend overtime. Additionally there is the potential for a seasonality trend within the years, possibly quarterly. There are several interesting, especially the largest single decline which coincides with the 2008 financial crisis.
autoplot(total_private_df, Employed)
The small portion of the dataframe, from Jan 1998 to Dec 2002 shows an overall trend of increasing employment from 1998 to 2001, then a decline from 2001 to 2002. It also shows what appears to be a seasonal trend where employment increases rapidly for the first four months of the year, then increases slowly until the last month of the year and then declines quickly just before the new year.
total_private_df |> filter(Month >= yearmonth("Jan 1998"), Month <= yearmonth("Dec 2002")) |> autoplot(Employed)
The overall trend of total employment increasing over time is supported by the seasonal plot.
total_private_df |> gg_season(Employed)
The subseries shows that the growth over time is consistent on average for the span of years. This is perhaps too much data for this method to be especially useful.
total_private_df |> gg_subseries(Employed)
The lag plot is not overly useful as it shows consistent positive correlation.
gg_lag(total_private_df, Employed)
The autocorrelation indicates a positive corelation
total_private_df |> ACF(Employed) |> autoplot() + labs(title = "US private employment")
Bricks
Brick production is explored below, from a dataframe of quarterly production of selected Australian commodities from 1956 to the mid 2000s.
head(bricks_df)# A tsibble: 6 x 2 [1Q]
quarter bricks
<qtr> <dbl>
1 1956 Q1 189
2 1956 Q2 204
3 1956 Q3 208
4 1956 Q4 197
5 1957 Q1 187
6 1957 Q2 214The plot below indicates a strongly increasing trend from 1956 to 1980, after that there appears to be a slightly decreasing trend until 2005. Additionally the plot possibly indicates seasonality. There is a notable downturn in Bricks produced in 18785 to 1876 and 1982 to 1983.
autoplot(bricks_df, bricks) + labs(x = "Year Quarter", y = "Bricks production (in millions)")
In general, the seasonal plot below indicates that there is highest brick production, generally in Q3 and likely lowest in Q1. Additionally the plot indicates that the peak years for birck production were the early 1980s.
bricks_df |> gg_season(bricks, labels = "both") + labs(x = "Year Quarter", y = "Bricks production (in millions)")
The subseries plot of bricks by quarter shows Q2 and Q3 and Q4 all had similarly high brick production, while Q1 often had the lowest brick production.
bricks_df |> gg_subseries(bricks) + labs(x = "Year Quarter", y = "Bricks production (in millions)")
In general the lag analysis indicate positive correlation across all lag intervals.
bricks_df |> gg_lag(bricks, geom = "point")
The plot of the ACF below supports the concept of the positive correlation in the lag with the correlation becoming less positively correlated over longer lag periods, but still notably positively correlated.
bricks_df |> ACF(bricks_df) |> autoplot()
Hare
The Hare data comes from the Pelt tsibble which track the number of Snowhsoe Hare Pelts traded annualy by the Hudson Bay Company in trading records from 1845 to 1935.
help(pelt)
hare_df <- pelt |> clean_names() |> select(year, hare) |> na.omit()
head(hare_df)# A tsibble: 6 x 2 [1Y]
year hare
<dbl> <dbl>
1 1845 19580
2 1846 19600
3 1847 19610
4 1848 11990
5 1849 28040
6 1850 58000The plot shows large differences generally from year to year in pelt trading, with significantly high trading amounts from 1863 to 1864 and 1886.
autoplot(hare_df, hare) + labs(x = "Year", y = "Hare")
Since the Hare data in Pelt is annual data the gg_season plot will not yield results, only an error, and is omitted here. Additionally gg_subseries produces a near identical plot to the autoplot with the addition of a mean line.
hare_df |> gg_subseries(hare)
The results for a lag plot for the hare data support the autoplot data where there is a near constant year to year undulation in the pelt counts from very few to many on a close to annual basis. As a result several lags show a negative correlation especially lags 4 through 8.
gg_lag(hare_df, hare, geom = "point")
Similare to the lag plot, the ACF data plotted below shows a ten year cycle occurring where at 5 years there is a large negative correlation and at 10 years there is another large positive correlation with the pelts produced. Without additional information this may point to several things: the life cycle of the hares and the rate at which they come to maturity, intentional restriction of hunting for some period related to conservation, or another similar reasoning.
hare_df |> ACF(hare) |> autoplot() + labs(title = "Hare Pelts")
HO2 Cost
The PBS data
h02_df <-PBS |> filter(ATC2 == "H02")
head(h02_df)# A tsibble: 6 x 9 [1M]
# Key: Concession, Type, ATC1, ATC2 [1]
Month Concession Type ATC1 ATC1_desc ATC2 ATC2_desc Scripts Cost
<mth> <chr> <chr> <chr> <chr> <chr> <chr> <dbl> <dbl>
1 1991 Jul Concessional Co-payme… H Systemic… H02 CORTICOS… 63261 317384
2 1991 Aug Concessional Co-payme… H Systemic… H02 CORTICOS… 53528 269891
3 1991 Sep Concessional Co-payme… H Systemic… H02 CORTICOS… 52822 269703
4 1991 Oct Concessional Co-payme… H Systemic… H02 CORTICOS… 54016 280418
5 1991 Nov Concessional Co-payme… H Systemic… H02 CORTICOS… 49281 268070
6 1991 Dec Concessional Co-payme… H Systemic… H02 CORTICOS… 51798 277139The autoplot of the H02 costs immediately shows a relatively complicated story of the interplay between the different costs and payment types related to the H02 costs. Overall, there appears an increasing trend in both Concessional/Co-Payments and Concessional/Safety, while General/Co-Payments appears to be staying neutral as a trend, and that General/Safety has mostly stayed neutral after a several high years early in the data. Additionally, it appears as though there is likely seasonal data, and an inverse relationship between Concessional/Co-payments and Concessional/Safety related to that seasonality.
autoplot(h02_df, Cost)
The seasonal plot provides greater insight into the apparent inverse relationship discussed above. For the months February through May the General Safety net and the Concessional safety net drop to almost nothing or nothing. At the same time Concessional Co-payments rise to their highest level during that time. This indicates a relationship between these safety net costs and co-payments, potentially related to budget availability, appropriations, or another similar related factor.
h02_df |> gg_season(Cost)
h02_df |> gg_subseries(Cost)
The Concessional Safety Net is an interesting facet to explore using the lag plot for the monthly data. There is a a positive correlation for most months for the first few lag intervals. However this morphs to a negative correlation, with a negative correlation around six months. Again this points towards a yearly cyclic behavior of the safety net and costs and may relate to annual appropriation renewals and similar funding structures.
h02_df |> filter(Concession == "Concessional", Type == "Safety net") |> gg_lag(Cost, geom = "point")
The ACF plot shows what has been observed previously: that for several cost types there is an annual cycle occurring, specifically for Concessional Co-Payments, Concessional Safety Net, and for General Safety Net. General Co-Payments instead goes from having a positive correlation to a neutral one indicating that there is a weaker linear dependence.
h02_df |> ACF(Cost) |> autoplot() + labs(title = "H02 Costs")
Barrels from us_gasoline
The US gasoline data sheet shows weekly data beginning in 1991 and continuing into 2017 of finished gasoline product supplied in millions of barrels per day.
help("us_gasoline")
head(us_gasoline)# A tsibble: 6 x 2 [1W]
Week Barrels
<week> <dbl>
1 1991 W06 6.62
2 1991 W07 6.43
3 1991 W08 6.58
4 1991 W09 7.22
5 1991 W10 6.88
6 1991 W11 6.95The autoplot indicates an increasing trend for the first half of the data and then a neutral or possibly decreasing trend for barrels in the second half of the date range, with an apparent increase at the very end of the date range. Additionally it indicates there may be an annual seasonal pattern in weekly production.
autoplot(us_gasoline, Barrels)
The seasonal plot supports the conclusions drawn from the autoplot. In general the production has in creased over the length of the data with some neutral or declining production in the later years.
us_gasoline |> gg_season(Barrels)
Week to week the lag plot shows a pretty consistent positive correlation over time.
gg_lag(us_gasoline, Barrels, geom = "point")
The ACF plot supports the lag plot analysis, the lag interval is a positive correlation that declines slightly over longer lag period but still staying notable positively correlated.
us_gasoline |> ACF(Barrels) |> autoplot()