Advertisement
Guest User

Untitled

a guest
May 26th, 2017
70
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.98 KB | None | 0 0
  1. if(!require("ggseas")) install.packages("ggseas")
  2. if(!require("forecast")) install.packages("forecast")
  3. if(!require("data.table")) install.packages("data.table")
  4. if(!require("knitr")) install.packages("knitr")
  5.  
  6. library(ggseas)
  7. library(forecast)
  8. library(data.table)
  9.  
  10. # Get data
  11. nzdata<-data.table(nzbop)
  12. nzdata<-nzdata[!((Account=="Capital account"&
  13. Category=="Balance")|
  14. (Account=="Financial account"&
  15. Category=="Foreign inv. in NZ; Financial derivative liabilities")|
  16. (Category=="Secondary income balance")),]
  17. sample_ts<-nzdata[Account == "Current account" & Category=="Services; Exports total",
  18. .(TimePeriod, Value)]
  19. knitr::kable(head(sample_ts))
  20.  
  21. # Add trend
  22. sample_ts[,trend := zoo::rollmean(Value, 8, fill=NA, align = "right")]
  23. knitr::kable(tail(sample_ts))
  24.  
  25. # De-trend data
  26. sample_ts[,`:=`( detrended_a = Value - trend, detrended_m = Value / trend )]
  27. knitr::kable(tail(sample_ts))
  28.  
  29. # Make seasonals
  30. sample_ts[,`:=`(seasonal_a = mean(detrended_a, na.rm = TRUE),
  31. seasonal_m = mean(detrended_m, na.rm = TRUE)),
  32. by=.(quarter(TimePeriod)) ]
  33. knitr::kable(tail(sample_ts))
  34.  
  35. # Make residuals
  36. sample_ts[,`:=`( residual_a = detrended_a - seasonal_a,
  37. residual_m = detrended_m / seasonal_m )]
  38. knitr::kable(tail(sample_ts))
  39.  
  40. # Visuals
  41. ggsdc(sample_ts, aes(x = TimePeriod, y = Value), method = "decompose",
  42. frequency = 4, s.window = 8, type = "additive")+ geom_line()+
  43. ggtitle("Additive")+ theme_minimal()
  44.  
  45. ggsdc(sample_ts, aes(x=TimePeriod, y=Value), method = "decompose",
  46. frequency=4, s.window=8, type = "multiplicative")+ geom_line()+
  47. ggtitle("Multiplicative")+ theme_minimal()
  48.  
  49. # Auto-correlated factor
  50. ssacf<- function(x) sum(acf(x, na.action = na.omit)$acf^2)
  51. compare_ssacf<-function(add,mult) ifelse(ssacf(add)< ssacf(mult),
  52. "Additive", "Multiplicative")
  53. knitr::kable(sample_ts[,.(compare_ssacf(residual_a, residual_m ))])
  54.  
  55. # Combined function
  56. ssacf<- function(x) sum(acf(x, na.action = na.omit, plot = FALSE)$acf^2)
  57. compare_ssacf<-function(add,mult) ifelse(ssacf(add)< ssacf(mult),
  58. "Additive", "Multiplicative")
  59. additive_or_multiplicative <- function(dt){
  60. m<-copy(dt)
  61. m[,trend := zoo::rollmean(Value, 8, fill="extend", align = "right")]
  62. m[,`:=`( detrended_a = Value - trend, detrended_m = Value / trend )]
  63. m[Value==0,detrended_m:= 0]
  64. m[,`:=`(seasonal_a = mean(detrended_a, na.rm = TRUE),
  65. seasonal_m = mean(detrended_m, na.rm = TRUE)),
  66. by=.(quarter(TimePeriod)) ]
  67. m[is.infinite(seasonal_m),seasonal_m:= 1]
  68. m[,`:=`( residual_a = detrended_a - seasonal_a,
  69. residual_m = detrended_m / seasonal_m)]
  70. compare_ssacf(m$residual_a, m$residual_m )
  71. }
  72.  
  73. # Applying it to all time series in table
  74. results<-nzdata[,.(Type=additive_or_multiplicative(.SD)),
  75. .(Account, Category)]
  76.  
  77. knitr::kable(results)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement