if (FALSE) {
## data generating
set.seed(1974)
N <- 30
T <- 80
NT <- N*T
## true parameter values
true.beta <- c(1, 1)
true.sigma <- 3
x1 <- rnorm(NT)
x2 <- runif(NT, 2, 4)
## group-specific breaks
break.point = rep(T/2, N); break.sigma=c(rep(1, N));
break.list <- rep(1, N)
X <- as.matrix(cbind(x1, x2), NT, );
y <- rep(NA, NT)
id <- rep(1:N, each=NT/N)
K <- ncol(X);
true.beta <- as.matrix(true.beta, K, 1)
## compute the break probability
ruler <- c(1:T)
W.mat <- matrix(NA, T, N)
for (i in 1:N){
W.mat[, i] <- pnorm((ruler-break.point[i])/break.sigma[i])
}
Weight <- as.vector(W.mat)
## draw time-varying individual effects and sample y
j = 1
true.sigma.alpha <- 30
true.alpha1 <- true.alpha2 <- rep(NA, N)
for (i in 1:N){
Xi <- X[j:(j+T-1), ]
true.mean <- Xi %*% true.beta
weight <- Weight[j:(j+T-1)]
true.alpha1[i] <- rnorm(1, 0, true.sigma.alpha)
true.alpha2[i] <- -1*true.alpha1[i]
y[j:(j+T-1)] <- ((1-weight)*true.mean + (1-weight)*rnorm(T, 0, true.sigma) +
(1-weight)*true.alpha1[i]) +
(weight*true.mean + weight*rnorm(T, 0, true.sigma) + weight*true.alpha2[i])
j <- j + T
}
## extract the standardized residuals from the OLS with fixed-effects
FEols <- lm(y ~ X + as.factor(id) -1 )
resid.all <- rstandard(FEols)
time.id <- rep(1:80, N)
## model fitting
G <- 100
BF <- testpanelSubjectBreak(subject.id=id, time.id=time.id,
resid= resid.all, max.break=3, minimum = 10,
mcmc=G, burnin = G, thin=1, verbose=G,
b0=0, B0=1/100, c0=2, d0=2, Time = time.id)
## get the estimated break numbers
estimated.breaks <- make.breaklist(BF, threshold=3)
## model fitting
out <- HMMpanelFE(subject.id = id, y, X=X, m = estimated.breaks,
mcmc=G, burnin=G, thin=1, verbose=G,
b0=0, B0=1/100, c0=2, d0=2, delta0=0, Delta0=1/100)
## print out the slope estimate
## true values are 1 and 1
summary(out)
## compare them with the result from the constant fixed-effects
summary(FEols)
}
Run the code above in your browser using DataLab