
#######################################################################################
#######################################################################################
################# generation of data from loglinear model with transient shift#########
#######################################################################################


loglinear.ts.ts <- function(d, a1,b1,size, omega, delta, time)
{
       y            <-  rep(NA, size)
       mu           <-  rep(NA, size)
       theta        <-  rep(NA, size)
       theta[1]     <-  0
       mu[1]        <-  1 ####initial value
       y[1]         <-  rpois(1, mu[1])
for (t in 2:size){
                   theta[t]  <- d+a1*theta[t-1]+b1*log(1+y[t-1])
                  if (t>=time){theta[t]=theta[t]+omega*(delta**(t-time))}
                   mu[t]     <- exp(theta[t])
                   y[t]      <- rpois(1, mu[t])
}
return(cbind(y,mu))
}

#### Version which drops burn in
loglinear.ts.ts <- function(d, a1,b1,size, omega, delta, time)
{
       y            <-  rep(NA, (size+30))
       mu           <-  rep(NA, (size+30))
       theta        <-  rep(NA, (size+30))
       theta[1]     <-  0
       mu[1]        <-  1 ####initial value
       y[1]         <-  rpois(1, mu[1])
for (t in 2:(size+30)){
                   theta[t]  <- d+a1*theta[t-1]+b1*log(1+y[t-1])
		  if (t>=(time+30)){theta[t]=theta[t]+omega*(delta**(t-time-30))}
                 #print(c(t,d,a1,b1,y[t-1],theta[t]))
                   mu[t]     <- exp(theta[t])
		  if (is.na(mu[t])){print(c(t,d,a1,b1,theta[t-2],y[t-2]))}
                   y[t]      <- rpois(1, mu[t])
}
return(cbind(y[31:(size+30)],mu[31:(size+30)]))
}

#### Data with several intervention effects
loglinear.ts.mult <- function(d, a1,b1,size, omega, delta, time)
{
       y            <-  rep(NA, (size+30))
       mu           <-  rep(NA, (size+30))
       theta        <-  rep(NA, (size+30))
       theta[1]     <-  0
       mu[1]        <-  1 ####initial value
       y[1]         <-  rpois(1, mu[1])
for (t in 2:(size+30)){
                   theta[t]  <- d+a1*theta[t-1]+b1*log(1+y[t-1])
                  for (i in 1:length(time)){if (t>=(time[i]+30)){theta[t]=theta[t]+omega[i]*(delta[i]**(t-time[i]-30))}}
                 #print(c(t,d,a1,b1,y[t-1],theta[t]))
                   mu[t]     <- exp(theta[t])
		  if (is.na(mu[t])){print(c(t,d,a1,b1,theta[t-2],y[t-2]))}
                   y[t]      <- rpois(1, mu[t])
}
return(cbind(y[31:(size+30)],mu[31:(size+30)]))
}
poliosimloglin<-loglinear.ts.mult(d=-.15,a1=0.51,b1=0.25,size=168,omega=c(1.974,2.094,2.046,0.819),delta=c(0,0,0,1),time=c(7,35,113,166))

#### seasonal model with period=lag
loglinear.ts.ts.seas <- function(d, a1,b1,lag,size, omega, delta, time)
{
       y            <-  rep(NA, (size+50))
       mu           <-  rep(NA, (size+50))
       theta        <-  rep(NA, (size+50))
       theta[1:lag]     <-  0
       mu[1:lag]        <-  1 ####initial value
       y[1:lag]         <-  rpois(1, mu[1])
for (t in (lag+1):(size+50)){
                   theta[t]  <- d+a1*theta[t-lag]+b1*log(1+y[t-1])
		  if (t>=(time+50)){theta[t]=theta[t]+omega*(delta**(t-time-50))}
                 #print(c(t,d,a1,b1,y[t-1],theta[t]))
                   mu[t]     <- exp(theta[t])
		  if (is.na(mu[t])){print(c(t,d,a1,b1,theta[t-2],y[t-2]))}
                   y[t]      <- rpois(1, mu[t])
}
return(cbind(y[51:(size+50)],mu[51:(size+50)]))
}

#### seasonal model with period=lag; the output includes the underlying conditional mean 
loglinear.ts.joint.seas <- function(d, a1,b1,lag,size, omega, delta, time)
{
      chp=length(omega)
       y            <-  rep(NA, (size+30))
       mu           <-  rep(NA, (size+30))
       theta        <-  rep(NA, (size+30))
       theta[1:lag]     <-  0
       mu[1:lag]        <-  1 ####initial value
       y[1:lag]         <-  rpois(1, mu[1])
for (t in (lag+1):(size+50)){
                   theta[t]  <- d+a1*theta[t-lag]+b1*log(1+y[t-1])
                  for (ii in 1:chp){
		  if (t>=(time[ii]+50)){theta[t]=theta[t]+omega[ii]*(delta[ii]**(t-time[ii]-50))}}
                 #print(c(t,d,a1,b1,y[t-1],theta[t]))
                   mu[t]     <- exp(theta[t])
		  if (is.na(mu[t])){print(c(t,d,a1,b1,theta[t-2],y[t-2]))}
                   y[t]      <- rpois(1, mu[t])
}
return(cbind(y[51:(size+50)],mu[51:(size+50)]))
}

############################################################################
############################################################################
###########Loglikelihood for log Linear Poisson Model
####################Here we put (theta[1], theta[2], theta[3])=(d,a1,b1)


likloglinear.poisson <- function(theta, data)
{
theta1=rep(NA, times=length(data))
loglik=rep(NA, times=length(data))
theta1[1]=1
loglik[1]=0
ldata=log(data+1)
for (t in 2:length(data)){
     theta1[t]=theta[1]+theta[2]*theta1[t-1]+theta[3]*ldata[t-1]
     loglik[t]=-data[t]*theta1[t]+exp(theta1[t])
}
final=sum(loglik)
}

#### version which initializes with marginal mean approximated by simulation

likloglinear.poisson <- function(theta, data)
{
theta1=rep(NA, times=length(data))
loglik=rep(NA, times=length(data))
y=loglinear.ts.ts(theta[1], theta[2],theta[3],20000, 0, 0, 100)
theta1[1]=mean(y[,1])
loglik[1]=0
ldata=log(data+1)
for (t in 2:length(data)){
     theta1[t]=theta[1]+theta[2]*theta1[t-1]+theta[3]*ldata[t-1]
     loglik[t]=-data[t]*theta1[t]+exp(theta1[t])
}
final=sum(loglik)
}

#### same for seasonal model with period=lag
likloglinear.poisson.seas <- function(theta, data,lag)
{
theta1=rep(NA, times=length(data))
loglik=rep(NA, times=length(data))
y=loglinear.ts.ts.seas(theta[1], theta[2],theta[3],lag,20000, 0, 0, 100)
theta1[1:lag]=mean(y[,1])
loglik[1:lag]=0
ldata=log(data+1)
for (t in (lag+1):length(data)){
     theta1[t]=theta[1]+theta[2]*theta1[t-lag]+theta[3]*ldata[t-1]
     loglik[t]=-data[t]*theta1[t]+exp(theta1[t])
}
final=sum(loglik)
}


###############################################################################
##############################################################################
###########################Score Function for the
##################################loglinear model

scoreloglinear.poisson <- function(theta, data)
{
theta1=rep(NA, times=length(data))
theta1[1]=1
first=rep(NA, times=length(data))
first[1]=1
second=rep(NA, times=length(data))
second[1]=1
third=rep(NA, times=length(data))
third[1]=1
s1=rep(NA, times=length(data))
s2=rep(NA, times=length(data))
s3=rep(NA, times=length(data))
ldata=log(data+1)
for (t in 2:length(data))
{
theta1[t]=theta[1]+theta[2]*theta1[t-1]+theta[3]*ldata[t-1]
first[t]= (1+theta[2]*first[t-1])
second[t]=(theta1[t-1]+theta[2]*second[t-1])
third[t]=(ldata[t-1]+theta[2]*third[t-1])
s1[t]=-( (data[t]-exp(theta1[t])))*first[t]
s2[t]=-( (data[t]-exp(theta1[t])))*second[t]
s3[t]=-( (data[t]-exp(theta1[t])))*third[t]
}
ss1=sum(s1[-1])
ss2=sum(s2[-1])
ss3=sum(s3[-1])
score=c(ss1,ss2,ss3)
}

#### version which initializes with marginal mean approximated by simulation

scoreloglinear.poisson <- function(theta, data)
{
theta1=rep(NA, times=length(data))
y=loglinear.ts.ts(theta[1], theta[2],theta[3],20000, 0, 0, 100)
theta1[1]=mean(y[,1])
first=rep(NA, times=length(data))
y=loglinear.ts.ts((theta[1]+0.05), theta[2],theta[3],20000, 0, 0, 100)
first[1]=(mean(y[,1])-theta1[1])/0.05
second=rep(NA, times=length(data))
y=loglinear.ts.ts(theta[1], (theta[2]+0.05),theta[3],20000, 0, 0, 100)
second[1]=(mean(y[,1])-theta1[1])/0.05
third=rep(NA, times=length(data))
y=loglinear.ts.ts(theta[1], theta[2],(theta[3]+0.05),20000, 0, 0, 100)
third[1]=(mean(y[,1])-theta1[1])/0.05
s1=rep(NA, times=length(data))
s2=rep(NA, times=length(data))
s3=rep(NA, times=length(data))
ldata=log(data+1)
for (t in 2:length(data))
{
theta1[t]=theta[1]+theta[2]*theta1[t-1]+theta[3]*ldata[t-1]
first[t]= (1+theta[2]*first[t-1])
second[t]=(theta1[t-1]+theta[2]*second[t-1])
third[t]=(ldata[t-1]+theta[2]*third[t-1])
s1[t]=-( (data[t]-exp(theta1[t])))*first[t]
s2[t]=-( (data[t]-exp(theta1[t])))*second[t]
s3[t]=-( (data[t]-exp(theta1[t])))*third[t]
}
ss1=sum(s1[-1])
ss2=sum(s2[-1])
ss3=sum(s3[-1])
score=c(ss1,ss2,ss3)
}

#### same for seasonal model with period=lag
scoreloglinear.poisson.seas <- function(theta, data,lag)
{
theta1=rep(NA, times=length(data))
y=loglinear.ts.ts.seas(theta[1], theta[2],theta[3],lag,20000, 0, 0, 100)
theta1[1:lag]=mean(y[,1])
first=rep(NA, times=length(data))
y=loglinear.ts.ts.seas((theta[1]+0.05), theta[2],theta[3],lag,20000, 0, 0, 100)
first[1:lag]=(mean(y[,1])-theta1[1])/0.05
second=rep(NA, times=length(data))
y=loglinear.ts.ts.seas(theta[1], (theta[2]-0.05),theta[3],lag,20000, 0, 0, 100)
second[1:lag]=-(mean(y[,1])-theta1[1])/0.05
third=rep(NA, times=length(data))
y=loglinear.ts.ts.seas(theta[1], theta[2],(theta[3]-0.05),lag,20000, 0, 0, 100)
third[1:lag]=-(mean(y[,1])-theta1[1])/0.05
s1=rep(NA, times=length(data))
s2=rep(NA, times=length(data))
s3=rep(NA, times=length(data))
ldata=log(data+1)
for (t in (lag+1):length(data))
{
theta1[t]=theta[1]+theta[2]*theta1[t-lag]+theta[3]*ldata[t-1]
first[t]= (1+theta[2]*first[t-lag])
second[t]=(theta1[t-lag]+theta[2]*second[t-lag])
third[t]=(ldata[t-1]+theta[2]*third[t-lag])
s1[t]=-( (data[t]-exp(theta1[t])))*first[t]
s2[t]=-( (data[t]-exp(theta1[t])))*second[t]
s3[t]=-( (data[t]-exp(theta1[t])))*third[t]
}
ss1=sum(s1[-(1:lag)])
ss2=sum(s2[-(1:lag)])
ss3=sum(s3[-(1:lag)])
score=c(ss1,ss2,ss3)
}
########################################################################
########################################################################

#####################################################
####the following function gives the log--likelihood function
#######when estimating with a transient shift.
######################################################
#####################################################

likloglinear.poisson.ts <- function(theta, data,delta, time)
{
theta1=rep(NA, times=length(data))
loglik=rep(NA, times=length(data))
theta1[1]=1
loglik[1]=0
ldata=log(data+1)
for (t in 2:length(data)){
     theta1[t]=theta[1]+theta[2]*theta1[t-1]+theta[3]*ldata[t-1]
     if (t>=time){theta1[t]=theta1[t]+ theta[4]*(delta**(t-time))*I(t >= time)}
     loglik[t]=-data[t]*theta1[t]+exp(theta1[t])
}
final=sum(loglik)
}

##### Version which initializes with marginal mean

likloglinear.poisson.ts <- function(theta, data,delta, time)
{
theta1=rep(NA, times=length(data))
loglik=rep(NA, times=length(data))
y=loglinear.ts.ts(theta[1], theta[2],theta[3],20000, 0, 0, 100)
theta1[1]=mean(y[,1])
loglik[1]=0
ldata=log(data+1)
for (t in 2:length(data)){
     theta1[t]=theta[1]+theta[2]*theta1[t-1]+theta[3]*ldata[t-1]
     if (t>=time){theta1[t]=theta1[t]+ theta[4]*(delta**(t-time))*I(t >= time)}
     loglik[t]=-data[t]*theta1[t]+exp(theta1[t])
}
final=sum(loglik)
}

#### same for seasonal model with period=lag
likloglinear.poisson.ts.seas <- function(theta, data,lag,delta, time)
{
theta1=rep(NA, times=length(data))
loglik=rep(NA, times=length(data))
y=loglinear.ts.ts.seas(theta[1], theta[2],theta[3],lag,20000, 0, 0, 100)
theta1[1:lag]=mean(y[,1])
loglik[1:lag]=0
ldata=log(data+1)
for (t in (lag+1):length(data)){
     theta1[t]=theta[1]+theta[2]*theta1[t-lag]+theta[3]*ldata[t-1]
     if (t>=time){theta1[t]=theta1[t]+ theta[4]*(delta**(t-time))*I(t >= time)}
     loglik[t]=-data[t]*theta1[t]+exp(theta1[t])
}
final=sum(loglik)
}


likloglinear.poisson.ts.seas.joint<-function(theta, data,lag,delta, time)
{
chp=length(delta)
theta1=rep(NA, times=length(data))
loglik=rep(NA, times=length(data))
y=loglinear.ts.ts.seas(theta[1], theta[2],theta[3],lag,20000, 0, 0, 100)
theta1[1:lag]=mean(y[,1])
loglik[1:lag]=0
ldata=log(data+1)
for (t in (lag+1):length(data)){
     theta1[t]=theta[1]+theta[2]*theta1[t-1]+theta[3]*ldata[t-lag]
     for (ii in 1:chp){if (t>=time[ii]){theta1[t]=theta1[t]+ theta[3+ii]*(delta[ii]**(t-time[ii]))*I(t >= time[ii])}}
     loglik[t]=-data[t]*theta1[t]+exp(theta1[t])
}
final=sum(loglik)
}
#########################################################################
####################Score for the log--linear model in the case of transient
####################shift or level shift.
#########################################################################

scoreloglinear.poisson.ts <- function(theta, data,delta, time)
{
theta1=rep(NA, times=length(data))
theta1[1]=1
first=rep(NA, times=length(data))
first[1]=1
second=rep(NA, times=length(data))
second[1]=1
third=rep(NA, times=length(data))
third[1]=1
fourth=rep(NA, times=length(data))
fourth[1]=1
s1=rep(NA, times=length(data))
s2=rep(NA, times=length(data))
s3=rep(NA, times=length(data))
s4=rep(NA, times=length(data))
ldata=log(data+1)
for (t in 2:length(data))
{
theta1[t]=theta[1]+theta[2]*theta1[t-1]+theta[3]*ldata[t-1]
if (t>=time){theta1[t]=theta1[t]+ theta[4]*(delta**(t-time))*I(t >= time)}
first[t]= (1+theta[2]*first[t-1])
second[t]=(theta1[t-1]+theta[2]*second[t-1])
third[t]=(ldata[t-1]+theta[2]*third[t-1])
fourth[t]=theta[2]*fourth[t-1]
if (t>=time){fourth[t]=fourth[t]+(delta**(t-time))*I(t >= time)}
s1[t]=-( (data[t]-exp(theta1[t])))*first[t]
s2[t]=-( (data[t]-exp(theta1[t])))*second[t]
s3[t]=-( (data[t]-exp(theta1[t])))*third[t]
s4[t]=-( (data[t]-exp(theta1[t])))*fourth[t]
}
ss1=sum(s1[-1])
ss2=sum(s2[-1])
ss3=sum(s3[-1])
ss4=sum(s4[-1])
score=c(ss1,ss2,ss3,ss4)
}

############## Version which initializes with the marginal mean
scoreloglinear.poisson.ts <- function(theta, data,delta, time)
{
theta1=rep(NA, times=length(data))
y=loglinear.ts.ts(theta[1], theta[2],theta[3],10000, 0, 0, 100)
theta1[1]=mean(y[,1])
first=rep(NA, times=length(data))
y=loglinear.ts.ts((theta[1]+0.05), theta[2],theta[3],10000, 0, 0, 100)
first[1]=(mean(y[,1])-theta1[1])/0.05
second=rep(NA, times=length(data))
y=loglinear.ts.ts(theta[1], (theta[2]+0.05),theta[3],10000, 0, 0, 100)
second[1]=(mean(y[,1])-theta1[1])/0.05
third=rep(NA, times=length(data))
y=loglinear.ts.ts(theta[1], theta[2],(theta[3]+0.05),10000, 0, 0, 100)
third[1]=(mean(y[,1])-theta1[1])/0.05
fourth=rep(NA, times=length(data))
fourth[1]=0
s1=rep(NA, times=length(data))
s2=rep(NA, times=length(data))
s3=rep(NA, times=length(data))
s4=rep(NA, times=length(data))
ldata=log(data+1)
for (t in 2:length(data))
{
theta1[t]=theta[1]+theta[2]*theta1[t-1]+theta[3]*ldata[t-1]
if (t>=time){theta1[t]=theta1[t]+ theta[4]*(delta**(t-time))*I(t >= time)}
first[t]= (1+theta[2]*first[t-1])
second[t]=(theta1[t-1]+theta[2]*second[t-1])
third[t]=(ldata[t-1]+theta[2]*third[t-1])
fourth[t]=theta[2]*fourth[t-1]
if (t>=time){fourth[t]=fourth[t]+(delta**(t-time))*I(t >= time)}
s1[t]=-( (data[t]-exp(theta1[t])))*first[t]
s2[t]=-( (data[t]-exp(theta1[t])))*second[t]
s3[t]=-( (data[t]-exp(theta1[t])))*third[t]
s4[t]=-( (data[t]-exp(theta1[t])))*fourth[t]
}
ss1=sum(s1[-1])
ss2=sum(s2[-1])
ss3=sum(s3[-1])
ss4=sum(s4[-1])
score=c(ss1,ss2,ss3,ss4)
}




############## Equivalent version which initializes with the marginal mean 
scoreloglinear.poisson.ts <- function(theta, data,delta, time,mu,deriv)
{
theta1=rep(NA, times=length(data))
#y=loglinear.ts.ts(theta[1], theta[2],theta[3],20000, 0, 0, 100)
#theta1[1]=mean(y[,1])
first=rep(NA, times=length(data))
#y=loglinear.ts.ts((theta[1]+0.05), theta[2],theta[3],20000, 0, 0, 100)
#first[1]=(mean(y[,1])-theta1[1])/0.05
second=rep(NA, times=length(data))
#y=loglinear.ts.ts(theta[1], (theta[2]+0.05),theta[3],20000, 0, 0, 100)
#second[1]=(mean(y[,1])-theta1[1])/0.05
third=rep(NA, times=length(data))
#y=loglinear.ts.ts(theta[1], theta[2],(theta[3]+0.05),20000, 0, 0, 100)
#third[1]=(mean(y[,1])-theta1[1])/0.05
theta1[1]=mu
first[1]=deriv[1]
second[1]=deriv[2]
third[1]=deriv[3]
fourth=rep(NA, times=length(data))
fourth[1]=0
s1=rep(NA, times=length(data))
s2=rep(NA, times=length(data))
s3=rep(NA, times=length(data))
s4=rep(NA, times=length(data))
ldata=log(data+1)
for (t in 2:length(data))
{
theta1[t]=theta[1]+theta[2]*theta1[t-1]+theta[3]*ldata[t-1]
if (t>=time){theta1[t]=theta1[t]+ theta[4]*(delta**(t-time))*I(t >= time)}
first[t]= (1+theta[2]*first[t-1])
second[t]=(theta1[t-1]+theta[2]*second[t-1])
third[t]=(ldata[t-1]+theta[2]*third[t-1])
fourth[t]=theta[2]*fourth[t-1]
if (t>=time){fourth[t]=fourth[t]+(delta**(t-time))*I(t >= time)}
s1[t]=-( (data[t]-exp(theta1[t])))*first[t]
s2[t]=-( (data[t]-exp(theta1[t])))*second[t]
s3[t]=-( (data[t]-exp(theta1[t])))*third[t]
s4[t]=-( (data[t]-exp(theta1[t])))*fourth[t]
}
ss1=sum(s1[-1])
ss2=sum(s2[-1])
ss3=sum(s3[-1])
ss4=sum(s4[-1])
score=c(ss1,ss2,ss3,ss4)
}


############## Score for the seasonal model initialized by the marginal mean
scoreloglinear.poisson.ts.seas <- function(theta, data,lag,delta, time,mu,deriv)
{
theta1=rep(NA, times=length(data))
#y=loglinear.ts.ts(theta[1], theta[2],theta[3],20000, 0, 0, 100)
#theta1[1]=mean(y[,1])
first=rep(NA, times=length(data))
#y=loglinear.ts.ts((theta[1]+0.05), theta[2],theta[3],20000, 0, 0, 100)
#first[1]=(mean(y[,1])-theta1[1])/0.05
second=rep(NA, times=length(data))
#y=loglinear.ts.ts(theta[1], (theta[2]+0.05),theta[3],20000, 0, 0, 100)
#second[1]=(mean(y[,1])-theta1[1])/0.05
third=rep(NA, times=length(data))
#y=loglinear.ts.ts(theta[1], theta[2],(theta[3]+0.05),20000, 0, 0, 100)
#third[1]=(mean(y[,1])-theta1[1])/0.05
theta1[1:lag]=mu
first[1:lag]=deriv[1]
second[1:lag]=deriv[2]
third[1:lag]=deriv[3]
fourth=rep(NA, times=length(data))
fourth[1:lag]=0
s1=rep(NA, times=length(data))
s2=rep(NA, times=length(data))
s3=rep(NA, times=length(data))
s4=rep(NA, times=length(data))
ldata=log(data+1)
for (t in (lag+1):length(data))
{
theta1[t]=theta[1]+theta[2]*theta1[t-lag]+theta[3]*ldata[t-1]
if (t>=time){theta1[t]=theta1[t]+ theta[4]*(delta**(t-time))*I(t >= time)}
first[t]= (1+theta[2]*first[t-lag])
second[t]=(theta1[t-1]+theta[2]*second[t-lag])
third[t]=(ldata[t-1]+theta[2]*third[t-lag])
fourth[t]=theta[2]*fourth[t-lag]
if (t>=time){fourth[t]=fourth[t]+(delta**(t-time))*I(t >= time)}
s1[t]=-( (data[t]-exp(theta1[t])))*first[t]
s2[t]=-( (data[t]-exp(theta1[t])))*second[t]
s3[t]=-( (data[t]-exp(theta1[t])))*third[t]
s4[t]=-( (data[t]-exp(theta1[t])))*fourth[t]
}
ss1=sum(s1[-(1:lag)])
ss2=sum(s2[-(1:lag)])
ss3=sum(s3[-(1:lag)])
ss4=sum(s4[-(1:lag)])
score=c(ss1,ss2,ss3,ss4)
}


##### score function for several intervention effects
scoreloglinear.poisson.ts.seas.joint <- function(theta, data,lag,time,delta)
{
chp=length(delta)
n=length(data)
theta1=rep(NA, times=length(data))
y=loglinear.ts.ts.seas(theta[1], theta[2],theta[3],lag,20000, 0, 0, 100)
theta1[1:lag]=mean(y[,1])
first=rep(NA, times=length(data))
y=loglinear.ts.ts((theta[1]+0.05), theta[2],theta[3],20000, 0, 0, 100)
first[1:lag]=(mean(y[,1])-theta1[1])/0.05
second=rep(NA, times=length(data))
y=loglinear.ts.ts(theta[1], (theta[2]-0.05),theta[3],20000, 0, 0, 100)
second[1:lag]=-(mean(y[,1])-theta1[1])/0.05
third=rep(NA, times=length(data))
y=loglinear.ts.ts(theta[1], theta[2],(theta[3]-0.05),20000, 0, 0, 100)
third[1:lag]=-(mean(y[,1])-theta1[1])/0.05
first[1:lag]=deriv[1]
second[1:lag]=deriv[2]
third[1:lag]=deriv[3]
fourth=matrix(NA, nrow=n,ncol=chp)
fourth[1:lag,]=0
s1=rep(NA, times=length(data))
s2=rep(NA, times=length(data))
s3=rep(NA, times=length(data))
s4=matrix(NA, nrow=n,ncol=chp)
ldata=log(data+1)
for (t in (lag+1):length(data))
{
theta1[t]=theta[1]+theta[2]*theta1[t-lag]+theta[3]*ldata[t-1]
for (ii in 1:chp){if (t>=time[ii]){theta1[t]=theta1[t]+ theta[3+ii]*(delta[ii]**(t-time[ii]))*I(t >= time[ii])}}
first[t]= (1+theta[2]*first[t-lag])
second[t]=(theta1[t-1]+theta[2]*second[t-lag])
third[t]=(ldata[t-1]+theta[2]*third[t-lag])
for (ii in 1:chp){fourth[t,ii]=theta[2]*fourth[(t-lag),ii]
if (t>=time[ii]){fourth[t,ii]=fourth[t,ii]+(delta[ii]**(t-time[ii]))*I(t >= time[ii])}}
s1[t]=-( (data[t]-exp(theta1[t])))*first[t]
s2[t]=-( (data[t]-exp(theta1[t])))*second[t]
s3[t]=-( (data[t]-exp(theta1[t])))*third[t]
ss4=rep(0,chp)
for (ii in 1:chp){s4[t,ii]=-( (data[t]-exp(theta1[t])))*fourth[t,ii]}
}
for (ii in 1:chp){ss4[ii]=sum(s4[-1,ii])}
ss1=sum(s1[-(1:lag)])
ss2=sum(s2[-(1:lag)])
ss3=sum(s3[-(1:lag)])
score=c(ss1,ss2,ss3,ss4)
}
##########################################################################################
##########################################################################################
######################Information Matrix with a transient shift.
##################################################
information1.logpoisson.ts <- function(theta, data,delta,time)
{
theta1=rep(NA, times=length(data))
theta1[1]=1
first=rep(NA, times=length(data))
first[1]=1
second=rep(NA, times=length(data))
second[1]=1
third=rep(NA, times=length(data))
third[1]=1
fourth=rep(NA, times=length(data))
fourth[1]=0
Information <- matrix(0, nrow=4, ncol=4)
s1=rep(NA, times=length(data))
s2=rep(NA, times=length(data))
s3=rep(NA, times=length(data))
s4=rep(NA, times=length(data))
for (t in 2:length(data))
{
theta1[t]=theta[1]+theta[2]*theta1[t-1]+theta[3]*log(data[t-1]+1)
if (t>=time){theta1[t]=theta1[t]+ theta[4]*(delta**(t-time))*I(t >= time)}
first[t]= (1+theta[2]*first[t-1])
second[t]=(theta1[t-1]+theta[2]*second[t-1])
third[t]=(log(data[t-1]+1)+theta[2]*third[t-1])
fourth[t]=theta[2]*fourth[t-1]
if (t>=time){fourth[t]=fourth[t]+(delta**(t-time))*I(t >= time)}
s1[t]=-first[t]
s2[t]=-second[t]
s3[t]=-third[t]
s4[t]= -fourth[t]
var.comp= (exp(theta1[t]/2))*c(s1[t], s2[t], s3[t], s4[t])
Information=Information+var.comp%*%t(var.comp)
}
return(Information)
}

########## Version which initializes with the marginal mean
information1.logpoisson.tsopt <- function(theta, data,delta,time)
{
theta1=rep(NA, times=length(data))
y=loglinear.ts.ts(theta[1], theta[2],theta[3],20000, 0, 0, 100)
theta1[1]=mean(y[,1])
first=rep(NA, times=length(data))
y=loglinear.ts.ts((theta[1]+0.05), theta[2],theta[3],20000, 0, 0, 100)
first[1]=(mean(y[,1])-theta1[1])/0.05
second=rep(NA, times=length(data))
y=loglinear.ts.ts(theta[1], (theta[2]+0.05),theta[3],20000, 0, 0, 100)
second[1]=(mean(y[,1])-theta1[1])/0.05
third=rep(NA, times=length(data))
y=loglinear.ts.ts(theta[1], theta[2],(theta[3]+0.05),20000, 0, 0, 100)
third[1]=(mean(y[,1])-theta1[1])/0.05
fourth=rep(NA, times=length(data))
fourth[1]=0
Information <- matrix(0, nrow=4, ncol=4)
s1=rep(NA, times=length(data))
s2=rep(NA, times=length(data))
s3=rep(NA, times=length(data))
s4=rep(NA, times=length(data))
for (t in 2:length(data))
{
theta1[t]=theta[1]+theta[2]*theta1[t-1]+theta[3]*log(data[t-1]+1)
if (t>=time){theta1[t]=theta1[t]+ theta[4]*(delta**(t-time))*I(t >= time)}
first[t]= (1+theta[2]*first[t-1])
second[t]=(theta1[t-1]+theta[2]*second[t-1])
third[t]=(log(data[t-1]+1)+theta[2]*third[t-1])
fourth[t]=theta[2]*fourth[t-1]
if (t>=time){fourth[t]=fourth[t]+(delta**(t-time))*I(t >= time)}
s1[t]=-first[t]
s2[t]=-second[t]
s3[t]=-third[t]
s4[t]= -fourth[t]
var.comp= (exp(theta1[t]/2))*c(s1[t], s2[t], s3[t], s4[t])
Information=Information+var.comp%*%t(var.comp)
}
return(Information)
}

###### equivalent version which initializes by the marginal mean
information1.logpoisson.ts <- function(theta, data,delta,time,mu,deriv)
{
theta1=rep(NA, times=length(data))
#y=loglinear.ts.ts(theta[1], theta[2],theta[3],20000, 0, 0, 100)
#theta1[1]=mean(y[,1])
first=rep(NA, times=length(data))
#y=loglinear.ts.ts((theta[1]+0.05), theta[2],theta[3],20000, 0, 0, 100)
#first[1]=(mean(y[,1])-theta1[1])/0.05
second=rep(NA, times=length(data))
#y=loglinear.ts.ts(theta[1], (theta[2]+0.05),theta[3],20000, 0, 0, 100)
#second[1]=(mean(y[,1])-theta1[1])/0.05
third=rep(NA, times=length(data))
#y=loglinear.ts.ts(theta[1], theta[2],(theta[3]+0.05),20000, 0, 0, 100)
#third[1]=(mean(y[,1])-theta1[1])/0.05
theta1[1]=mu
first[1]=deriv[1]
second[1]=deriv[2]
third[1]=deriv[3]
fourth=rep(NA, times=length(data))
fourth[1]=0
Information <- matrix(0, nrow=4, ncol=4)
s1=rep(NA, times=length(data))
s2=rep(NA, times=length(data))
s3=rep(NA, times=length(data))
s4=rep(NA, times=length(data))
for (t in 2:length(data))
{
theta1[t]=theta[1]+theta[2]*theta1[t-1]+theta[3]*log(data[t-1]+1)
if (t>=time){theta1[t]=theta1[t]+ theta[4]*(delta**(t-time))*I(t >= time)}
first[t]= (1+theta[2]*first[t-1])
second[t]=(theta1[t-1]+theta[2]*second[t-1])
third[t]=(log(data[t-1]+1)+theta[2]*third[t-1])
fourth[t]=theta[2]*fourth[t-1]
if (t>=time){fourth[t]=fourth[t]+(delta**(t-time))*I(t >= time)}
s1[t]=-first[t]
s2[t]=-second[t]
s3[t]=-third[t]
s4[t]= -fourth[t]
var.comp= (exp(theta1[t]/2))*c(s1[t], s2[t], s3[t], s4[t])
Information=Information+var.comp%*%t(var.comp)
}
return(Information)
}

####### information matrix for the seasonal model
information1.logpoisson.ts.seas <- function(theta, data,lag,delta,time,mu,deriv)
{
theta1=rep(NA, times=length(data))
#y=loglinear.ts.ts(theta[1], theta[2],theta[3],20000, 0, 0, 100)
#theta1[1]=mean(y[,1])
first=rep(NA, times=length(data))
#y=loglinear.ts.ts((theta[1]+0.05), theta[2],theta[3],20000, 0, 0, 100)
#first[1]=(mean(y[,1])-theta1[1])/0.05
second=rep(NA, times=length(data))
#y=loglinear.ts.ts(theta[1], (theta[2]+0.05),theta[3],20000, 0, 0, 100)
#second[1]=(mean(y[,1])-theta1[1])/0.05
third=rep(NA, times=length(data))
#y=loglinear.ts.ts(theta[1], theta[2],(theta[3]+0.05),20000, 0, 0, 100)
#third[1]=(mean(y[,1])-theta1[1])/0.05
theta1[1:lag]=mu
first[1:lag]=deriv[1]
second[1:lag]=deriv[2]
third[1:lag]=deriv[3]
fourth=rep(NA, times=length(data))
fourth[1:lag]=0
Information <- matrix(0, nrow=4, ncol=4)
s1=rep(NA, times=length(data))
s2=rep(NA, times=length(data))
s3=rep(NA, times=length(data))
s4=rep(NA, times=length(data))
for (t in (lag+1):length(data))
{
theta1[t]=theta[1]+theta[2]*theta1[t-lag]+theta[3]*log(data[t-1]+1)
if (t>=time){theta1[t]=theta1[t]+ theta[4]*(delta**(t-time))*I(t >= time)}
first[t]= (1+theta[2]*first[t-lag])
second[t]=(theta1[t-1]+theta[2]*second[t-lag])
third[t]=(log(data[t-1]+1)+theta[2]*third[t-lag])
fourth[t]=theta[2]*fourth[t-lag]
if (t>=time){fourth[t]=fourth[t]+(delta**(t-time))*I(t >= time)}
s1[t]=-first[t]
s2[t]=-second[t]
s3[t]=-third[t]
s4[t]= -fourth[t]
var.comp= (exp(theta1[t]/2))*c(s1[t], s2[t], s3[t], s4[t])
Information=Information+var.comp%*%t(var.comp)
}
return(Information)
}


###### information matrix for the seasonal model with several intervention effects
information1.logpoisson.ts.seas.joint <- function(theta, data,lag,delta,time)
{
chp=length(delta)
theta1=rep(NA, times=length(data))
y=loglinear.ts.ts.seas(theta[1], theta[2],theta[3],lag,20000, 0, 0, 100)
theta1[1:lag]=mean(y[,1])
first=rep(NA, times=length(data))
y=loglinear.ts.ts.seas((theta[1]+0.05), theta[2],theta[3],lag,20000, 0, 0, 100)
first[1:lag]=(mean(y[,1])-theta1[1])/0.05
second=rep(NA, times=length(data))
y=loglinear.ts.ts.seas(theta[1], (theta[2]-0.05),theta[3],lag,20000, 0, 0, 100)
second[1:lag]=-(mean(y[,1])-theta1[1])/0.05
third=rep(NA, times=length(data))
y=loglinear.ts.ts.seas(theta[1], theta[2],(theta[3]-0.05),lag,20000, 0, 0, 100)
third[1:lag]=-(mean(y[,1])-theta1[1])/0.05
first[1:lag]=deriv[1]
second[1:lag]=deriv[2]
third[1:lag]=deriv[3]
fourth=matrix(NA, nrow=length(data),ncol=chp)
fourth[1:lag,]=0
Information <- matrix(0, nrow=(3+chp), ncol=(3+chp))
s1=rep(NA, times=length(data))
s2=rep(NA, times=length(data))
s3=rep(NA, times=length(data))
s4=matrix(NA, nrow=length(data),ncol=chp)
for (t in (lag+1):length(data))
{
theta1[t]=theta[1]+theta[2]*theta1[t-lag]+theta[3]*log(data[t-1]+1)
for (ii in 1:chp){
if (t>=time[ii]){theta1[t]=theta1[t]+ theta[ii+3]*(delta[ii]**(t-time[ii]))*I(t >= time[ii])}}
first[t]= (1+theta[2]*first[t-lag])
second[t]=(theta1[t-1]+theta[2]*second[t-lag])
third[t]=(log(data[t-1]+1)+theta[2]*third[t-lag])
for (ii in 1:chp){
fourth[t,ii]=theta[2]*fourth[t-lag,ii]
if (t>=time[ii]){fourth[t,ii]=fourth[t,ii]+(delta[ii]**(t-time[ii]))*I(t >= time[ii])}}
s1[t]=-first[t]
s2[t]=-second[t]
s3[t]=-third[t]
s4[t,]= -fourth[t,]
var.comp= (exp(theta1[t]/2))*c(s1[t], s2[t], s3[t], s4[t,])
Information=Information+var.comp%*%t(var.comp)
}
return(Information)
}

#################################################################
######### Joint estimation
#################################################################
joint.loglin.est <- function(dataset,lag, delta, time)
{
n=length(dataset)
size=n
chp=length(delta)
x=matrix(0, nrow=size,ncol=chp)
for (ii in 1:chp){
for (j in time[ii]:(size)){x[j,ii]=(delta[ii]**(j-time[ii]))*I(j >= time[ii])}}
LY=log(dataset+1)
start=glm(dataset[(lag+1):n]~ LY[1:(n-lag)]+x[(lag+1):n,1]+x[(lag+1):n,2]+x[(lag+1):n,3], family=poisson)$coef
results2=optim(likloglinear.poisson.ts.seas.joint, par=c(start[1], 0, start[2], start[3],start[4],start[5]),
data=dataset,lag=lag, delta=delta, time=time,scoreloglinear.poisson.ts.seas.joint , method="BFGS")
coef= results2$par
print(sqrt(diag(ginv(information1.logpoisson.ts.seas.joint(theta=coef,data= dataset,lag,delta=delta,time=time)))))
print(likloglinear.poisson.ts.seas.joint(coef, dataset,lag,delta, time))
return(coef)
}

joint.loglin.est <- function(dataset,lag, delta, time)
{
n=length(dataset)
size=n
chp=length(delta)
x=matrix(0, nrow=size,ncol=chp)
for (ii in 1:chp){
for (j in time[ii]:(size)){x[j,ii]=(delta[ii]**(j-time[ii]))*I(j >= time[ii])}}
LY=log(dataset+1)
start=glm(dataset[(lag+1):n]~ LY[1:(n-lag)]+x[(lag+1):n,1]+x[(lag+1):n,2]+x[(lag+1):n,3], family=poisson)$coef
results2=optim(likloglinear.poisson.ts.seas.joint, par=c(start[1], 0, start[2], start[3],start[4],start[5]),
data=dataset,lag=lag, delta=delta, time=time,scoreloglinear.poisson.ts.seas.joint , method="BFGS")
coef= results2$par
print(sqrt(diag(ginv(information1.logpoisson.ts.seas.joint(theta=coef,data= dataset,lag,delta=delta,time=time)))))
print(likloglinear.poisson.ts.seas.joint(coef, dataset,lag,delta, time))
return(coef)
}

################################################################
##################Simulation of the estimators#################
################################################################

sim.logfun.ts.est <- function(d,a1, b1,size, omega, delta, time, sim)
{
coef=matrix(NA, nrow=sim, ncol=4)
x=rep(0, size)
for (j in time:(size))
{
x[j]=(delta**(j-time))*I(j >= time)
}
for (i in 1:sim)
{
Response <- loglinear.ts.ts(d,a1, b1,size, omega, delta, time)[,1]
LY=log(Response+1)
start=glm(Response[2:length(Response)]~ LY[1:(length(Response)-1)]+x[1:(length(Response)-1)], family=poisson)$coef
results2=optim(likloglinear.poisson.ts, par=c(start[1], 0, start[2], start[3]),
data=Response, delta=delta, time=time, scoreloglinear.poisson.ts , method="BFGS")
coef[i,]= results2$par
}
return(coef)
}


###############################################################################
##################Simulation of the score test#
###############################################################
sim.fun.logscore.ts <- function(d,a1, b1,size,omega,delta, time, sim)
{
test=rep(NA,sim)
for (i in 1:sim)
{
Response <- loglinear.ts.ts(d,a1,b1,size,omega, delta, time )[,1]
LY=log(Response+1)
#X=rep(0, length(Response))
#for (i in 1:length(Response))
#{
#X[t]=(delta**(t-time))*I(t >= time)
#}
start=glm(Response[2:length(Response)]~ LY[1:(length(Response)-1)], family=poisson)$coef
results2=optim(likloglinear.poisson, p=c(start[1], 0, start[2]),
data=Response, scoreloglinear.poisson , method="BFGS")
parameters1= results2$par
test[i]=t(scoreloglinear.poisson.ts(c(parameters1,0), Response, delta, time))%*% solve(information1.logpoisson.ts(c(parameters1,0),
Response, delta, time))%*%scoreloglinear.poisson.ts(c(parameters1,0), Response, delta, time)
}
return(test)
}

################## Version which initializes with the marginal mean
sim.fun.logscore.ts <- function(d,a1, b1,size,omega,delta, time, sim)
{
test=rep(NA,sim)
for (i in 1:sim)
{
print(i)
Response <- loglinear.ts.ts(d,a1,b1,size,omega, delta, time )[,1]
LY=log(Response+1)
#X=rep(0, length(Response))
#for (i in 1:length(Response))
#{
#X[t]=(delta**(t-time))*I(t >= time)
#}
start=glm(Response[2:length(Response)]~ LY[1:(length(Response)-1)], family=poisson)$coef
ui=matrix(0,nrow=4,ncol=3)
ui[1,2]=1
ui[1,3]=1
ui[2,2]=-1
ui[2,3]=-1
ui[3,2]=1
ui[4,2]=-1
ci=c(-1,-1,-1,-1)
#print("ja")
results2=constrOptim( theta=c(start[1], 0, max(-0.99,min(start[2],0.99))),likloglinear.poisson,ui,ci,
data=Response, grad=scoreloglinear.poisson , method="BFGS")
parameters1= results2$par
deriv=rep(0,3)
y=loglinear.ts.ts(parameters1[1],parameters1[2],parameters1[3],20000, 0, 0, 100)
mu=mean(y[,1])
y=loglinear.ts.ts((parameters1[1]+0.05), parameters1[2],parameters1[3],20000, 0, 0, 100)
deriv[1]=(mean(y[,1])-mu)/0.05
y=loglinear.ts.ts(parameters1[1], (parameters1[2]-0.05),parameters1[3],20000, 0, 0, 100)
deriv[2]=-(mean(y[,1])-mu)/0.05
third=rep(NA, times=length(data))
y=loglinear.ts.ts(parameters1[1], parameters1[2],(parameters1[3]-0.05),20000, 0, 0, 100)
deriv[3]=-(mean(y[,1])-mu)/0.05
t1v=scoreloglinear.poisson.ts(c(parameters1,0), Response, delta, time,mu,deriv)
test[i]=t(t1v)%*% ginv(information1.logpoisson.ts(c(parameters1,0),Response, delta, time,mu,deriv))%*%t1v
}
return(test)
}


###############################################################################
##################Simulation of the max-score test#
###############################################################
sim.fun.logmaxscore.ts <- function(d,a1, b1,size,omega,delta, time, sim,maxit=100)
{
test=matrix(0,nrow=3*size,ncol=sim)
for (i in 1:sim)
{
print(i)
Response <- loglinear.ts.ts(d,a1,b1,size,omega, delta, time )[,1]
LY=log(Response+1)
#X=rep(0, length(Response))
#for (i in 1:length(Response))
#{
#X[t]=(delta**(t-time))*I(t >= time)
#}
start=glm(Response[2:length(Response)]~ LY[1:(length(Response)-1)], family=poisson)$coef
results2=optim(likloglinear.poisson, p=c(start[1], 0, start[2]),
data=Response, scoreloglinear.poisson , method="BFGS",control=list(maxit=maxit))
parameters1= results2$par
for (j in 3:(size-2)){
test[j,i]=t(scoreloglinear.poisson.ts(c(parameters1,0), Response, 0, j))%*% solve(information1.logpoisson.ts(c(parameters1,0),
Response, 0, j))%*%scoreloglinear.poisson.ts(c(parameters1,0), Response, 0, j)
test[size+j,i]=t(scoreloglinear.poisson.ts(c(parameters1,0), Response, delta, j))%*% solve(information1.logpoisson.ts(c(parameters1,0),
Response, delta, j))%*%scoreloglinear.poisson.ts(c(parameters1,0), Response, delta, j)
test[2*size+j,i]=t(scoreloglinear.poisson.ts(c(parameters1,0), Response, 1, j))%*% solve(information1.logpoisson.ts(c(parameters1,0),
Response, 1, j))%*%scoreloglinear.poisson.ts(c(parameters1,0), Response, 1, j)
}}
return(test)
}

##################### Version with initialization from marginal mean
sim.fun.logmaxscore.ts <- function(d,a1, b1,size,omega,delta, time, sim,maxit=100)
{
test=matrix(0,nrow=3*size,ncol=sim)
for (i in 1:sim)
{
print(i)
Response <- loglinear.ts.ts(d,a1,b1,size,omega, delta, time )[,1]
LY=log(Response+1)
#X=rep(0, length(Response))
#for (i in 1:length(Response))
#{
#X[t]=(delta**(t-time))*I(t >= time)
#}
start=glm(Response[2:length(Response)]~ LY[1:(length(Response)-1)], family=poisson)$coef
ui=matrix(0,nrow=4,ncol=3)
ui[1,2]=1
ui[1,3]=1
ui[2,2]=-1
ui[2,3]=-1
ui[3,2]=1
ui[4,2]=-1
ci=c(-1,-1,-1,-1)
#print("ja")
results2=constrOptim( theta=c(start[1], 0, max(-0.99,min(start[2],0.99))),likloglinear.poisson,ui,ci,
data=Response, grad=scoreloglinear.poisson , method="BFGS",control=list(maxit=maxit))
parameters1= results2$par
deriv=rep(0,3)
y=loglinear.ts.ts(parameters1[1],parameters1[2],parameters1[3],20000, 0, 0, 100)
mu=mean(y[,1])
y=loglinear.ts.ts((parameters1[1]+0.05), parameters1[2],parameters1[3],20000, 0, 0, 100)
deriv[1]=(mean(y[,1])-mu)/0.05
y=loglinear.ts.ts(parameters1[1], (parameters1[2]-0.05),parameters1[3],20000, 0, 0, 100)
deriv[2]=-(mean(y[,1])-mu)/0.05
third=rep(NA, times=length(data))
y=loglinear.ts.ts(parameters1[1], parameters1[2],(parameters1[3]-0.05),20000, 0, 0, 100)
deriv[3]=-(mean(y[,1])-mu)/0.05
for (j in 3:(size-2)){
t1v=scoreloglinear.poisson.ts(c(parameters1,0), Response, 0, j,mu,deriv)
test[j,i]=t(t1v)%*% solve(information1.logpoisson.ts(c(parameters1,0),Response, 0, j,mu,deriv))%*%t1v
t1v=scoreloglinear.poisson.ts(c(parameters1,0), Response, delta, j,mu,deriv)
test[size+j,i]=t(t1v)%*% solve(information1.logpoisson.ts(c(parameters1,0),Response, delta, j,mu,deriv))%*%t1v
t1v=scoreloglinear.poisson.ts(c(parameters1,0), Response, 1, j,mu,deriv)
test[2*size+j,i]=t(t1v)%*% solve(information1.logpoisson.ts(c(parameters1,0),Response, 1, j,mu,deriv))%*%t1v
}}
return(test)
}



###############################################################################
####################################################################
#### FUNCTION FOR BOOTSTRAP TEST ###################################
####################################################################
bootstrap.main=function(d,a1, b1,size,omega,delta, time, sim,maxit=40,brep=200){
testres=matrix(0,nrow=3*size,ncol=sim)
for (i in 1:sim)
{
print(i)
Response <- loglinear.ts.ts(d,a1,b1,size,omega, delta, time )[,1]
testres[,i]=bootsloglinmod(dataset=Response,delta=delta, brep=brep,maxit=maxit)
}
testres}

bootsloglinmod<-function(dataset,delta=0.8, brep=500,maxit=40){
n=length(dataset)
LY=log(dataset+1)
ui=matrix(0,nrow=4,ncol=3)
ui[1,2]=1
ui[1,3]=1
ui[2,2]=-1
ui[2,3]=-1
ui[3,2]=1
ui[4,2]=-1
ci=c(-1,-1,-1,-1)
time=2:n
# matrix for storing the values of the test statistics
scoreao=matrix(0, ncol=n,nrow=brep+1)
scorets=scoreao
scorels=scoreao
detect=rep(NA,3*n)
pvalues=rep(NA,3*n)
# obtain initial estimates 
start=glm(dataset[2:n]~ LY[1:(n-1)], family=poisson)$coef
#results2=optim(likloglinear.poisson, p=c(start[1], 0, start[2]),
#data=dataset, scoreloglinear.poisson , method="BFGS",control=list(maxit=maxit))
results2=constrOptim( theta=c(start[1], 0, max(-0.99,min(start[2],0.99))),likloglinear.poisson,ui,ci,
data=dataset, grad=scoreloglinear.poisson , method="BFGS",outer.iterations=maxit)
parameters1= results2$par
deriv=rep(0,3)
y=loglinear.ts.ts(parameters1[1],parameters1[2],parameters1[3],20000, 0, 0, 100)
mu=mean(y[,1])
y=loglinear.ts.ts((parameters1[1]+0.05), parameters1[2],parameters1[3],20000, 0, 0, 100)
deriv[1]=(mean(y[,1])-mu)/0.05
y=loglinear.ts.ts(parameters1[1], (parameters1[2]-0.05),parameters1[3],20000, 0, 0, 100)
deriv[2]=-(mean(y[,1])-mu)/0.05
third=rep(NA, times=length(data))
y=loglinear.ts.ts(parameters1[1], parameters1[2],(parameters1[3]-0.05),20000, 0, 0, 100)
deriv[3]=-(mean(y[,1])-mu)/0.05
for (t in 3:(n-2)){
scoreao[1,t]=t(scoreloglinear.poisson.ts(c(parameters1,0), dataset, 0, t,mu,deriv))%*% solve(information1.logpoisson.ts(c(parameters1,0),
  dataset, 0, t,mu,deriv))%*%scoreloglinear.poisson.ts(c(parameters1,0), dataset, 0, t,mu,deriv)
scorets[1,t]=t(scoreloglinear.poisson.ts(c(parameters1,0), dataset, delta=.8, t,mu,deriv))%*% solve(information1.logpoisson.ts(c(parameters1,0),
  dataset, delta=.8, t,mu,deriv))%*%scoreloglinear.poisson.ts(c(parameters1,0), dataset, delta=0.8, t,mu,deriv)
scorels[1,t]=t(scoreloglinear.poisson.ts(c(parameters1,0), dataset, 1, t,mu,deriv))%*% solve(information1.logpoisson.ts(c(parameters1,0),
  dataset, 1, t,mu,deriv))%*%scoreloglinear.poisson.ts(c(parameters1,0), dataset, 1, t,mu,deriv)
}
scoreao[1,1]=max(scoreao[1,2:n])
scorets[1,1]=max(scorets[1,2:n])
scorels[1,1]=max(scorels[1,2:n])
scoreao[1,2]=which(scoreao[1,2:n]==max(scoreao[1,2:n]))[1]+1
scorets[1,2]=which(scorets[1,2:n]==max(scorets[1,2:n]))[1]+1
scorels[1,2]=which(scorels[1,2:n]==max(scorels[1,2:n]))[1]+1
# generate bootstrap replicates and obtain the corresponding test statistics
for (j in 1:brep){
    print(j)
    data.test <- loglinear.ts.ts(parameters1[1],parameters1[2],parameters1[3],n,0, 0, 10)[,1]
#    LY=log(data.test+1)
#    start=glm(data.test[2:n]~ LY[1:(n-1)], family=poisson)$coef
#    results2=optim(likloglinear.poisson, p=c(start[1], 0, start[2]),
#    data=data.test, scoreloglinear.poisson , method="BFGS",control=list(maxit=maxit))
#    parameters1= results2$par
    for (t in 3:(n-2)){
       scoreao[(j+1),t]=t(scoreloglinear.poisson.ts(c(parameters1,0), data.test, 0, t,mu,deriv))%*% solve(information1.logpoisson.ts(c(parameters1,0),
                 data.test, 0, t,mu,deriv))%*%scoreloglinear.poisson.ts(c(parameters1,0), data.test, 0, t,mu,deriv)
       scorets[(j+1),t]=t(scoreloglinear.poisson.ts(c(parameters1,0), data.test, delta, t,mu,deriv))%*%solve(information1.logpoisson.ts(c(parameters1,0),
        data.test, delta, t,mu,deriv))%*%scoreloglinear.poisson.ts(c(parameters1,0), data.test, delta, t,mu,deriv)
       scorels[(j+1),t]=t(scoreloglinear.poisson.ts(c(parameters1,0), data.test, 1, t,mu,deriv))%*% solve(information1.logpoisson.ts(c(parameters1,0),
     data.test, 1, t,mu,deriv))%*%scoreloglinear.poisson.ts(c(parameters1,0), data.test, 1, t,mu,deriv)
    }
    scoreao[(j+1),1]=max(scoreao[(j+1),])
    scorets[(j+1),1]=max(scorets[(j+1),])
    scorels[(j+1),1]=max(scorels[(j+1),])
 }
for (t in 1:n){
 detect[t]=length(which(scoreao[2:(brep+1),t]>scoreao[1,t]))
 detect[n+t]=length(which(scorets[2:(brep+1),t]>scorets[1,t]))
 detect[2*n+t]=length(which(scorels[2:(brep+1),t]>scorels[1,t]))
}
detect[2]=scoreao[1,2]
detect[n+2]=scorets[1,2]
detect[2*n+2]=scorels[1,2]
pvalues=detect/brep
print("SO individually significant at times:")
print(which(pvalues[1:n]<0.05))
print("with corresponding p-values")
print(pvalues[which(pvalues[1:n]<0.05)])
print("TS individually significant at times")
print(which(pvalues[(n+1):(2*n)]<0.05))
print("with corresponding p-values")
print(pvalues[which(pvalues[(n+1):(2*n)]<0.05)])
print("LS individually significant at times")
print(which(pvalues[(2*n+1):(3*n)]<0.05))
print("with corresponding p-values")
print(pvalues[which(pvalues[(2*n+1):(3*n)]<0.05)])
if (pvalues[2*n+1]<=min(pvalues[1],detect[2*n+1],0.05)){
  print("Globally level shift detected at time: ")
  print(scorels[1,2])
  #print(c(which(detect[(2*n+1):(3*n)]==detect[(2*n+1)],pvalues[which(pvalues[(2*n+1):(3*n)]==min(pvalues[(2*n+1):(3*n)]))])))
  tau=which(detect[(2*n+1):(3*n)]==detect[2*n+1])-2*n
  delta=1
}else{if (pvalues[n+1]<=min(pvalues[1],0.05)){
  print("Globally transient shift with delta=0.8 detected at time: ")
  #print(c(which(detect[(n+1):(2*n)]==detect[n+1],pvalues[which(pvalues[(n+1):(2*n)]==min(pvalues[(n+1):(2*n)]))])))
   print(scorets[1,2])
  tau=which(detect[(n+1):(2*n)]==detect[n+1])-n
  delta=0.8}
else{if(pvalues[1]<=0.05){
  print("Globally spiky outlier with delta=0 detected at time: ")
  #print(c(which(detect[(1:n)]==detect[1],pvalues[which(pvalues[1:n]==min(pvalues[(1:n)]))])))
  print(scoreao[1,2])
  tau=which(detect[1:n]==detect[1])
  delta=0
}}}
detect
}







########### Bootstrap test for seasonal model #######################
##########
bootsloglinmod<-function(dataset,delta=0.8, brep=500,maxit=40,lag=1){
n=length(dataset)
LY=log(dataset+1)
ui=matrix(0,nrow=4,ncol=3)
ui[1,2]=1
ui[1,3]=1
ui[2,2]=-1
ui[2,3]=-1
ui[3,2]=1
ui[4,2]=-1
ci=c(-1,-1,-1,-1)
time=(lag+1):n
# matrix for storing the values of the test statistics
scoreao=matrix(0, ncol=n,nrow=brep+1)
scorets=scoreao
scorels=scoreao
detect=rep(NA,3*n)
pvalues=rep(NA,3*n)
# obtain initial estimates 
start=glm(dataset[time]~ LY[time-1], family=poisson)$coef
#results2=optim(likloglinear.poisson, p=c(start[1], 0, start[2]),
#data=dataset, scoreloglinear.poisson , method="BFGS",control=list(maxit=maxit))
results2=constrOptim( theta=c(start[1], 0, max(-0.99,min(start[2],0.99))),likloglinear.poisson.seas,ui,ci,
data=dataset, lag=13,grad=scoreloglinear.poisson.seas , method="BFGS",outer.iterations=maxit)
parameters1= results2$par
deriv=rep(0,3)
y=loglinear.ts.ts.seas(parameters1[1],parameters1[2],parameters1[3],lag,20000, 0, 0, 100)
mu=mean(y[,1])
y=loglinear.ts.ts.seas((parameters1[1]+0.05), parameters1[2],parameters1[3],lag,20000, 0, 0, 100)
deriv[1]=(mean(y[,1])-mu)/0.05
y=loglinear.ts.ts.seas(parameters1[1], (parameters1[2]-0.05),parameters1[3],lag,20000, 0, 0, 100)
deriv[2]=-(mean(y[,1])-mu)/0.05
third=rep(NA, times=length(data))
y=loglinear.ts.ts.seas(parameters1[1], parameters1[2],(parameters1[3]-0.05),lag,20000, 0, 0, 100)
deriv[3]=-(mean(y[,1])-mu)/0.05
for (t in 3:(n-2)){
scoreao[1,t]=t(scoreloglinear.poisson.ts.seas(c(parameters1,0), dataset,lag, 0, t,mu,deriv))%*% ginv(information1.logpoisson.ts.seas(c(parameters1,0),
  dataset, lag, 0, t,mu,deriv))%*%scoreloglinear.poisson.ts.seas(c(parameters1,0), dataset, lag,0, t,mu,deriv)
scorets[1,t]=t(scoreloglinear.poisson.ts.seas(c(parameters1,0), dataset, lag,delta=0.8, t,mu,deriv))%*% ginv(information1.logpoisson.ts.seas(c(parameters1,0),
  dataset, lag,delta=0.8, t,mu,deriv))%*%scoreloglinear.poisson.ts.seas(c(parameters1,0), dataset, lag,delta=0.8, t,mu,deriv)
scorels[1,t]=t(scoreloglinear.poisson.ts.seas(c(parameters1,0), dataset,lag, 1, t,mu,deriv))%*% ginv(information1.logpoisson.ts.seas(c(parameters1,0),
  dataset,lag, 1, t,mu,deriv))%*%scoreloglinear.poisson.ts.seas(c(parameters1,0), dataset, lag,1, t,mu,deriv)
}
scoreao[1,1]=max(scoreao[1,2:n])
scorets[1,1]=max(scorets[1,2:n])
scorels[1,1]=max(scorels[1,2:n])
# generate bootstrap replicates and obtain the corresponding test statistics
for (j in 1:brep){
    print(j)
    data.test <- loglinear.ts.ts.seas(parameters1[1],parameters1[2],parameters1[3],lag,n,0, 0, 10)[,1]
#    LY=log(data.test+1)
#    start=glm(data.test[2:n]~ LY[1:(n-1)], family=poisson)$coef
#    results2=optim(likloglinear.poisson, p=c(start[1], 0, start[2]),
#    data=data.test, scoreloglinear.poisson , method="BFGS",control=list(maxit=maxit))
#    parameters1= results2$par
    for (t in 3:(n-2)){
       scoreao[(j+1),t]=t(scoreloglinear.poisson.ts.seas(c(parameters1,0), data.test, lag,0, t,mu,deriv))%*% ginv(information1.logpoisson.ts.seas(c(parameters1,0),
                 data.test,lag, 0, t,mu,deriv))%*%scoreloglinear.poisson.ts.seas(c(parameters1,0), data.test, lag,0, t,mu,deriv)
       scorets[(j+1),t]=t(scoreloglinear.poisson.ts.seas(c(parameters1,0), data.test, lag,delta, t,mu,deriv))%*%ginv(information1.logpoisson.ts.seas(c(parameters1,0),
        data.test,lag, delta, t,mu,deriv))%*%scoreloglinear.poisson.ts.seas(c(parameters1,0), data.test,lag, delta, t,mu,deriv)
       scorels[(j+1),t]=t(scoreloglinear.poisson.ts.seas(c(parameters1,0), data.test, lag,1, t,mu,deriv))%*% ginv(information1.logpoisson.ts.seas(c(parameters1,0),
     data.test,lag, 1, t,mu,deriv))%*%scoreloglinear.poisson.ts.seas(c(parameters1,0), data.test, lag,1, t,mu,deriv)
    }
    scoreao[(j+1),1]=max(scoreao[(j+1),])
    scorets[(j+1),1]=max(scorets[(j+1),])
    scorels[(j+1),1]=max(scorels[(j+1),])
}
for (t in 1:n){
 detect[t]=length(which(scoreao[2:(brep+1),t]>scoreao[1,t]))
 detect[n+t]=length(which(scorets[2:(brep+1),t]>scorets[1,t]))
 detect[2*n+t]=length(which(scorels[2:(brep+1),t]>scorels[1,t]))
}
pvalues=detect/brep
print("SO individually significant at times:")
print(which(pvalues[1:n]<0.05))
print("with corresponding p-values")
print(pvalues[which(pvalues[1:n]<0.05)])
print("TS individually significant at times")
print(which(pvalues[(n+1):(2*n)]<0.05))
print("with corresponding p-values")
print(pvalues[which(pvalues[(n+1):(2*n)]<0.05)])
print("LS individually significant at times")
print(which(pvalues[(2*n+1):(3*n)]<0.05))
print("with corresponding p-values")
print(pvalues[which(pvalues[(2*n+1):(3*n)]<0.05)])
if (pvalues[2*n+1]<=min(pvalues[1],detect[2*n+1],0.05)){
  print("Globally level shift detected at time: ")
  print(c(which(detect[(2*n+1):(3*n)]==detect[(2*n+1)],pvalues[which(pvalues[(2*n+1):(3*n)]==min(pvalues[(2*n+1):(3*n)]))])))
  tau=which(detect[(2*n+1):(3*n)]==detect[2*n+1])-2*n
  delta=1
}else{if (pvalues[n+1]<=min(pvalues[1],0.05)){
  print("Globally transient shift with delta=0.8 detected at time: ")
  print(c(which(detect[(n+1):(2*n)]==detect[n+1],pvalues[which(pvalues[(n+1):(2*n)]==min(pvalues[(n+1):(2*n)]))])))
  tau=which(detect[(n+1):(2*n)]==detect[n+1])-n
  delta=0.8}
else{if(pvalues[1]<=0.05){
  print("Globally spiky outlier with delta=0 detected at time: ")
  print(c(which(detect[(1:n)]==detect[1],pvalues[which(pvalues[1:n]==min(pvalues[(1:n)]))])))
  tau=which(detect[1:n]==detect[1])
  delta=0
}}}
detect
}

 



###########################################################################################################
########### function for fitting loglinear model with intervention effect and data cleaning ###############
###########################################################################################################
tsestimateloglinmod<-function(dataset,delta,tau,maxit=40){
n=length(dataset)
LY=log(dataset+1)
ui=matrix(0,nrow=4,ncol=4)
ui[1,2]=1
ui[1,3]=1
ui[2,2]=-1
ui[2,3]=-1
ui[3,2]=1
ui[4,2]=-1
ci=c(-1,-1,-1,-1)
time=2:n
x=rep(0, n)
x[tau:n]=delta**(0:(n-tau))
# obtain initial estimates 
start=glm(dataset[2:n]~ LY[1:(n-1)]+x[2:n], family=poisson)$coef
#results2=optim(likloglinear.poisson, p=c(start[1], 0, start[2]),
#data=dataset, scoreloglinear.poisson , method="BFGS",control=list(maxit=maxit))
results2=constrOptim( theta=c(start[1], 0, max(-0.99,min(start[2],0.99)),start[3]),likloglinear.poisson.ts,ui,ci,delta=delta,time=tau,data=dataset, grad=scoreloglinear.poisson.tsopt, method="BFGS",outer.iterations=maxit)
parameters1= results2$par
if (sum(parameters1[2:3])>0.99){
parameters1[2:3]=parameters1[2:3]/(sum(parameters1[2:3])+0.01)}
print(parameters1)
#print(diag(ginv(information1.logpoisson.tsopt.seas)))
dataset1=cleanloglinseries(dataset,tau,x,coeffi=parameters1)
}


####################################
###### FUNCTION FOR DATA CLEANING ##
####################################
cleanloglinseries<-function(dataset,tau,x,coeffi){
n=length(dataset)
C.est=rep(0,n)
mu.est=C.est
nu.est=C.est
nu.est[1]=coeffi[1]/(1-coeffi[2]-coeffi[3])
for (t in 2:(tau-1)){
nu.est[t]=coeffi[1]+coeffi[2]*nu.est[t-1]+coeffi[3]*dataset[t-1]
}
y.est=dataset
mu.est=x*coeffi[4]
nu.est[tau]=coeffi[1]+coeffi[2]*nu.est[t-1]+coeffi[3]*y.est[t-1]
y.est[tau]=round(dataset[tau]/exp(mu.est[tau]))
for (t in (tau+1):n){
mu.est[t]=mu.est[t]+coeffi[2]*mu.est[t-1]+coeffi[3]*(log(1+C.est[t-1]/(y.est[t-1]+1)))
nu.est[t]=coeffi[1]+coeffi[2]*nu.est[t-1]+coeffi[3]*y.est[t-1]
y.est[t]=round(dataset[t]/exp(mu.est[t]))
C.est[t]=dataset[t]-y.est[t]
}
cbind(y.est)}


####################################################################################################################
########### function for fitting seasonal loglinear model with intervention effect and data cleaning ###############
####################################################################################################################
tsestimateloglinmod.seas<-function(dataset,lag,delta,tau,maxit=40){
n=length(dataset)
LY=log(dataset+1)
ui=matrix(0,nrow=4,ncol=4)
ui[1,2]=1
ui[1,3]=1
ui[2,2]=-1
ui[2,3]=-1
ui[3,2]=1
ui[4,2]=-1
ci=c(-1,-1,-1,-1)
time=2:n
x=rep(0, n)
x[tau:n]=delta**(0:(n-tau))
# obtain initial estimates 
start=glm(dataset[(lag+1):n]~ LY[lag:(n-1)]+x[(lag+1):n], family=poisson)$coef
#results2=optim(likloglinear.poisson, p=c(start[1], 0, start[2]),
#data=dataset, scoreloglinear.poisson , method="BFGS",control=list(maxit=maxit))
results2=constrOptim( theta=c(start[1], 0, max(-0.99,min(start[2],0.99)),start[3]),likloglinear.poisson.ts.seas,ui,ci,
lag=lag,delta=delta,time=tau,data=dataset, grad=scoreloglinear.poisson.tsopt.seas, method="BFGS",outer.iterations=maxit)
parameters1= results2$par
if (sum(parameters1[2:3])>0.99){
parameters1[2:3]=parameters1[2:3]/(sum(parameters1[2:3])+0.01)}
print(parameters1)
print(sqrt(diag(ginv(information1.logpoisson.tsopt.seas(theta=parameters1, data=dataset,lag=lag,delta=delta,time=tau)))))
dataset1=cleanloglinseries.seas(dataset,lag,tau,x,coeffi=parameters1)
}

#####################################
#### FUNCTION FOR SEASONAL DATA CLEANING
#####################################
cleanloglinseries.seas<-function(dataset,lag,tau,x,coeffi){
n=length(dataset)
C.est=rep(0,n)
mu.est=C.est
nu.est=C.est
y=loglinear.ts.ts.seas(coeffi[1],coeffi[2],coeffi[3],lag,20000, 0, 0, 100)
mu=mean(y[,1])
nu.est[1:lag]=mu
for (t in (lag+1):(tau-1)){
nu.est[t]=coeffi[1]+coeffi[2]*nu.est[t-lag]+coeffi[3]*log(dataset[t-1]+1)
}
y.est=dataset
mu.est=x*coeffi[4]
nu.est[tau]=coeffi[1]+coeffi[2]*nu.est[t-lag]+coeffi[3]*y.est[t-1]
y.est[tau]=round(dataset[tau]/exp(mu.est[tau]))
for (t in (tau+1):n){
mu.est[t]=mu.est[t]+coeffi[2]*mu.est[t-lag]+coeffi[3]*(log(1+C.est[t-1]/(y.est[t-1]+1)))
nu.est[t]=coeffi[1]+coeffi[2]*nu.est[t-lag]+coeffi[3]*log(y.est[t-1]+1)
y.est[t]=round(dataset[t]/exp(mu.est[t]))
C.est[t]=dataset[t]-y.est[t]
}
cbind(y.est)}

###############################################################################
###############################################################################
#############Function to simulate a log--linear model with an additive outlier
################################################################################

loglinear.ts.ao <- function(d, a1,b1,size, omega,time)
{
       y            <-  rep(NA, size)
       mu           <-  rep(NA, size)
       theta        <-  rep(NA, size)
       theta[1]     <-  0
       mu[1]        <-  1 ####initial value
       y[1]         <-  rpois(1, mu[1])
for (t in 2:size){
                   theta[t]  <- d+a1*theta[t-1]+b1*log(1+y[t-1])+omega*I(t == time)
                   mu[t]     <- exp(theta[t])
                   y[t]      <- rpois(1, mu[t])
}
return(cbind(y,mu))
}

#######################################################################
#######################################################################
#####################Score function for the log--linear model with an
#####################additive outlier
#########################################################################

scoreloglinear.poisson.ao <- function(theta, data, time)
{
theta1=rep(NA, times=length(data))
theta1[1]=1
first=rep(NA, times=length(data))
first[1]=1
second=rep(NA, times=length(data))
second[1]=1
third=rep(NA, times=length(data))
third[1]=1
fourth=rep(NA, times=length(data))
fourth[1]=1
s1=rep(NA, times=length(data))
s2=rep(NA, times=length(data))
s3=rep(NA, times=length(data))
s4=rep(NA, times=length(data))
ldata=log(data+1)
for (t in 2:length(data))
{
theta1[t]=theta[1]+theta[2]*theta1[t-1]+theta[3]*ldata[t-1]+theta[4]*I(t == time)
first[t]= (1+theta[2]*first[t-1])
second[t]=(theta1[t-1]+theta[2]*second[t-1])
third[t]=(ldata[t-1]+theta[2]*third[t-1])
fourth[t]=theta[2]*fourth[t-1]+I(t == time)
s1[t]=-( (data[t]-exp(theta1[t])))*first[t]
s2[t]=-( (data[t]-exp(theta1[t])))*second[t]
s3[t]=-( (data[t]-exp(theta1[t])))*third[t]
s4[t]=-( (data[t]-exp(theta1[t])))*fourth[t]
}
ss1=sum(s1[-1])
ss2=sum(s2[-1])
ss3=sum(s3[-1])
ss4=sum(s4[-1])
score=c(ss1,ss2,ss3,ss4)
}

##########################################################################################
##########################################################################################
######################Information Matrix with a transient shift.
##################################################


information1.logpoisson.ao <- function(theta, data,time)
{
theta1=rep(NA, times=length(data))
theta1[1]=1
first=rep(NA, times=length(data))
first[1]=1
second=rep(NA, times=length(data))
second[1]=1
third=rep(NA, times=length(data))
third[1]=1
fourth=rep(NA, times=length(data))
fourth[1]=0
Information <- matrix(0, nrow=4, ncol=4)
s1=rep(NA, times=length(data))
s2=rep(NA, times=length(data))
s3=rep(NA, times=length(data))
s4=rep(NA, times=length(data))
for (t in 2:length(data))
{
theta1[t]=theta[1]+theta[2]*theta1[t-1]+theta[3]*log(data[t-1]+1)+theta[4]*I(t == time)
first[t]= (1+theta[2]*first[t-1])
second[t]=(theta1[t-1]+theta[2]*second[t-1])
third[t]=(log(data[t-1]+1)+theta[2]*third[t-1])
fourth[t]=theta[2]*fourth[t-1]+I(t == time)
s1[t]=-first[t]
s2[t]=-second[t]
s3[t]=-third[t]
s4[t]= -fourth[t]
var.comp= (exp(theta1[t]/2))*c(s1[t], s2[t], s3[t], s4[t])
Information=Information+var.comp%*%t(var.comp)
}
return(Information)
}

###########################################################################
##########################################################################

sim.fun.logscore.ao <- function(d,a1, b1,size,omega,time, sim)
{
test=rep(NA,sim)
for (i in 1:sim)
{
Response <- loglinear.ts.ao(d,a1,b1,size,omega, time )[,1]
LY=log(Response+1)
start=glm(Response[2:length(Response)]~ LY[1:(length(Response)-1)], family=poisson)$coef
results2=optim(likloglinear.poisson, p=c(start[1], 0, start[2]),
data=Response, scoreloglinear.poisson , method="BFGS")
parameters1= results2$par
test[i]=t(scoreloglinear.poisson.ao(c(parameters1,0), Response, time))%*% solve(information1.logpoisson.ao(c(parameters1,0),
Response, time))%*%scoreloglinear.poisson.ao(c(parameters1,0), Response, time)
}
return(test)
}