Merge pull request #29 from palatej/develop

Vignettes (cont.)

.gitignore

@@ -56,3 +56,5 @@ rsconnect/
 
 # produced README.html
 README.html
+/doc/
+/Meta/

inst/doc/regsplines.R

@@ -0,0 +1,56 @@
+## ----setup, include = FALSE---------------------------------------------------
+knitr::opts_chunk$set(
+  collapse = TRUE,
+  comment = "#>"
+)
+
+## ----echo=FALSE---------------------------------------------------------------
+
+suppressPackageStartupMessages(library(rjd3toolkit))
+suppressPackageStartupMessages(library(rjd3sts))
+library(knitr)
+
+## ----data---------------------------------------------------------------------
+s<-log(ABS$X0.2.09.10.M)
+
+## ----bsm----------------------------------------------------------------------
+model<-model()
+
+llt<-locallineartrend('l')
+seas<-seasonal("s", 12, "HarrisonStevens")
+n<-noise('n')
+add(model, llt)
+add(model, seas)
+add(model, n)
+
+rslt<-estimate(model, s)
+
+sa1<-result(rslt, "ssf.smoothing.components")
+
+## ----bsm_splines1-------------------------------------------------------------
+model<-model()
+seas<-splines_regular("s", 12, nodes=c(0:11))
+add(model, llt)
+add(model, seas)
+add(model, n)
+
+rslt<-estimate(model, s)
+
+sa2<-result(rslt, "ssf.smoothing.components")
+
+summary(sa1[,2]-sa2[,2])
+
+## ----bsm_splines2, fig.width=6, fig.height=5----------------------------------
+model<-model()
+seas<-splines_regular("s", 12, nodes=c(1,2,6,7,8,9,10,11))
+add(model, llt)
+add(model, seas)
+add(model, n)
+
+rslt<-estimate(model, s)
+
+sa3<-result(rslt, "ssf.smoothing.components")
+
+
+matplot(cbind(sa1[301:336,2],sa2[301:336,2],sa3[301:336,2]), type='l', ylab="Seasonal")
+

inst/doc/regsplines.Rmd

@@ -0,0 +1,84 @@
+---
+title: "Regular periodic cubic splines"
+author: "Jean Palate"
+date: "`r Sys.Date()`"
+output: rmarkdown::html_vignette
+vignette: >
+  %\VignetteIndexEntry{Regular periodic cubic splines}
+  %\VignetteEngine{knitr::rmarkdown}
+  %\VignetteEncoding{UTF-8}
+---
+
+```{r setup, include = FALSE}
+knitr::opts_chunk$set(
+  collapse = TRUE,
+  comment = "#>"
+)
+```
+
+## Use of regular periodic cubic splines
+
+```{r echo=FALSE}
+
+suppressPackageStartupMessages(library(rjd3toolkit))
+suppressPackageStartupMessages(library(rjd3sts))
+library(knitr)
+```
+
+```{r data}
+s<-log(ABS$X0.2.09.10.M)
+```
+
+### Usual BSM with Harrison-Stevens seasonal component
+
+```{r bsm}
+model<-model()
+
+llt<-locallineartrend('l')
+seas<-seasonal("s", 12, "HarrisonStevens")
+n<-noise('n')
+add(model, llt)
+add(model, seas)
+add(model, n)
+
+rslt<-estimate(model, s)
+
+sa1<-result(rslt, "ssf.smoothing.components")
+```
+###  BSM with full periodic splines seasonal component
+
+The results of the first two models should be identical (up to numerical precision)
+
+
+```{r bsm_splines1}
+model<-model()
+seas<-splines_regular("s", 12, nodes=c(0:11))
+add(model, llt)
+add(model, seas)
+add(model, n)
+
+rslt<-estimate(model, s)
+
+sa2<-result(rslt, "ssf.smoothing.components")
+
+summary(sa1[,2]-sa2[,2])
+```
+
+###  BSM with partial periodic splines seasonal component
+
+The splines are computed on 8 points (instead of 12)
+```{r bsm_splines2, fig.width=6, fig.height=5}
+model<-model()
+seas<-splines_regular("s", 12, nodes=c(1,2,6,7,8,9,10,11))
+add(model, llt)
+add(model, seas)
+add(model, n)
+
+rslt<-estimate(model, s)
+
+sa3<-result(rslt, "ssf.smoothing.components")
+
+
+matplot(cbind(sa1[301:336,2],sa2[301:336,2],sa3[301:336,2]), type='l', ylab="Seasonal")
+```
+