World of Warcraft and the online black market, part 3.

This last and final look at the online gold market for world of warcraft looks at the token prices and tries to forecast the price based on just historical values.
## supressing package warnings
## loading the packages you want
library(tidyverse, quietly = TRUE)
library(forecastHybrid, quietly = TRUE)
library(Metrics, quietly = TRUE)
library(dplyr, quietly = TRUE)
library(prophet, quietly = TRUE)

## renaming the files and removing the singular date value at the end of the file
token <- wowtokenstata
token <- na.omit(token)

## subsetting on regions
token_cn <- subset(token, region=="CN")
token_eu <- subset(token, region=="EU")
token_kr <- subset(token, region=="KR")
token_nam <- subset(token, region=="NAM")
token_tw <- subset(token, region=="TW")

Next we are essentially making our main function that'll do everything for us when we call it,

## turning what we did in the last paper into a function so I can apply it to all the seperate data sets.
forecast_token <- function(data, ahead ){
  arimaGold <- auto.arima(data$gtousd)
  fcastarimagold <- forecast(arimaGold, h= ahead)
  x <- plot(fcastarimagold, include = 50)

  etsGold <- ets(data$gtousd)
  fcastetsgold <- forecast(etsGold, h=ahead)
  x1 <- plot(fcastetsgold, include = 50)

  tbatsGold <- tbats(data$gtousd)
  fcasttbatsgold <- forecast(tbatsGold, h=ahead)
  x2 <- plot(fcasttbatsgold, include = 50)

  prophetBlack <- data
  prophetBlack <- prophetBlack[c(2,4)]
  prophetBlack <- rename(prophetBlack, ds = date, y = gtousd)

  pBlack <- prophet(prophetBlack)
  fprophet <- make_future_dataframe(pBlack, periods = ahead, freq = "day")
  fcastprophet <- predict(pBlack, fprophet)
  x3 <- plot(pBlack, fcastprophet)

  hybridblack <- hybridModel(data$gtousd, weights = "insample.errors", errorMethod = "MASE")
  blackfcast <- forecast(hybridblack, h=ahead)
  x4 <- plot(blackfcast, include = 50)

  hybridblack1 <- hybridModel(data$gtousd, weights = "equal", errorMethod = "MASE")
  blackfcast1 <- forecast(hybridblack1, h=ahead)
  x5 <- plot(blackfcast1, include = 50)

  actVsFcast <- cbind(ts(data$gtousd), ts(fcastetsgold$mean, start = length(data)-length(ahead)), ts(fcastarimagold$mean, start =   length(data)-length(ahead)), ts(fcasttbatsgold$mean, start = length(data)-length(ahead)), ts(tail(fcastprophet$yhat,ahead),       start = length(data)-length(ahead)), ts(blackfcast$mean, start = length(data)-length(ahead)), ts(blackfcast1$mean, start =        length   (data)-length(ahead)))
  colnames(actVsFcast) <- c("Orignal", "ETS", "Arima", "Tbats", "Prophet", "HybridE", "HybridIn")
  x6 <- autoplot(actVsFcast)

  ETS <- rbind(mape(tail(data$gtousd,ahead),fcastetsgold$mean))
  ARIMA <- rbind(mape(tail(data$gtousd,ahead),fcastarimagold$mean))
  TBATS <- rbind(mape(tail(data$gtousd,ahead),fcasttbatsgold$mean))
  PROPHET <- rbind(mape(tail(data$gtousd,ahead),tail(fcastprophet$yhat,ahead)))
  HYBRIDE <- rbind(mape(tail(data$gtousd,ahead),blackfcast$mean))
  HYBRIDIN <- rbind(mape(tail(data$gtousd,ahead),blackfcast1$mean))

  error_metrics <- cbind(ETS, ARIMA, TBATS, PROPHET, HYBRIDE, HYBRIDIN)
  colnames(error_metrics) <-c("ETS", "Arima", "Tbats", "Prophet", "HybridE", "HybridIn")

  #most_precise <- cbind(ts(data$gtousd), ts(blackfcast1$mean, start = 117)) 
  #colnames(most_precise) <- c("Original", "HybridIn")
  #x7 <- autoplot(most_precise)



The last part is greened out since we don't know what the best forecast is for the tokens. If you want you can just look at the MAPE's and do an min() statement to pick the best one. I was getting bored of this data set so I neglected to do that. I will leave that as a task to the reader, if anyone ever does read this.

## calling the function
cn <-  forecast_token(token_cn, 5)
plot of chunk unnamed-chunk-3
plot of chunk unnamed-chunk-3
plot of chunk unnamed-chunk-3
plot of chunk unnamed-chunk-3
plot of chunk unnamed-chunk-3
#tw <-  forecast_token(token_tw, 5)
#na <-  forecast_token(token_nam, 5)
#kr <-  forecast_token(token_kr, 5)
#eu <-  forecast_token(token_eu, 5)

## making a final data frame with all the errors
row.names(cn) <- c("China")
final <- cn
## changing the mape to make it eaiser to explain
final <- final*100
##            ETS     Arima     Tbats  Prophet   HybridE  HybridIn
## China 0.266724 0.3006359 0.2897247 8.474142 0.4654321 0.4832933
## turning back on warnings

Now the final df is the percent error(mean absolute) of each of our forecasts.