Data 624 R Programming
Week 3 Homework
Frederick Jones
2024-02-11
3.1
Consider the GDP information in global_economy. Plot the GDP per capita for each country over time. Which country has the highest GDP per capita? How has this changed over time?
library(fpp3)## ── Attaching packages ────────────────────────────────────────────── fpp3 0.5 ──## ✔ tibble 3.2.1 ✔ tsibble 1.1.4
## ✔ dplyr 1.1.3 ✔ 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.4.0## ── 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()head(global_economy,3)gpc<-global_economy|>
mutate( gdp_per_capita = GDP/Population)
head(gpc, 3)#install.packages(c("plotly", "dygraphs"))
library(plotly)##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutgpc$Year <- as.factor(gpc$Year)
p <- ggplot(gpc, aes(x = Year, y = gdp_per_capita, group = Country, color = Country)) +
geom_line() +
labs(x = "Year", y = "GDP per Capita") +
theme_minimal()+
theme(axis.text.x = element_text(angle = 90, hjust = 1))
p <- ggplotly(p)
pIt can be observed from the interactive graph that Monaco has the highest GDP per capita. With time GDP per capita of each country has an upward trend with little cycle. Seasonality is not observed in the data of gdp per capita.
3.2
For each of the following series, make a graph of data. If transforming seems appropriate, do so and describe the effect.
United States GDP from global_economy
Slaughter of Victorian “Bulls, bullock and steers’ in aus_livestock
Victorian Electricity Demand from vlc_elc
Gas Production from aus_production
Answer.
United states GDP from global_economy:
global_economy|> filter(Country=="United States")|>
mutate(gdp_per_capita = GDP/Population)|>
autoplot(gdp_per_capita)+
labs(title = "GDP per capita of United States",
x="Year", y="GDP per capita")
Since absolute GDP might give incorrect perception so, GDP per capita was calculated and plotted to see if the economy of the US actually rising. It can be seen that from 1960 to 2017. The GDP per capita is actually showing an upward trend with little bump due to recession.
“Bulls, bullock and steers’ in aus_livestock:
aus_livestock|>
filter(Animal == "Bulls, bullocks and steers")|>
autoplot(Count)+
labs(title = "Time Series of Victorian Bulls, bullocks and steers Slaughtered",
x= "Month")
Victorian Electricity Demand
vic_elec |>
autoplot(Demand)+
labs(
title = "Time series plot of Victorian Electricity Demand",
x= "Time (30 minute interval)",
y="Demand"
)
Gas Production from aus_production
aus_production|>
autoplot(Gas)
This time series has seasonality proportional to the trend. as the trend is trend goes up the seasonality goes up to. We can fix it using the log of the data.
aus_production|>
mutate(log_gas = log(Gas))|>
autoplot(log_gas)+
labs(
title = "Time series plot of log of gas production",
x="Quarter",
y='log(Gas)'
)
Now it can be seen that the seasonality is not changing but it is almost constant.
3.3
Why is Box-Cox transformation unhelpful for the Canadian_gas data?
canadian_gas|>
autoplot(Volume)
It can be observed that the seasonality is not uniformly increasing or decreasing. But first it increases then decreases then increases. lambda cannot be negative so the Box-Cox transformation fails to help for the Canadian_gas data.
3.4
What Box-Cox transformation would you select for your retail data (from exercise 7 in section 2.10)
set.seed(1000)
my_series <- aus_retail |>
filter(`Series ID`==sample(aus_retail$`Series ID`, 1))
autoplot(my_series, Turnover)+
labs(
title = "Plot of sample australian retail data",
x=" Time (in Month)",
y="Turnover"
)
Since the seasonality is changing with time and increasing with the time so, the log transformation will be the best for this data. or lambda value should be selected so that the seasonality seems constant throughout the time period.
library(latex2exp)##
## Attaching package: 'latex2exp'## The following object is masked from 'package:plotly':
##
## TeXlambda <- my_series |>
features(Turnover, features = guerrero)|>
pull(lambda_guerrero)
my_series|>
autoplot(box_cox(Turnover, lambda))+
labs( y="Transformed Turnover",
x="Time in month",
title = latex2exp::TeX(paste0(
"Transformed Turnover with $\\lambda$ = ",
round(lambda, 2))))
3.5
For the following series, find an appropriate Box-Cox transformation in order to stabilize the variance. Tobacco from aus_production, Economy class between Melbourne and sydney from ansett, Pedestrian counts at Southern Cross Station from pedestrian.
Answers.
Tobacco from aus_production
lambda <- aus_production |>
features(Tobacco, features = guerrero)|>
pull(lambda_guerrero)
aus_production|>
autoplot(box_cox(Tobacco, lambda))+
labs( y="Modified Tobacco Production",
x="Quarter",
title = latex2exp::TeX(paste0(
"Modified Tobacco Production with $\\lambda$ = ",
round(lambda, 2))))## Warning: Removed 24 rows containing missing values (`geom_line()`).
Here the suitable transformation when \[\lambda = 0.93\]
Economy class between Melbourne and sydney from ansett
mel_syd_eco <- ansett |>
filter(Class=="Economy" & Airports =="MEL-SYD")
lambda <- mel_syd_eco |>
features(Passengers, features = guerrero)|>
pull(lambda_guerrero)
mel_syd_eco|>
autoplot(box_cox(Passengers, lambda))+
labs( y="Transformed Passengers",
x="Week",
title = latex2exp::TeX(paste0(
"Transformed passengers with $\\lambda$ = ",
round(lambda, 2))))
Pedestrian counts at Southern Cross Station from pedestrian.
southern_Cross_station <- pedestrian |>
filter(Sensor == "Southern Cross Station")
lambda <- southern_Cross_station |>
features(Count, features = guerrero)|>
pull(lambda_guerrero)
southern_Cross_station|>
autoplot(box_cox(Count, lambda))+
labs( y="Transformed pedestrian Count",
#x="Week",
title = latex2exp::TeX(paste0(
"Transformed pedestrian count with $\\lambda$ = ",
round(lambda, 2))))
$<0 $ is not allowed for the Box-Cox transformation. Hence, we have to use log transformation
pedestrian |>
filter(Sensor == "Southern Cross Station")|>
autoplot(log(Count))+
labs(
title = "Log of pedestrian count",
x="time in hour",
y= "Log(Count)"
)
3.6
Show that a \(3 \times 5\)MA is equivalent to a 7-term Weighted moving average with weights of 0.067, 0.133, 0.200, 0.200, 0.200, 0.133, and 0.067
Answer.
Let the time series be \[ y_{t-3}, y_{t-2}, y_{t-1}, y_{t}, y_{t+1}, y_{t+2}, y_{t+3}\]
3-MA can be computed as follows:
\[ \frac {y_{t-3}+ y_{t-2}+y_{t-1}}{3}, \frac {y_{t-2}+ y_{t-1}+y_{t}}{3}, \frac {y_{t-1}+ y_{t}+y_{t+1}}{3}, \frac {y_{t}+ y_{t+1}+y_{t+2}}{3}, \frac {y_{t+1}+ y_{t-2}+y_{t+3}}{3}\]
Aand the 5-MA of the above time series.
\[ \frac{1}{5}(\frac {y_{t-3}+ y_{t-2}+y_{t-1}}{3}+\frac {y_{t-2}+ y_{t-1}+y_{t}}{3}+\frac {y_{t-1}+ y_{t}+y_{t+1}}{3}+\frac {y_{t}+ y_{t+1}+y_{t+2}}{3}+ \frac {y_{t+1}+ y_{t-2}+y_{t+3}}{3})\]
\[= \frac{1}{5}(\frac {y_{t-3}+2 y_{t-2}+3y_{t-1}+3y_{t}+3y_{t+1}+ 2y_{t+2}+y_{t+3}}{3})\]
\[= 0.067y_{t-3}+0.133 y_{t-2}+0.200y_{t-1}+0.200y_{t}+0.200y_{t+1}+ 0.067y_{t+2}+y_{t+3} \]
It’s the 7 term - weighted time series with weights 0.067, 0.133, 0.200. 0.200, 0.200, 0.133, 0.067.
Hence, proved.
3.7
Consider the last five years of the Gas data from aus_production
gas <- tail(aus_production, 5*4)|> select(Gas)
Plot the time series. Can you identify seasonal fluctuations and/or a trend-cycle?
Use classical_decomposition with type=multiplicative to calculate the trend-cycle and seasonal indices.
Do the results support the graphical interpretation from part a?
Compute and plot the seasonal adjusted data.
Change one observation to be an outlier (e.g., add 300 to one observation), and recompute the seasonal adjusted data. What is the effect of the outlier?
Does it make any difference if the outlier is near the end rather than in the middle of the time series?
gas <- tail(aus_production, 5*4)|> select(Gas)Answer a.
gas|>
autoplot(Gas)+
labs(
title = "Australian gas production time series",
x="Quarter",
y="Gas"
)
It can be observed that the the trend is upward and there is fix seasonality due to which the gas production oscillates about the trend line.
Answer b.
gas |>
model(
classical_decomposition(Gas ,type="multiplicative")
)|> components()|>
autoplot()+
labs(title = "Classical multiplicative decomposition of Australian Gas production ")## Warning: Removed 2 rows containing missing values (`geom_line()`).
Answer c. Yes, the seasonality can be seen clearly in the third plot from th top. Although there is noise or remainder in the dataset but the seasonality is as expected.
Answer d.
lambda <- gas |>
features(Gas, features = guerrero)|>
pull(lambda_guerrero)
gas|>
autoplot(box_cox(Gas, lambda))+
labs( y="Transformed Gas production ",
x="Quarter",
title = latex2exp::TeX(paste0(
"Transformed Australian Gas Production $\\lambda$ = ",
round(lambda, 2))))
gas$Gas[5] =300
lambda <- gas |>
features(Gas, features = guerrero)|>
pull(lambda_guerrero)
gas|>
autoplot(box_cox(Gas, lambda))+
labs( y="Transformed Gas production ",
x="Quarter",
title = latex2exp::TeX(paste0(
"Transformed Australian Gas Production $\\lambda$ = ",
round(lambda, 2))))
The outlier creates noise in the dataset but the seasonality remains unaffected.
Answer f. No, outlier will just create noise and its position does not matter. The seasonality seems to be remains the same. as before the outlier was added.
3.8
Recall your retail time series data (from exercise 7 in section 2.10). Decompose the series using X-11. Does ir reveal any outliers, or unusual features that you had not noticed previously?
Answer.
library(seasonal)##
## Attaching package: 'seasonal'## The following object is masked from 'package:tibble':
##
## viewdecmp_X11 <- my_series|>
model(x11 = X_13ARIMA_SEATS(Turnover ~ x11()))|>
components()
autoplot(decmp_X11)+
labs(title = "Decomposition of Turnover using X-11.")
Seasonal pattern is constant but unusual spikes are present in the remainder. This spikes generally bring some sudden instantaneous changes.
3.9
Figure 3.1 and 3.2 show the result of decomposing the number of persons in the civilian labor force in Australia each month from February 1978 to August 1995.
Figure 3.1: Decomposition of the number of persons in the civilian labor force in Australia each month from February 1978 to August 1995.
Figure 3.2: Seasonal component from the decomposition shown in the previous figure.
Write about 3-5 sentences describing the result of the decomposition. Pay particular attention to the scales of the graphics in making your interpretation.
Is the recession of 1991/1992 visible in the estimated components?
Answer 1. The decomposition of the given time series produces 3 components: trend, season_year+remainder. The scale of trend is similar to the scale of the give time series but the scale of season_year is from -100 to 100, it means season_year is fluctuating between the -100 and 100. The remainder is just like noise and it gives uncertainty in the time series.
Answer 2. Yes, the recession of 1991/1992 is visible in the estimated components. It can be observed that there is huge dip in the remainder component during 1991/1992. The dip in 1991/1992 is not observed in the trend or season_year. So, it was a temporary incident and after the recession, the time series again shows upward trend.