period<- function(out,SI_Ratios=FALSE, xlab="", ylab="", lwd_seasonal=2,col_seasonal="black",lwd_mean=3,col_mean="brown",lty_mean="dashed",col_siratio="darkgreen",col_replaced="brown",cex_siratio=.9,cex_replaced=.9,SI_Ratios_replaced=TRUE,plot_legend=TRUE,...){ if(!SI_Ratios) v <- as.vector(out) # Seasonal Factors else v <- as.vector(out)[1:length(out)] # Seasonal Factors without forecast f <- frequency(out) star <-start(out)[2] sto <-end(out)[2] si <- f-sto if(star!=1) { v[(star):(length(out)+star-1)]=v v[1:(star-1)]=NA } ki=length(v) dif <- ki%%f if(dif!=0) { v[(ki+1):(ki+si)]<-NA out_matrix <- matrix(v,ncol=f,byrow=TRUE) } out_matrix <- matrix(v,ncol=f,byrow=TRUE) out_matrix if(f==12){ lab <- c("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec") }else if(f==4){ lab <- c("Qtr1","Qtr2","Qtr3","Qtr4") }else if(f==2){ lab <- c("1st Half","2nd Half") }else{ lab <- 1:f } if(SI_Ratios){ main="Seasonal Factors by period and SI Ratios" }else{ main="" } ylim <- c(min(v,na.rm=TRUE)*.95,max(v,na.rm=TRUE)*1.09) xlim <- c(0,f) plot(1,type="n",main=main,xlim=xlim,ylim=ylim,xaxt="n",ylab=ylab,xlab=xlab,cex=cex_siratio,...) axis(1,at=(1:f)-1/2,labels=lab) for(i in 0:(f)){ abline(v=i,col="grey") } if(SI_Ratios){ vv <- as.vector(out[["d8"]]) #final unmodified SI Ratios dif <- length(vv)%%f if(dif>0) vv[length(vv)+(1:(f-dif))]<-NA out_matrix2 <- matrix(vv,ncol=f,byrow=TRUE) vvv <- as.vector(out[["d9"]]) # final replacement for SI Ratios dif <- length(vvv)%%f if(dif>0) vvv[length(vvv)+(1:(f-dif))]<-NA out_matrix3 <- matrix(vvv,ncol=f,byrow=TRUE) } for(i in 0:(f-1)){ s <- seq(.1+i,(i+1)-.1,l=nrow(out_matrix)) m <- mean(out_matrix[,i+1],na.rm=TRUE) points(rep(m,2)~c(s[1],s[length(s)]),type="l",col=col_mean,lwd=lwd_mean) points(out_matrix[,i+1]~s,type="l",col=col_seasonal,lwd=lwd_seasonal) if(SI_Ratios){ points(out_matrix2[,i+1]~s,pch=25,cex=cex_siratio,col=col_siratio) if(SI_Ratios_replaced) points(out_matrix3[,i+1]~s,pch=25,cex=cex_replaced,col=col_replaced) } } if(plot_legend){ if(SI_Ratios){ if(SI_Ratios_replaced) legend(x=(f/2)-1,y=ylim[2],legend=c("Seasonal Factors","Mean","SI Ratio","Replaced SI Ratio"),col=c(col_seasonal,col_mean,col_siratio,col_replaced),pch=c(NA,NA,20,20),lty=c(1,1,NA,NA),bg="white") else legend(x=(f/2)-1,y=ylim[2],legend=c("Seasonal Factors","Mean","SI Ratio"),col=c(col_seasonal,col_mean,col_siratio),pch=c(NA,NA,20),lty=c(1,1,NA),bg="white") }else legend(x="topright",legend=c("Point on point growth rate","Mean growth rate"),col=c(col_seasonal,col_mean),lty=c(1,1), lwd=c(2,3),bg="white",bty="n") } }