Homework 1

Questions

Exercise 1

tute1 <- read_excel("/Users/Peter Cook/Documents/Economics and Finance/Business Forecasting/Forecasting Data/tute1.xlsx")

        
mytimeseries <- tute1 %>%
  mutate(Quarter = yearmonth(Quarter)) %>%
  as_tsibble(index = Quarter)
mytimeseries %>%
  pivot_longer(-Quarter) %>%
  ggplot(aes(x = Quarter, y = value, colour = name)) +
  geom_line() +
  facet_grid(name ~ ., scales = "free_y")

Exercise 2

library(USgas)
GAS <- us_total %>%
  as_tsibble(index=year,key=state)
GAS %>%
  filter(state %in% c("New Hampshire", "Maine", "Vermont", "Massachusetts", "Connecticut", "Rhode Island")) %>% 
  autoplot()+
  labs(y="Gas Consumption", x="Time")

## Plot variable not specified, automatically selected `.vars = y`

### Exercise 3

tourism <- read_excel("/Users/Peter Cook/Documents/Economics and Finance/Business Forecasting/Forecasting Data/tourism.xlsx")

tourism1 <- tourism %>%
  mutate(Quarter = yearmonth(Quarter)) %>%
  as_tsibble(index = "Quarter", key = c("Region", "State", "Purpose"))

tourism1 %>%
  as_tibble %>%
  group_by(Region, Purpose) %>%
  summarize(avg_trips = mean(Trips)) %>%
  arrange(desc(avg_trips))

## `summarise()` has grouped output by 'Region'. You can override using the
## `.groups` argument.

## # A tibble: 304 × 3
## # Groups:   Region [76]
##    Region          Purpose  avg_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.
##  6 Gold Coast      Holiday       528.
##  7 Melbourne       Holiday       507.
##  8 South Coast     Holiday       495.
##  9 Brisbane        Visiting      493.
## 10 Melbourne       Business      478.
## # … with 294 more rows
## # ℹ Use `print(n = ...)` to see more rows

tourism %>%
  unite(region_purpose, Region,Purpose) %>%
  group_by(State) %>%
  summarize(Total_Trips = sum(Trips))

## # A tibble: 8 × 2
##   State              Total_Trips
##   <chr>                    <dbl>
## 1 ACT                     41007.
## 2 New South Wales        557367.
## 3 Northern Territory      28614.
## 4 Queensland             386643.
## 5 South Australia        118151.
## 6 Tasmania                54137.
## 7 Victoria               390463.
## 8 Western Australia      147820.

Exercise 4

aus_arrivals %>%
  autoplot()

## Plot variable not specified, automatically selected `.vars = Arrivals`

aus_arrivals %>%
  gg_season()

## Plot variable not specified, automatically selected `y = Arrivals`

aus_arrivals %>%
  gg_subseries()

## Plot variable not specified, automatically selected `y = Arrivals`

#The majority of tourists from Japan and New Zealand are in Q3 and tourists from the UK prefer Q1 and Q4. #Japanese tourism to Austrailia peaked in the mid-late 90s and has been steadily declining since then.

Exercise 5

set.seed(987654321)
myseries <- aus_retail %>%
  filter(`Series ID` == sample(aus_retail$`Series ID`,1))
autoplot(myseries, Turnover)

gg_season(myseries, Turnover)

gg_subseries(myseries, Turnover)

gg_lag(myseries, Turnover) + 
  geom_point()

ACF(myseries, Turnover) %>% autoplot()

#There is definitely some seasonality in the turnover rates for retail stores. Turnover rates rise steadily from #the beginning of the year in January all the way until December, when it reaches its peak. There is also a trend #of turnover rising from the 90s until now.

Exercise 6

facebook <- as.data.frame(gafa_stock) %>% group_by(Symbol) %>%
  filter(Symbol == "FB")

mean(facebook$Close)

## [1] 120.4625

sd(facebook$Close)

## [1] 41.32364

vec1 <- pull(facebook, Close)
FBmedian <- median(vec1)
FBmeandif <- mean(vec1, na.rm = TRUE)
FBSDdif <- sd(vec1, na.rm = TRUE)
FBkurtDIF <- kurtosis(vec1, na.rm = TRUE)
FBskewDIF <- skewness(vec1, na.rm = TRUE)

fbMEANbyHAND <- sum(vec1, na.rm = TRUE)/nrow(facebook)

fbSDbyHAND <- sqrt(sum((vec1-mean(vec1))^2/(length(vec1)-1)))

fbKURTbyHAND <- ((sum((vec1-mean(vec1))^4))/length(vec1))/(sum((vec1-mean(vec1))^2/length(vec1)^2))

fbSKEWbyHAND <- (3*(fbMEANbyHAND-FBmedian))/fbSDbyHAND

Exercise 7

TXN <- read_excel("/Users/Peter Cook/Documents/Economics and Finance/Business Forecasting/Forecasting Data/TXN.xlsx")
head(TXN)

## # A tibble: 6 × 7
##   Date                 Open  High   Low Close `Adj Close`  Volume
##   <dttm>              <dbl> <dbl> <dbl> <dbl>       <dbl>   <dbl>
## 1 2021-09-07 00:00:00  189.  190.  188.  189.        185. 2295900
## 2 2021-09-08 00:00:00  188.  189.  187.  189.        184. 2021600
## 3 2021-09-09 00:00:00  190.  191.  188.  188.        184. 1827900
## 4 2021-09-10 00:00:00  189.  193.  189.  191.        186. 3331700
## 5 2021-09-13 00:00:00  193.  194.  191.  194.        189. 3687200
## 6 2021-09-14 00:00:00  195   196.  194.  195.        190. 3239600

TXNadj <- TXN %>% select(-(Open:Close)) %>%
  select(-(Volume))
TXNadj2 <- TXNadj %>%
  mutate(Date =as_date(Date)) %>%
  as_tsibble(index = "Date", key = "Adj Close")

TXNadj3 <- TXNadj2 %>%
  filter(Date >= as.Date("2022-06-01") & Date <= as.Date("2022-06-30")) %>%
  ggplot(aes(x = Date, y = `Adj Close`)) +
  geom_line()
TXNadj3

TXNjan <- TXNadj2 %>%
  filter(Date >= as.Date("2022-01-01") & Date <= as.Date("2022-01-31"))
TXNfeb <- TXNadj2 %>%
  filter(Date >= as.Date("2022-02-01") & Date <= as.Date("2022-02-28"))
TXNmar <- TXNadj2 %>%
  filter(Date >= as.Date("2022-03-01") & Date <= as.Date("2022-03-31"))
TXNap <- TXNadj2 %>%
  filter(Date >= as.Date("2022-04-01") & Date <= as.Date("2022-04-30")) 
TXNmay <- TXNadj2 %>%
  filter(Date >= as.Date("2022-05-01") & Date <= as.Date("2022-05-31"))
TXNjune <- TXNadj2 %>%
  filter(Date >= as.Date("2022-06-01") & Date <= as.Date("2022-06-30"))
TXNjul <- TXNadj2 %>%
  filter(Date >= as.Date("2022-07-01") & Date <= as.Date("2022-07-31"))
TXNaug <- TXNadj2 %>%
  filter(Date >= as.Date("2022-08-01") & Date <= as.Date("2022-08-31"))

Tjan_Vec <- pull(TXNjan, "Adj Close")
Tjan_mean <- mean(Tjan_Vec)
Tjan_mean #This is the mean for January

## [1] 178.0862

Tfeb_Vec <- pull(TXNfeb, "Adj Close")
Tfeb_mean <- mean(Tfeb_Vec)
Tfeb_mean #This is the mean for February

## [1] 168.3438

Tmar_Vec <- pull(TXNmar, "Adj Close")
Tmar_mean <- mean(Tmar_Vec)
Tmar_mean #This is the mean for March

## [1] 174.1279

Tap_Vec <- pull(TXNap, "Adj Close")
Tap_mean <- mean(Tap_Vec)
Tap_mean #This is the mean for April

## [1] 173.0784

Tmay_Vec <- pull(TXNmay, "Adj Close")
Tmay_mean <- mean(Tmay_Vec)
Tmay_mean #This is the mean for May

## [1] 169.2282

Tjune_Vec <- pull(TXNjune, "Adj Close")
Tjune_mean <- mean(Tjune_Vec)
Tjune_mean #This is the mean for June

## [1] 158.0197

Tjul_Vec <- pull(TXNjul, "Adj Close")
Tjul_mean <- mean(Tjul_Vec)
Tjul_mean #This is the mean for July

## [1] 159.4919

Taug_Vec <- pull(TXNaug, "Adj Close")
Taug_mean <- mean(Taug_Vec)
Taug_mean #This is the mean for August

## [1] 177.5213

Tjan_var <- var(Tjan_Vec)
Tjan_var #This is the variance for January

## [1] 27.32669

Tfeb_var <- var(Tfeb_Vec)
Tfeb_var #This is the variance for February

## [1] 37.88166

Tmar_var <- var(Tmar_Vec)
Tmar_var #This is the variance for March

## [1] 55.9989

Tap_var <- var(Tap_Vec)
Tap_var #This is the variance for April

## [1] 14.56005

Tmay_var <- var(Tmay_Vec)
Tmay_var #This is the variance for May

## [1] 13.69582

Tjune_var <- var(Tjune_Vec)
Tjune_var #This is the variance for June

## [1] 69.91271

Tjul_var <- var(Tjul_Vec)
Tjul_var #This is the variance for July

## [1] 72.17855

Taug_var <- var(Taug_Vec)
Taug_var #This is the variance for August

## [1] 40.57648