x <- c(8.6,8.5,8.3,7.8,7.8,8,8.6,8.9,8.9,8.6,8.3,8.3,8.3,8.4,8.5,8.4,8.6,8.5,8.5,8.4,8.5,8.5,8.5,8.5,8.5,8.5,8.5,8.5,8.6,8.4,8.1,8,8,8,8,7.9,7.8,7.8,7.9,8.1,8,7.6,7.3,7,6.8,7,7.1,7.2,7.1,6.9,6.7,6.7,6.6,6.9,7.3,7.5,7.3,7.1,6.9,7.1) par8 = 'FALSE' par7 = '1' par6 = '' par5 = '1' par4 = '' par3 = '0' par2 = 'periodic' par1 = '12' main = 'Seasonal Decomposition by Loess' #'GNU S' R Code compiled by R2WASP v. 1.0.44 () #Author: Prof. Dr. P. Wessa #To cite this work: AUTHOR(S), (YEAR), YOUR SOFTWARE TITLE (vNUMBER) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_YOURPAGE.wasp/ #Source of accompanying publication: Office for Research, Development, and Education #Technical description: Write here your technical program description (don't use hard returns!) par1 <- as.numeric(par1) #seasonal period if (par2 != 'periodic') par2 <- as.numeric(par2) #s.window par3 <- as.numeric(par3) #s.degree if (par4 == '') par4 <- NULL else par4 <- as.numeric(par4)#t.window par5 <- as.numeric(par5)#t.degree if (par6 != '') par6 <- as.numeric(par6)#l.window par7 <- as.numeric(par7)#l.degree if (par8 == 'FALSE') par8 <- FALSE else par9 <- TRUE #robust nx <- length(x) x <- ts(x,frequency=par1) if (par6 != '') { m <- stl(x,s.window=par2, s.degree=par3, t.window=par4, t.degre=par5, l.window=par6, l.degree=par7, robust=par8) } else { m <- stl(x,s.window=par2, s.degree=par3, t.window=par4, t.degre=par5, l.degree=par7, robust=par8) } m$time.series m$win m$deg m$jump m$inner m$outer postscript(file="/var/www/html/rcomp/tmp/1fznq1259922447.ps",horizontal=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) plot(m,main=main) dev.off() mylagmax <- nx/2 postscript(file="/var/www/html/rcomp/tmp/2pjyr1259922447.ps",horizontal=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) op <- par(mfrow = c(2,2)) acf(as.numeric(x),lag.max = mylagmax,main='Observed') acf(as.numeric(m$time.series[,'trend']),na.action=na.pass,lag.max = mylagmax,main='Trend') acf(as.numeric(m$time.series[,'seasonal']),na.action=na.pass,lag.max = mylagmax,main='Seasonal') acf(as.numeric(m$time.series[,'remainder']),na.action=na.pass,lag.max = mylagmax,main='Remainder') par(op) dev.off() postscript(file="/var/www/html/rcomp/tmp/3d3ug1259922447.ps",horizontal=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) op <- par(mfrow = c(2,2)) spectrum(as.numeric(x),main='Observed') spectrum(as.numeric(m$time.series[!is.na(m$time.series[,'trend']),'trend']),main='Trend') spectrum(as.numeric(m$time.series[!is.na(m$time.series[,'seasonal']),'seasonal']),main='Seasonal') spectrum(as.numeric(m$time.series[!is.na(m$time.series[,'remainder']),'remainder']),main='Remainder') par(op) dev.off() postscript(file="/var/www/html/rcomp/tmp/4hvrv1259922447.ps",horizontal=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) op <- par(mfrow = c(2,2)) cpgram(as.numeric(x),main='Observed') cpgram(as.numeric(m$time.series[!is.na(m$time.series[,'trend']),'trend']),main='Trend') cpgram(as.numeric(m$time.series[!is.na(m$time.series[,'seasonal']),'seasonal']),main='Seasonal') cpgram(as.numeric(m$time.series[!is.na(m$time.series[,'remainder']),'remainder']),main='Remainder') par(op) dev.off() #Note: the /var/www/html/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab load(file="/var/www/html/rcomp/createtable") a<-table.start() a<-table.row.start(a) a<-table.element(a,'Seasonal Decomposition by Loess - Parameters',4,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Component',header=TRUE) a<-table.element(a,'Window',header=TRUE) a<-table.element(a,'Degree',header=TRUE) a<-table.element(a,'Jump',header=TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Seasonal',header=TRUE) a<-table.element(a,m$win['s']) a<-table.element(a,m$deg['s']) a<-table.element(a,m$jump['s']) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Trend',header=TRUE) a<-table.element(a,m$win['t']) a<-table.element(a,m$deg['t']) a<-table.element(a,m$jump['t']) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Low-pass',header=TRUE) a<-table.element(a,m$win['l']) a<-table.element(a,m$deg['l']) a<-table.element(a,m$jump['l']) a<-table.row.end(a) a<-table.end(a) table.save(a,file="/var/www/html/rcomp/tmp/5fcje1259922447.tab") a<-table.start() a<-table.row.start(a) a<-table.element(a,'Seasonal Decomposition by Loess - Time Series Components',6,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'t',header=TRUE) a<-table.element(a,'Observed',header=TRUE) a<-table.element(a,'Fitted',header=TRUE) a<-table.element(a,'Seasonal',header=TRUE) a<-table.element(a,'Trend',header=TRUE) a<-table.element(a,'Remainder',header=TRUE) a<-table.row.end(a) for (i in 1:nx) { a<-table.row.start(a) a<-table.element(a,i,header=TRUE) a<-table.element(a,x[i]) a<-table.element(a,x[i]+m$time.series[i,'remainder']) a<-table.element(a,m$time.series[i,'seasonal']) a<-table.element(a,m$time.series[i,'trend']) a<-table.element(a,m$time.series[i,'remainder']) a<-table.row.end(a) } a<-table.end(a) table.save(a,file="/var/www/html/rcomp/tmp/6cak21259922447.tab") system("convert tmp/1fznq1259922447.ps tmp/1fznq1259922447.png") system("convert tmp/2pjyr1259922447.ps tmp/2pjyr1259922447.png") system("convert tmp/3d3ug1259922447.ps tmp/3d3ug1259922447.png") system("convert tmp/4hvrv1259922447.ps tmp/4hvrv1259922447.png")